{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module : cabal2arch: convert cabal packages to Arch Linux PKGBUILD format
-- Copyright : (c) Don Stewart, 2008
-- License : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
-- Portability:
--
-- TODO: libraries should be "haskell-$packagefoo"
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration
import Distribution.Simple.Utils hiding (die)
import Distribution.Verbosity
import Distribution.Version
import Distribution.Package
import Distribution.License
import Distribution.Text
import Distribution.Compiler
import Distribution.System
import Distribution.Simple.PackageIndex
import Data.Digest.Pure.MD5
import qualified Data.ByteString.Lazy as B
import Control.Monad
import Control.Concurrent
import Control.Exception
import qualified Control.Exception as C
import Data.List
import Data.Maybe
import qualified Data.Map as M
import Data.Monoid
import Data.Char
import Debug.Trace
import Text.PrettyPrint
import Paths_cabal2arch
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Process
main :: IO ()
main =
bracket
-- We do all our work in a temp directory
(do cwd <- getCurrentDirectory
etmp <- readProcess "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
do x <- getArgs
case x of
["--help"] -> help
["-h"] -> help
_ -> return ()
email <- maybe "" id `fmap` getEnvMaybe "DARCS_EMAIL"
cabalfile <- findCabalFile cwd tmp
hPutStrLn stderr $ "Using " ++ cabalfile
cabalsrc <- readPackageDescription normal cabalfile
-- Create a package description with all configurations resolved.
let e_finalcabalsrc = finalizePackageDescription
[]
(Nothing :: Maybe (PackageIndex PackageIdentifier))
buildOS -- linux/x86_64
X86_64
(CompilerId GHC (Version [6,8,2] []))
-- now constrain it to solve in the context of a modern ghc only
corePackages
cabalsrc
finalcabal <- case e_finalcabalsrc of
Left deps -> die $ "Unresolved dependencies: " ++show deps
Right (pkg,_) ->
return $ pkg { buildDepends = removeCoreFrom (buildDepends pkg) }
let (pkgbuild', hooks) = cabal2pkg finalcabal
pkgbuild <- getMD5 pkgbuild'
let doc = pkg2doc email pkgbuild
dir = arch_pkgname pkgbuild
setCurrentDirectory cwd
createDirectory 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
tarred <- readProcess "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"))
------------------------------------------------------------------------
-- | Given an abstract pkgbuild, download the source bundle,
-- and compute its md5, returning a modified PkgBuild with
-- the md5 set.
--
-- TODO we may want to use a local package.
--
getMD5 :: PkgBuild -> IO PkgBuild
getMD5 pkg@(PkgBuild { arch_source = ArchList [url] }) = do
hPutStrLn stderr $ "Fetching " ++ url
hFlush stderr
eres <- readProcess "wget" [url] []
case eres of
Left (_,s,_) -> do
hPutStrLn stderr s
die $ "Couldn't download package: " ++ show url
Right _ -> do
src <- B.readFile (takeBaseName url <.> "gz")
let !md5sum = show (md5 src)
return pkg { arch_md5sum = ArchList [md5sum] }
getMD5 _ = die "Malformed PkgBuild"
-- attempt to filter out core packages we've already satisified
-- not actuall correct, since it doesn't take any version
-- info into account.
--
-- TODO this should use configDependency to find the precise
-- versions we have available on Arch.
--
removeCoreFrom :: [Dependency] -> [Dependency]
removeCoreFrom [] = []
removeCoreFrom (x@(Dependency n _):xs) =
case find (\(Dependency k _) -> n == k) corePackages of
Just _ -> removeCoreFrom xs
Nothing -> x : removeCoreFrom xs
--
-- Core packages and their versions. These come with
-- ghc, so we should be right.
--
-- TODO populate this based on a dynamic check.
--
corePackages :: [Dependency]
corePackages =
[Dependency "ALUT" (ThisVersion (Version [2,1,0,0] []))
,Dependency "Cabal" (ThisVersion (Version [1,2,3,0] []))
,Dependency "GLUT" (ThisVersion (Version [2,1,1,1] []))
,Dependency "HUnit" (ThisVersion (Version [1,2,0,0] []))
,Dependency "OpenAL" (ThisVersion (Version [1,3,1,1] []))
,Dependency "QuickCheck" (ThisVersion (Version [1,1,0,0] []))
,Dependency "array" (ThisVersion (Version [0,1,0,0] []))
,Dependency "base" (ThisVersion (Version [3,0,1,0] []))
,Dependency "bytestring" (ThisVersion (Version [0,9,0,1] []))
,Dependency "cgi" (ThisVersion (Version [3001,1,5,1] []))
,Dependency "containers" (ThisVersion (Version [0,1,0,1] []))
,Dependency "directory" (ThisVersion (Version [1,0,0,0] []))
,Dependency "fgl" (ThisVersion (Version [5,4,1,1] []))
,Dependency "filepath" (ThisVersion (Version [1,1,0,0] []))
,Dependency "haskell-src" (ThisVersion (Version [1,0,1,1] []))
,Dependency "haskell98" (ThisVersion (Version [1,0,1,0] []))
,Dependency "hpc" (ThisVersion (Version [0,5,0,0] []))
,Dependency "html" (ThisVersion (Version [1,0,1,1] []))
,Dependency "mtl" (ThisVersion (Version [1,1,0,1] []))
,Dependency "network" (ThisVersion (Version [2,1,0,0] []))
,Dependency "old-locale" (ThisVersion (Version [1,0,0,0] []))
,Dependency "old-time" (ThisVersion (Version [1,0,0,0] []))
,Dependency "packedstring" (ThisVersion (Version [0,1,0,0] []))
,Dependency "parallel" (ThisVersion (Version [1,0,0,0] []))
,Dependency "parsec" (ThisVersion (Version [2,1,0,0] []))
,Dependency "pretty" (ThisVersion (Version [1,0,0,0] []))
,Dependency "process" (ThisVersion (Version [1,0,0,0] []))
,Dependency "random" (ThisVersion (Version [1,0,0,0] []))
,Dependency "readline" (ThisVersion (Version [1,0,1,0] []))
,Dependency "regex-base" (ThisVersion (Version [0,72,0,1] []))
,Dependency "regex-compat" (ThisVersion (Version [0,71,0,1] []))
,Dependency "regex-posix" (ThisVersion (Version [0,72,0,2] []))
,Dependency "stm" (ThisVersion (Version [2,1,1,0] []))
,Dependency "template-haskell" (ThisVersion (Version [2,2,0,0] []))
,Dependency "time" (ThisVersion (Version [1,1,2,0] []))
,Dependency "unix" (ThisVersion (Version [2,3,0,0] []))
,Dependency "xtml" (ThisVersion (Version [3000,0,2,1] []))
{-
ALUT-2.1.0.0 cgi-3001.1.5.1 network-2.1.0.0 regex-base-0.72.0.1
Cabal-1.2.3.0 containers-0.1.0.1 old-locale-1.0.0.0 regex-compat-0.71.0.1
GLUT-2.1.1.1 directory-1.0.0.0 old-time-1.0.0.0 regex-posix-0.72.0.2
HUnit-1.2.0.0 fgl-5.4.1.1 packedstring-0.1.0.0 stm-2.1.1.0
OpenAL-1.3.1.1 filepath-1.1.0.0 parallel-1.0.0.0 template-haskell-2.2.0.0
OpenGL-2.2.1.1 haskell-src-1.0.1.1 parsec-2.1.0.0 time-1.1.2.0
QuickCheck-1.1.0.0 haskell98-1.0.1.0 pretty-1.0.0.0 unix-2.3.0.0
array-0.1.0.0 hpc-0.5.0.0 process-1.0.0.0 xhtml-3000.0.2.1
base-3.0.1.0 html-1.0.1.1 random-1.0.0.0
bytestring-0.9.0.1 mtl-1.1.0.0 readline-1.0.1.0
-}
]
-- 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 :: FilePath -> FilePath -> IO FilePath
findCabalFile cwd tmp = do
args <- getArgs
let epath | null args
= Right cwd
| "http://" `isPrefixOf` file
= Left file
| ".cabal" `isSuffixOf` file
= Right (makeValid (joinPath [cwd,file]))
| otherwise -- a directory path
= Right file
where file = head args
-- download url to .cabal
case epath of
Left url -> do
eres <- readProcess "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
findCLibs :: PackageDescription -> [String]
findCLibs (PackageDescription { library = lib, executables = exe }) =
-- warn for packages not in list.
map canonicalise (some ++ rest)
where
some = concatMap (extraLibs.buildInfo) exe
rest = case lib of
Nothing -> []
Just l -> extraLibs (libBuildInfo l)
canonicalise k = case M.lookup k translationTable of
Nothing -> trace "WARNING: this library depends on a C library we do not know the pacman name for. Check the C library names in the generated PKGBUILD File" $ k
Just s -> s
-- known pacman packages for C libraries we use:
translationTable = M.fromList
[("curses", "ncurses")
,("bz2", "bzip2")
,("z", "zlib")
]
------------------------------------------------------------------------
-- Parsing and pretty printing:
--
-- | Translate an abstract PkgBuild file into a document structure
--
pkg2doc :: String -> PkgBuild -> Doc
pkg2doc email pkg = vcat
[ text "# Contributor:"
<+> text email
, text "# Package generated by cabal2arch" <+> disp version
, text "pkgname"
<=> text (arch_pkgname pkg)
, text "pkgrel"
<=> int (arch_pkgrel pkg)
, text "pkgver"
<=> disp (arch_pkgver pkg)
, text "pkgdesc"
<=> doubleQuotes (text (arch_pkgdesc pkg))
, text "url"
<=> doubleQuotes (text (arch_url pkg))
, text "license"
<=> disp (arch_license pkg)
, text "arch"
<=> disp (arch_arch pkg)
, text "makedepends"
<=> disp (arch_makedepends pkg)
, text "source"
<=> dispNoQuotes (arch_source pkg)
, case arch_install pkg of
Nothing -> empty
Just p -> text "install" <=> disp p
, text "md5sums"
<=> disp (arch_md5sum pkg)
, hang
(text "build() {") 4
(vcat $ (map text) (arch_build pkg))
$$ char '}'
]
--
-- | Tranlsate a generic cabal file into a PGKBUILD
--
cabal2pkg :: PackageDescription -> (PkgBuild, Maybe String)
cabal2pkg cabal
-- TODO decide if its a library or an executable,
-- handle mullltipackages
-- extract C dependencies
-- = trace (show cabal) $
=
(emptyPkgBuild
{ arch_pkgname = archName
, arch_pkgver = vers
, arch_url = "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"++name
-- else homepage cabal
, arch_pkgdesc = synopsis cabal
, arch_license =
ArchList . return $
case license cabal of
GPL -> GPL
LGPL -> LGPL
l -> UnknownLicense ("custom:"++ show l)
-- All Hackage packages depend on GHC at build time
-- All Haskell libraries are prefixed with "haskell-"
, arch_makedepends = (arch_makedepends emptyPkgBuild)
`mappend`
-- Haskell libraries
-- TODO: use a real package spec to compute these names
-- based on what is in Arch.
ArchList
[ ArchDep (Dependency ("haskell" <-> map toLower d) v)
| Dependency d v <- buildDepends cabal ]
`mappend`
anyClibraries
-- need the dependencies of all flags that are on by default, for all libraries and executables
-- Hackage programs only need their own source to build
, arch_source = ArchList . return $
"http://hackage.haskell.org/packages/archive/"
++ (name </> display vers </> name <-> display vers <.> "tar.gz")
, arch_build =
[ "cd $startdir/src/" </> name <-> display vers
, "runhaskell Setup configure --prefix=/usr || return 1"
, "runhaskell Setup build || return 1"
] ++
-- Only needed for libraries:
(if hasLibrary
then
["runhaskell Setup register --gen-script || return 1"
,"runhaskell Setup unregister --gen-script || return 1"
,"install -D -m744 register.sh $startdir/pkg/usr/share/haskell/$pkgname/register.sh"
, "install -m744 unregister.sh $startdir/pkg/usr/share/haskell/$pkgname/unregister.sh"
]
else [])
++
["runhaskell Setup copy --destdir=$startdir/pkg || return 1"]
++
(if license cabal `notElem` [GPL,LGPL]
then ["install -D -m644 " ++ licenseFile cabal ++
" $startdir/pkg/usr/share/licenses/$pkgname/LICENSE || return 1" ]
else [])
-- if its a library:
, arch_install = if hasLibrary then Just $ install_hook_name archName
else Nothing
}, if hasLibrary
then Just (install_hook archName)
else Nothing
)
where
archName = map toLower (if isLibrary then "haskell-" ++ name else name)
name = pkgName (package cabal)
vers = pkgVersion (package cabal)
hasLibrary = isJust (library cabal)
isLibrary = isJust (library cabal) && null (executables cabal)
anyClibraries | null libs = ArchList []
| otherwise = ArchList libs
where
libs = [ ArchDep (Dependency s AnyVersion) | s <- findCLibs cabal ]
--
-- post install, and pre-remove hooks to run, to sync up ghc-pkg
--
install_hook_name :: String -> String
install_hook_name pkgname = pkgname <.> "install"
install_hook :: String -> String
install_hook pkgname = unlines
[ "HS_DIR=/usr/share/haskell/" ++ pkgname
, "post_install() {"
, " ${HS_DIR}/register.sh"
, "}"
, "pre_upgrade() {"
, " ${HS_DIR}/unregister.sh"
, "}"
, "post_upgrade() {"
, " ${HS_DIR}/register.sh"
, "}"
, "pre_remove() {"
, " ${HS_DIR}/unregister.sh"
, "}"
, "op=$1"
, "shift"
, "$op $*" ]
--
-- | A data type to represent PKGBUILD files
--
data PkgBuild =
PkgBuild
{ arch_pkgname :: String
-- ^
-- The name of the package. This has be a unix-friendly name
-- as it will be used in the package filename.
, arch_pkgver :: Version
-- ^ The version of the software as released from the authorii
-- (e.g. ´2.7.1´).
, arch_pkgrel :: !Int
-- ^
-- This is the release number specific to the Arch Linux
-- release. This allows package maintainers to make updates to
-- the package´s configure flags, for example. A pkgrel of 1
-- is typically used for each upstream software release and is
-- incremented for intermediate PKGBUILD updates.
, arch_pkgdesc :: String
-- ^
-- This should be a brief description of the package and its
-- functionality. Try to keep the description to one line of text.
, arch_arch :: ArchList ArchArch
-- ^
-- Defines on which architectures the given package is
-- available (e.g. arch=(´i686´ ´x86_64´)).
, arch_url :: String
-- ^
-- This field contains a URL that is associated with the software
-- being packaged. This is typically the project´s website.
, arch_license :: ArchList License
-- ^
-- This field specifies the license(s) that apply to the package.
-- Commonly-used licenses are found in /usr/share/licenses/common. If
-- you see the package´s license there, simply reference it in the
-- license field (e.g. license=(´GPL´)). If the package provides a
-- license not found in /usr/share/licenses/common, then you should
-- include the license in the package itself and set
-- license=(´custom´) or license=(´custom:LicenseName´). The license
-- should be placed in $pkgdir/usr/share/licenses/$pkgname when
-- building the package. If multiple licenses are applicable for a
-- package, list all of them: license=(´GPL´ ´FDL´).
, arch_makedepends :: ArchList ArchDep
-- ^
-- An array of packages that this package depends on to build, but are
-- not needed at runtime. Packages in this list follow the same format
-- as depends.
, arch_depends :: ArchList ArchDep
-- ^
-- An array of packages that this package depends on to run. Packages
-- in this list should be surrounded with single quotes and contain at
-- least the package name. Entries can also include a version
-- requirement of the form name<>version, where <> is one of five
-- comparisons: >= (greater than or equal to), <= (less than or equal
-- to), = (equal to), > (greater than), or < (less than).
, arch_source :: ArchList String
-- ^
-- An array of source files required to build the package. Source
-- files must either reside in the same directory as the PKGBUILD
-- file, or be a fully-qualified URL that makepkg will use to download
-- the file. In order to make the PKGBUILD as useful as possible, use
-- the $pkgname and $pkgver variables if possible when specifying the
-- download location. Any files that are compressed will automatically
-- be extracted, unless found in the noextract array listed below.
, arch_md5sum :: ArchList String
-- ^
-- This array contains an MD5 hash for every source file specified in
-- the source array (in the same order). makepkg will use this to
-- verify source file integrity during subsequent builds. To easily
-- generate md5sums, run “makepkg -g >> PKGBUILD”. If desired, move
-- the md5sums line to an appropriate location. NOTE: makepkg
-- supports multiple integrity algorithms and their corresponding
-- arrays (i.e. sha1sums for the SHA1 algorithm); however, official
-- packages use only md5sums for the time being.
, arch_build :: [String]
-- ^
-- The build hook
, arch_install :: Maybe String
-- ^
-- Specifies a special install script that is to be included in the package. This
-- file should reside in the same directory as the PKGBUILD, and will be copied
-- into the package by makepkg. It does not need to be included in the source
-- array (e.g. install=pkgname.install).
}
deriving (Show, Eq)
--
-- | An empty PKGBUILD
--
emptyPkgBuild :: PkgBuild
emptyPkgBuild =
PkgBuild
{ arch_pkgname = pkgName (package e)
, arch_pkgver = pkgVersion (package e)
, arch_pkgrel = 1
, arch_pkgdesc = synopsis e
, arch_arch = ArchList [Arch_X86, Arch_X86_64]
, arch_url = homepage e
, arch_license = ArchList [license e]
, arch_makedepends = ArchList [(ArchDep (Dependency "ghc" AnyVersion))]
-- makedepends=('ghc>=6.6') ?
, arch_depends = ArchList []
, arch_source = ArchList []
, arch_md5sum = ArchList []
-- sha1sums=('a08670e4c749850714205f425cb460ed5a0a56b2')
, arch_build = []
, arch_install = Nothing -- executable
}
where
e = emptyPackageDescription
------------------------------------------------------------------------
-- Extra pretty printer instances and types
newtype ArchDep = ArchDep Dependency
deriving (Eq,Show)
-- the PKGBUILD version spec is less expressive than cabal, we can't
-- really handle unions or intersections well yet.
instance Text ArchDep where
disp (ArchDep (Dependency name ver)) =
text name <> mydisp ver
where
-- >= (greater than or equal to), <= (less than or
-- equal to), = (equal to), > (greater than), or <
mydisp AnyVersion = empty
mydisp (ThisVersion v) = text "=" <> disp v
mydisp (LaterVersion v) = char '>' <> disp v
mydisp (EarlierVersion v) = char '<' <> disp v
mydisp (UnionVersionRanges (ThisVersion v1) (LaterVersion v2))
| v1 == v2 = text ">=" <> disp v1
mydisp (UnionVersionRanges (LaterVersion v2) (ThisVersion v1))
| v1 == v2 = text ">=" <> disp v1
mydisp (UnionVersionRanges (ThisVersion v1) (EarlierVersion v2))
| v1 == v2 = text "<=" <> disp v1
mydisp (UnionVersionRanges (EarlierVersion v2) (ThisVersion v1))
| v1 == v2 = text "<=" <> disp v1
{-
mydisp (UnionVersionRanges r1 r2)
= disp r1 <+> text "||" <+> disp r2
mydisp (IntersectVersionRanges r1 r2)
= disp r1 <+> text "&&" <+> disp r2
-}
mydisp x = trace ("WARNING: Can't handle this version format yet: " ++ show x ++ "\ncheck the dependencies by hand.")$ empty
parse = undefined
--
-- | Valid linux platforms
--
data ArchArch = Arch_X86 | Arch_X86_64
deriving (Show, Eq)
instance Text ArchArch where
disp x = case x of
Arch_X86 -> text "i686"
Arch_X86_64 -> text "x86_64"
parse = error "Text.parrse not defined for ArchList"
-- Lists with quotes
newtype ArchList a = ArchList [a]
deriving (Show, Eq, Monoid, Functor)
instance Text String where
disp s = text s
parse = error "Text.parse not defined for String"
instance Text a => Text (ArchList a) where
disp (ArchList xs) =
parens (hcat
(intersperse space
(map (quotes . disp) xs)))
parse = error "Text.parse not defined for ArchList"
-- | Printing with no quotes
dispNoQuotes :: Text a => ArchList a -> Doc
dispNoQuotes (ArchList xs) =
parens (hcat
(intersperse space
(map disp xs)))
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Some extras
--
help :: IO a
help = do
hPutStrLn stderr $ unlines
[ "cabal2pkg: [-h|--help] [directory|url]"
, ""
, " Generate PKGBUILD to stdout for .cabal file in <directory> or at <url>"
, ""
, "Usage:"
, " -h Display help message"
, ""
, "Arguments: <directory>"
, " Look for .cabal file in <directory>"
, " If directory is empty, use pwd"
, " <file.cabal>"
, " Use .cabal file as source"
, " <url>"
, " Download .cabal file from <url>"
]
exitWith ExitSuccess
------------------------------------------------------------------------
die :: String -> IO a
die s = do
hPutStrLn stderr $ "cabal2pkg:\n" ++ s
exitWith (ExitFailure 1)
(<=>) :: Doc -> Doc -> Doc
x <=> y = x <> char '=' <> y
(<->) :: String -> String -> String
x <-> y = x ++ "-" ++ y
-- Safe wrapper for getEnv
getEnvMaybe :: String -> IO (Maybe String)
getEnvMaybe name = handle (const $ return Nothing) (Just `fmap` getEnv name)
------------------------------------------------------------------------
--
-- Strict process reading
--
readProcess :: 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
readProcess cmd args input = C.handle (return . handler) $ do
(inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing
output <- hGetContents outh
outMVar <- newEmptyMVar
forkIO $ (C.evaluate (length output) >> putMVar outMVar ())
errput <- hGetContents errh
errMVar <- newEmptyMVar
forkIO $ (C.evaluate (length errput) >> putMVar errMVar ())
when (not (null input)) $ hPutStr inh input
takeMVar outMVar
takeMVar errMVar
ex <- C.catch (waitForProcess pid) (\_e -> 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 (C.ExitException e) = Left (e,"","")
handler e = Left (ExitFailure 1, show e, "")