diff --git a/cblrepo.cabal b/cblrepo.cabal --- a/cblrepo.cabal +++ b/cblrepo.cabal @@ -1,5 +1,5 @@ name: cblrepo -version: 0.3.1 +version: 0.4.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0 @@ -26,9 +26,9 @@ executable cblrepo hs-source-dirs: src main-is: Main.hs - other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs IdxSync - IdxVersion Updates ListPkgs Urls PkgBuild Util.Translation - OldPkgDB ConvertDB + other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs Sync + Versions Updates ListPkgs Urls PkgBuild Util.Translation + OldPkgDB ConvertDB Remove build-depends: base ==4.3.*, cmdargs ==0.7.*, filepath ==1.2.*, directory ==1.1.*, Cabal ==1.10.*, json ==0.4.*, bytestring ==0.9.*, tar ==0.3.*, zlib ==0.5.*, mtl ==2.0.*, diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -29,6 +29,7 @@ import Control.Monad import Control.Monad.Error import Control.Monad.Reader +import Data.Either import Data.List import Data.Maybe import Data.Version @@ -121,9 +122,9 @@ pD <- cfgGet patchDir cbls <- cfgGet cbls dR <- cfgGet dryRun - genPkgs <- liftIO $ mapM (\ c -> withTemporaryDirectory "/tmp/cblrepo." (readCabal pD c)) cbls + genPkgs <- mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabal pD c d)) cbls >>= exitOnErrors let pkgNames = map ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) genPkgs - liftIO $ when (or . catMaybes $ map (liftM isBasePkg . lookupPkg db) pkgNames) (putStrLn "Trying to add a base pkg!!" >> exitFailure) + exitOnErrors $ map (Left . (++) "Trying to add base package: ") (filter (maybe False isBasePkg . lookupPkg db) pkgNames) let tmpDb = filter (\ p -> not $ pkgName p `elem` pkgNames) db case doAddRepo tmpDb genPkgs of Left (unSats, brksOthrs) -> liftIO (mapM_ printUnSat unSats >> mapM_ printBrksOth brksOthrs) diff --git a/src/IdxSync.hs b/src/IdxSync.hs deleted file mode 100644 --- a/src/IdxSync.hs +++ /dev/null @@ -1,28 +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 IdxSync where - -import Util.Misc - -import Control.Monad.Reader -import System.FilePath -import Control.Monad.Error - -idxSync :: ReaderT Cmds IO () -idxSync = do - aD <- cfgGet appDir - liftIO $ getFromURL "http://hackage.haskell.org/packages/archive/00-index.tar.gz" (aD "00-index.tar.gz") diff --git a/src/IdxVersion.hs b/src/IdxVersion.hs deleted file mode 100644 --- a/src/IdxVersion.hs +++ /dev/null @@ -1,56 +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 IdxVersion where - -import Util.Misc - -import Codec.Archive.Tar as Tar -import Codec.Compression.GZip as GZip -import Control.Monad -import Control.Monad.Reader -import Data.List -import Data.Maybe -import Distribution.Text -import Distribution.Version -import System.FilePath -import qualified Data.ByteString.Lazy.Char8 as BS - -idxVersion :: ReaderT Cmds IO () -idxVersion = do - aD <- cfgGet appDir - pkgs <- cfgGet pkgs - liftIO $ do - es <- liftM (Tar.read . GZip.decompress) (BS.readFile $ aD "00-index.tar.gz") - mapM_ (printVersions . findVersions es) pkgs - -findVersions es p = (p, findV p es []) - where - 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 - - findV _ Done acc = let - vs :: [Version] - vs = map (fromJust . simpleParse) acc - in map display $ sort vs - -printVersions (p, vs) = do - putStr $ p ++ " : " - putStrLn $ unwords vs diff --git a/src/ListPkgs.hs b/src/ListPkgs.hs --- a/src/ListPkgs.hs +++ b/src/ListPkgs.hs @@ -27,9 +27,9 @@ listPkgs :: ReaderT Cmds IO () listPkgs = do - iB <- cfgGet incBase + lA <- cfgGet listAll db <- cfgGet dbFile >>= liftIO . readDb - let pkgs = if not iB + let pkgs = if not lA then filter (not . isBasePkg) db else db liftIO $ mapM_ printCblPkgShort pkgs diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -19,14 +19,15 @@ import Add import BuildPkgs import BumpPkgs -import IdxSync -import IdxVersion +import Sync +import Versions import ListPkgs import Updates import Util.Misc import Urls import PkgBuild import ConvertDB +import Remove import Paths_cblrepo @@ -72,18 +73,18 @@ , pkgs := def += args += typ "PKG" ] += name "build" += help "list packages that need rebuilding, in order" -cmdIdxSync = record defIdxSync [ argAppDir ] += help "update the index" +cmdSync = record defSync [ argAppDir ] += name "sync" += help "update the index" -cmdIdxVersion = record defIdxVersion +cmdVersions = record defVersions [ argAppDir , pkgs := def += args += typ "PKG" - ] += help "list available versions" + ] += name "versions" += help "list available versions" cmdUpdates = record defUpdates [ argAppDir , argDbFile ] += name "updates" += help "check for availabale updates" cmdListPkgs = record defListPkgs [ argAppDir, argDbFile - , incBase := False += help "include base packages in listing" + , listAll := False += name "a" += explicit += help "list all packages" ] += name "list" += help "list packages in repo" cmdUrls = record defUrls @@ -104,17 +105,23 @@ , outDbFile := "new-cblrepo.db" += explicit += name "o" += name "outdb" += typFile += help "new database" ] += help "convert an old database to the new format" +cmdRemovePkg = record defRemovePkg + [ argAppDir, argDbFile, argDryRun + , pkgs := def += args += typ "PKG" + ] += name "rm" += help "remove packages" + cmds = cmdArgsMode_ $ modes_ [ cmdAddPkg , cmdBuildPkgs , cmdBumpPkgs - , cmdIdxSync - , cmdIdxVersion + , cmdSync + , cmdVersions , cmdListPkgs , cmdUpdates , cmdUrls , cmdPkgBuild , cmdConvertDb + , cmdRemovePkg ] += program progName += summary (progName ++ " v" ++ (display version)) @@ -131,10 +138,11 @@ CmdAdd {} -> runReaderT add c' BuildPkgs {} -> runReaderT buildPkgs c' BumpPkgs {} -> runReaderT bumpPkgs c' - IdxSync {} -> runReaderT idxSync c' - IdxVersion {} -> runReaderT idxVersion c' + Sync {} -> runReaderT sync c' + Versions {} -> runReaderT versions c' ListPkgs {} -> runReaderT listPkgs c' Updates {} -> runReaderT updates c' Urls {} -> runReaderT urls c' PkgBuild {} -> runReaderT pkgBuild c' ConvertDb {} -> runReaderT convertDb c' + RemovePkg {} -> runReaderT remove c' diff --git a/src/PkgBuild.hs b/src/PkgBuild.hs --- a/src/PkgBuild.hs +++ b/src/PkgBuild.hs @@ -20,55 +20,46 @@ import Util.Misc import Util.Translation +import Control.Monad.Error import Control.Monad.Reader +import Data.Either import Data.Maybe import Distribution.Text -import System.Exit -import System.Unix.Directory import System.Directory -import System.IO(openFile) +import System.Exit import System.IO +import System.Unix.Directory import Text.PrettyPrint.ANSI.Leijen +pkgBuild :: ReaderT Cmds IO () +pkgBuild = do + db <- cfgGet dbFile >>= liftIO . readDb + pD <- cfgGet patchDir + pkgs <- cfgGet pkgs + mapM (runErrorT . generatePkgBuild db pD) pkgs >>= exitOnErrors >> return () + -- TODO: -- - patches: --- .cabal patch - put into sources array, copied into package dir --- PKGBUILD patch - applied -- build patch - put into source array, copied into package dir -- - flags -pkgBuild :: ReaderT Cmds IO () -pkgBuild = let - failFinalize _ = error "pkgBuild: unexpected failure to finalize a package" +-- generatePkgBuild :: CblDB -> String -> String -> ErrorT String IO () +generatePkgBuild db patchDir pkg = let + appendPkgVer = pkg ++ "," ++ (display $ pkgVersion $ fromJust $ lookupPkg db pkg) in do - db <- cfgGet dbFile >>= liftIO . readDb - pD <- cfgGet patchDir - pkgs <- cfgGet pkgs - unless (all isJust (map (lookupPkg db) pkgs)) $ - liftIO (mapM_ (printNotAPkg db) pkgs >> exitFailure) - let cbls = map (appendPkgVer db) pkgs - genPDs <- liftIO $ mapM (\ c -> withTemporaryDirectory "/tmp/cblrepo." (readCabal pD c)) cbls - let pds = map (either failFinalize id . finalizePkg db) genPDs - let aps = map (translate db . fst) pds - apsP <- liftIO $ mapM (addPatches pD) aps - apsF <- liftIO $ mapM (\ a -> withTemporaryDirectory "/tmp/cblrepo." (addHashes a)) apsP - liftIO $ mapM_ (\ a -> createDirectoryIfMissing False (apPkgName a)) apsF - liftIO $ mapM_ (\ a -> withWorkingDirectory (apPkgName a) $ do - copyPatches "." a - hF <- openFile "PKGBUILD" WriteMode - hPutDoc hF $ pretty a - hClose hF - maybe (return ()) (\ pfn -> applyPatch "PKGBUILD" pfn) (apPkgbuildPatch a) - when (apHasLibrary a) $ do - hFI <- openFile (apPkgName a ++ ".install") WriteMode - let ai = aiFromAP a - hPutDoc hFI $ pretty ai - hClose hFI - ) apsF - -printNotAPkg db pkg = maybe doPrint (const $ return ()) (lookupPkg db pkg) - where - doPrint = putStrLn $ "Unknown package: " ++ pkg - -appendPkgVer db pkg = let - displayVer = display . pkgVersion . fromJust . lookupPkg db - in pkg ++ "," ++ (displayVer pkg) + maybe (throwError $ "Unknown package: " ++ pkg) (const $ return ()) (lookupPkg db pkg) + genericPkgDesc <- withTempDirErrT "/tmp/cblrepo." (readCabal patchDir appendPkgVer) + pkgDesc <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) (return . fst) (finalizePkg db genericPkgDesc) + let archPkg = translate db pkgDesc + archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkg) + liftIO $ createDirectoryIfMissing False (apPkgName archPkgWHash) + liftIO $ withWorkingDirectory (apPkgName archPkgWHash) $ do + copyPatches "." archPkgWHash + hPKGBUILD <- openFile "PKGBUILD" WriteMode + hPutDoc hPKGBUILD $ pretty archPkgWHash + hClose hPKGBUILD + maybe (return ()) (\ pfn -> (runErrorT $ applyPatch "PKGBUILD" pfn) >> return ()) (apPkgbuildPatch archPkgWHash) + when (apHasLibrary archPkgWHash) $ do + hInstall <- openFile (apPkgName archPkgWHash ++ ".install") WriteMode + let archInstall = aiFromAP archPkgWHash + hPutDoc hInstall $ pretty archInstall + hClose hInstall diff --git a/src/Remove.hs b/src/Remove.hs new file mode 100644 --- /dev/null +++ b/src/Remove.hs @@ -0,0 +1,47 @@ +{- + - 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 Remove where + +-- {{{1 imports +-- {{{1 local +import PkgDB +import Util.Misc + +-- {{{1 system +import Control.Monad.Error +import Control.Monad.Reader +import System.Exit + +-- {{{1 remove +remove :: ReaderT Cmds IO () +remove = do + dbFn <- cfgGet dbFile + db <- liftIO $ readDb dbFn + pkgs <- cfgGet pkgs + dR <- cfgGet dryRun + liftIO $ either + (\ s -> putStrLn s >> exitFailure) + (\ newDb -> unless dR $ saveDb newDb dbFn) + (foldM removeOne db pkgs) + +removeOne :: CblDB -> String -> Either String CblDB +removeOne db pkg = let + deps = tail $ transitiveDependants db [pkg] + depsString = foldr (\ s t -> " " ++ s ++ "\n" ++ t) "" deps + in if null deps + then return (delPkg db pkg) + else throwError ("Can't delete package " ++ pkg ++ ", dependants:\n" ++ depsString) diff --git a/src/Sync.hs b/src/Sync.hs new file mode 100644 --- /dev/null +++ b/src/Sync.hs @@ -0,0 +1,28 @@ +{- + - 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 Sync where + +import Util.Misc + +import Control.Monad.Reader +import System.FilePath +import Control.Monad.Error + +sync :: ReaderT Cmds IO () +sync = do + aD <- cfgGet appDir + liftIO $ getFromURL "http://hackage.haskell.org/packages/archive/00-index.tar.gz" (aD "00-index.tar.gz") diff --git a/src/Util/Misc.hs b/src/Util/Misc.hs --- a/src/Util/Misc.hs +++ b/src/Util/Misc.hs @@ -26,6 +26,7 @@ import Control.Monad.Error import Control.Monad.Reader import Data.Data +import Data.Either import Data.List import Data.Typeable import Distribution.Compiler @@ -43,6 +44,7 @@ import System.IO import System.Posix.Files import System.Process +import System.Unix.Directory import qualified Control.Exception as CE import qualified Data.ByteString.Lazy.Char8 as BS @@ -71,25 +73,27 @@ = CmdAdd { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, dryRun :: Bool, pkgType :: PkgType, cbls :: [FilePath] } | BuildPkgs { appDir :: FilePath, dbFile :: FilePath, pkgs :: [String] } | BumpPkgs { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, inclusive :: Bool, pkgs :: [String] } - | IdxSync { appDir :: FilePath } - | IdxVersion { appDir :: FilePath, pkgs :: [String] } - | ListPkgs { appDir :: FilePath, dbFile :: FilePath, incBase :: Bool } + | Sync { appDir :: FilePath } + | Versions { appDir :: FilePath, pkgs :: [String] } + | ListPkgs { appDir :: FilePath, dbFile :: FilePath, listAll :: Bool } | Updates { appDir :: FilePath, dbFile :: FilePath } | Urls { appDir :: FilePath, pkgVers :: [(String, String)] } | PkgBuild { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, pkgs :: [String] } | ConvertDb { appDir :: FilePath, inDbFile :: FilePath, outDbFile :: FilePath } + | RemovePkg { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, pkgs :: [String] } deriving (Show, Data, Typeable) defCmdAdd = CmdAdd "" "" "" True RepoPkgT [] defBuildPkgs = BuildPkgs "" "" [] defBumpPkgs = BumpPkgs "" "" False False [] -defIdxSync = IdxSync "" -defIdxVersion = IdxVersion "" [] -defListPkgs = ListPkgs "" "" True +defSync = Sync "" +defVersions = Versions "" [] +defListPkgs = ListPkgs "" "" False defUpdates = Updates "" "" defUrls = Urls "" [] defPkgBuild = PkgBuild "" "" "" [] defConvertDb = ConvertDb "" "" "" +defRemovePkg = RemovePkg "" "" False [] cfgGet f = liftM f ask @@ -105,20 +109,21 @@ -- {{{1 applyPatchIfExist applyPatch origFilename patchFilename = do - (ec, _, err) <- readProcessWithExitCode "patch" [origFilename, patchFilename] "" + (ec, _, err) <- liftIO $ readProcessWithExitCode "patch" [origFilename, patchFilename] "" case ec of ExitSuccess -> return () ExitFailure _ -> - hPutStrLn stderr ("Failed patching " ++ origFilename ++ " with " ++ patchFilename) >> exitFailure + throwError ("Failed patching " ++ origFilename ++ " with " ++ patchFilename) applyPatchIfExist origFilename patchFilename = - fileExist patchFilename >>= flip when (applyPatch origFilename patchFilename) + (liftIO $ fileExist patchFilename) >>= flip when (applyPatch origFilename patchFilename) -- {{{1 package descriptions -- {{{2 readCabal data LocType = Url | Idx | File -- | Read in a Cabal file. +readCabal :: FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription readCabal patchDir loc tmpDir = let locType | isInfixOf "://" loc = Url @@ -150,16 +155,16 @@ _ -> Nothing in do - fp <- getAppUserDataDirectory "cblrepo" + fp <- liftIO $ getAppUserDataDirectory "cblrepo" es <- liftM (Tar.read . GZip.decompress) - (BS.readFile $ fp "00-index.tar.gz") - e <- maybe (error $ "No entry for " ++ pkgStr) + (liftIO $ BS.readFile $ fp "00-index.tar.gz") + e <- maybe (throwError $ "No entry for " ++ pkgStr) return (esFindEntry path es) - cbl <- maybe (error $ "Failed to extract contents for " ++ pkgStr) + cbl <- maybe (throwError $ "Failed to extract contents for " ++ pkgStr) return (eGetContent e) - writeFile fn cbl + liftIO $ writeFile fn cbl return fn extractName fn = liftM name $ readPackageDescription silent fn @@ -169,14 +174,13 @@ in do cblFn <- case locType of - File -> copyCabal tmpDir loc + File -> liftIO $ copyCabal tmpDir loc Idx -> extractCabal tmpDir loc - Url -> downloadCabal tmpDir loc - pn <- extractName cblFn + Url -> liftIO $ downloadCabal tmpDir loc + pn <- liftIO $ extractName cblFn let patchFn = patchDir pn <.> "cabal" - return patchFn applyPatchIfExist cblFn patchFn - readPackageDescription silent cblFn + liftIO $ readPackageDescription silent cblFn -- {{{2 finalising finalizePkg db = finalizePackageDescription @@ -205,3 +209,18 @@ return (if cE then Just cblPatch else Nothing, if pE then Just pkgPatch else Nothing, if bE then Just bldPatch else Nothing) + +-- {{{1 ErrorT +reWrapErrT (Left e) = throwError e +reWrapErrT (Right v) = return v + +withTempDirErrT fp func = do + r <- liftIO $ withTemporaryDirectory fp (\ p -> runErrorT $ func p) + reWrapErrT r + +exitOnErrors vs = let + es = lefts vs + in + if (not $ null $ lefts vs) + then liftIO $ mapM_ (hPutStrLn stderr) es >> exitFailure + else return (rights vs) diff --git a/src/Util/Translation.hs b/src/Util/Translation.hs --- a/src/Util/Translation.hs +++ b/src/Util/Translation.hs @@ -25,22 +25,23 @@ import PkgDB as DB import Util.Misc +import Control.Monad +import Control.Monad.Error +import Data.Char +import Data.List +import Data.Maybe import Data.Monoid -import Text.PrettyPrint.ANSI.Leijen hiding(()) import Data.Version -import Distribution.Text import Distribution.Package as P -import Data.Char import Distribution.PackageDescription -import Data.Maybe -import System.FilePath -import System.Unix.Directory +import Distribution.Text +import System.Directory import System.Exit +import System.FilePath import System.IO import System.Process -import Data.List -import System.Directory -import Control.Monad +import System.Unix.Directory +import Text.PrettyPrint.ANSI.Leijen hiding(()) -- {{{1 ShQuotedString newtype ShQuotedString = ShQuotedString String @@ -349,22 +350,19 @@ in maybe (return ()) (\ fn -> copyFile fn (destDir "cabal.patch")) cabalPatch -- {{{1 addHashes --- TODO: --- • deal with errors better addHashes ap tmpDir = let hashes = map (filter (`elem` "1234567890abcdef")) . lines . drop 11 pkgbuildFn = tmpDir "PKGBUILD" pkgbuildPatch = apPkgbuildPatch ap in do - copyPatches tmpDir ap - writeFile pkgbuildFn (show $ pretty ap) - maybe (return ()) (\ pfn -> applyPatch pkgbuildFn pfn) pkgbuildPatch - (ec, out, er) <- withWorkingDirectory tmpDir (readProcessWithExitCode "makepkg" ["-g"] "") + 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"] "") case ec of ExitFailure _ -> do - hPutStrLn stderr er - hPutStrLn stderr "makepkg: error while calculating the source hashes" - return ap + -- 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) } diff --git a/src/Versions.hs b/src/Versions.hs new file mode 100644 --- /dev/null +++ b/src/Versions.hs @@ -0,0 +1,56 @@ +{- + - 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 Versions where + +import Util.Misc + +import Codec.Archive.Tar as Tar +import Codec.Compression.GZip as GZip +import Control.Monad +import Control.Monad.Reader +import Data.List +import Data.Maybe +import Distribution.Text +import Distribution.Version +import System.FilePath +import qualified Data.ByteString.Lazy.Char8 as BS + +versions :: ReaderT Cmds IO () +versions = do + aD <- cfgGet appDir + pkgs <- cfgGet pkgs + liftIO $ do + es <- liftM (Tar.read . GZip.decompress) (BS.readFile $ aD "00-index.tar.gz") + mapM_ (printVersions . findVersions es) pkgs + +findVersions es p = (p, findV p es []) + where + 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 + + findV _ Done acc = let + vs :: [Version] + vs = map (fromJust . simpleParse) acc + in map display $ sort vs + +printVersions (p, vs) = do + putStr $ p ++ " : " + putStrLn $ unwords vs