cblrepo 0.17.1 → 0.18.0

raw patch · 21 files changed

+331/−175 lines, 21 filesdep ~Unixutilsdep ~zlib

Dependency ranges changed: Unixutils, zlib

Files

• cblrepo.cabal +5/−5
• src/Add.hs +12/−10
• src/BuildPkgs.hs +2/−2
• src/BumpPkgs.hs +4/−4
• src/ConvertDB.hs +2/−2
• src/CreateConfig.hs +34/−0
• src/Extract.hs +21/−3
• src/ListPkgs.hs +14/−10
• src/Main.hs +31/−22
• src/PkgBuild.hs +10/−8
• src/Remove.hs +3/−3
• src/Sync.hs +0/−27
• src/Update.hs +30/−0
• src/Updates.hs +0/−56
• src/Upgrades.hs +58/−0
• src/Util/Cabal.hs +5/−3
• src/Util/Cfg.hs +53/−0
• src/Util/HackageIndex.hs +9/−6
• src/Util/Misc.hs +29/−9
• src/Util/Translation.hs +3/−1
• src/Versions.hs +6/−4

@@ -1,5 +1,5 @@ name: cblrepo-version: 0.17.1+version: 0.18.0 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0@@ -23,12 +23,12 @@ executable cblrepo     hs-source-dirs: src     main-is: Main.hs-    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+    other-modules: Add BumpPkgs BuildPkgs Update Versions Upgrades ListPkgs PkgBuild OldPkgDB ConvertDB Remove Extract CreateConfig+        PkgDB Util.Translation Util.Cabal Util.HackageIndex Util.Misc Util.Dist Util.Cfg     build-depends: base ==4.8.*, filepath ==1.4.*,         directory ==1.2.*, Cabal ==1.22.*, transformers ==0.4.*,-        bytestring ==0.10.*, tar ==0.4.*, zlib ==0.5.*, mtl ==2.2.*,-        process ==1.2.*, Unixutils ==1.53.*, unix ==2.7.*,+        bytestring ==0.10.*, tar ==0.4.*, zlib ==0.6.*, mtl ==2.2.*,+        process ==1.2.*, Unixutils ==1.54.*, unix ==2.7.*,         ansi-wl-pprint ==0.6.*, aeson ==0.9.*, stringsearch ==0.3.*,         optparse-applicative ==0.11.*, safe ==0.3.*, containers ==0.5.*,         utf8-string ==1

