cblrepo 0.8.0 → 0.9.0
raw patch · 15 files changed
+188/−248 lines, 15 filesdep +aesondep +optparse-applicativedep −cmdargs
Dependencies added: aeson, optparse-applicative
Dependencies removed: cmdargs
Files
- cblrepo.cabal +3/−3
- src/Add.hs +8/−12
- src/BuildPkgs.hs +1/−5
- src/BumpPkgs.hs +4/−8
- src/ConvertDB.hs +3/−3
- src/ListPkgs.hs +4/−7
- src/Main.hs +81/−92
- src/OldPkgDB.hs +20/−8
- src/PkgBuild.hs +2/−5
- src/PkgDB.hs +20/−65
- src/Remove.hs +3/−4
- src/Updates.hs +1/−1
- src/Urls.hs +1/−1
- src/Util/Misc.hs +36/−33
- src/Versions.hs +1/−1
cblrepo.cabal view
@@ -1,5 +1,5 @@ name: cblrepo-version: 0.8.0+version: 0.9.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0@@ -25,11 +25,11 @@ other-modules: Util.Misc PkgDB Add BumpPkgs BuildPkgs Sync Versions Updates ListPkgs Urls PkgBuild Util.Translation OldPkgDB ConvertDB Remove- build-depends: base ==4.6.*, cmdargs ==0.10.*, filepath ==1.3.*,+ build-depends: base ==4.6.*, filepath ==1.3.*, directory ==1.2.*, Cabal ==1.16.*, 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.*,- ansi-wl-pprint ==0.6.*+ ansi-wl-pprint ==0.6.*, aeson ==0.6.*, optparse-applicative ==0.5.* Source-Repository head Type: git
src/Add.hs view
@@ -16,8 +16,6 @@ module Add where -import Debug.Trace- -- {{{1 imports -- {{{2 local import PkgDB@@ -25,8 +23,6 @@ -- {{{2 system import Control.Monad.Error-import Control.Monad.Reader-import Data.Either import Data.List import Data.Maybe import Distribution.PackageDescription@@ -44,16 +40,16 @@ -- {{{1 add add :: Command () add = do- dbFn <- cfgGet dbFile+ dbFn <- cfgGet dbFile db <- liftIO $ readDb dbFn- pd <- cfgGet patchDir- dr <- cfgGet dryRun+ pd <- cfgGet $ patchDir . optsCmd+ dr <- cfgGet dryRun --- ghcPkgs <- cfgGet cmdAddGhcPkgs- distroPkgs <- cfgGet cmdAddDistroPkgs- genUrlPkgs <- cfgGet cmdAddUrlCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromUrl pd c d))- genFilePkgs <- cfgGet cmdAddFileCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromFile pd c d))- genIdxPkgs <- cfgGet cmdAddCbls >>= mapM (\ c -> runErrorT $ withTempDirErrT "/tmp/cblrepo." (\ d -> readCabalFromIdx pd c d))+ 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)) pkgs <- exitOnErrors $ argsToPkgType ghcPkgs distroPkgs (genUrlPkgs ++ genFilePkgs ++ genIdxPkgs) -- let pkgNames = map getName pkgs
src/BuildPkgs.hs view
@@ -19,14 +19,10 @@ import PkgDB import Util.Misc -import Control.Monad import Control.Monad.Reader-import Data.List-import Data.Maybe-import System.FilePath buildPkgs :: Command () buildPkgs = do db <- cfgGet dbFile >>= liftIO . readDb- pkgs <- cfgGet pkgs+ pkgs <- cfgGet $ pkgs . optsCmd liftIO $ mapM_ putStrLn $ transitiveDependants db pkgs
src/BumpPkgs.hs view
@@ -19,19 +19,15 @@ import PkgDB import Util.Misc -import Control.Monad import Control.Monad.Reader-import Data.List-import Data.Maybe-import System.FilePath bumpPkgs :: Command () bumpPkgs = do- dbFn <- cfgGet dbFile+ dbFn <- cfgGet $ dbFile db <- liftIO $ readDb dbFn- dR <- cfgGet dryRun- pkgs <- cfgGet pkgs- incl <- cfgGet inclusive+ 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
src/ConvertDB.hs view
@@ -27,12 +27,12 @@ convertDb :: Command () convertDb = do- inDbFn <- cfgGet inDbFile- outDbFn <- cfgGet outDbFile+ inDbFn <- cfgGet $ inDbFile . optsCmd+ outDbFn <- cfgGet $ outDbFile . optsCmd newDb <- liftIO $ liftM (map doConvert) (ODB.readDb inDbFn) 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 r)) = NDB.CP n (NDB.RepoPkg v d [] r)+doConvert (ODB.CP n (ODB.RepoPkg v d f r)) = NDB.CP n (NDB.RepoPkg v d f r)
src/ListPkgs.hs view
@@ -20,20 +20,17 @@ import Util.Misc import PkgDB -import Control.Monad import Control.Monad.Reader import Data.List-import Data.Maybe import Distribution.Text-import System.FilePath import Distribution.PackageDescription listPkgs :: Command () listPkgs = do- lG <- cfgGet listGhc- lD <- cfgGet listDistro- lR <- cfgGet noListRepo- lH <- cfgGet hackageFmt+ lG <- cfgGet $ listGhc . optsCmd+ lD <- cfgGet $ listDistro . optsCmd+ lR <- cfgGet $ noListRepo . optsCmd+ lH <- cfgGet $ hackageFmt . optsCmd db <- cfgGet dbFile >>= liftIO . readDb let pkgs = filter (pkgFilter lG lD lR) db let printer = if lH
src/Main.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.@@ -34,114 +34,103 @@ import Control.Monad import Control.Monad.Reader import Distribution.Text-import System.Console.CmdArgs import System.Directory import System.FilePath+import Options.Applicative as OA --- {{{1 command line arguments-argAppDir = appDir := def += explicit += name "appdir" += help "application data directory" += typDir-argDbFile = dbFile := "cblrepo.db" += explicit += name "db" += help "package database" += typFile-argDryRun = dryRun := False += explicit += name "n" += help "dry run"+-- -- {{{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") -cmdAddPkg = record defCmdAdd- [ argAppDir, argDbFile- , patchDir := "patches" += explicit += name "patchdir" += help "location of patches" += typDir- , argDryRun- , cmdAddGhcPkgs := def += explicit += name "g" += name "ghc-pkg" += typ "PKG,VER" += help "GHC base package (multiple)"- , cmdAddDistroPkgs := def += explicit += name "d" += name "distro-pkg" += typ "PKG,VER,REL" += help "distro package (multiple)"- , cmdAddUrlCbls := def += explicit += name "u" += name "cbl-url" += typ "URL" += help "url of Cabal file (multiple)"- , cmdAddFileCbls := def += explicit += name "f" += name "cbl-file" += typFile += help "Cabal file (multiple)"- , cmdAddCbls := def += args += typ "PKG,VER"- ] += name "add" += help "add a package to the database"+cmdAddPkgOpts = CmdAdd+ <$> strOption (long "patchdir" <> value "patches" <> help "location of patches (patches)")+ <*> 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 (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")) -cmdBumpPkgs = record defBumpPkgs- [ argAppDir, argDbFile- , argDryRun- , inclusive := False += explicit += name "inclusive" += help "include listed packages"- , pkgs := def += args += typ "PKG"- ] += name "bump" += help "bump packages that need it after updating the named packages"+cmdBumpPkgsOpts = CmdBumpPkgs+ <$> 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")) -cmdBuildPkgs = record defBuildPkgs- [ argAppDir, argDbFile- , pkgs := def += args += typ "PKG"- ] += name "build" += help "list packages that need rebuilding, in order"+cmdBuildPkgsOpts = CmdBuildPkgs+ <$> arguments1 Just (metavar "PKGNAME ...")+cmdBuildPkgsCmd = command "build" (info (helper <*> cmdBuildPkgsOpts)+ (fullDesc <> progDesc "re-order packages into a good build order")) -cmdSync = record defSync [ argAppDir ] += name "sync" += help "update the index"+cmdSyncOpts = CmdSync <$> switch (internal <> hidden)+cmdSyncCmd = command "sync" (info (helper <*> cmdSyncOpts)+ (fullDesc <> progDesc "update the index")) -cmdVersions = record defVersions- [ argAppDir- , pkgs := def += args += typ "PKG"- ] += name "versions" += help "list available versions"+cmdVersionsOpts = CmdVersions+ <$> arguments1 Just (metavar "PKGNAME ...")+cmdVersionsCmd = command "versions" (info (helper <*> cmdVersionsOpts)+ (fullDesc <> progDesc "list available versions of packages")) -cmdUpdates = record defUpdates- [ argAppDir, argDbFile- , idxStyle := False += explicit += name "s" += help "a shorter output suitable for scripting"- ] += name "updates" += help "check for available updates"+cmdUpdatesOpts = CmdUpdates+ <$> switch (short 's' <> help "a shorter output suitable for scripting")+cmdUpdatesCmd = command "updates" (info (helper <*> cmdUpdatesOpts)+ (fullDesc <> progDesc "check for available updates")) -cmdListPkgs = record defCmdListPkgs- [ argAppDir, argDbFile- , listGhc := False += explicit += name "g" += name "ghc" += help "list ghc packages"- , listDistro := False += explicit += name "d" += name "distro" += help "list distro packages"- , noListRepo := False += explicit += name "no-repo" += help "do not list repo packages"- , hackageFmt := False += explicit += name "hackage" += help "list in hackage format"- ] += name "list" += help "list packages in repo"+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")+cmdListPkgsCmd = command "list" (info (helper <*> cmdListPkgsOpts)+ (fullDesc <> progDesc "list packages in repo")) -cmdUrls = record defUrls- [ argAppDir- , pkgVers := def += args += typ "STRING,STRING"- ] += help "list urls of cabal files for the given packages" += details- [ "The format for a package is <name>,<version>." ]+cmdUrlsOpts = CmdUrls+ <$> arguments1 strPairArg (metavar "PKGNAME,VERSION ...")+cmdUrlsCmd = command "urls" (info (helper <*> cmdUrlsOpts)+ (fullDesc <> progDesc "list urls of CABAL files for the given packages")) -cmdPkgBuild = record defPkgBuild- [ argAppDir, argDbFile- , patchDir := "patches" += explicit += name "patchdir" += help "location of patches (patches)" += typDir- , pkgs := def += args += typ "PKG"- ] += help "create a PKGBUILD, and other files necessary for an Arch package"+cmdPkgBuildOpts = CmdPkgBuild+ <$> 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")) -cmdConvertDb = record defConvertDb- [ argAppDir- , inDbFile := "cblrepo.db" += explicit += name "i" += name "indb" += typFile += help "old database"- , outDbFile := "new-cblrepo.db" += explicit += name "o" += name "outdb" += typFile += help "new database"- ] += help "convert an old database to the new format"+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")+cmdConvertDbCmd = command "convertdb" (info (helper <*> cmdConvertDbOpts)+ (fullDesc <> progDesc "convert and old database to the new format")) -cmdRemovePkg = record defRemovePkg- [ argAppDir, argDbFile, argDryRun- , pkgs := def += args += typ "PKG"- ] += name "rm" += help "remove packages"+cmdRemovePkgOpts = CmdRemovePkg+ <$> arguments1 Just (metavar "PKGNAME ...")+cmdRemovePkgCmd = command "rm" (info (helper <*> cmdRemovePkgOpts)+ (fullDesc <> progDesc "remove packages")) -cmds = cmdArgsMode_ $ modes_- [ cmdAddPkg- , cmdBuildPkgs- , cmdBumpPkgs- , cmdSync- , cmdVersions- , cmdListPkgs- , cmdUpdates- , cmdUrls- , cmdPkgBuild- , cmdConvertDb- , cmdRemovePkg- ]- += program progName- += summary (progName ++ " v" ++ (display version))- += help "maintain a database 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 (+ cmdAddPkgCmd <> cmdBumpPkgsCmd <> cmdBuildPkgsCmd <> cmdSyncCmd <> cmdVersionsCmd <>+ cmdUpdatesCmd <> cmdListPkgsCmd <> cmdUrlsCmd <> cmdPkgBuildCmd <> cmdConvertDbCmd <> cmdRemovePkgCmd) -- {{{1 main main = do defAppDir <- getAppUserDataDirectory progName- cmdArgsRun cmds >>= \ c -> do- let aD = if null (appDir c) then defAppDir else (appDir c)- let c' = c { appDir = aD }+ execParser argParser >>= \ o -> do+ let aD = if null (appDir o) then defAppDir else (appDir o)+ let o' = o { appDir = aD } createDirectoryIfMissing True (aD)- case c' of- CmdAdd {} -> runCommand c' add- BuildPkgs {} -> runCommand c' buildPkgs- BumpPkgs {} -> runCommand c' bumpPkgs- Sync {} -> runCommand c' sync- Versions {} -> runCommand c' versions- CmdListPkgs {} -> runCommand c' listPkgs- Updates {} -> runCommand c' updates- Urls {} -> runCommand c' urls- PkgBuild {} -> runCommand c' pkgBuild- ConvertDb {} -> runCommand c' convertDb- RemovePkg {} -> runCommand c' remove+ case (optsCmd o') of+ CmdAdd {} -> runCommand o' add+ CmdBuildPkgs {} -> runCommand o' buildPkgs+ CmdBumpPkgs {} -> runCommand o' bumpPkgs+ CmdSync {} -> runCommand o' sync+ 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
src/OldPkgDB.hs view
@@ -38,7 +38,7 @@ data Pkg = GhcPkg { version :: V.Version } | DistroPkg { version :: V.Version, release :: String }- | RepoPkg { version :: V.Version, deps :: [P.Dependency], release :: String }+ | RepoPkg { version :: V.Version, deps :: [P.Dependency], flags :: FlagAssignment, release :: String } deriving (Eq, Show) data CblPkg = CP String Pkg@@ -80,6 +80,10 @@ pkgDeps (CP _ RepoPkg { deps = d}) = d pkgDeps _ = [] +pkgFlags :: CblPkg -> FlagAssignment+pkgFlags (CP _ RepoPkg { flags = fa}) = fa+pkgFlags _ = []+ pkgRelease :: CblPkg -> String pkgRelease (CP _ GhcPkg {}) = "xx" pkgRelease (CP _ DistroPkg { release = r }) = r@@ -87,10 +91,10 @@ createGhcPkg n v = CP n (GhcPkg v) createDistroPkg n v r = CP n (DistroPkg v r)-createRepoPkg n v d r = CP n (RepoPkg v d r)+createRepoPkg n v d fa r = CP n (RepoPkg v d fa r) -createCblPkg :: PackageDescription -> CblPkg-createCblPkg pd = createRepoPkg name version deps "1"+createCblPkg :: PackageDescription -> FlagAssignment -> CblPkg+createCblPkg pd fa = createRepoPkg name version deps fa "1" where name = (\ (P.PackageName n) -> n) (P.pkgName $ package pd) version = P.pkgVersion $ package pd@@ -205,12 +209,20 @@ 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, release = r }) =- makeObj [("RepoPkg", showJSON (v, d, r))]+ showJSON p@(RepoPkg { version = v, deps = d, flags = fa, release = r }) =+ makeObj [("RepoPkg", showJSON (v, d, fa, r))] readJSON object = let readGhc = do@@ -225,7 +237,7 @@ readRepo = do obj <- readJSON object- (v, d, r) <- valFromObj "RepoPkg" obj >>= readJSON- return $ RepoPkg v d r+ (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"
src/PkgBuild.hs view
@@ -21,13 +21,10 @@ import Util.Translation import Control.Monad.Error-import Control.Monad.Reader-import Data.Either import Data.Maybe import Distribution.Text import System.Directory import System.FilePath-import System.Exit import System.IO import System.Unix.Directory import Text.PrettyPrint.ANSI.Leijen@@ -35,8 +32,8 @@ pkgBuild :: Command () pkgBuild = do db <- cfgGet dbFile >>= liftIO . readDb- pD <- cfgGet patchDir- pkgs <- cfgGet pkgs+ pD <- cfgGet $ patchDir . optsCmd+ pkgs <- cfgGet $ pkgs . optsCmd mapM (runErrorT . generatePkgBuild db pD) pkgs >>= exitOnErrors >> return () -- TODO:
src/PkgDB.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,24 @@ - limitations under the License. -} +{-# LANGUAGE TemplateHaskell #-}+ module PkgDB where -- {{{1 imports 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)+import qualified Data.ByteString.Lazy.Char8 as C+ -- {{{ temporary _depName (P.Dependency (P.PackageName n) _) = n _depVersionRange (P.Dependency _ vr) = vr@@ -175,69 +177,22 @@ then return emptyPkgDB else throwIO e) $ do- r <- readFile fp >>= return . sequence . map decode . lines+ r <- (sequence . map 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 id ''CblPkg)+$(deriveJSON id ''V.Version)+$(deriveJSON id ''V.VersionRange)+$(deriveJSON id ''P.Dependency)+$(deriveJSON id ''P.PackageName)+$(deriveJSON id ''FlagName)+$(deriveJSON id ''Pkg)+$(deriveJSON id ''CblPkg)
src/Remove.hs view
@@ -23,16 +23,15 @@ -- {{{1 system import Control.Monad.Error-import Control.Monad.Reader import System.Exit -- {{{1 remove remove :: Command () remove = do- dbFn <- cfgGet dbFile+ dbFn <- cfgGet $ dbFile db <- liftIO $ readDb dbFn- pkgs <- cfgGet pkgs- dR <- cfgGet dryRun+ pkgs <- cfgGet $ pkgs . optsCmd+ dR <- cfgGet $ dryRun liftIO $ either (\ s -> putStrLn s >> exitFailure) (\ newDb -> unless dR $ saveDb newDb dbFn)
src/Updates.hs view
@@ -33,7 +33,7 @@ updates = do db <- cfgGet dbFile >>= liftIO . readDb aD <- cfgGet appDir- aCS <- cfgGet idxStyle+ aCS <- cfgGet $ idxStyle .optsCmd entries <- liftIO $ liftM (Tar.read . GZip.decompress) (BS.readFile $ aD </> "00-index.tar.gz") let nonBasePkgs = filter (not . isBasePkg) db
src/Urls.hs view
@@ -22,7 +22,7 @@ urls :: Command () urls = do- pkgs <- cfgGet pkgVers+ pkgs <- cfgGet $ pkgVers . optsCmd liftIO $ mapM_ (putStrLn . createUrl) pkgs createUrl (pkg, ver) = "http://hackage.haskell.org/packages/archive/" ++ pkg ++ "/" ++ ver ++ "/" ++ pkg ++ ".cabal"
src/Util/Misc.hs view
@@ -1,6 +1,5 @@-{-# LANGUAGE DeriveDataTypeable #-} {-- - 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.@@ -15,20 +14,20 @@ - limitations under the License. -} +{-# LANGUAGE TemplateHaskell #-}+ module Util.Misc where +-- {{{1 imports import qualified PkgDB as DB import Codec.Archive.Tar as Tar import Codec.Compression.GZip as GZip-import Control.Concurrent import Control.Monad import Control.Monad.Error import Control.Monad.Reader-import Data.Data import Data.Either import Data.List-import Data.Typeable import Distribution.Compiler import Distribution.Package as P import Distribution.PackageDescription@@ -45,10 +44,9 @@ 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 --- {{{1 Dependency+-- {{{1 dependency depName (Dependency (PackageName n) _) = n depVersionRange (Dependency _ vr) = vr @@ -72,33 +70,38 @@ data Cmds = CmdAdd- { appDir :: FilePath, dbFile :: FilePath, patchDir :: FilePath, dryRun :: Bool- , cmdAddGhcPkgs :: [(String,String)], cmdAddDistroPkgs :: [(String, String, String)]- , cmdAddUrlCbls :: [String], cmdAddFileCbls :: [FilePath], cmdAddCbls :: [(String, String)] }- | BuildPkgs { appDir :: FilePath, dbFile :: FilePath, pkgs :: [String] }- | BumpPkgs { appDir :: FilePath, dbFile :: FilePath, dryRun :: Bool, inclusive :: Bool, pkgs :: [String] }- | Sync { appDir :: FilePath }- | Versions { appDir :: FilePath, pkgs :: [String] }- | CmdListPkgs { appDir :: FilePath, dbFile :: FilePath, listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool, hackageFmt :: Bool }- | Updates { appDir :: FilePath, dbFile :: FilePath, idxStyle :: Bool }- | 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)+ { patchDir :: FilePath, cmdAddGhcPkgs :: [(String,String)]+ , cmdAddDistroPkgs :: [(String, String, String)], cmdAddUrlCbls :: [String]+ , cmdAddFileCbls :: [FilePath], cmdAddCbls :: [(String, String)] }+ | CmdBuildPkgs { pkgs :: [String] }+ | CmdBumpPkgs { inclusive :: Bool, pkgs :: [String] }+ | CmdSync { unused :: Bool }+ | CmdVersions { pkgs :: [String] }+ | CmdListPkgs+ { listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool+ , hackageFmt :: Bool }+ | CmdUpdates { idxStyle :: Bool }+ | CmdUrls { pkgVers :: [(String, String)] }+ | CmdPkgBuild { patchDir :: FilePath, pkgs :: [String] }+ | CmdConvertDb { inDbFile :: FilePath, outDbFile :: FilePath }+ | CmdRemovePkg { pkgs :: [String] }+ deriving (Show) -defCmdAdd = CmdAdd "" "" "" True [] [] [] [] []-defBuildPkgs = BuildPkgs "" "" []-defBumpPkgs = BumpPkgs "" "" False False []-defSync = Sync ""-defVersions = Versions "" []-defCmdListPkgs = CmdListPkgs "" "" False False False False-defUpdates = Updates "" "" False-defUrls = Urls "" []-defPkgBuild = PkgBuild "" "" "" []-defConvertDb = ConvertDb "" "" ""-defRemovePkg = RemovePkg "" "" False []+data Opts = Opts+ { appDir :: FilePath+ , dbFile :: FilePath+ , dryRun :: Bool+ , optsCmd :: Cmds+ } deriving (Show) +strPairArg s = let+ (s0, s1) = break (== ',') s+ in return (s0, tail s1)+strTripleArg s = let+ (s0, r1) = break (== ',') s+ (s1, r2) = break (== ',') (tail r1)+ in return (s0, s1, tail r2)+ cfgGet f = liftM f ask -- {{{1 getFromURL@@ -211,7 +214,7 @@ Just (DB.CP _ p) -> withinRange (DB.version p) dVR -- {{{1 Command type-type Command a = ReaderT Cmds IO a+type Command a = ReaderT Opts IO a runCommand cmds func = runReaderT func cmds
src/Versions.hs view
@@ -32,7 +32,7 @@ versions :: Command () versions = do aD <- cfgGet appDir- pkgs <- cfgGet pkgs+ pkgs <- cfgGet $ pkgs . optsCmd liftIO $ do es <- liftM (Tar.read . GZip.decompress) (BS.readFile $ aD </> "00-index.tar.gz") mapM_ (printVersions . findVersions es) pkgs