diff --git a/cblrepo.cabal b/cblrepo.cabal --- a/cblrepo.cabal +++ b/cblrepo.cabal @@ -1,5 +1,5 @@ name: cblrepo -version: 0.10.1 +version: 0.11 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0 @@ -26,12 +26,12 @@ other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs Sync Versions Updates ListPkgs Urls PkgBuild Util.Translation OldPkgDB ConvertDB Remove - build-depends: base ==4.6.*, filepath ==1.3.*, - directory ==1.2.*, Cabal ==1.16.*, json ==0.7.*, + build-depends: base ==4.7.*, filepath ==1.3.*, + directory ==1.2.*, Cabal ==1.18.*, json ==0.7.*, bytestring ==0.10.*, tar ==0.4.*, zlib ==0.5.*, mtl >=2.0 && <2.2, - process ==1.1.*, Unixutils ==1.52.*, unix ==2.6.*, + process ==1.2.*, Unixutils ==1.52.*, unix ==2.7.*, ansi-wl-pprint ==0.6.*, aeson ==0.7.* && >= 0.6.2, - optparse-applicative ==0.7.* + optparse-applicative ==0.7.*, safe Source-Repository head Type: git diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -1,5 +1,5 @@ {- - - Copyright 2011 Per Magnus Therning + - Copyright 2011-2014 Per Magnus Therning - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. @@ -44,17 +44,18 @@ db <- liftIO $ readDb dbFn pd <- cfgGet $ patchDir . optsCmd dr <- cfgGet dryRun + ghcVersion <- cfgGet $ ghcVer . optsCmd -- ghcPkgs <- cfgGet $ cmdAddGhcPkgs . optsCmd distroPkgs <- cfgGet $ cmdAddDistroPkgs . optsCmd - genUrlPkgs <- cfgGet (cmdAddUrlCbls . optsCmd) >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromUrl pd c d)) - genFilePkgs <- cfgGet (cmdAddFileCbls . optsCmd) >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromFile pd c d)) - genIdxPkgs <- cfgGet (cmdAddCbls . optsCmd) >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromIdx pd c d)) + genUrlPkgs <- cfgGet (cmdAddUrlCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromUrl pd) + genFilePkgs <- cfgGet (cmdAddFileCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromFile pd) + genIdxPkgs <- cfgGet (cmdAddCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromIdx pd) pkgs <- exitOnErrors $ argsToPkgType ghcPkgs distroPkgs (genUrlPkgs ++ genFilePkgs ++ genIdxPkgs) -- let pkgNames = map getName pkgs let tmpDb = foldl delPkg db pkgNames - case addPkgs tmpDb pkgs of + case addPkgs ghcVersion tmpDb pkgs of Left (unsatisfiables, breaksOthers) -> liftIO (mapM_ printUnSat unsatisfiables >> mapM_ printBrksOth breaksOthers) Right newDb -> liftIO $ unless dr $ saveDb newDb dbFn @@ -75,35 +76,35 @@ getName (RepoType gpd) = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd -- {{{1 addPkgs -addPkgs db pkgs = let - (succs, fails) = partition (canBeAdded db) pkgs - newDb = foldl addPkg2 db (map (pkgTypeToCblPkg db) succs) - unsatisfieds = mapMaybe (finalizeToUnsatisfiableDeps db) fails +addPkgs ghcVer db pkgs = let + (succs, fails) = partition (canBeAdded ghcVer db) pkgs + newDb = foldl addPkg2 db (map (pkgTypeToCblPkg ghcVer db) succs) + unsatisfieds = mapMaybe (finalizeToUnsatisfiableDeps ghcVer db) fails breaksOthers = mapMaybe (findBreaking db) fails in case (succs, fails) of (_, []) -> Right newDb ([], _) -> Left (unsatisfieds, breaksOthers) - (_, _) -> addPkgs newDb fails + (_, _) -> addPkgs ghcVer newDb fails -canBeAdded db (GhcType n v) = null $ checkDependants db n v -canBeAdded db (DistroType n v _) = null $ checkDependants db n v -canBeAdded db (RepoType gpd) = let - finable = either (const False) (const True) (finalizePkg db gpd) +canBeAdded _ db (GhcType n v) = null $ checkDependants db n v +canBeAdded _ db (DistroType n v _) = null $ checkDependants db n v +canBeAdded ghcVer db (RepoType gpd) = let + finable = either (const False) (const True) (finalizePkg ghcVer db gpd) n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd v = P.pkgVersion $ package $ packageDescription gpd depsOK = null $ checkDependants db n v in finable && depsOK -pkgTypeToCblPkg _ (GhcType n v) = createGhcPkg n v -pkgTypeToCblPkg _ (DistroType n v r) = createDistroPkg n v r -pkgTypeToCblPkg db (RepoType gpd) = fromJust $ case finalizePkg db gpd of +pkgTypeToCblPkg _ _ (GhcType n v) = createGhcPkg n v +pkgTypeToCblPkg _ _ (DistroType n v r) = createDistroPkg n v r +pkgTypeToCblPkg ghcVer db (RepoType gpd) = fromJust $ case finalizePkg ghcVer db gpd of Right (pd, fa) -> Just $ createCblPkg pd fa Left _ -> Nothing -finalizeToUnsatisfiableDeps db (RepoType gpd) = case finalizePkg db gpd of - Left ds -> Just $ (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd, ds) +finalizeToUnsatisfiableDeps ghcVer db (RepoType gpd) = case finalizePkg ghcVer db gpd of + Left ds -> Just (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd, ds) _ -> Nothing -finalizeToUnsatisfiableDeps _ _ = Nothing +finalizeToUnsatisfiableDeps _ _ _ = Nothing findBreaking db (GhcType n v) = let d = checkDependants db n v diff --git a/src/BumpPkgs.hs b/src/BumpPkgs.hs --- a/src/BumpPkgs.hs +++ b/src/BumpPkgs.hs @@ -23,15 +23,15 @@ bumpPkgs :: Command () bumpPkgs = do - dbFn <- cfgGet $ dbFile + dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn - dR <- cfgGet $ dryRun + dR <- cfgGet dryRun pkgs <- cfgGet $ pkgs . optsCmd incl <- cfgGet $ inclusive . optsCmd let bpkgs = transDependants db incl pkgs - let newDb = foldl (\ db p -> bumpRelease db p) db bpkgs - if dR - then liftIO $ putStrLn "Would bump:" >> mapM_ putStrLn bpkgs - else liftIO $ saveDb newDb dbFn + let newDb = foldl bumpRelease db bpkgs + liftIO $ if dR + then putStrLn "Would bump:" >> mapM_ putStrLn bpkgs + else saveDb newDb dbFn -transDependants db i pkgs = filter ((||) i . (not . flip elem pkgs)) $ transitiveDependants db pkgs +transDependants db i pkgs = filter ((||) i . not . flip elem pkgs) $ transitiveDependants db pkgs diff --git a/src/ListPkgs.hs b/src/ListPkgs.hs --- a/src/ListPkgs.hs +++ b/src/ListPkgs.hs @@ -21,7 +21,6 @@ import PkgDB import Control.Monad.Reader -import Data.List import Distribution.Text import Distribution.PackageDescription @@ -31,25 +30,30 @@ lD <- cfgGet $ listDistro . optsCmd lR <- cfgGet $ noListRepo . optsCmd lH <- cfgGet $ hackageFmt . optsCmd + ps <- cfgGet $ pkgs . optsCmd db <- cfgGet dbFile >>= liftIO . readDb - let pkgs = filter (pkgFilter lG lD lR) db + let allPkgs = filter (pkgFilter lG lD lR) db + let pkgsToList = if null ps + then allPkgs + else filter (\p -> pkgName p `elem` ps) allPkgs let printer = if lH then printCblPkgHackage else printCblPkgShort - liftIO $ mapM_ printer pkgs + liftIO $ mapM_ printer pkgsToList +pkgFilter :: Bool -> Bool -> Bool -> CblPkg -> Bool pkgFilter g d r p = (g && isGhcPkg p) || (d && isDistroPkg p) || (not r && isRepoPkg p) printCblPkgShort :: CblPkg -> IO () printCblPkgShort p = - putStrLn $ pkgName p ++ " " ++ (display $ pkgVersion p) ++ "-" ++ pkgRelease p ++ showFlagsIfPresent p + putStrLn $ pkgName p ++ " " ++ display (pkgVersion p) ++ "-" ++ pkgRelease p ++ showFlagsIfPresent p where - showFlagsIfPresent p - | [] <- pkgFlags p = "" - | fa <- pkgFlags p = " (" ++ (intercalate " " $ map showSingleFlag fa) ++ ")" + showFlagsIfPresent _p + | [] <- pkgFlags _p = "" + | fa <- pkgFlags _p = " (" ++ unwords (map showSingleFlag fa) ++ ")" showSingleFlag (FlagName n, True) = n showSingleFlag (FlagName n, False) = '-' : n printCblPkgHackage :: CblPkg -> IO () printCblPkgHackage p = - print (pkgName p, (display $ pkgVersion p), Nothing :: Maybe String) + print (pkgName p, display $ pkgVersion p, Nothing :: Maybe String) diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,5 @@ {- - - Copyright 2011-2013 Per Magnus Therning + - Copyright 2011-2014 Per Magnus Therning - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. @@ -16,6 +16,7 @@ module Main where +-- {{{1 imports import Add import BuildPkgs import BumpPkgs @@ -31,85 +32,86 @@ import Paths_cblrepo -import Control.Monad -import Control.Monad.Reader import Distribution.Text import System.Directory -import System.FilePath import Options.Applicative as OA -- -- {{{1 command line arguments -argAppDir = strOption (long "appdir" <> value "" <> help "application data directory") -argDbFile = strOption (long "db" <> value "cblrepo.db" <> help "package database") -argDryRun = switch (short 'n' <> help "dry run") +argAppDir = strOption (long "appdir" <> value "" <> help "Path to application data directory") +argDbFile = strOption (long "db" <> value "cblrepo.db" <> help "Path to package database") +argDryRun = switch (short 'n' <> help "Make no changes, (dry run)") cmdAddPkgOpts = CmdAdd - <$> strOption (long "patchdir" <> value "patches" <> help "location of patches (patches)") + <$> strOption (long "patchdir" <> value "patches" <> help "Location of patches (patches)") + <*> nullOption (long "ghc-version" <> reader readerGhcVersion <> value ghcDefVersion <> help "GHC version to use") <*> many (nullOption (short 'g' <> long "ghc-pkg" <> OA.reader strPairArg <> metavar "PKG,VER" <> help "GHC base package (multiple)")) - <*> many (nullOption (short 'd' <> long "distro-pkg" <> OA.reader strTripleArg <> metavar "PKG,VER,REL" <> help "distro package (multiple)")) - <*> many (strOption (short 'u' <> long "cbl-url" <> metavar "URL" <> help "url of CABAL file (multiple)")) + <*> many (nullOption (short 'd' <> long "distro-pkg" <> OA.reader strTripleArg <> metavar "PKG,VER,REL" <> help "Distro package (multiple)")) + <*> many (strOption (short 'u' <> long "cbl-url" <> metavar "URL" <> help "URL of CABAL file (multiple)")) <*> many (strOption (short 'f' <> long "cbl-file" <> metavar "FILE" <> help "CABAL file (multiple)")) <*> arguments strPairArg (metavar "PKGNAME,VERSION ...") cmdAddPkgCmd = command "add" (info (helper <*> cmdAddPkgOpts) - (fullDesc <> progDesc "add a package to the database")) + (fullDesc <> progDesc "Add a package to the database")) cmdBumpPkgsOpts = CmdBumpPkgs - <$> switch (long "inclusive" <> help "include the listed packages") + <$> switch (long "inclusive" <> help "Include the listed packages") <*> arguments1 Just (metavar "PKGNAME ...") cmdBumpPkgsCmd = command "bump" (info (helper <*> cmdBumpPkgsOpts) - (fullDesc <> progDesc "bump packages that need it after updating the named packages")) + (fullDesc <> progDesc "Bump packages that need it after updating the named packages")) cmdBuildPkgsOpts = CmdBuildPkgs <$> arguments1 Just (metavar "PKGNAME ...") cmdBuildPkgsCmd = command "build" (info (helper <*> cmdBuildPkgsOpts) - (fullDesc <> progDesc "re-order packages into a good build order")) + (fullDesc <> progDesc "Re-order packages into a good build order")) cmdSyncOpts = CmdSync <$> switch (internal <> hidden) cmdSyncCmd = command "sync" (info (helper <*> cmdSyncOpts) - (fullDesc <> progDesc "update the index")) + (fullDesc <> progDesc "Update the index")) cmdVersionsOpts = CmdVersions - <$> switch (short 'l' <> long "latest" <> help "list only the latest version of packages") + <$> switch (short 'l' <> long "latest" <> help "List only the latest version of packages") <*> arguments1 Just (metavar "PKGNAME ...") cmdVersionsCmd = command "versions" (info (helper <*> cmdVersionsOpts) - (fullDesc <> progDesc "list available versions of packages")) + (fullDesc <> progDesc "List available versions of packages")) cmdUpdatesOpts = CmdUpdates - <$> switch (short 's' <> help "a shorter output suitable for scripting") + <$> switch (short 's' <> help "A shorter output suitable for scripting") cmdUpdatesCmd = command "updates" (info (helper <*> cmdUpdatesOpts) - (fullDesc <> progDesc "check for available updates")) + (fullDesc <> progDesc "Check for available updates")) cmdListPkgsOpts = CmdListPkgs - <$> switch (short 'g' <> long "ghc" <> help "list ghc packages") - <*> switch (short 'd' <> long "distro" <> help "list distro packages") - <*> switch (long "no-repo" <> help "do not list repo packages") - <*> switch (long "hackage" <> help "list in hackage format") + <$> switch (short 'g' <> long "ghc" <> help "List ghc packages") + <*> switch (short 'd' <> long "distro" <> help "List distro packages") + <*> switch (long "no-repo" <> help "Do not list repo packages") + <*> switch (long "hackage" <> help "List in hackage format") + <*> arguments str (metavar "PKGNAME ...") cmdListPkgsCmd = command "list" (info (helper <*> cmdListPkgsOpts) - (fullDesc <> progDesc "list packages in repo")) + (fullDesc <> progDesc "List packages in repo")) cmdUrlsOpts = CmdUrls <$> arguments1 strPairArg (metavar "PKGNAME,VERSION ...") cmdUrlsCmd = command "urls" (info (helper <*> cmdUrlsOpts) - (fullDesc <> progDesc "list urls of CABAL files for the given packages")) + (fullDesc <> progDesc "List urls of CABAL files for the given packages")) cmdPkgBuildOpts = CmdPkgBuild - <$> strOption (long "patchdir" <> value "patches" <> help "location of patches (patches)") + <$> nullOption (long "ghc-version" <> reader readerGhcVersion <> value ghcDefVersion <> help "GHC version to use in PKGBUILD") + <*> option (long "ghc-release" <> value 1 <> help "GHC release to use in PKGBUILD") + <*> strOption (long "patchdir" <> value "patches" <> help "Location of patches (patches)") <*> arguments1 Just (metavar "PKGNAME ...") cmdPkgBuildCmd = command "pkgbuild" (info (helper <*> cmdPkgBuildOpts) - (fullDesc <> progDesc "create PKGBUILD other files necessary for an Arch package")) + (fullDesc <> progDesc "Create PKGBUILD other files necessary for an Arch package")) cmdConvertDbOpts = CmdConvertDb - <$> strOption (short 'i' <> long "indb" <> value "cblrepo.db" <> help "old database") - <*> strOption (short 'o' <> long "outdb" <> value "new-cblrepo.db" <> help "new database") + <$> strOption (short 'i' <> long "indb" <> value "cblrepo.db" <> help "Old database") + <*> strOption (short 'o' <> long "outdb" <> value "new-cblrepo.db" <> help "New database") cmdConvertDbCmd = command "convertdb" (info (helper <*> cmdConvertDbOpts) - (fullDesc <> progDesc "convert an old database to the new format")) + (fullDesc <> progDesc "Convert an old database to the new format")) cmdRemovePkgOpts = CmdRemovePkg <$> arguments1 Just (metavar "PKGNAME ...") cmdRemovePkgCmd = command "rm" (info (helper <*> cmdRemovePkgOpts) - (fullDesc <> progDesc "remove packages")) + (fullDesc <> progDesc "Remove packages")) -argParser = info (helper <*> opts) (fullDesc <> header (progName ++ " v" ++ (display version)) <> progDesc "maintain a datatbase of dependencies of CABAL packages") +argParser = info (helper <*> opts) (fullDesc <> header (progName ++ " v" ++ display version) <> progDesc "Maintain a datatbase of dependencies of CABAL packages") where opts = Opts <$> argAppDir <*> argDbFile <*> argDryRun <*> subparser ( @@ -117,13 +119,14 @@ cmdUpdatesCmd <> cmdListPkgsCmd <> cmdUrlsCmd <> cmdPkgBuildCmd <> cmdConvertDbCmd <> cmdRemovePkgCmd) -- {{{1 main +main :: IO () main = do defAppDir <- getAppUserDataDirectory progName execParser argParser >>= \ o -> do - let aD = if null (appDir o) then defAppDir else (appDir o) + let aD = if null (appDir o) then defAppDir else appDir o let o' = o { appDir = aD } - createDirectoryIfMissing True (aD) - case (optsCmd o') of + createDirectoryIfMissing True aD + case optsCmd o' of CmdAdd {} -> runCommand o' add CmdBuildPkgs {} -> runCommand o' buildPkgs CmdBumpPkgs {} -> runCommand o' bumpPkgs diff --git a/src/PkgBuild.hs b/src/PkgBuild.hs --- a/src/PkgBuild.hs +++ b/src/PkgBuild.hs @@ -1,5 +1,5 @@ {- - - Copyright 2011 Per Magnus Therning + - Copyright 2011-2014 Per Magnus Therning - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. @@ -34,17 +34,17 @@ db <- cfgGet dbFile >>= liftIO . readDb pD <- cfgGet $ patchDir . optsCmd pkgs <- cfgGet $ pkgs . optsCmd - mapM (runErrorT . generatePkgBuild db pD) pkgs >>= exitOnErrors >> return () + ghcVersion <- cfgGet $ ghcVer . optsCmd + ghcRelease <- cfgGet $ ghcRel . optsCmd + void $ mapM (runErrorT . generatePkgBuild ghcVersion ghcRelease db pD) pkgs >>= exitOnErrors --- TODO: --- generatePkgBuild :: CblDB -> String -> String -> ErrorT String IO () -generatePkgBuild db patchDir pkg = let - appendPkgVer = pkg ++ "," ++ (display $ pkgVersion $ fromJust $ lookupPkg db pkg) +generatePkgBuild ghcVer ghcRel db patchDir pkg = let + appendPkgVer = pkg ++ "," ++ display (pkgVersion $ fromJust $ lookupPkg db pkg) in do maybe (throwError $ "Unknown package: " ++ pkg) (const $ return ()) (lookupPkg db pkg) genericPkgDesc <- withTempDirErrT "/tmp/cblrepo." (readCabal patchDir appendPkgVer) - pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return (finalizePkg db genericPkgDesc) - let archPkg = translate db (snd pkgDescAndFlags) (fst pkgDescAndFlags) + pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return (finalizePkg ghcVer db genericPkgDesc) + let archPkg = translate ghcVer ghcRel db (snd pkgDescAndFlags) (fst pkgDescAndFlags) archPkgWPatches <- liftIO $ addPatches patchDir archPkg archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkgWPatches) liftIO $ createDirectoryIfMissing False (apPkgName archPkgWHash) @@ -53,10 +53,10 @@ hPKGBUILD <- openFile "PKGBUILD" WriteMode hPutDoc hPKGBUILD $ pretty archPkgWHash hClose hPKGBUILD - maybe (return ()) (\ pfn -> (runErrorT $ applyPatch "PKGBUILD" pfn) >> return ()) (apPkgbuildPatch archPkgWHash) + maybe (return ()) (void . runErrorT . applyPatch "PKGBUILD") (apPkgbuildPatch archPkgWHash) when (apHasLibrary archPkgWHash) $ do hInstall <- openFile (apPkgName archPkgWHash <.> "install") WriteMode let archInstall = aiFromAP archPkgWHash hPutDoc hInstall $ pretty archInstall hClose hInstall - maybe (return ()) (\ pfn -> (runErrorT $ applyPatch (apPkgName archPkgWHash <.> "install") pfn)>> return ()) (apInstallPatch archPkgWHash) + maybe (return ()) (void . runErrorT . applyPatch (apPkgName archPkgWHash <.> "install") ) (apInstallPatch archPkgWHash) diff --git a/src/PkgDB.hs b/src/PkgDB.hs --- a/src/PkgDB.hs +++ b/src/PkgDB.hs @@ -19,6 +19,7 @@ module PkgDB where -- {{{1 imports +import Control.Arrow import Control.Exception as CE import Control.Monad import Data.List @@ -125,7 +126,7 @@ addPkg db n p = nubBy cmp newdb where cmp (CP n1 _) (CP n2 _) = n1 == n2 - newdb = (CP n p):db + newdb = CP n p:db addPkg2 :: CblDB -> CblPkg -> CblDB addPkg2 db (CP n p) = addPkg db n p @@ -143,7 +144,7 @@ bumpRelease db n = let doBump (CP n' p@RepoPkg { release = r }) = CP n' (p { release = nr }) where - nr = show $ (read r) + 1 + nr = show $ read r + (1 :: Int) doBump p = p in maybe db (addPkg2 db . doBump) (lookupPkg db n) @@ -153,12 +154,12 @@ | n == pkgName p = Just p | otherwise = lookupPkg db n -lookupDependants db n = filter (/= n) $ map pkgName $ filter (\ p -> doesDependOn p n) db +lookupDependants db n = filter (/= n) $ map pkgName $ filter (`doesDependOn` n) db where - doesDependOn p n = n `elem` (map _depName $ pkgDeps p) + doesDependOn p n = n `elem` map _depName (pkgDeps p) transitiveDependants :: CblDB -> [String] -> [String] -transitiveDependants db names = keepLast $ concat $ map transUsersOfOne names +transitiveDependants db names = keepLast $ concatMap transUsersOfOne names where transUsersOfOne n = n : transitiveDependants db (lookupDependants db n) keepLast = reverse . nub . reverse @@ -166,18 +167,19 @@ -- Todo: test checkDependants :: CblDB -> String -> V.Version -> [(String, Maybe P.Dependency)] checkDependants db n v = let - d1 = catMaybes $ map (lookupPkg db) (lookupDependants db n) - d2 = map (\ p -> (pkgName p, getDependencyOn n p)) d1 + d1 = mapMaybe (lookupPkg db) (lookupDependants db n) + -- d2 = map (\ p -> (pkgName p, getDependencyOn n p)) d1 + d2 = map (pkgName &&& getDependencyOn n ) d1 fails = filter (not . V.withinRange v . _depVersionRange . fromJust . snd) d2 in fails readDb :: FilePath -> IO CblDB -readDb fp = (flip CE.catch) +readDb fp = handle (\ e -> if isDoesNotExistError e then return emptyPkgDB else throwIO e) $ do - r <- (sequence . map decode . C.lines) `liftM` (C.readFile fp) + r <- (mapM decode . C.lines) `liftM` C.readFile fp case r of Just a -> return a Nothing -> fail "JSON parsing failed" diff --git a/src/Remove.hs b/src/Remove.hs --- a/src/Remove.hs +++ b/src/Remove.hs @@ -28,10 +28,10 @@ -- {{{1 remove remove :: Command () remove = do - dbFn <- cfgGet $ dbFile + dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn pkgs <- cfgGet $ pkgs . optsCmd - dR <- cfgGet $ dryRun + dR <- cfgGet dryRun liftIO $ either (\ s -> putStrLn s >> exitFailure) (\ newDb -> unless dR $ saveDb newDb dbFn) diff --git a/src/Updates.hs b/src/Updates.hs --- a/src/Updates.hs +++ b/src/Updates.hs @@ -21,23 +21,22 @@ import Codec.Archive.Tar as Tar import Codec.Compression.GZip as GZip +import Control.Arrow import Control.Monad import Control.Monad.Reader import Data.Maybe import Distribution.Text import Distribution.Version import System.FilePath -import qualified Data.ByteString.Lazy.Char8 as BS updates :: Command () updates = do db <- cfgGet dbFile >>= liftIO . readDb aD <- cfgGet appDir aCS <- cfgGet $ idxStyle .optsCmd - entries <- liftIO $ liftM (Tar.read . GZip.decompress) - (BS.readFile $ aD indexFileName) + entries <- liftIO $ liftM (Tar.read . GZip.decompress) (readIndexFile aD) let nonBasePkgs = filter (not . isBasePkg) db - let pkgsNVers = map (\ p -> (pkgName p, pkgVersion p)) nonBasePkgs + let pkgsNVers = map (pkgName &&& pkgVersion) nonBasePkgs let availPkgs = catMaybes $ eMap extractPkgVer entries let outdated = filter (\ (p, v) -> maybe False (> v) (latestVer p availPkgs)) @@ -45,7 +44,7 @@ let printer = if aCS then printOutdatedIdx else printOutdated - liftIO $ mapM_ (flip printer availPkgs) outdated + liftIO $ mapM_ (`printer` availPkgs) outdated type PkgVer = (String, Version) @@ -56,7 +55,7 @@ (pkg:ver':_) = map dropTrailingPathSeparator $ splitPath ep ver = simpleParse ver' in if isCabal && isJust ver - then Just $ (pkg, (fromJust ver)) + then Just (pkg, fromJust ver) else Nothing latestVer p pvs = let @@ -66,14 +65,15 @@ else Just $ maximum vs eMap _ Done = [] -eMap f (Next e es) = (f e):(eMap f es) +eMap f (Next e es) = f e:eMap f es +eMap _ (Fail _) = error "Failure to read index" printOutdated (p, v) avail = let l = fromJust $ latestVer p avail in - putStrLn $ p ++ ": " ++ (display v) ++ " (" ++ (display l) ++ ")" + putStrLn $ p ++ ": " ++ display v ++ " (" ++ display l ++ ")" -printOutdatedIdx (p, v) avail = let +printOutdatedIdx (p, _) avail = let l = fromJust $ latestVer p avail in - putStrLn $ p ++ "," ++ (display l) + putStrLn $ p ++ "," ++ display l diff --git a/src/Util/Misc.hs b/src/Util/Misc.hs --- a/src/Util/Misc.hs +++ b/src/Util/Misc.hs @@ -14,8 +14,6 @@ - limitations under the License. -} -{-# LANGUAGE TemplateHaskell #-} - module Util.Misc where -- {{{1 imports @@ -23,11 +21,13 @@ import Codec.Archive.Tar as Tar import Codec.Compression.GZip as GZip +import Control.Exception (onException) import Control.Monad import Control.Monad.Error import Control.Monad.Reader import Data.Either import Data.List +import Data.Version import Distribution.Compiler import Distribution.Package as P import Distribution.PackageDescription @@ -37,6 +37,8 @@ import Distribution.Text import Distribution.Verbosity import Distribution.Version +import Options.Applicative +import Safe (lastMay) import System.Directory import System.Exit import System.FilePath @@ -44,6 +46,7 @@ import System.Posix.Files import System.Process import System.Unix.Directory +import Text.ParserCombinators.ReadP (readP_to_S) import qualified Data.ByteString.Lazy.Char8 as BS -- {{{1 dependency @@ -56,24 +59,31 @@ mapM_ (putStrLn . (" " ++) . display) ds printBrksOth ((n, v), brks) = do - putStrLn $ "Adding " ++ n ++ " " ++ (display v) ++ " would break:" - mapM_ (\ (bN, (Just bD)) -> putStrLn $ " " ++ bN ++ " : " ++ (display bD)) brks + putStrLn $ "Adding " ++ n ++ " " ++ display v ++ " would break:" + mapM_ (\ (bN, Just bD) -> putStrLn $ " " ++ bN ++ " : " ++ display bD) brks -- {{{1 program variables progName = "cblrepo" dbName = progName ++ ".db" -ghcVersion = (Version [7, 6, 3] []) -ghcVersionDep = "ghc=" ++ display ghcVersion ++ "-1" +ghcDefVersion = Version [7, 6, 3] [] +ghcVersionDep :: Version -> Int -> String +ghcVersionDep ghcVer ghcRel = "ghc=" ++ display ghcVer ++ "-" ++ show ghcRel indexUrl = "http://hackage.haskell.org/packages/index.tar.gz" indexFileName = "index.tar.gz" +-- {{{1 command line parser helpers +readerGhcVersion :: String -> ReadM Version +readerGhcVersion arg = case lastMay $ readP_to_S parseVersion arg of + Just (v, "") -> return v + _ -> fail $ "cannot parse value `" ++ arg ++ "`" + -- {{{1 command line argument type data Cmds = CmdAdd - { patchDir :: FilePath, cmdAddGhcPkgs :: [(String,String)] + { patchDir :: FilePath, ghcVer :: Version, cmdAddGhcPkgs :: [(String,String)] , cmdAddDistroPkgs :: [(String, String, String)], cmdAddUrlCbls :: [String] , cmdAddFileCbls :: [FilePath], cmdAddCbls :: [(String, String)] } | CmdBuildPkgs { pkgs :: [String] } @@ -82,10 +92,10 @@ | CmdVersions { latest :: Bool, pkgs :: [String] } | CmdListPkgs { listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool - , hackageFmt :: Bool } + , hackageFmt :: Bool, pkgs :: [String] } | CmdUpdates { idxStyle :: Bool } | CmdUrls { pkgVers :: [(String, String)] } - | CmdPkgBuild { patchDir :: FilePath, pkgs :: [String] } + | CmdPkgBuild { ghcVer :: Version, ghcRel :: Int, patchDir :: FilePath, pkgs :: [String] } | CmdConvertDb { inDbFile :: FilePath, outDbFile :: FilePath } | CmdRemovePkg { pkgs :: [String] } deriving (Show) @@ -119,15 +129,20 @@ -- {{{1 applyPatchIfExist applyPatch origFilename patchFilename = do - (ec, _, err) <- liftIO $ readProcessWithExitCode "patch" [origFilename, patchFilename] "" + (ec, _, _) <- liftIO $ readProcessWithExitCode "patch" [origFilename, patchFilename] "" case ec of ExitSuccess -> return () ExitFailure _ -> throwError ("Failed patching " ++ origFilename ++ " with " ++ patchFilename) applyPatchIfExist origFilename patchFilename = - (liftIO $ fileExist patchFilename) >>= flip when (applyPatch origFilename patchFilename) + liftIO (fileExist patchFilename) >>= flip when (applyPatch origFilename patchFilename) +-- {{{1 index functions +readIndexFile indexLocation = exitOnException + "Cannot open index file, have you run the 'sync' command?" + (BS.readFile $ indexLocation indexFileName) + -- {{{1 package descriptions -- {{{2 readCabal data LocType = Url | Idx | File @@ -135,7 +150,7 @@ -- | Read in a Cabal file. readCabalFromUrl = readCabal readCabalFromFile = readCabal -readCabalFromIdx pd (p, v) td = readCabal pd (p ++ "," ++ v) td +readCabalFromIdx pd (p, v) = readCabal pd (p ++ "," ++ v) readCabal :: FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription readCabal patchDir loc tmpDir = let @@ -152,12 +167,12 @@ fn = tmpDir takeFileName loc extractCabal tmpDir loc = let - (p, (_: v)) = span (/= ',') loc + (p, _: v) = span (/= ',') loc path = p v p ++ ".cabal" pkgStr = p ++ " " ++ v fn = tmpDir (p ++ ".cabal") - esFindEntry p (Next e es) = if p == (entryPath e) + esFindEntry p (Next e es) = if p == entryPath e then Just e else esFindEntry p es esFindEntry _ _ = Nothing @@ -170,8 +185,7 @@ in do aD <- liftIO $ getAppUserDataDirectory "cblrepo" - es <- liftM (Tar.read . GZip.decompress) - (liftIO $ BS.readFile $ aD indexFileName) + es <- liftM (Tar.read . GZip.decompress) (liftIO $ readIndexFile aD) e <- maybe (throwError $ "No entry for " ++ pkgStr) return (esFindEntry path es) @@ -197,7 +211,7 @@ liftIO $ readPackageDescription silent cblFn -- {{{2 finalising -finalizePkg db gpd = let +finalizePkg ghcVersion db gpd = let n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd in finalizePackageDescription [] -- no flags @@ -210,11 +224,10 @@ checkAgainstDb db name dep = let dN = depName dep dVR = depVersionRange dep - in if dN == name - then True - else case DB.lookupPkg db dN of - Nothing -> False - Just (DB.CP _ p) -> withinRange (DB.version p) dVR + in (dN == name) || + (case DB.lookupPkg db dN of + Nothing -> False + Just (DB.CP _ p) -> withinRange (DB.version p) dVR) -- {{{1 Command type type Command a = ReaderT Opts IO a @@ -226,12 +239,14 @@ reWrapErrT (Left e) = throwError e reWrapErrT (Right v) = return v in do - r <- liftIO $ withTemporaryDirectory fp (\ p -> runErrorT $ func p) + r <- liftIO $ withTemporaryDirectory fp (runErrorT . func) reWrapErrT r exitOnErrors vs = let es = lefts vs in - if (not $ null $ lefts vs) + if not $ null $ lefts vs then liftIO $ mapM_ (hPutStrLn stderr) es >> exitFailure else return (rights vs) + +exitOnException msg a = onException a $ hPutStrLn stderr msg >> exitFailure diff --git a/src/Util/Translation.hs b/src/Util/Translation.hs --- a/src/Util/Translation.hs +++ b/src/Util/Translation.hs @@ -17,12 +17,6 @@ module Util.Translation where --- -import Add -import Distribution.PackageDescription.Parse -import Distribution.Verbosity --- - import PkgDB as DB import Util.Misc @@ -65,6 +59,7 @@ data ShVar a = ShVar String a deriving (Eq, Show) +{-# ANN shVarNewValue "HLint: ignore Eta reduce" #-} shVarNewValue (ShVar n _) v = ShVar n v shVarAppendValue (ShVar n v1) v2 = ShVar n (v1 `mappend` v2) shVarValue (ShVar _ v) = v @@ -149,7 +144,7 @@ }) = vsep [ text "# custom variables" , pretty hkgName - , maybe empty (\ fn -> pretty $ ShVar "_licensefile" fn) licenseFile + , maybe empty (pretty . ShVar "_licensefile") licenseFile , empty, text "# PKGBUILD options/directives" , pretty pkgName , pretty pkgVer @@ -165,22 +160,32 @@ , maybe empty pretty install , pretty sha256sums , empty, text "# PKGBUILD functions" + , empty + , prepareFunction + , empty , if hasLib then libBuildFunction else exeBuildFunction , empty , if hasLib then libPackageFunction else exePackageFunction , empty ] where - libBuildFunction = text "build() {" <> + prepareFunction = text "prepare() {" <> nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$> - maybe empty (\ _ -> + empty <$> + maybe (text "# no cabal patch") (\ _ -> text $ "patch " ++ shVarValue hkgName ++ ".cabal \"${srcdir}/cabal.patch\" ") cabalPatchFile <$> - maybe empty (\ _ -> - text $ "patch -p4 < \"${srcdir}/source.patch\"") - buildPatchFile <$> - nest 4 (text "runhaskell Setup configure -O -p --enable-split-objs --enable-shared \\" <$> + maybe (text "# no source patch") (\ _ -> + text "patch -p4 < \"${srcdir}/source.patch\"") + buildPatchFile + ) <$> + char '}' + libBuildFunction = text "build() {" <> + nest 4 (empty <$> + text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$> + empty <$> + nest 4 (text "runhaskell Setup configure -O --enable-library-profiling --enable-shared \\" <$> text "--prefix=/usr --docdir=\"/usr/share/doc/${pkgname}\" \\" <$> text "--libsubdir=\\$compiler/site-local/\\$pkgid" <> confFlags) <$> text "runhaskell Setup build" <$> @@ -193,12 +198,7 @@ exeBuildFunction = text "build() {" <> nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$> - maybe empty - (\ _ -> text $ "patch " ++ shVarValue hkgName ++ ".cabal \"${srcdir}/cabal.patch\" ") - cabalPatchFile <$> - maybe empty (\ _ -> - text $ "patch -p4 < \"${srcdir}/source.patch\"") - buildPatchFile <$> + empty <$> text "runhaskell Setup configure -O --prefix=/usr --docdir=\"/usr/share/doc/${pkgname}\"" <> confFlags <$> text "runhaskell Setup build" ) <$> @@ -212,13 +212,14 @@ libPackageFunction = text "package() {" <> nest 4 (empty <$> text "cd \"${srcdir}/${_hkgname}-${pkgver}\"" <$> + empty <$> text "install -D -m744 register.sh \"${pkgdir}/usr/share/haskell/${pkgname}/register.sh\"" <$> text "install -m744 unregister.sh \"${pkgdir}/usr/share/haskell/${pkgname}/unregister.sh\"" <$> text "install -d -m755 \"${pkgdir}/usr/share/doc/ghc/html/libraries\"" <$> text "ln -s \"/usr/share/doc/${pkgname}/html\" \"${pkgdir}/usr/share/doc/ghc/html/libraries/${_hkgname}\"" <$> text "runhaskell Setup copy --destdir=\"${pkgdir}\"" <$> - (maybe empty (\ _ -> text "install -D -m644 \"${_licensefile}\" \"${pkgdir}/usr/share/licenses/${pkgname}/LICENSE\"" <$> - text "rm -f \"${pkgdir}/usr/share/doc/${pkgname}/${_licensefile}\"") licenseFile) + maybe empty (\ _ -> text "install -D -m644 \"${_licensefile}\" \"${pkgdir}/usr/share/licenses/${pkgname}/LICENSE\"" <$> + text "rm -f \"${pkgdir}/usr/share/doc/${pkgname}/${_licensefile}\"") licenseFile ) <$> char '}' @@ -288,21 +289,21 @@ -- {{{1 translate -- TODO: -- • translation of extraLibDepends-libs to Arch packages -translate db fa pd = let +translate ghcVer ghcRel db fa pd = let ap = baseArchPkg (PackageName hkgName) = packageName pd pkgVer = packageVersion pd pkgRel = maybe "1" pkgRelease (lookupPkg db hkgName) - hasLib = maybe False (const True) (library pd) + hasLib = isJust (library pd) licFn = let l = licenseFile pd in if null l then Nothing else Just l - archName = (if hasLib then "haskell-" else "") ++ (map toLower hkgName) + archName = (if hasLib then "haskell-" else "") ++ map toLower hkgName pkgDesc = synopsis pd - url = if null (homepage pd) then "http://hackage.haskell.org/package/${_hkgname}" else (homepage pd) + url = if null (homepage pd) then "http://hackage.haskell.org/package/${_hkgname}" else homepage pd lic = display (license pd) - makeDepends = if hasLib then [] else [ghcVersionDep] ++ calcExactDeps db pd - depends = if hasLib then [ghcVersionDep] ++ calcExactDeps db pd else [] + makeDepends = if hasLib then [] else ghcVersionDep ghcVer ghcRel : calcExactDeps db pd + depends = if hasLib then ghcVersionDep ghcVer ghcRel : calcExactDeps db pd else [] extraLibDepends = maybe [] (extraLibs . libBuildInfo) (library pd) - install = if hasLib then (apShInstall ap) else Nothing + install = if hasLib then apShInstall ap else Nothing in ap { apPkgName = archName , apHkgName = hkgName @@ -329,9 +330,8 @@ -- correctly for all possible dependencies calcExactDeps db pd = let n = (\ (P.PackageName n) -> n ) (P.packageName pd) - remPkgs = (map DB.pkgName (filter isGhcPkg db)) ++ ghcPkgs ++ [n] - deps = filter (not . flip elem remPkgs) (map depName (buildDepends pd)) - lookupPkgVer = display . DB.pkgVersion . fromJust . lookupPkg db + remPkgs = map DB.pkgName (filter isGhcPkg db) ++ [n] + deps = filter (not . (`elem` remPkgs)) (map depName (buildDepends pd)) depString n = let pkg = fromJust $ lookupPkg db n name = map toLower $ DB.pkgName pkg @@ -340,10 +340,6 @@ in "haskell-" ++ name ++ "=" ++ ver ++ "-" ++ rel in map depString deps --- {{{2 ghcPkgs --- libraries included in GHC, but not marked as provided by the Arch package -ghcPkgs = ["base", "bin-package-db", "ffi", "ghc", "ghc-binary", "ghc-prim", "haskell2010", "integer-gmp", "rts"] - -- {{{1 stuff with patches -- {{{2 addPatches addPatches patchDir ap = let @@ -385,13 +381,12 @@ in do liftIO $ copyPatches tmpDir ap liftIO $ writeFile pkgbuildFn (show $ pretty ap) - maybe (return ()) (\ pfn -> (applyPatch pkgbuildFn pfn) >> return ()) pkgbuildPatch - (ec, out, er) <- liftIO $ withWorkingDirectory tmpDir (readProcessWithExitCode "makepkg" ["-g"] "") + maybe (return ()) (void . applyPatch pkgbuildFn) pkgbuildPatch + (ec, out, _) <- liftIO $ withWorkingDirectory tmpDir (readProcessWithExitCode "makepkg" ["-g"] "") case ec of - ExitFailure _ -> do - -- hPutStrLn stderr er - throwError $ "makepkg: error while calculating the source hashes for " ++ (apHkgName ap) - ExitSuccess -> do - if "sha256sums=(" `isPrefixOf` out - then return ap { apShSha256Sums = shVarNewValue (apShSha256Sums ap) (ShArray $ hashes out) } - else return ap + ExitFailure _ -> + throwError $ "makepkg: error while calculating the source hashes for " ++ apHkgName ap + ExitSuccess -> + return (if "sha256sums=(" `isPrefixOf` out then replaced else ap) + where + replaced = ap { apShSha256Sums = shVarNewValue (apShSha256Sums ap) (ShArray $ hashes out) } diff --git a/src/Versions.hs b/src/Versions.hs --- a/src/Versions.hs +++ b/src/Versions.hs @@ -27,7 +27,6 @@ import Distribution.Text import Distribution.Version import System.FilePath -import qualified Data.ByteString.Lazy.Char8 as BS versions :: Command () versions = do @@ -36,7 +35,7 @@ pkgs <- cfgGet $ pkgs . optsCmd let printFunc = if l then printLatestVersion else printAllVersions liftIO $ do - es <- liftM (Tar.read . GZip.decompress) (BS.readFile $ aD indexFileName) + es <- liftM (Tar.read . GZip.decompress) (readIndexFile aD) mapM_ (printFunc . findVersions es) pkgs findVersions es p = (p, findV p es []) @@ -44,14 +43,15 @@ findV pkgName (Next e es) acc = let eP = entryPath e (ePkg:v:_) = splitDirectories eP - in if ('/' `elem` eP) && (pkgName == ePkg) - then findV pkgName es (v:acc) - else findV pkgName es acc + in findV pkgName es + (if ('/' `elem` eP) && (pkgName == ePkg) then v:acc else acc) findV _ Done acc = let vs :: [Version] vs = map (fromJust . simpleParse) acc in map display $ sort vs + + findV _ (Fail _) _ = error "Failure to read index file" printAllVersions (p, vs) = do putStr $ p ++ " : "