cblrepo 0.10.1 → 0.11
raw patch · 12 files changed
+199/−179 lines, 12 filesdep +safedep ~Cabaldep ~basedep ~process
Dependencies added: safe
Dependency ranges changed: Cabal, base, process, unix
Files
- cblrepo.cabal +5/−5
- src/Add.hs +21/−20
- src/BumpPkgs.hs +7/−7
- src/ListPkgs.hs +12/−8
- src/Main.hs +38/−35
- src/PkgBuild.hs +10/−10
- src/PkgDB.hs +11/−9
- src/Remove.hs +2/−2
- src/Updates.hs +10/−10
- src/Util/Misc.hs +39/−24
- src/Util/Translation.hs +39/−44
- src/Versions.hs +5/−5
cblrepo.cabal view
@@ -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
src/Add.hs view
@@ -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
src/BumpPkgs.hs view
@@ -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
src/ListPkgs.hs view
@@ -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)
src/Main.hs view
@@ -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
src/PkgBuild.hs view
@@ -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)
src/PkgDB.hs view
@@ -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"
src/Remove.hs view
@@ -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)
src/Updates.hs view
@@ -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
src/Util/Misc.hs view
@@ -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
src/Util/Translation.hs view
@@ -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) }
src/Versions.hs view
@@ -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 ++ " : "