diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008 Don Stewart + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,420 @@ +{-# 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 +-- Stability : provisional +-- Portability: +-- + +import Distribution.PackageDescription +import Distribution.Simple.Utils hiding (die) +import Distribution.Verbosity +import Distribution.Version +import Distribution.Package +import Distribution.License +import Distribution.Text + +import Data.Digest.MD5 +import qualified Data.ByteString.Lazy as B + +import Control.Exception +import Data.List +import Data.Monoid +import System.Environment +import Control.Concurrent +import qualified Control.Exception as C +import System.Process +import Text.PrettyPrint +import System.FilePath +import System.Exit +import System.IO +import Control.Monad +import System.Directory + +main :: IO () +main = + bracket + -- Set up a temp dir to work in + (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 + let pkgbuild' = cabal2pkg cabalsrc + + pkgbuild <- getMD5 pkgbuild' + let doc = pkg2doc email pkgbuild + putStrLn (render doc) + +------------------------------------------------------------------------ + +-- | Given an abstract pkgbuild, download the source bundle, +-- and compute its md5, returning a modified PkgBuild with +-- the md5 set. +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" + +-- 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 + +------------------------------------------------------------------------ +-- 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 "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) + , text "md5sum" + <=> disp (arch_md5sum pkg) + ] + +-- +-- | Tranlsate a generic cabal file into a PGKBUILD +-- +cabal2pkg :: GenericPackageDescription -> PkgBuild +cabal2pkg GenericPackageDescription + { packageDescription = cabal + , genPackageFlags = _cabal_genPackageFlags + , condLibrary = _cabal_condLibrary + , condExecutables = _cabal_condExecutables + } + = emptyPkgBuild + { arch_pkgname = name + , arch_pkgver = vers + , arch_url = homepage cabal + , arch_pkgdesc = synopsis cabal + , arch_license = ArchList [license cabal] + + -- All Hackage packages depend on GHC at build time + , arch_makedepends = (arch_makedepends emptyPkgBuild) + `mappend` + (ArchList (buildDepends cabal)) + + -- 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") + } + where + name = pkgName (package cabal) + vers = pkgVersion (package cabal) + +-- +-- | 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 Arch + -- ^ + -- 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 Dependency + -- ^ + -- 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 Dependency + -- ^ + -- 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. + } + 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 [X86, X86_64] + , arch_url = homepage e + , arch_license = ArchList [license e] + , arch_makedepends = ArchList [(Dependency "ghc" AnyVersion)] + , arch_depends = ArchList [] + , arch_source = ArchList [] + , arch_md5sum = ArchList [] + } + where + e = emptyPackageDescription + +------------------------------------------------------------------------ +-- Extra pretty printer instances and types + +-- +-- | Valid linux platforms +-- +data Arch = X86 | X86_64 + deriving (Show, Eq) + +instance Text Arch where + disp x = case x of + X86 -> text "i686" + 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 or at " + , "" + , "Usage:" + , " -h Display help message" + , "" + , "Arguments: " + , " Look for .cabal file in " + , " If directory is empty, use pwd" + , " " + , " Use .cabal file as source" + , " " + , " Download .cabal file from " + ] + 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, "") + diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/cabal2arch.cabal b/cabal2arch.cabal new file mode 100644 --- /dev/null +++ b/cabal2arch.cabal @@ -0,0 +1,36 @@ +name: cabal2arch +version: 0.1 +homepage: http://code.haskell.org/~dons/code/cabal2arch +synopsis: Create Arch Linux packages from Cabal packages +description: Create Arch Linux packages from Cabal packages +category: Distribution +license: BSD3 +license-file: LICENSE +author: Don Stewart +maintainer: dons@galois.com +cabal-version: >= 1.2 +build-type: Simple + +flag small_base + description: Choose the new smaller, split-up base package. + +executable cabal2arch + main-is: Main.hs + ghc-options: -Wall + + if flag(small_base) + build-depends: + base >= 3, + pretty, + process, + directory, + bytestring + else + build-depends: + base < 3 + + build-depends: + Cabal >= 1.3.11, + filepath, + pureMD5 +