@@ -22,6 +22,7 @@ import qualified Util.Cabal as Cbl import Util.Misc import Util.Dist+import Util.Cfg  -- {{{2 system import Control.Monad.Reader@@ -45,15 +46,15 @@ -- {{{1 add add :: Command () add = do-    dbFn <- asks  dbFile+    dbFn <- asks $ dbFile . fst     db <- liftIO $ readDb dbFn-    dr <- asks  dryRun-    ghcVersion <- asks $ ghcVer . optsCmd-    filePkgs <- asks $ cmdAddFileCbls . optsCmd-    idxPkgs <- asks $ cmdAddCbls . optsCmd+    dr <- asks $ dryRun . fst+    ghcVersion <- asks $ ghcVer . optsCmd . fst+    filePkgs <- asks $ cmdAddFileCbls . optsCmd . fst+    idxPkgs <- asks $ cmdAddCbls . optsCmd . fst     ---    ghcPkgs <- asks  $ map (uncurry GhcType) . cmdAddGhcPkgs . optsCmd-    distroPkgs <- asks $ map (\ (n, v, x, r) -> DistroType n v x r) . cmdAddDistroPkgs . optsCmd+    ghcPkgs <- asks  $ map (uncurry GhcType) . cmdAddGhcPkgs . optsCmd . fst+    distroPkgs <- asks $ map (\ (n, v, x, r) -> DistroType n v x r) . cmdAddDistroPkgs . optsCmd . fst     genFilePkgs <- mapM (runCabalParseWithTempDir . fmap snd . Cbl.readFromFile . fst) filePkgs     genIdxPkgs <- mapM ((runCabalParseWithTempDir . fmap snd . Cbl.readFromIdx) . (\ (a, b, _) -> (a, b))) idxPkgs     genPkgs <- liftM (map RepoType) $ exitOnAnyLefts (genFilePkgs ++ genIdxPkgs)@@ -72,10 +73,11 @@  runCabalParseWithTempDir :: Cbl.CabalParse a -> Command (Either String a) runCabalParseWithTempDir f = do-    aD <- asks appDir-    pD <- asks $ patchDir . optsCmd+    aD <- asks $ appDir . fst+    pD <- asks $ patchDir . optsCmd . fst+    cfg <- asks snd     liftIO $ withTemporaryDirectory "/tmp/cblrepo." $ \ destDir -> do-        let cpe = Cbl.CabalParseEnv aD pD destDir+        let cpe = Cbl.CabalParseEnv aD pD destDir (getIndexFileName cfg)         Cbl.runCabalParse cpe f  getName (GhcType n _) = n

@@ -23,6 +23,6 @@  buildPkgs :: Command () buildPkgs = do-    db <- asks dbFile >>= liftIO . readDb-    pkgs <- asks  $ pkgs . optsCmd+    db <- asks (dbFile . fst) >>= liftIO . readDb+    pkgs <- asks  $ pkgs . optsCmd . fst     liftIO $ mapM_ putStrLn $ transitiveDependants db pkgs

@@ -23,11 +23,11 @@  bumpPkgs :: Command () bumpPkgs = do-    dbFn <- asks dbFile+    dbFn <- asks $ dbFile . fst     db <- liftIO $ readDb dbFn-    dR <- asks dryRun-    pkgs <- asks  $ pkgs . optsCmd-    incl <- asks  $ inclusive . optsCmd+    dR <- asks (dryRun . fst)+    pkgs <- asks  $ pkgs . optsCmd . fst+    incl <- asks  $ inclusive . optsCmd . fst     let bpkgs = transDependants db incl pkgs     let newDb = foldl bumpRelease db bpkgs     liftIO $ if dR

@@ -25,8 +25,8 @@  convertDb :: Command () convertDb = do-    inDbFn <- asks $ inDbFile . optsCmd-    outDbFn <- asks $ outDbFile . optsCmd+    inDbFn <- asks $ inDbFile . optsCmd . fst+    outDbFn <- asks $ outDbFile . optsCmd . fst     dbExist <- liftIO $ doesFileExist inDbFn     when dbExist $ do         newDb <- fmap doConvertDB (liftIO $ ODB.readDb inDbFn)

@@ -0,0 +1,34 @@+{-+ - Copyright 2015 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 CreateConfig+    where++import Util.Cfg+import Util.Misc++import Data.Aeson+import Control.Monad+import Control.Monad.IO.Class+import System.Exit+import System.Posix.Files++createConfig :: Command ()+createConfig = liftIO $ do+    exists <- fileExist "cblrepo.cfg"+    if exists+        then putStrLn "Configuration file already exists" >> exitFailure+        else saveDefCfg "cblrepo.cfg"

@@ -1,9 +1,26 @@+{-+ - Copyright 2014 - 2015 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.+ -}+ {-# LANGUAGE FlexibleContexts #-} module Extract     where  import Util.HackageIndex import Util.Misc+import Util.Cfg  import Control.Monad.Trans.Except import Control.Monad.Reader@@ -14,10 +31,11 @@  extract :: Command () extract = do-    aD <- asks appDir-    pkgsNVersions <- asks $ cmdExtractPkgs . optsCmd+    aD <- asks $ appDir . fst+    pkgsNVersions <- asks $ cmdExtractPkgs . optsCmd . fst+    cfg <- asks snd     ---    idx <- liftIO $ readIndexFile aD+    idx <- liftIO $ readIndexFile aD (getIndexFileName cfg)     _ <- mapM (runExceptT . extractAndSave idx) pkgsNVersions >>= exitOnAnyLefts     return () 

@@ -26,26 +26,30 @@  listPkgs :: Command () listPkgs = do-    lG <- asks $ listGhc . optsCmd-    lD <- asks $ listDistro . optsCmd-    lR <- asks $ noListRepo . optsCmd-    lH <- asks $ hackageFmt . optsCmd-    ps <- asks $ pkgs . optsCmd-    db <- asks dbFile >>= liftIO . readDb+    lG <- asks $ listGhc . optsCmd . fst+    lD <- asks $ listDistro . optsCmd . fst+    lR <- asks $ noListRepo . optsCmd . fst+    lF <- asks $ listFmt . optsCmd . fst+    ps <- asks $ pkgs . optsCmd . fst+    db <- asks (dbFile . fst) >>= liftIO . readDb     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+    let printer = case lF of+            CmdListShortFmt -> printCblPkgShort+            CmdListNormalFmt -> printCblPkgNormal+            CmdListHackageFmt -> printCblPkgHackage     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 =+printCblPkgShort p = putStrLn $ (pkgName p) ++ "," ++ (display $ pkgVersion p)++printCblPkgNormal :: CblPkg -> IO ()+printCblPkgNormal p =     putStrLn $ pkgName p ++ "  " ++ v ++ "-" ++ r ++ showFlagsIfPresent p         where             v = display (pkgVersion p) ++ if (not $ isGhcPkg p) then ("_" ++ show (pkgXRev p)) else ""

@@ -20,15 +20,17 @@ import Add import BuildPkgs import BumpPkgs-import Sync+import Update import Versions import ListPkgs-import Updates+import Upgrades import Util.Misc import PkgBuild import ConvertDB import Remove import Extract+import CreateConfig+import Util.Cfg  import Paths_cblrepo @@ -66,8 +68,8 @@ cmdBuildPkgsCmd = command "build" (info (helper <*> cmdBuildPkgsOpts)     (fullDesc <> progDesc "Re-order packages into a good build order")) -cmdSyncOpts = CmdSync <$> switch (internal <> hidden)-cmdSyncCmd = command "sync" (info (helper <*> cmdSyncOpts)+cmdUpdateOpts = CmdUpdate <$> switch (internal <> hidden)+cmdUpdateCmd = command "update" (info (helper <*> cmdUpdateOpts)     (fullDesc <> progDesc "Update the index"))  cmdVersionsOpts = CmdVersions@@ -76,16 +78,17 @@ cmdVersionsCmd = command "versions" (info (helper <*> cmdVersionsOpts)     (fullDesc <> progDesc "List available versions of packages")) -cmdUpdatesOpts = CmdUpdates+cmdUpgradesOpts = CmdUpgrades     <$> switch (short 's' <> help "A shorter output suitable for scripting")-cmdUpdatesCmd = command "updates" (info (helper <*> cmdUpdatesOpts)-    (fullDesc <> progDesc "Check for available updates"))+cmdUpgradesCmd = command "upgrades" (info (helper <*> cmdUpgradesOpts)+    (fullDesc <> progDesc "Check for packages that can be upgraded"))  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")+    <*> option listFormatReader (short 'f' <> long "format" <> value CmdListNormalFmt <>+            help "Output format: short, normal (default), hackage")     <*> many (argument str (metavar "PKGNAME ...")) cmdListPkgsCmd = command "list" (info (helper <*> cmdListPkgsOpts)     (fullDesc <> progDesc "List packages in repo"))@@ -113,12 +116,16 @@     <$> many (argument pkgNVersionArgReader (metavar "PKGNAME,VERSION")) cmdExtractCmd = command "extract" (info (helper <*> cmdExtractOpts) (fullDesc <> progDesc "Extract Cabal file from index")) +cmdCreateConfigOpts = pure CmdCreateConfig+cmdCreateConfigCmd = command "create-config" (info (helper <*> cmdCreateConfigOpts) (fullDesc <> progDesc "Create configuration file with defaults"))+ 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+                <> cmdBumpPkgsCmd <> cmdBuildPkgsCmd <> cmdUpdateCmd <> cmdVersionsCmd <> cmdUpgradesCmd                 <> cmdListPkgsCmd <> cmdPkgBuildCmd <> cmdConvertDbCmd <> cmdRemovePkgCmd <> cmdExtractCmd+                <> cmdCreateConfigCmd                 )  -- {{{1 main@@ -127,17 +134,19 @@     defAppDir <- getAppUserDataDirectory progName     execParser argParser >>= \ o -> do         let aD = if null (appDir o) then defAppDir else appDir o-        let o' = o { appDir = aD }         createDirectoryIfMissing True aD-        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-            CmdPkgBuild {} -> runCommand o' pkgBuild-            CmdConvertDb {} -> runCommand o' convertDb-            CmdRemovePkg {} -> runCommand o' remove-            CmdExtract {} -> runCommand o' extract+        cfg <- readCfg "cblrepo.cfg"+        let e = (o { appDir = aD }, cfg)+        case optsCmd o of+            CmdAdd {} -> runCommand e add+            CmdBuildPkgs {} -> runCommand e buildPkgs+            CmdBumpPkgs {} -> runCommand e bumpPkgs+            CmdUpdate {} -> runCommand e update+            CmdVersions {} -> runCommand e versions+            CmdListPkgs {} -> runCommand e listPkgs+            CmdUpgrades {} -> runCommand e upgrades+            CmdPkgBuild {} -> runCommand e pkgBuild+            CmdConvertDb {} -> runCommand e convertDb+            CmdRemovePkg {} -> runCommand e remove+            CmdExtract {} -> runCommand e extract+            CmdCreateConfig -> runCommand e createConfig

@@ -20,6 +20,7 @@ import Util.Misc import Util.Translation import qualified Util.Cabal as Cbl+import Util.Cfg  import Control.Arrow import Control.Monad.Reader@@ -33,15 +34,15 @@  pkgBuild :: Command () pkgBuild = do-    pkgs <- asks  $ pkgs . optsCmd+    pkgs <- asks  $ pkgs . optsCmd . fst     void $ mapM (runExceptT . generatePkgBuild) pkgs >>= exitOnAnyLefts  generatePkgBuild :: String -> ExceptT String Command () generatePkgBuild pkg = do-        db <- asks dbFile >>= liftIO . readDb-        patchDir <- asks  $ patchDir . optsCmd-        ghcVer <- asks $ ghcVer . optsCmd-        ghcRel <- asks $ ghcRel . optsCmd+        db <- asks (dbFile . fst) >>= liftIO . readDb+        patchDir <- asks  $ patchDir . optsCmd . fst+        ghcVer <- asks $ ghcVer . optsCmd . fst+        ghcRel <- asks $ ghcRel . optsCmd . fst         (ver, fa) <- maybe (throwE $ "Unknown package: " ++ pkg) (return . (pkgVersion &&& pkgFlags)) $ lookupPkg db pkg         ---         (cblFile, genericPkgDesc) <- runCabalParseWithTempDir $ Cbl.readFromIdx (pkg, ver)@@ -69,9 +70,10 @@  runCabalParseWithTempDir :: Cbl.CabalParse a -> ExceptT String Command a runCabalParseWithTempDir f = do-    aD <- asks appDir-    pD <- asks $ patchDir . optsCmd+    aD <- asks (appDir . fst)+    pD <- asks $ patchDir . optsCmd . fst+    cfg <- asks snd     r <- liftIO $ withTemporaryDirectory "/tmp/cblrepo." $ \ destDir -> do-        let cpe = Cbl.CabalParseEnv aD pD destDir+        let cpe = Cbl.CabalParseEnv aD pD destDir (getIndexFileName cfg)         Cbl.runCabalParse cpe f     reThrowE r

@@ -30,10 +30,10 @@ -- {{{1 remove remove :: Command () remove = do-    dbFn <- asks dbFile+    dbFn <- asks (dbFile . fst)     db <- liftIO $ readDb dbFn-    pkgs <- asks $ pkgs . optsCmd-    dR <- asks dryRun+    pkgs <- asks $ pkgs . optsCmd . fst+    dR <- asks (dryRun . fst)     liftIO $ either         (\ s -> putStrLn s >> exitFailure)         (\ newDb -> unless dR $ saveDb newDb dbFn)

@@ -1,27 +0,0 @@-{-- - 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.- - 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--sync :: Command ()-sync = do-    aD <- asks appDir-    liftIO $ getFromURL indexUrl (aD </> indexFileName)

@@ -0,0 +1,30 @@+{-+ - 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.+ - 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 Update where++import Util.Misc+import Util.Cfg++import Control.Monad.Reader+import System.FilePath++update :: Command ()+update = do+    aD <- asks $ appDir . fst+    cfg <- asks snd+    let idxFn = getIndexFileName cfg+    liftIO $ getFromURL (cfgIdxUrl cfg) (aD </> idxFn)

@@ -1,56 +0,0 @@-{-- - 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.- - 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 Updates-    ( updates-    ) where--import PkgDB-import Util.Misc-import Util.HackageIndex--import Control.Applicative-import Control.Arrow-import Control.Monad.Reader-import Data.Maybe-import Distribution.Text-import Distribution.Version--updates :: Command ()-updates = do-    db <- asks dbFile >>= liftIO . readDb-    aD <- asks appDir-    aCS <- asks $ idxStyle .optsCmd-    availPkgsNVers <- liftIO $ buildPkgVersions <$> readIndexFile aD-    let nonBasePkgs = filter (not . isBasePkg) db-        pkgsNVers = map (pkgName &&& pkgVersion &&& pkgXRev) nonBasePkgs-        outdated = filter-            (\ (p, vx) -> maybe False (> vx) (latestVersion availPkgsNVers p))-            pkgsNVers-        printer = if aCS-            then printOutdatedShort-            else printOutdated-    liftIO $ mapM_ (printer availPkgsNVers) outdated--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--printOutdatedShort :: PkgVersions -> (String, (Version, Int)) -> IO ()-printOutdatedShort avail (p, _) = putStrLn $ p ++ "," ++ display l-    where-        l = fst $ fromJust $ latestVersion avail p

@@ -0,0 +1,58 @@+{-+ - 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.+ - 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 Upgrades+    ( upgrades+    ) where++import PkgDB+import Util.Misc+import Util.HackageIndex+import Util.Cfg++import Control.Applicative+import Control.Arrow+import Control.Monad.Reader+import Data.Maybe+import Distribution.Text+import Distribution.Version++upgrades :: Command ()+upgrades = do+    db <- asks (dbFile . fst) >>= liftIO . readDb+    aD <- asks $ appDir . fst+    aCS <- asks $ idxStyle .optsCmd . fst+    cfg <- asks snd+    availPkgsNVers <- liftIO $ buildPkgVersions <$> readIndexFile aD (getIndexFileName cfg)+    let nonBasePkgs = filter (not . isBasePkg) db+        pkgsNVers = map (pkgName &&& pkgVersion &&& pkgXRev) nonBasePkgs+        outdated = filter+            (\ (p, vx) -> maybe False (> vx) (latestVersion availPkgsNVers p))+            pkgsNVers+        printer = if aCS+            then printOldShort+            else printOld+    liftIO $ mapM_ (printer availPkgsNVers) outdated++printOld :: PkgVersions -> (String, (Version, Int)) -> IO ()+printOld avail (p, (v, x)) = putStrLn $ p ++ ": " ++ display v ++ ":x" ++ show x ++ " (" ++ display lv ++ ":x" ++ show lx ++ ")"+    where+        (lv, lx) = fromJust $ latestVersion avail p++printOldShort :: PkgVersions -> (String, (Version, Int)) -> IO ()+printOldShort avail (p, _) = putStrLn $ p ++ "," ++ display l+    where+        l = fst $ fromJust $ latestVersion avail p

@@ -40,6 +40,7 @@     { cpeAppDir :: FilePath     , cpePatchDir :: FilePath     , cpeDestDir :: FilePath+    , cpeIdxFn :: FilePath     } deriving (Eq, Show)  -- | Type used for reading Cabal files@@ -67,15 +68,16 @@ readFromIdx (pN, pV) = do     destDir <- asks cpeDestDir     appDir <- asks cpeAppDir+    idxFn <- asks cpeIdxFn     let destFn = destDir </> pN <.> ".cabal"-    lift $ copyCabal appDir destFn+    lift $ copyCabal appDir idxFn destFn     cblFile <- patch destFn     gpd <- liftIO $ readPackageDescription silent destFn     return (cblFile, gpd)      where-        copyCabal appDir destFn = do-            idx <- liftIO $ readIndexFile appDir+        copyCabal appDir idxFn destFn = do+            idx <- liftIO $ readIndexFile appDir idxFn             cbl <- maybe (throwE $ "Failed to extract contents for " ++ pN ++ " " ++ display pV) return                 (extractCabal idx pN pV)             liftIO $ BSL.writeFile destFn cbl

@@ -0,0 +1,53 @@+{-+ - Copyright 2015 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.+ -}++{-# LANGUAGE TemplateHaskell #-}++module Util.Cfg+    ( Cfg(..)+    , readCfg+    , saveDefCfg+    , getIndexFileName+    ) where++import Control.Monad+import Data.Aeson+import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..))+import qualified Data.ByteString.Lazy as BSL+import Data.Maybe+import System.Posix.Files++data Cfg = Cfg { cfgIdxUrl :: String }+    deriving (Show)++defCfg = Cfg "http://hackage.fpcomplete.com/00-index.tar.gz"++readCfg :: FilePath -> IO Cfg+readCfg fn = do+    exists <- fileExist fn+    if exists+        then (fromMaybe defCfg . decode) `fmap` BSL.readFile fn+        else return defCfg++saveDefCfg :: FilePath -> IO ()+saveDefCfg fn = BSL.writeFile fn (encode defCfg)++getIndexFileName :: Cfg -> String+getIndexFileName cfg = map repSlash $ drop 7 $ cfgIdxUrl cfg+    where+        repSlash c = if c == '/' then '_' else c++$(deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField, allNullaryToStringTag = False } ''Cfg)

@@ -19,6 +19,7 @@  import Util.Misc import Util.Dist+import Util.Cfg  import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip@@ -36,10 +37,10 @@ import Distribution.Text import System.FilePath -readIndexFile :: FilePath -> IO BSL.ByteString-readIndexFile indexLocation = exitOnException+readIndexFile :: FilePath -> FilePath -> IO BSL.ByteString+readIndexFile indexLocation indexFilename = exitOnException     "Cannot open index file, have you run the 'sync' command?"-    (BSL.readFile $ indexLocation </> indexFileName)+    (BSL.readFile $ indexLocation </> indexFilename)  type PkgVersions = M.Map String [(Version, Int)] @@ -51,14 +52,16 @@     where         entries = Tar.read $ GZip.decompress idx -        createPkgVerMap acc (Tar.Next e es) = createPkgVerMap (M.insertWith (++) (parts !! 0) [(ver, xrev)] acc) es+        createPkgVerMap acc (Tar.Next e es) = case ver of+                Nothing -> createPkgVerMap acc es+                Just ver -> createPkgVerMap (M.insertWith (++) (head parts) [(ver, xrev)] acc) es             where                 parts = splitDirectories (Tar.entryPath e)-                ver = fromJust . simpleParse $ parts !! 1+                ver = simpleParse $ parts !! 1                 content = case Tar.entryContent e of                     Tar.NormalFile c _ -> Just $ BSLU.toString c                     _ -> Nothing-                xrev = case (parsePackageDescription <$> content) of+                xrev = case parsePackageDescription <$> content of                     Just (ParseOk _ gpd) -> pkgXRev (packageDescription gpd)                     _ -> 0 

@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-- - Copyright 2011-2014 Per Magnus Therning+ - Copyright 2011-2015 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.@@ -20,6 +20,7 @@ -- {{{1 imports import qualified PkgDB as DB import Util.Dist+import Util.Cfg  import Control.Exception (onException) import Control.Monad@@ -55,13 +56,10 @@ progName = "cblrepo" dbName = progName ++ ".db" -ghcDefVersion = Version [7, 10, 1] []+ghcDefVersion = Version [7, 10, 2] [] 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 readPkgNVersion :: ReadP (String, Version) readPkgNVersion = do@@ -152,7 +150,19 @@             Just (r, "") -> return r             _ -> fail $ "Cannot parse: " ++ s +listFormatReader :: ReadM CmdListFormat+listFormatReader = do+    s <- readerAsk+    case s of+        "normal" -> return CmdListNormalFmt+        "short" -> return CmdListShortFmt+        "hackage" -> return CmdListHackageFmt+        _ -> fail $ "Cannot parse: " ++ s+ -- {{{1 command line argument type+data CmdListFormat = CmdListNormalFmt | CmdListShortFmt | CmdListHackageFmt+    deriving (Eq, Show)+ data Cmds     = CmdAdd         { patchDir :: FilePath, ghcVer :: Version, cmdAddGhcPkgs :: [(String, Version)]@@ -160,16 +170,17 @@         , cmdAddCbls :: [(String, Version, FlagAssignment)] }     | CmdBuildPkgs { pkgs :: [String] }     | CmdBumpPkgs { inclusive :: Bool, pkgs :: [String] }-    | CmdSync { unused :: Bool }+    | CmdUpdate { unused :: Bool }     | CmdVersions { latest :: Bool, pkgs :: [String] }     | CmdListPkgs         { listGhc :: Bool, listDistro :: Bool, noListRepo :: Bool-        , hackageFmt :: Bool, pkgs :: [String] }-    | CmdUpdates { idxStyle :: Bool }+        , listFmt :: CmdListFormat, pkgs :: [String] }+    | CmdUpgrades { idxStyle :: Bool }     | CmdPkgBuild { ghcVer :: Version, ghcRel :: Int, patchDir :: FilePath, pkgs :: [String] }     | CmdConvertDb { inDbFile :: FilePath, outDbFile :: FilePath }     | CmdRemovePkg { pkgs :: [String] }     | CmdExtract { cmdExtractPkgs :: [(String, Version)] }+    | CmdCreateConfig     deriving (Show)  data Opts = Opts@@ -212,7 +223,7 @@         n = pkgNameStr gpd  -- {{{1 Command type-type Command = ReaderT Opts IO+type Command = ReaderT (Opts, Cfg) IO  runCommand cmds func = runReaderT func cmds @@ -233,3 +244,12 @@             else return (rights vs)  exitOnException msg a = onException a $ hPutStrLn stderr msg >> exitFailure++-- {{{1 shell escaping+shEsc :: String -> String+shEsc s = concatMap escChar s+    where+        escChar '\"' = "\\\""+        escChar '`' = "\\`"+        escChar '\'' = "\\\'"+        escChar c = [c]

@@ -47,7 +47,9 @@     deriving (Eq, Show)  instance Pretty ShQuotedString where-    pretty (ShQuotedString s) = char '"' <> text s <> char '"'+    pretty (ShQuotedString s) = char '"' <> text quotStr <> char '"'+        where+            quotStr = shEsc $ unwords $ lines s  -- {{{1 ShArray newtype ShArray = ShArray [String]

@@ -18,6 +18,7 @@  import Util.HackageIndex import Util.Misc+import Util.Cfg  import Control.Applicative import Control.Monad.Reader@@ -27,12 +28,13 @@  versions :: Command () versions = do-    aD <- asks appDir-    l <- asks $ latest . optsCmd-    pkgs <- asks $ pkgs . optsCmd+    aD <- asks (appDir . fst)+    l <- asks $ latest . optsCmd . fst+    pkgs <- asks $ pkgs . optsCmd . fst+    cfg <- asks snd     let printFunc = if l then printLatestVersion else printAllVersions     liftIO $ do-        pkgsNVers <- buildPkgVersions <$> readIndexFile aD+        pkgsNVers <- buildPkgVersions <$> readIndexFile aD (getIndexFileName cfg)         mapM_ (\ pkg -> printFunc (pkg, M.lookup pkg pkgsNVers)) pkgs  printAllVersions :: (String, Maybe [(Version, Int)]) -> IO ()