packages feed

cabal2arch 0.7.5 → 0.7.6

raw patch · 3 files changed

+194/−300 lines, 3 filesdep +cmdargsdep ~archlinuxdep ~basenew-uploader

Dependencies added: cmdargs

Dependency ranges changed: archlinux, base

Files

Main.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeSynonymInstances       #-}-{-# LANGUAGE BangPatterns               #-}-{-# OPTIONS_GHC -fno-warn-orphans       #-}+{-# LANGUAGE DeriveDataTypeable #-}  -- | -- Module    : cabal2arch: convert cabal packages to Arch Linux PKGBUILD format@@ -20,6 +17,7 @@ -- rather than makedepends  import Distribution.PackageDescription.Parse+import Distribution.PackageDescription import Distribution.Simple.Utils hiding (die) import Distribution.Verbosity import Distribution.Text@@ -27,12 +25,15 @@ -- 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.OldException as C+import qualified Control.Exception as CE  import Data.List+import qualified Data.ByteString.Lazy as Bytes  import Text.PrettyPrint @@ -45,199 +46,230 @@ import System.IO import System.Process hiding(cwd) -comment :: String-comment = render $ vcat- [ text "# Note: we list all package dependencies."- , text "# Your package tool should understand 'provides' syntax"- , text "#"- , text "# Keep up to date on http://archhaskell.wordpress.com/"- , text "#"]+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 =- C.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))+main = cmdArgs cmdLnArgs >>= subCmd -   -- Always remember to clean up-  (\(d,cwd) -> do-            setCurrentDirectory cwd+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+        -- Now, get to work:+        $ \(tmp, _cwd) -> do -   do x <- getArgs-      case x of-           ["--help"] -> help-           ["-h"]     -> help-           _          -> return ()-   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+            -- 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 cwd tmp-   hPutStrLn stderr $ "Using " ++ cabalfile+            cabalfile <- findCabalFile cabalLoc _cwd tmp+            hPutStrLn stderr $ "Using " ++ cabalfile -   cabalsrc  <- readPackageDescription normal cabalfile+            cabalsrc  <- readPackageDescription normal cabalfile -   -- Create a package description with all configurations resolved.-   let finalcabal = preprocessCabal cabalsrc-   finalcabal' <- case finalcabal of-                    Nothing -> die "Aborting..."-                    Just f -> return f-   let (pkgbuild', hooks) = cabal2pkg finalcabal'+            -- 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 -   pkgbuild  <- getMD5 pkgbuild'-   let apkgbuild = AnnotatedPkgBuild { pkgBuiltWith = Just version, pkgHeader = comment, pkgBody = pkgbuild }-       doc = pkg2doc email apkgbuild-       dir = arch_pkgname pkgbuild+            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+            setCurrentDirectory _cwd+            createDirectoryIfMissing False dir+            setCurrentDirectory dir -   writeFile "PKGBUILD" (render doc ++ "\n")+            writeFile "PKGBUILD" (render doc ++ "\n") -   -- print pkgname.install-   case hooks of-        Nothing -> return ()-        Just i  -> writeFile (install_hook_name (arch_pkgname pkgbuild)) i+            -- print pkgname.install+            case hooks of+                Nothing -> return ()+                Just i  -> writeFile (install_hook_name (arch_pkgname pkgbuild)) i -   setCurrentDirectory cwd+            setCurrentDirectory _cwd -   system $ "rm -rf " ++ dir </> "{pkg,src,*.tar.gz}"-   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"))+            _ <- 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+            -- 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 $ (,,)+                            -- Log to build file.+                            appendFile (home </> ".cabal2arch.log") $ (show $ (,,)+                                (arch_pkgname pkgbuild ++ "-" ++ (display $ arch_pkgver pkgbuild))+                                (arch_pkgdesc pkgbuild)+                                (arch_url pkgbuild)) ++ "\n" -                   (arch_pkgname pkgbuild ++ "-" ++ (render . disp $ 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 :: PkgBuild -> IO PkgBuild+getMD5 :: AnnotatedPkgBuild -> IO AnnotatedPkgBuild getMD5 pkg = do-   putStrLn "Feeding the PKGBUILD to `makepkg -g`..."-   eres <- readProcessWithExitCode "makepkg" ["-g"] (render $ disp pkg)-   case eres of-       (ExitFailure _,_,err) -> 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+        (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 { arch_md5sum = ArchList [md5sum] }-               else do-                 hPutStrLn stderr $ "Incorrect output from makepkg."-                 return pkg-getMD5 _ = die "Malformed PkgBuild"+                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 :: FilePath -> FilePath -> IO FilePath-findCabalFile cwd tmp = do-   args <- getArgs-   let epath | null args-                = Right cwd-             | "http://" `isPrefixOf` file+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+            | ".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 <- 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+    -- 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+        -- 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+        -- 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 -- -help :: IO a-help = do- hPutStrLn stderr $ unlines-    [ "cabal2arch: [-h|--help] [directory|url]"-    , ""-    , "  Generate PKGBUILD for the .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@@ -245,7 +277,7 @@  -- Safe wrapper for getEnv getEnvMaybe :: String -> IO (Maybe String)-getEnvMaybe name = C.handle (const $ return Nothing) (Just `fmap` getEnv name)+getEnvMaybe _name = CE.handle ((const :: a -> CE.SomeException -> a) $ return Nothing) (Just `fmap` getEnv _name)  ------------------------------------------------------------------------ @@ -257,21 +289,21 @@             -> String                                -- ^ standard input             -> IO (Either (ExitCode,String,String) String)  -- ^ either the stdout, or an exitcode and any output -myReadProcess cmd args input = C.handle (return . handler) $ do-    (inh,outh,errh,pid) <- runInteractiveProcess cmd args Nothing Nothing+myReadProcess cmd _args input = CE.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 ())+    _ <- forkIO $ (CE.evaluate (length output) >> putMVar outMVar ())      errput  <- hGetContents errh     errMVar <- newEmptyMVar-    forkIO $ (C.evaluate (length errput) >> putMVar errMVar ())+    _ <- forkIO $ (CE.evaluate (length errput) >> putMVar errMVar ())      when (not (null input)) $ hPutStr inh input     takeMVar outMVar     takeMVar errMVar-    ex     <- C.catch (waitForProcess pid) (\_e -> return ExitSuccess)+    ex <- CE.catch (waitForProcess pid) ((const :: a -> CE.SomeException -> a) $ return ExitSuccess)     hClose outh     hClose inh          -- done with stdin     hClose errh         -- ignore stderr@@ -280,7 +312,6 @@         ExitSuccess   -> Right output         ExitFailure _ -> Left (ex, errput, output) -  where-    handler (C.ExitException e) = Left (e,"","")-    handler e                   = Left (ExitFailure 1, show e, "")-+    where+        handler (ExitFailure e) = Left (ExitFailure e,"","")+        handler e               = Left (ExitFailure 1, show e, "")
cabal2arch.cabal view
@@ -1,5 +1,5 @@ name:               cabal2arch-version:            0.7.5+version:            0.7.6 homepage:           http://github.com/archhaskell/ synopsis:           Create Arch Linux packages from Cabal packages. description:        Create Arch Linux packages from Cabal packages.@@ -28,14 +28,5 @@         bytestring,         Cabal > 1.8,         filepath,-        archlinux >= 0.3.3--executable manycabal2arch-    main-is:            scripts/manycabal2arch.hs-    ghc-options:        -Wall--    build-depends:-        base >=4 && <6,-        directory,-        filepath,-        archlinux >= 0.3.3+        archlinux >= 0.3.5,+        cmdargs
− scripts/manycabal2arch.hs
@@ -1,128 +0,0 @@--- |--- Module    : manycabal2arch: batch creation of PKGBUILDs from Hackage tarball--- Copyright : (c) Rémy Oudompheng 2010--- License   : BSD3------ Maintainer: Arch Haskell Team <arch-haskell@haskell.org>--- Stability : provisional--- Portability:-----import Distribution.ArchLinux.PkgBuild-import Distribution.ArchLinux.CabalTranslation-import Distribution.ArchLinux.HackageTranslation--import Distribution.PackageDescription-import Distribution.Text-import Text.PrettyPrint--import Data.List-import qualified Data.ByteString.Lazy as Bytes-import System.Directory-import System.FilePath---- Input/output-import System.Environment-import System.IO-import System.Process-import System.Exit--import qualified Control.OldException as C--import Debug.Trace--import Paths_cabal2arch--exportPackage :: FilePath -> String -> GenericPackageDescription -> IO ()-exportPackage dot email p = do-  let q = preprocessCabal p-  case q of-    Nothing -> return ()-    Just p' -> do-      let (pkg, script) = cabal2pkg p'-          pkgname = trace ("Converting package " ++ arch_pkgname pkg) (arch_pkgname pkg)-      pkgbuild  <- getMD5 pkg-      let apkgbuild = AnnotatedPkgBuild { pkgBuiltWith = Just version, pkgHeader = comment, pkgBody = pkgbuild }-          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 </> pkgname ++ ".install") s--main :: IO ()-main = do-  argv <- getArgs-  x <- case argv of-    _:_:_:_ -> return ()-    _ -> help-  pkglist <- readFile (argv !! 0)-  tarball <- Bytes.readFile (argv !! 1)-  repo <- canonicalizePath (argv !! 2)-  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-  let cabals = getSpecifiedCabalsFromTarball tarball (lines pkglist)-  mapM (exportPackage repo email) cabals-  return ()---- Safe wrapper for getEnv                                                                                            -getEnvMaybe :: String -> IO (Maybe String)-getEnvMaybe name = C.handle (const $ return Nothing) (Just `fmap` getEnv name)--comment :: String-comment = render $ vcat- [ text "# Note: we list all package dependencies."- , text "# Your package tool should understand 'provides' syntax"- , text "#"- , text "# Keep up to date on http://archhaskell.wordpress.com/"- , text "#"]---- | Given an abstract pkgbuild, run "makepkg -g" to compute md5--- of source files (possibly cached locally), and modify the PkgBuild--- accordingly.----getMD5 :: PkgBuild -> IO PkgBuild-getMD5 pkg = do-   putStrLn "Feeding the PKGBUILD to `makepkg -g`..."-   eres <- readProcessWithExitCode "makepkg" ["-g"] (render $ disp 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 { arch_md5sum = ArchList [md5sum] }-               else do-                 hPutStrLn stderr $ "Incorrect output from makepkg."-                 return pkg------- | Help file----help :: IO a-help = do- hPutStrLn stderr $ unlines-    [ "Usage: manycabal2arch pkglist tarball destination"-    , ""-    , "  Generate a ABS-like tree from a list of packages and the"-    , "  uncompressed Hackage tarball"-    , ""-    , "Arguments: pkglist"-    , "              A file with lines of the form \"<package-name> <version-number>\""-    , "           tarball"-    , "              The path to 00-index.tar, for example"-    , "              $HOME/.cabal/packages/hackage.haskell.org/00-index.tar"-    , "           destination"-    , "              The directory where the repository will be created"-    ]- exitWith ExitSuccess