{-# LANGUAGE DeriveDataTypeable #-}
-- |
-- Module : cabal2arch: convert cabal packages to Arch Linux PKGBUILD format
-- Copyright : (c) Don Stewart, 2008 .. 2010
-- License : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--
-- TODO: if build-type: Configure, accurate C library dependecies
-- require downloading the source, and running configure
--
-- C libraries are dynamically linked, should be listed in depends,
-- rather than makedepends
import Distribution.PackageDescription.Parse
import Distribution.PackageDescription
import Distribution.Simple.Utils hiding (die)
import Distribution.Verbosity
import Distribution.Text
-- from the archlinux package:
import Distribution.ArchLinux.PkgBuild
import Distribution.ArchLinux.CabalTranslation
import Distribution.ArchLinux.SystemProvides
import Distribution.ArchLinux.HackageTranslation
import Control.Monad
import Control.Concurrent
import qualified Control.Exception as CE
import Data.List
import qualified Data.ByteString.Lazy as Bytes
import Text.PrettyPrint
import Paths_cabal2arch
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Process hiding(cwd)
import System.Console.CmdArgs
data CmdLnArgs
= CmdLnConvertOne { argCabalFile :: String, argCreateTar :: Bool }
| CmdLnConvertMany { argPkgList :: FilePath, argTarBall :: FilePath, argRepo :: FilePath }
deriving (Data, Typeable)
cmdLnConvertOne :: CmdLnArgs
cmdLnConvertOne = CmdLnConvertOne
{ argCabalFile = "" &= argPos 0 &= typ "FILE|DIR|URL"
, argCreateTar = False &= name "tar" &= explicit &= help "Create a tar-ball for the source package."
} &= auto &= name "conv" &= help "Convert a single CABAL file."
cmdLnConvertMany :: CmdLnArgs
cmdLnConvertMany = CmdLnConvertMany
{ argPkgList = def &= argPos 0 &= typFile
, argTarBall = def &= argPos 1 &= typFile
, argRepo = def &= argPos 2 &= typDir
} &= name "convtar" &= help "Convert a tarball of CABAL files into an ABS tree."
&= details
[ " cabal2arch convtar list tar abs"
, "'list' is a file consisting of lines of the form \"<pkg name> <version>\"."
, "'tar' is a tar ball of package descriptions (CABAL files) like the one published on Hackage:", " http://hackage.haskell.org/packages/archive/00-index.tar.gz"
, "'abs' is a directory where the ABS tree will be created."
]
cmdLnArgs :: CmdLnArgs
cmdLnArgs = modes [cmdLnConvertOne, cmdLnConvertMany]
&= program "cabal2arch"
&= summary "cabal2arch: Convert .cabal file to ArchLinux source package"
main :: IO ()
main = cmdArgs cmdLnArgs >>= subCmd
subCmd :: CmdLnArgs -> IO ()
subCmd (CmdLnConvertOne cabalLoc createTar) =
CE.bracket
-- We do all our work in a temp directory
(do _cwd <- getCurrentDirectory
etmp <- myReadProcess "mktemp" ["-d"] []
case etmp of
Left _ -> die "Unable to create temp directory"
Right d -> do
let dir = makeValid (init d) -- drop newline
setCurrentDirectory dir
return (dir, _cwd))
-- Always remember to clean up
(\(d, _cwd) -> do
setCurrentDirectory _cwd
removeDirectoryRecursive d)
-- Now, get to work:
$ \(tmp, _cwd) -> do
-- myArgs <- cmdArgs cmdLnArgs
email <- do
r <- getEnvMaybe "ARCH_HASKELL"
case r of
Nothing -> do
hPutStrLn stderr "Warning: ARCH_HASKELL environment variable not set. Set this to the maintainer contact you wish to use. \n E.g. 'Arch Haskell Team <arch-haskell@haskell.org>'"
return []
Just s -> return s
cabalfile <- findCabalFile cabalLoc _cwd tmp
hPutStrLn stderr $ "Using " ++ cabalfile
cabalsrc <- readPackageDescription normal cabalfile
-- Create a package description with all configurations resolved.
sysProvides <- getDefaultSystemProvides
let finalcabal = preprocessCabal cabalsrc sysProvides
finalcabal' <- case finalcabal of
Nothing -> die "Aborting..."
Just f -> return f
let (pkgbuild', hooks) = cabal2pkg finalcabal' sysProvides
apkgbuild' <- getMD5 pkgbuild'
let apkgbuild = apkgbuild' { pkgBuiltWith = Just version }
pkgbuild = pkgBody apkgbuild
doc = pkg2doc email apkgbuild
dir = arch_pkgname pkgbuild
setCurrentDirectory _cwd
createDirectoryIfMissing False dir
setCurrentDirectory dir
writeFile "PKGBUILD" (render doc ++ "\n")
-- print pkgname.install
case hooks of
Nothing -> return ()
Just i -> writeFile (install_hook_name (arch_pkgname pkgbuild)) i
setCurrentDirectory _cwd
_ <- system $ "rm -rf " ++ dir </> "{pkg,src,*.tar.gz}"
when createTar $ do
tarred <- myReadProcess "tar" ["-zcvvf",(dir <.> "tar.gz"), dir] []
case tarred of
Left (_,s,_) -> do
hPutStrLn stderr s
die "Unable to tar package"
Right _ -> putStrLn ("Created " ++ (_cwd </> dir <.> "tar.gz"))
-- If the user created a .cabal2arch.log file, append log results there.
mh <- getEnvMaybe "HOME"
case mh of
Nothing -> return ()
Just home -> do
b <- doesFileExist $ home </> ".cabal2arch.log"
if not b
then return ()
else do
-- Log to build file.
appendFile (home </> ".cabal2arch.log") $ (show $ (,,)
(arch_pkgname pkgbuild ++ "-" ++ (display $ arch_pkgver pkgbuild))
(arch_pkgdesc pkgbuild)
(arch_url pkgbuild)) ++ "\n"
subCmd (CmdLnConvertMany pkgListLoc tarballLoc repoLoc) = do
pkglist <- readFile pkgListLoc
tarball <- Bytes.readFile tarballLoc
repo <- canonicalizePath repoLoc
email <- do
r <- getEnvMaybe "ARCH_HASKELL"
case r of
Nothing -> do
hPutStrLn stderr "Warning: ARCH_HASKELL environment variable not set. Set this to the maintainer contact you wish to use. \n E.g. 'Arch Haskell Team <arch-haskell@haskell.org>'"
return []
Just s -> return s
sysProvides <- getDefaultSystemProvides
let cabals = getSpecifiedCabalsFromTarball tarball (lines pkglist)
mapM_ (exportPackage repo email sysProvides) cabals
exportPackage :: FilePath -> String -> SystemProvides -> GenericPackageDescription -> IO ()
exportPackage dot email sysProvides p = do
let q = preprocessCabal p sysProvides
case q of
Nothing -> return ()
Just p' -> do
let (pkg, script) = cabal2pkg p' sysProvides
pkgname = arch_pkgname (pkgBody pkg)
pkgbuild <- getMD5 pkg
let apkgbuild = pkgbuild { pkgBuiltWith = Just version }
rawpkgbuild = (render $ pkg2doc email apkgbuild) ++ "\n"
createDirectoryIfMissing True (dot </> pkgname)
writeFile (dot </> pkgname </> "PKGBUILD") rawpkgbuild
case script of
Nothing -> return ()
Just s -> writeFile (dot </> pkgname </> (install_hook_name pkgname)) s
------------------------------------------------------------------------
-- | Given an abstract pkgbuild, run "makepkg -g" to compute md5
-- of source files (possibly cached locally), and modify the PkgBuild
-- accordingly.
--
getMD5 :: AnnotatedPkgBuild -> IO AnnotatedPkgBuild
getMD5 pkg = do
putStrLn "Feeding the PKGBUILD to `makepkg -g`..."
eres <- readProcessWithExitCode "makepkg" ["-g"] $ display pkg
case eres of
(ExitFailure _,_,err) -> do
hPutStrLn stderr err
hPutStrLn stderr $ "makepkg encountered an error while calculating MD5."
return pkg
(ExitSuccess,out,err) -> do
-- s should be "md5sums=(' ... ')"
hPutStrLn stderr err
if "md5sums=('" `isPrefixOf` out
then
let md5sum = takeWhile (\x -> x `elem` "0123456789abcdef") $ drop 10 out
in return pkg { pkgBody = (pkgBody pkg) { arch_md5sum = ArchList [md5sum] } }
else do
hPutStrLn stderr $ "Incorrect output from makepkg."
return pkg
-- Return the path to a .cabal file.
-- If not arguments are specified, use ".",
-- if the argument looks like a url, download that
-- otherwise, assume its a directory
--
findCabalFile :: String -> FilePath -> FilePath -> IO FilePath
findCabalFile file _cwd tmp = do
let epath
| null file
= Right _cwd
| "http://" `isPrefixOf` file
= Left file
| ".cabal" `isSuffixOf` file
= Right (makeValid (joinPath [_cwd,file]))
| otherwise -- a directory path
= Right file
-- download url to .cabal
case epath of
Left url -> do
eres <- myReadProcess "wget" [url] []
case eres of
Left (_,s,_) -> do
hPutStrLn stderr s
die $ "Couldn't download .cabal file: " ++ show url
Right _ -> findPackageDesc tmp -- tmp dir
-- it might be a .cabal file
Right f | ".cabal" `isSuffixOf` f -> do
b <- doesFileExist f
if not b
then die $ ".cabal file doesn't exist: " ++ show f
else return f
-- or assume it is a dir to a file:
Right dir -> do
b <- doesDirectoryExist dir
if not b
then die $ "directory doesn't exist: " ++ show dir
else findPackageDesc dir
------------------------------------------------------------------------
-- Some extras
--
die :: String -> IO a
die s = do
hPutStrLn stderr $ "cabal2pkg:\n" ++ s
exitWith (ExitFailure 1)
-- Safe wrapper for getEnv
getEnvMaybe :: String -> IO (Maybe String)
getEnvMaybe _name = CE.handle ((const :: a -> CE.SomeException -> a) $ return Nothing) (Just `fmap` getEnv _name)
------------------------------------------------------------------------
--
-- Strict process reading
--
myReadProcess :: FilePath -- ^ command to run
-> [String] -- ^ any arguments
-> String -- ^ standard input
-> IO (Either (ExitCode,String,String) String) -- ^ either the stdout, or an exitcode and any output
myReadProcess cmd _args input = CE.handle (return . handler) $ do
(inh,outh,errh,pid) <- runInteractiveProcess cmd _args Nothing Nothing
output <- hGetContents outh
outMVar <- newEmptyMVar
_ <- forkIO $ (CE.evaluate (length output) >> putMVar outMVar ())
errput <- hGetContents errh
errMVar <- newEmptyMVar
_ <- forkIO $ (CE.evaluate (length errput) >> putMVar errMVar ())
when (not (null input)) $ hPutStr inh input
takeMVar outMVar
takeMVar errMVar
ex <- CE.catch (waitForProcess pid) ((const :: a -> CE.SomeException -> a) $ return ExitSuccess)
hClose outh
hClose inh -- done with stdin
hClose errh -- ignore stderr
return $ case ex of
ExitSuccess -> Right output
ExitFailure _ -> Left (ex, errput, output)
where
handler (ExitFailure e) = Left (ExitFailure e,"","")
handler e = Left (ExitFailure 1, show e, "")