cblrepo 0.13 → 0.14.0
raw patch · 16 files changed
+497/−339 lines, 16 filesdep +containersdep +utf8-stringdep −json
Dependencies added: containers, utf8-string
Dependencies removed: json
Files
- cblrepo.cabal +5/−6
- src/Add.hs +21/−10
- src/ConvertDB.hs +13/−7
- src/Extract.hs +28/−0
- src/Main.hs +10/−10
- src/OldPkgDB.hs +29/−73
- src/PkgBuild.hs +29/−17
- src/PkgDB.hs +66/−15
- src/Updates.hs +21/−44
- src/Urls.hs +0/−29
- src/Util/Cabal.hs +104/−0
- src/Util/Dist.hs +45/−0
- src/Util/HackageIndex.hs +97/−0
- src/Util/Misc.hs +15/−99
- src/Util/Translation.hs +2/−1
- src/Versions.hs +12/−28
cblrepo.cabal view
@@ -1,5 +1,5 @@ name: cblrepo-version: 0.13+version: 0.14.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0@@ -23,15 +23,14 @@ executable cblrepo hs-source-dirs: src main-is: Main.hs- other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs Sync- Versions Updates ListPkgs Urls PkgBuild Util.Translation- OldPkgDB ConvertDB Remove+ other-modules: PkgDB Add BumpPkgs BuildPkgs Sync Versions Updates ListPkgs PkgBuild OldPkgDB ConvertDB Remove Extract+ Util.Translation Util.Cabal Util.HackageIndex Util.Misc Util.Dist build-depends: base ==4.7.*, filepath ==1.3.*,- directory ==1.2.*, Cabal ==1.18.*, json ==0.7.*,+ directory ==1.2.*, Cabal ==1.18.*, bytestring ==0.10.*, tar ==0.4.*, zlib ==0.5.*, mtl >=2.0 && <2.2, process ==1.2.*, Unixutils ==1.52.*, unix ==2.7.*, ansi-wl-pprint ==0.6.*, aeson ==0.8.*,- optparse-applicative ==0.11.*, safe+ optparse-applicative ==0.11.*, safe, containers, utf8-string Source-Repository head Type: git
src/Add.hs view
@@ -19,10 +19,13 @@ -- {{{1 imports -- {{{2 local import PkgDB+import qualified Util.Cabal as Cbl import Util.Misc+import Util.Dist -- {{{2 system-import Control.Monad.Error+import Control.Monad.Reader+-- import Control.Monad.Error import Data.List import Data.Maybe import Distribution.PackageDescription@@ -31,6 +34,7 @@ import Control.Arrow import Data.Monoid import Data.Either+import System.Unix.Directory -- {{{1 types data PkgType@@ -44,8 +48,6 @@ add = do dbFn <- optGet dbFile db <- liftIO $ readDb dbFn- ad <- optGet appDir- pd <- optGet $ patchDir . optsCmd dr <- optGet dryRun ghcVersion <- optGet $ ghcVer . optsCmd filePkgs <- optGet $ cmdAddFileCbls . optsCmd@@ -53,24 +55,33 @@ -- ghcPkgs <- optGet $ map (uncurry GhcType) . cmdAddGhcPkgs . optsCmd distroPkgs <- optGet $ map (\ (n, v, r) -> DistroType n v r) . cmdAddDistroPkgs . optsCmd- genFilePkgs <- mapM ((runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromFile ad pd) . fst) filePkgs- genIdxPkgs <- mapM ((runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromIdx ad pd) . (\ (a, b, _) -> (a, b))) idxPkgs+ genFilePkgs <- mapM (runCabalParseWithTempDir . Cbl.readFromFile . fst) filePkgs+ genIdxPkgs <- mapM ((runCabalParseWithTempDir . Cbl.readFromIdx) . (\ (a, b, _) -> (a, b))) idxPkgs genPkgs <- liftM (map RepoType) $ exitOnErrors (genFilePkgs ++ genIdxPkgs) -- let pkgs = ghcPkgs ++ distroPkgs ++ genPkgs pkgNames = map getName pkgs tmpDb = foldl delPkg db pkgNames oldFlags = map (maybe ([], []) (pkgName &&& pkgFlags) . lookupPkg db . getName) pkgs- fileFlags = map (\ (pkg, (_, fa)) -> ((\ (P.PackageName n) -> n) $ P.packageName pkg, fa)) (zip (rights genFilePkgs) filePkgs)+ fileFlags = map (\ (pkg, (_, fa)) -> (pkgNameStr pkg, fa))+ (zip (rights genFilePkgs) filePkgs) idxFlags = map (\ (a, _, b) -> (a, b)) idxPkgs flags = fileFlags `combineFlags` idxFlags `combineFlags` oldFlags case addPkgs ghcVersion tmpDb flags pkgs of Left (unsatisfiables, breaksOthers) -> liftIO (mapM_ printUnSat unsatisfiables >> mapM_ printBrksOth breaksOthers) Right newDb -> liftIO $ unless dr $ saveDb newDb dbFn +runCabalParseWithTempDir :: Cbl.CabalParse a -> Command (Either String a)+runCabalParseWithTempDir f = do+ aD <- asks appDir+ pD <- asks $ patchDir . optsCmd+ liftIO $ withTemporaryDirectory "/tmp/cblrepo." $ \ destDir -> do+ let cpe = Cbl.CabalParseEnv aD pD destDir+ Cbl.runCabalParse cpe f+ getName (GhcType n _) = n getName (DistroType n _ _) = n-getName (RepoType gpd) = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd+getName (RepoType gpd) = pkgNameStr $ packageDescription gpd -- {{{1 addPkgs addPkgs :: Version -> CblDB -> [(String, FlagAssignment)] -> [PkgType] -> Either ([(String, [P.Dependency])], [((String, Version), [(String, Maybe P.Dependency)])]) CblDB@@ -91,7 +102,7 @@ where fa = fromMaybe [] $ lookup (getName pkg) flags finable = either (const False) (const True) (finalizePkg ghcVer db fa gpd)- n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd+ n = pkgNameStr (packageDescription gpd) v = P.pkgVersion $ package $ packageDescription gpd depsOK = null $ checkDependants db n v @@ -106,7 +117,7 @@ finalizeToUnsatisfiableDeps ghcVer db flags pkg@(RepoType gpd) = let fa = fromMaybe [] $ lookup (getName pkg) flags in case finalizePkg ghcVer db fa gpd of- Left ds -> Just (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd, ds)+ Left ds -> Just (pkgNameStr (packageDescription gpd), ds) _ -> Nothing finalizeToUnsatisfiableDeps _ _ _ _ = Nothing@@ -122,7 +133,7 @@ then Nothing else Just ((n, v), d) findBreaking db (RepoType gpd) = let- n = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd+ n = pkgNameStr (packageDescription gpd) v = P.pkgVersion $ package $ packageDescription gpd d = checkDependants db n v in if null d
src/ConvertDB.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.@@ -16,13 +16,10 @@ module ConvertDB where --- {{{1 imports--- {{{2 local import Util.Misc import qualified OldPkgDB as ODB import qualified PkgDB as NDB --- {{{2 system import Control.Monad.Reader convertDb :: Command ()@@ -33,6 +30,15 @@ liftIO $ NDB.saveDb newDb outDbFn doConvert :: ODB.CblPkg -> NDB.CblPkg-doConvert (ODB.CP n (ODB.GhcPkg v)) = NDB.CP n (NDB.GhcPkg v)-doConvert (ODB.CP n (ODB.DistroPkg v r)) = NDB.CP n (NDB.DistroPkg v r)-doConvert (ODB.CP n (ODB.RepoPkg v d f r)) = NDB.CP n (NDB.RepoPkg v d f r)+doConvert o+ | ODB.isGhcPkg o = NDB.createGhcPkg n v+ | ODB.isDistroPkg o = NDB.createDistroPkg n v r+ | ODB.isRepoPkg o = NDB.createRepoPkg n v x d f r+ | otherwise = error ""+ where+ n = ODB.pkgName o+ v = ODB.pkgVersion o+ x = 0+ d = ODB.pkgDeps o+ f = ODB.pkgFlags o+ r = ODB.pkgRelease o
+ src/Extract.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}+module Extract+ where++import Util.HackageIndex+import Util.Misc++import Control.Monad.Error+import Control.Monad.Reader+import qualified Data.ByteString.Lazy as BSL+import Data.Version+import Distribution.Text (display)+import System.FilePath++extract :: Command ()+extract = do+ aD <- asks appDir+ pkgsNVersions <- asks $ cmdExtractPkgs . optsCmd+ --+ idx <- liftIO $ readIndexFile aD+ _ <- mapM (runErrorT . extractAndSave idx) pkgsNVersions >>= exitOnErrors+ return ()++extractAndSave :: (MonadError String m, MonadIO m) => BSL.ByteString -> (String, Version) -> m ()+extractAndSave idx (pkg, ver) = maybe (throwError errorMsg) (liftIO . BSL.writeFile destFn) (extractCabal idx pkg ver)+ where+ destFn = pkg <.> "cabal"+ errorMsg = "Failed to extract Cabal for " ++ pkg ++ " " ++ display ver
src/Main.hs view
@@ -25,10 +25,10 @@ import ListPkgs import Updates import Util.Misc-import Urls import PkgBuild import ConvertDB import Remove+import Extract import Paths_cblrepo @@ -87,11 +87,6 @@ cmdListPkgsCmd = command "list" (info (helper <*> cmdListPkgsOpts) (fullDesc <> progDesc "List packages in repo")) -cmdUrlsOpts = CmdUrls- <$> some (option pkgNVersionArgReader (metavar "PKGNAME,VERSION ..."))-cmdUrlsCmd = command "urls" (info (helper <*> cmdUrlsOpts)- (fullDesc <> progDesc "List urls of CABAL files for the given packages"))- cmdPkgBuildOpts = CmdPkgBuild <$> option ghcVersionArgReader (long "ghc-version" <> value ghcDefVersion <> help "GHC version to use in PKGBUILD") <*> option auto (long "ghc-release" <> value 1 <> help "GHC release to use in PKGBUILD")@@ -111,12 +106,17 @@ cmdRemovePkgCmd = command "rm" (info (helper <*> cmdRemovePkgOpts) (fullDesc <> progDesc "Remove packages")) +cmdExtractOpts = CmdExtract+ <$> many (argument pkgNVersionArgReader (metavar "PKGNAME,VERSION"))+cmdExtractCmd = command "extract" (info (helper <*> cmdExtractOpts) (fullDesc <> progDesc "Extract Cabal file from index"))+ 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 (- cmdAddPkgCmd <> cmdBumpPkgsCmd <> cmdBuildPkgsCmd <> cmdSyncCmd <> cmdVersionsCmd <>- cmdUpdatesCmd <> cmdListPkgsCmd <> cmdUrlsCmd <> cmdPkgBuildCmd <> cmdConvertDbCmd <> cmdRemovePkgCmd)+ <*> subparser ( cmdAddPkgCmd+ <> cmdBumpPkgsCmd <> cmdBuildPkgsCmd <> cmdSyncCmd <> cmdVersionsCmd <> cmdUpdatesCmd+ <> cmdListPkgsCmd <> cmdPkgBuildCmd <> cmdConvertDbCmd <> cmdRemovePkgCmd <> cmdExtractCmd+ ) -- {{{1 main main :: IO ()@@ -134,7 +134,7 @@ CmdVersions {} -> runCommand o' versions CmdListPkgs {} -> runCommand o' listPkgs CmdUpdates {} -> runCommand o' updates- CmdUrls {} -> runCommand o' urls CmdPkgBuild {} -> runCommand o' pkgBuild CmdConvertDb {} -> runCommand o' convertDb CmdRemovePkg {} -> runCommand o' remove+ CmdExtract {} -> runCommand o' extract
src/OldPkgDB.hs view
@@ -1,5 +1,5 @@ {-- - Copyright 2011 Per Magnus Therning+ - Copyright 2011-2013 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.@@ -14,22 +14,25 @@ - limitations under the License. -} +{-# LANGUAGE TemplateHaskell #-}+ module OldPkgDB where -- {{{1 imports+import Control.Arrow import Control.Exception as CE import Control.Monad-import Data.Data import Data.List import Data.Maybe-import Data.Typeable import Distribution.PackageDescription-import Distribution.Text import System.IO.Error-import Text.JSON import qualified Distribution.Package as P import qualified Distribution.Version as V +import Data.Aeson (decode, encode)+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..))+import qualified Data.ByteString.Lazy.Char8 as C+ -- {{{ temporary _depName (P.Dependency (P.PackageName n) _) = n _depVersionRange (P.Dependency _ vr) = vr@@ -123,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@@ -141,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) @@ -151,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@@ -164,80 +167,33 @@ -- 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 <- readFile fp >>= return . sequence . map decode . lines+ r <- (mapM decode . C.lines) `liftM` C.readFile fp case r of- Ok a -> return a- Error s -> fail s+ Just a -> return a+ Nothing -> fail "JSON parsing failed" saveDb :: CblDB -> FilePath -> IO ()-saveDb db fp = writeFile fp s+saveDb db fp = C.writeFile fp s where- s = unlines $ map encode $ sort db+ s = C.unlines $ map encode $ sort db -- {{{1 JSON instances-instance JSON CblPkg where- showJSON (CP n p) = showJSON (n, p)-- readJSON object = do- (n,p) <- readJSON object- return (CP n p)--instance JSON V.Version where- showJSON v = makeObj [ ("Version", showJSON $ display v) ]-- readJSON object = do- obj <- readJSON object- version <- valFromObj "Version" obj- maybe (fail "Not a Version object") return (simpleParse version)--instance JSON P.Dependency where- showJSON d = makeObj [ ("Dependency", showJSON $ display d) ]-- readJSON object = do- obj <- readJSON object- dep <- valFromObj "Dependency" obj- maybe (fail "Not a Dependency object") return (simpleParse dep)--instance JSON FlagName where- showJSON (FlagName n) = makeObj [ ("FlagName", showJSON n) ]-- readJSON object = do- obj <- readJSON object- n <- valFromObj "FlagName" obj- return $ FlagName n--instance JSON Pkg where- showJSON p@(GhcPkg { version = v}) = makeObj [("GhcPkg", showJSON v)]- showJSON p@(DistroPkg { version = v, release = r}) =- makeObj [("DistroPkg", showJSON (v, r))]- showJSON p@(RepoPkg { version = v, deps = d, flags = fa, release = r }) =- makeObj [("RepoPkg", showJSON (v, d, fa, r))]-- readJSON object = let- readGhc = do- obj <- readJSON object- v <- valFromObj "GhcPkg" obj >>= readJSON- return $ GhcPkg v-- readDistro = do- obj <- readJSON object- (v, r) <- valFromObj "DistroPkg" obj >>= readJSON- return $ DistroPkg v r-- readRepo = do- obj <- readJSON object- (v, d, fa, r) <- valFromObj "RepoPkg" obj >>= readJSON- return $ RepoPkg v d fa r-- in readGhc `mplus` readDistro `mplus` readRepo `mplus` fail "Not a Pkg object"+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''V.Version)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''V.VersionRange)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''P.Dependency)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''P.PackageName)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''FlagName)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''Pkg)+$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''CblPkg)
src/PkgBuild.hs view
@@ -19,10 +19,11 @@ import PkgDB import Util.Misc import Util.Translation+import qualified Util.Cabal as Cbl +import Control.Arrow+import Control.Monad.Reader import Control.Monad.Error-import Data.Maybe-import Distribution.Text import System.Directory import System.FilePath import System.IO@@ -31,20 +32,20 @@ pkgBuild :: Command () pkgBuild = do- db <- optGet dbFile >>= liftIO . readDb- aD <- optGet appDir- pD <- optGet $ patchDir . optsCmd- pkgs <- optGet $ pkgs . optsCmd- ghcVersion <- optGet $ ghcVer . optsCmd- ghcRelease <- optGet $ ghcRel . optsCmd- void $ mapM (runErrorT . generatePkgBuild ghcVersion ghcRelease db aD pD) pkgs >>= exitOnErrors+ pkgs <- asks $ pkgs . optsCmd+ void $ mapM (runErrorT . generatePkgBuild) pkgs >>= exitOnErrors -generatePkgBuild ghcVer ghcRel db appDir patchDir pkg = let- appendPkgVer = pkg ++ "," ++ display (pkgVersion $ fromJust $ lookupPkg db pkg)- in do- fa <- maybe (throwError $ "Unknown package: " ++ pkg) (\(CP _ x) -> return $ PkgDB.flags x) (lookupPkg db pkg)- genericPkgDesc <- withTempDirErrT "/tmp/cblrepo." (readCabal appDir patchDir appendPkgVer)- pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return (finalizePkg ghcVer db fa genericPkgDesc)+generatePkgBuild :: String -> ErrorT String Command ()+generatePkgBuild pkg = do+ db <- optGet dbFile >>= liftIO . readDb+ patchDir <- asks $ patchDir . optsCmd+ ghcVer <- optGet $ ghcVer . optsCmd+ ghcRel <- optGet $ ghcRel . optsCmd+ (ver, fa) <- maybe (throwError $ "Unknown package: " ++ pkg) (return . (pkgVersion &&& pkgFlags)) $ lookupPkg db pkg+ --+ genericPkgDesc <- runCabalParseWithTempDir $ Cbl.readFromIdx (pkg, ver)+ pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return+ (finalizePkg ghcVer db fa genericPkgDesc) let archPkg = translate ghcVer ghcRel db (snd pkgDescAndFlags) (fst pkgDescAndFlags) archPkgWPatches <- liftIO $ addPatches patchDir archPkg archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkgWPatches)@@ -54,10 +55,21 @@ hPKGBUILD <- openFile "PKGBUILD" WriteMode hPutDoc hPKGBUILD $ pretty archPkgWHash hClose hPKGBUILD- maybe (return ()) (void . runErrorT . applyPatch "PKGBUILD") (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 ()) (void . runErrorT . applyPatch (apPkgName archPkgWHash <.> "install") ) (apInstallPatch archPkgWHash)+ maybe (return ()) (void . runErrorT . applyPatch (apPkgName archPkgWHash <.> "install"))+ (apInstallPatch archPkgWHash)++runCabalParseWithTempDir :: Cbl.CabalParse a -> ErrorT String Command a+runCabalParseWithTempDir f = do+ aD <- asks appDir+ pD <- asks $ patchDir . optsCmd+ r <- liftIO $ withTemporaryDirectory "/tmp/cblrepo." $ \ destDir -> do+ let cpe = Cbl.CabalParseEnv aD pD destDir+ Cbl.runCabalParse cpe f+ reThrowError r
src/PkgDB.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,7 +16,38 @@ {-# LANGUAGE TemplateHaskell #-} -module PkgDB where+module PkgDB+ ( CblPkg+ , pkgName+ , pkgPkg+ , pkgVersion+ , pkgXRev+ , pkgDeps+ , pkgFlags+ , pkgRelease+ --+ , isGhcPkg+ , isDistroPkg+ , isRepoPkg+ , isBasePkg+ --+ , createGhcPkg+ , createDistroPkg+ , createRepoPkg+ , createCblPkg+ --+ , CblDB+ , addPkg+ , addPkg2+ , delPkg+ , bumpRelease+ , lookupPkg+ , transitiveDependants+ , checkDependants+ , checkAgainstDb+ , saveDb+ , readDb+ ) where -- {{{1 imports import Control.Arrow@@ -33,15 +64,13 @@ import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..)) import qualified Data.ByteString.Lazy.Char8 as C --- {{{ temporary-_depName (P.Dependency (P.PackageName n) _) = n-_depVersionRange (P.Dependency _ vr) = vr+import qualified Util.Dist -- {{{1 types data Pkg = GhcPkg { version :: V.Version } | DistroPkg { version :: V.Version, release :: String }- | RepoPkg { version :: V.Version, deps :: [P.Dependency], flags :: FlagAssignment, release :: String }+ | RepoPkg { version :: V.Version, xrev :: Int, deps :: [P.Dependency], flags :: FlagAssignment, release :: String } deriving (Eq, Show) data CblPkg = CP String Pkg@@ -79,6 +108,10 @@ pkgVersion :: CblPkg -> V.Version pkgVersion (CP _ p) = version p +pkgXRev :: CblPkg -> Int+pkgXRev (CP _ RepoPkg { xrev = x }) = x+pkgXRev _ = 0+ pkgDeps :: CblPkg -> [P.Dependency] pkgDeps (CP _ RepoPkg { deps = d}) = d pkgDeps _ = []@@ -92,26 +125,35 @@ pkgRelease (CP _ DistroPkg { release = r }) = r pkgRelease (CP _ RepoPkg { release = r }) = r +createGhcPkg :: String -> V.Version -> CblPkg createGhcPkg n v = CP n (GhcPkg v)++createDistroPkg :: String -> V.Version -> String -> CblPkg createDistroPkg n v r = CP n (DistroPkg v r)-createRepoPkg n v d fa r = CP n (RepoPkg v d fa r) +createRepoPkg :: String -> V.Version -> Int -> [P.Dependency] -> FlagAssignment -> String -> CblPkg+createRepoPkg n v x d fa r = CP n (RepoPkg v x d fa r)+ createCblPkg :: PackageDescription -> FlagAssignment -> CblPkg-createCblPkg pd fa = createRepoPkg name version deps fa "1"+createCblPkg pd fa = createRepoPkg name version xrev deps fa "1" where- name = (\ (P.PackageName n) -> n) (P.pkgName $ package pd)+ name = Util.Dist.pkgNameStr pd version = P.pkgVersion $ package pd+ xrev = Util.Dist.pkgXRev pd deps = buildDepends pd getDependencyOn :: String -> CblPkg -> Maybe P.Dependency-getDependencyOn n p = find (\ d -> _depName d == n) (pkgDeps p)+getDependencyOn n p = find (\ d -> Util.Dist.depName d == n) (pkgDeps p) +isGhcPkg :: CblPkg -> Bool isGhcPkg (CP _ GhcPkg {}) = True isGhcPkg _ = False +isDistroPkg :: CblPkg -> Bool isDistroPkg (CP _ DistroPkg {}) = True isDistroPkg _ = False +isRepoPkg :: CblPkg -> Bool isRepoPkg (CP _ RepoPkg {}) = True isRepoPkg _ = False @@ -141,12 +183,12 @@ delPkg db n = filter (\ p -> n /= pkgName p) db bumpRelease :: CblDB -> String -> CblDB-bumpRelease db n = let+bumpRelease db n = maybe db (addPkg2 db . doBump) (lookupPkg db n)+ where doBump (CP n' p@RepoPkg { release = r }) = CP n' (p { release = nr }) where nr = show $ read r + (1 :: Int) doBump p = p- in maybe db (addPkg2 db . doBump) (lookupPkg db n) lookupPkg :: CblDB -> String -> Maybe CblPkg lookupPkg [] _ = Nothing@@ -154,9 +196,10 @@ | n == pkgName p = Just p | otherwise = lookupPkg db n +lookupDependants :: [CblPkg] -> String -> [String] 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 Util.Dist.depName (pkgDeps p) transitiveDependants :: CblDB -> [String] -> [String] transitiveDependants db names = keepLast $ concatMap transUsersOfOne names@@ -164,14 +207,22 @@ transUsersOfOne n = n : transitiveDependants db (lookupDependants db n) keepLast = reverse . nub . reverse --- Todo: test checkDependants :: CblDB -> String -> V.Version -> [(String, Maybe P.Dependency)] checkDependants db n v = let 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+ fails = filter (not . V.withinRange v . Util.Dist.depVersionRange . fromJust . snd) d2 in fails++checkAgainstDb :: CblDB -> String -> P.Dependency -> Bool+checkAgainstDb db name dep = let+ dN = Util.Dist.depName dep+ dVR = Util.Dist.depVersionRange dep+ in (dN == name) ||+ (case lookupPkg db dN of+ Nothing -> False+ Just (CP _ p) -> V.withinRange (version p) dVR) readDb :: FilePath -> IO CblDB readDb fp = handle
src/Updates.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.@@ -14,66 +14,43 @@ - limitations under the License. -} -module Updates where+module Updates+ ( updates+ ) where import PkgDB import Util.Misc+import Util.HackageIndex -import Codec.Archive.Tar as Tar-import Codec.Compression.GZip as GZip+import Control.Applicative import Control.Arrow-import Control.Monad import Control.Monad.Reader import Data.Maybe import Distribution.Text import Distribution.Version-import System.FilePath updates :: Command () updates = do db <- optGet dbFile >>= liftIO . readDb aD <- optGet appDir aCS <- optGet $ idxStyle .optsCmd- entries <- liftIO $ liftM (Tar.read . GZip.decompress) (readIndexFile aD)+ availPkgsNVers <- liftIO $ buildPkgVersions <$> readIndexFile aD let nonBasePkgs = filter (not . isBasePkg) db- let pkgsNVers = map (pkgName &&& pkgVersion) nonBasePkgs- let availPkgs = catMaybes $ eMap extractPkgVer entries- let outdated = filter- (\ (p, v) -> maybe False (> v) (latestVer p availPkgs))+ pkgsNVers = map (pkgName &&& pkgVersion &&& pkgXRev) nonBasePkgs+ outdated = filter+ (\ (p, vx) -> maybe False (> vx) (latestVersion availPkgsNVers p)) pkgsNVers- let printer = if aCS- then printOutdatedIdx+ printer = if aCS+ then printOutdatedShort else printOutdated- liftIO $ mapM_ (`printer` availPkgs) outdated--type PkgVer = (String, Version)--extractPkgVer :: Entry -> Maybe PkgVer-extractPkgVer e = let- ep = entryPath e- isCabal = '/' `elem` ep- (pkg:ver':_) = map dropTrailingPathSeparator $ splitPath ep- ver = simpleParse ver'- in if isCabal && isJust ver- then Just (pkg, fromJust ver)- else Nothing--latestVer p pvs = let- vs = map snd $ filter ((== p) . fst) pvs- in if null vs- then Nothing- else Just $ maximum vs--eMap _ Done = []-eMap f (Next e es) = f e:eMap f es-eMap _ (Fail _) = error "Failure to read index"+ liftIO $ mapM_ (printer availPkgsNVers) outdated -printOutdated (p, v) avail = let- l = fromJust $ latestVer p avail- in- putStrLn $ p ++ ": " ++ display v ++ " (" ++ display l ++ ")"+printOutdated :: PkgVersions -> (String, (Version, Int)) -> IO ()+printOutdated avail (p, (v, x)) = putStrLn $ p ++ ": " ++ display v ++ ":x" ++ show x ++ " (" ++ display lv ++ ":x" ++ show lx ++ ")"+ where+ (lv, lx) = fromJust $ latestVersion avail p -printOutdatedIdx (p, _) avail = let- l = fromJust $ latestVer p avail- in- putStrLn $ p ++ "," ++ display l+printOutdatedShort :: PkgVersions -> (String, (Version, Int)) -> IO ()+printOutdatedShort avail (p, _) = putStrLn $ p ++ "," ++ display l+ where+ l = fst $ fromJust $ latestVersion avail p
− src/Urls.hs
@@ -1,29 +0,0 @@-{-- - Copyright 2011 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.- - You may obtain a copy of the License at- -- - http://www.apache.org/licenses/LICENSE-2.0- -- - Unless required by applicable law or agreed to in writing, software- - distributed under the License is distributed on an "AS IS" BASIS,- - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.- - See the License for the specific language governing permissions and- - limitations under the License.- -}--module Urls where--import Util.Misc--import Control.Monad.Reader-import Distribution.Text (display)--urls :: Command ()-urls = do- pkgs <- optGet $ pkgVers . optsCmd- liftIO $ mapM_ (putStrLn . createUrl) pkgs--createUrl (pkg, ver) = "http://hackage.haskell.org/packages/archive/" ++ pkg ++ "/" ++ display ver ++ "/" ++ pkg ++ ".cabal"
+ src/Util/Cabal.hs view
@@ -0,0 +1,104 @@+{-+ - Copyright 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.+ - You may obtain a copy of the License at+ -+ - http://www.apache.org/licenses/LICENSE-2.0+ -+ - Unless required by applicable law or agreed to in writing, software+ - distributed under the License is distributed on an "AS IS" BASIS,+ - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ - See the License for the specific language governing permissions and+ - limitations under the License.+ -}++module Util.Cabal+ where++import Util.HackageIndex++import Control.Monad.Error+import Control.Monad.Reader+import qualified Data.ByteString.Lazy as BSL+import Distribution.Package+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse+import Distribution.Text+import Distribution.Verbosity+import Distribution.Version+import System.Directory+import System.Exit+import System.FilePath+import System.Posix+import System.Process++data CabalParseEnv = CabalParseEnv+ { cpeAppDir :: FilePath+ , cpePatchDir :: FilePath+ , cpeDestDir :: FilePath+ } deriving (Eq, Show)++-- | Type used for reading Cabal files+type CabalParse a = ReaderT CabalParseEnv (ErrorT String IO) a++-- | Run a Cabal parse action in the provided environment.+runCabalParse :: CabalParseEnv -> CabalParse a -> IO (Either String a)+runCabalParse cpe f = runErrorT $ runReaderT f cpe++runCabalParseE :: CabalParseEnv -> CabalParse a -> (ErrorT String IO) a+runCabalParseE cpe f = runReaderT f cpe++readFromFile :: FilePath -- ^ file name+ -> CabalParse GenericPackageDescription+readFromFile fn = do+ destDir <- asks cpeDestDir+ let destFn = destDir </> takeFileName fn+ liftIO $ copyFile fn destFn+ patch destFn+ liftIO $ readPackageDescription silent destFn++readFromIdx :: (String, Version) -- ^ package name and version+ -> CabalParse GenericPackageDescription+readFromIdx (pN, pV) = do+ destDir <- asks cpeDestDir+ appDir <- asks cpeAppDir+ let destFn = destDir </> pN <.> ".cabal"+ copyCabal appDir destFn+ patch destFn+ liftIO $ readPackageDescription silent destFn++ where+ copyCabal appDir destFn = do+ idx <- liftIO $ readIndexFile appDir+ cbl <- maybe (throwError $ "Failed to extract contents for " ++ pN ++ " " ++ display pV) return+ (extractCabal idx pN pV)+ liftIO $ BSL.writeFile destFn cbl++-- | Patch a Cabal file.+--+-- The name of the patch file is based on the name of the Cabal package: @<cabal+-- pkg name>.patch@. The file is patched only if a patch with the correct name+-- is found in the patch directory (provided via 'CabalParseEnv').+patch :: FilePath -- ^ file to patch+ -> CabalParse ()+patch fn = do+ pkgName <- liftIO $ extractName fn+ patchDir <- asks cpePatchDir+ let patchFn = patchDir </> pkgName <.> "cabal"+ applyPatchIfExist fn patchFn++ where+ extractName fn = liftM name $ readPackageDescription silent fn+ name = display . pkgName . package . packageDescription++ applyPatchIfExist origFn patchFn =+ liftIO (fileExist patchFn) >>= flip when (applyPatch origFn patchFn)++ applyPatch origFn patchFn = do+ (ec, _, _) <- liftIO $ readProcessWithExitCode "patch" [origFn, patchFn] ""+ case ec of+ ExitSuccess -> return ()+ ExitFailure _ ->+ throwError ("Failed patching " ++ origFn ++ " with " ++ patchFn)
+ src/Util/Dist.hs view
@@ -0,0 +1,45 @@+{-+ - Copyright 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.+ - You may obtain a copy of the License at+ -+ - http://www.apache.org/licenses/LICENSE-2.0+ -+ - Unless required by applicable law or agreed to in writing, software+ - distributed under the License is distributed on an "AS IS" BASIS,+ - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ - See the License for the specific language governing permissions and+ - limitations under the License.+ -}++module Util.Dist+ ( depName+ , depVersionRange+ , pkgNameStr+ , pkgXRev+ ) where++import Distribution.Package+import Distribution.PackageDescription+import Distribution.Version++-- | Extract the name of a 'Dependency'.+depName :: Dependency -> String+depName (Dependency (PackageName n) _) = n++-- | Extract the version range from a 'Dependency'.+depVersionRange :: Dependency -> VersionRange+depVersionRange (Dependency _ vr) = vr++-- | Get the name from a 'Package', i.e. various variants of package+-- descriptions.+pkgNameStr :: Package pkg => pkg -> String+pkgNameStr p = n+ where+ (PackageName n) = packageName p++-- | Get the "x-revision" from a 'PackageDescription'.+pkgXRev :: PackageDescription -> Int+pkgXRev p = maybe 0 read $ lookup "x-revision" (customFieldsPD p)
+ src/Util/HackageIndex.hs view
@@ -0,0 +1,97 @@+{-+ - Copyright 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.+ - You may obtain a copy of the License at+ -+ - http://www.apache.org/licenses/LICENSE-2.0+ -+ - Unless required by applicable law or agreed to in writing, software+ - distributed under the License is distributed on an "AS IS" BASIS,+ - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ - See the License for the specific language governing permissions and+ - limitations under the License.+ -}++module Util.HackageIndex+ where++import Util.Misc+import Util.Dist++import qualified Codec.Archive.Tar as Tar+import qualified Codec.Compression.GZip as GZip+import Control.Applicative+import qualified Data.ByteString.Lazy as BSL+import qualified Data.ByteString.Lazy.UTF8 as BSLU+import Data.List+import qualified Data.Map as M+import Data.Maybe+import Data.Version+import Distribution.PackageDescription+import Distribution.PackageDescription.Parse+import Distribution.Text+import System.FilePath++readIndexFile :: FilePath -> IO BSL.ByteString+readIndexFile indexLocation = exitOnException+ "Cannot open index file, have you run the 'sync' command?"+ (BSL.readFile $ indexLocation </> indexFileName)++type PkgVersions = M.Map String [(Version, Int)]++-- | Build up a map of packages and their versions. The versions are listed in+-- descending order, i.e. `head` contains the latest version.+buildPkgVersions :: BSL.ByteString -- ^ the index+ -> PkgVersions+buildPkgVersions idx = createPkgVerMap M.empty entries+ where+ entries = Tar.read $ GZip.decompress idx++ createPkgVerMap acc (Tar.Next e es) = createPkgVerMap (M.insertWith (++) (parts !! 0) [(ver, xrev)] acc) es+ where+ parts = splitDirectories (Tar.entryPath e)+ ver = fromJust . simpleParse $ parts !! 1+ content = case Tar.entryContent e of+ Tar.NormalFile c _ -> Just $ BSLU.toString c+ _ -> Nothing+ xrev = case (parsePackageDescription <$> content) of+ Just (ParseOk _ gpd) -> pkgXRev (packageDescription gpd)+ _ -> 0++ createPkgVerMap acc Tar.Done = acc+ createPkgVerMap _ (Tar.Fail _) = undefined++latestVersion :: PkgVersions+ -> String -- ^ package name+ -> Maybe (Version, Int)+latestVersion pnv pkg = last . sort <$> M.lookup pkg pnv++extractCabal :: BSL.ByteString -- ^ the index+ -> String -- ^ package name+ -> Version -- ^ package version+ -> Maybe BSL.ByteString+extractCabal idx pkg ver = getContent entries+ where+ entries = Tar.read $ GZip.decompress idx+ pkgPath = pkg </> display ver </> pkg <.> "cabal"++ getContent (Tar.Next e es)+ | pkgPath == Tar.entryPath e =+ case Tar.entryContent e of+ Tar.NormalFile c _ -> Just c+ _ -> Nothing+ | otherwise = getContent es++ getContent _ = Nothing++getRevision :: BSL.ByteString -- ^ the index+ -> String -- ^ package name+ -> Version -- ^ package version+ -> Maybe Int+getRevision idx pkg ver = do+ cblStr <- BSLU.toString <$> extractCabal idx pkg ver+ case parsePackageDescription cblStr of+ ParseOk _ gpd -> maybe (return 0) (return . read) $ lookup "x-revision" (customFieldsPD $ packageDescription gpd)+ _ -> fail "no good"
src/Util/Misc.hs view
@@ -18,9 +18,8 @@ -- {{{1 imports import qualified PkgDB as DB+import Util.Dist -import Codec.Archive.Tar as Tar-import Codec.Compression.GZip as GZip import Control.Exception (onException) import Control.Monad import Control.Monad.Error@@ -28,31 +27,20 @@ import Data.Either import Data.Version import Distribution.Compiler-import Distribution.Package as P import Distribution.PackageDescription import Distribution.PackageDescription.Configuration-import Distribution.PackageDescription.Parse import Distribution.System import Distribution.Text-import Distribution.Verbosity-import Distribution.Version import Options.Applicative import Options.Applicative.Types import Safe (lastMay)-import System.Directory import System.Exit-import System.FilePath import System.IO import System.Posix.Files import System.Process import System.Unix.Directory import Text.ParserCombinators.ReadP hiding (many)-import qualified Data.ByteString.Lazy.Char8 as BS --- {{{1 dependency-depName (Dependency (PackageName n) _) = n-depVersionRange (Dependency _ vr) = vr- -- {{{ print functions printUnSat (n, ds) = do putStrLn $ "Failed to satisfy the following dependencies for " ++ n ++ ":"@@ -179,10 +167,10 @@ { listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool , hackageFmt :: Bool, pkgs :: [String] } | CmdUpdates { idxStyle :: Bool }- | CmdUrls { pkgVers :: [(String, Version)] } | CmdPkgBuild { ghcVer :: Version, ghcRel :: Int, patchDir :: FilePath, pkgs :: [String] } | CmdConvertDb { inDbFile :: FilePath, outDbFile :: FilePath } | CmdRemovePkg { pkgs :: [String] }+ | CmdExtract { cmdExtractPkgs :: [(String, Version)] } deriving (Show) data Opts = Opts@@ -213,102 +201,30 @@ applyPatchIfExist 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 = Idx | File---- | Read in a Cabal file.-readCabalFromFile = readCabal-readCabalFromIdx ad pd (p, v) = readCabal ad pd (p ++ "," ++ v')- where v' = display v--readCabal :: FilePath -> FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription-readCabal appDir patchDir loc tmpDir = let- locType- | ',' `elem` loc = Idx- | otherwise = File-- copyCabal tmpDir loc = copyFile loc fn >> return fn- where fn = tmpDir </> takeFileName loc-- extractCabal tmpDir loc = let- (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- then Just e- else esFindEntry p es- esFindEntry _ _ = Nothing-- eGetContent e = let- ec = entryContent e- in case ec of- NormalFile c _ -> Just $ BS.unpack c- _ -> Nothing-- in do- es <- liftM (Tar.read . GZip.decompress) (liftIO $ readIndexFile appDir)- e <- maybe (throwError $ "No entry for " ++ pkgStr)- return- (esFindEntry path es)- cbl <- maybe (throwError $ "Failed to extract contents for " ++ pkgStr)- return- (eGetContent e)- liftIO $ writeFile fn cbl- return fn-- extractName fn = liftM name $ readPackageDescription silent fn- where- packageName (PackageName s) = s- name = packageName . pkgName . package . packageDescription-- in do- cblFn <- case locType of- File -> liftIO $ copyCabal tmpDir loc- Idx -> extractCabal tmpDir loc- pn <- liftIO $ extractName cblFn- let patchFn = patchDir </> pn <.> "cabal"- applyPatchIfExist cblFn patchFn- liftIO $ readPackageDescription silent cblFn---- {{{2 finalising-finalizePkg ghcVersion db fa gpd = let- n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd- in finalizePackageDescription+-- {{{1 finalising package descriptions+finalizePkg ghcVersion db fa gpd = finalizePackageDescription fa- (checkAgainstDb db n)+ (DB.checkAgainstDb db n) (Platform X86_64 buildOS) -- platform (CompilerId GHC ghcVersion) -- compiler version [] -- no additional constraints gpd--checkAgainstDb db name dep = let- dN = depName dep- dVR = depVersionRange dep- in (dN == name) ||- (case DB.lookupPkg db dN of- Nothing -> False- Just (DB.CP _ p) -> withinRange (DB.version p) dVR)+ where+ n = pkgNameStr gpd -- {{{1 Command type-type Command a = ReaderT Opts IO a+type Command = ReaderT Opts IO runCommand cmds func = runReaderT func cmds -- {{{1 ErrorT-withTempDirErrT fp func = let- reWrapErrT (Left e) = throwError e- reWrapErrT (Right v) = return v- in do- r <- liftIO $ withTemporaryDirectory fp (runErrorT . func)- reWrapErrT r+reThrowError :: MonadError a m => Either a b -> m b+reThrowError = either throwError return++withTempDirErrT :: (MonadError e m, MonadIO m) => FilePath -> (FilePath -> ErrorT e IO b) -> m b+withTempDirErrT fp func = do+ r <- liftIO $ withTemporaryDirectory fp (runErrorT . func)+ reThrowError r exitOnErrors vs = let es = lefts vs
src/Util/Translation.hs view
@@ -19,6 +19,7 @@ import PkgDB as DB import Util.Misc+import Util.Dist import Control.Monad import Control.Monad.Error@@ -329,7 +330,7 @@ -- • this is most likely too simplistic to create the Arch package names -- correctly for all possible dependencies calcExactDeps db pd = let- n = (\ (P.PackageName n) -> n ) (P.packageName pd)+ n = pkgNameStr pd remPkgs = map DB.pkgName (filter isGhcPkg db) ++ [n] deps = filter (not . (`elem` remPkgs)) (map depName (buildDepends pd)) depString n = let
src/Versions.hs view
@@ -16,17 +16,14 @@ module Versions where +import Util.HackageIndex import Util.Misc -import Codec.Archive.Tar as Tar-import Codec.Compression.GZip as GZip-import Control.Monad+import Control.Applicative import Control.Monad.Reader-import Data.List-import Data.Maybe+import Data.Map as M import Distribution.Text import Distribution.Version-import System.FilePath versions :: Command () versions = do@@ -35,28 +32,15 @@ pkgs <- optGet $ pkgs . optsCmd let printFunc = if l then printLatestVersion else printAllVersions liftIO $ do- es <- liftM (Tar.read . GZip.decompress) (readIndexFile aD)- mapM_ (printFunc . findVersions es) pkgs+ pkgsNVers <- buildPkgVersions <$> readIndexFile aD+ mapM_ (\ pkg -> printFunc (pkg, M.lookup pkg pkgsNVers)) pkgs -findVersions es p = (p, findV p es [])+printAllVersions :: (String, Maybe [(Version, Int)]) -> IO ()+printAllVersions (p, Nothing) = putStrLn $ p ++ ": No such package"+printAllVersions (p, Just vs) = putStrLn $ p ++ ": " ++ versions where- findV pkgName (Next e es) acc = let- eP = entryPath e- (ePkg:v:_) = splitDirectories eP- 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 ++ " : "- putStrLn $ unwords vs+ versions = unwords $ display . fst <$> vs -printLatestVersion (p, vs) = do- putStr $ p ++ ","- putStrLn $ last vs+printLatestVersion :: (String, Maybe [(Version, Int)]) -> IO ()+printLatestVersion (p, Nothing) = putStrLn $ p ++ ": No such package"+printLatestVersion (p, Just vs) = putStrLn $ p ++ "," ++ display (fst $ head vs)