diff --git a/cblrepo.cabal b/cblrepo.cabal --- a/cblrepo.cabal +++ b/cblrepo.cabal @@ -1,5 +1,5 @@ name: cblrepo -version: 0.11.3 +version: 0.12 cabal-version: >= 1.6 license: OtherLicense license-file: LICENSE-2.0 @@ -31,7 +31,7 @@ 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.7.* && >= 0.6.2, - optparse-applicative ==0.9.*, safe + optparse-applicative ==0.10.*, safe Source-Repository head Type: git diff --git a/src/Add.hs b/src/Add.hs --- a/src/Add.hs +++ b/src/Add.hs @@ -26,9 +26,11 @@ import Data.List import Data.Maybe import Distribution.PackageDescription -import Distribution.Text import Distribution.Version import qualified Distribution.Package as P +import Control.Arrow +import Data.Monoid +import Data.Either -- {{{1 types data PkgType @@ -40,72 +42,75 @@ -- {{{1 add add :: Command () add = do - dbFn <- cfgGet dbFile + dbFn <- optGet dbFile db <- liftIO $ readDb dbFn - pd <- cfgGet $ patchDir . optsCmd - dr <- cfgGet dryRun - ghcVersion <- cfgGet $ ghcVer . optsCmd + ad <- optGet appDir + pd <- optGet $ patchDir . optsCmd + dr <- optGet dryRun + ghcVersion <- optGet $ ghcVer . optsCmd + filePkgs <- optGet $ cmdAddFileCbls . optsCmd + idxPkgs <- optGet $ cmdAddCbls . optsCmd -- - ghcPkgs <- cfgGet $ cmdAddGhcPkgs . optsCmd - distroPkgs <- cfgGet $ cmdAddDistroPkgs . optsCmd - genUrlPkgs <- cfgGet (cmdAddUrlCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromUrl pd) - genFilePkgs <- cfgGet (cmdAddFileCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromFile pd) - genIdxPkgs <- cfgGet (cmdAddCbls . optsCmd) >>= mapM (runErrorT . withTempDirErrT "/tmp/cblrepo." . readCabalFromIdx pd) - pkgs <- exitOnErrors $ argsToPkgType ghcPkgs distroPkgs (genUrlPkgs ++ genFilePkgs ++ genIdxPkgs) + 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 + genPkgs <- liftM (map RepoType) $ exitOnErrors (genFilePkgs ++ genIdxPkgs) -- - let pkgNames = map getName pkgs - let tmpDb = foldl delPkg db pkgNames - case addPkgs ghcVersion tmpDb pkgs of + 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) + 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 -argsToPkgType ghcPkgs distroPkgs repoPkgs = let - toGhcType (n, v) = maybe - (Left $ "Not a valid version given for " ++ n ++ " (" ++ v ++ ")") - (Right . GhcType n) - (simpleParse v :: Maybe Version) - toDistroType (n, v, r) = maybe - (Left $ "Not a valid version given for " ++ n ++ " (" ++ v ++ ")") - (\ v' -> Right $ DistroType n v' r) - (simpleParse v :: Maybe Version) - toRepoType = either Left (Right . RepoType) - in map toGhcType ghcPkgs ++ map toDistroType distroPkgs ++ map toRepoType repoPkgs - getName (GhcType n _) = n getName (DistroType n _ _) = n getName (RepoType gpd) = (\ (P.PackageName n) -> n) $ P.pkgName $ package $ packageDescription gpd -- {{{1 addPkgs -addPkgs ghcVer db pkgs = let - (succs, fails) = partition (canBeAdded ghcVer db) pkgs - newDb = foldl addPkg2 db (map (pkgTypeToCblPkg ghcVer db) succs) - unsatisfieds = mapMaybe (finalizeToUnsatisfiableDeps ghcVer db) fails +addPkgs :: Version -> CblDB -> [(String, FlagAssignment)] -> [PkgType] -> Either ([(String, [P.Dependency])], [((String, Version), [(String, Maybe P.Dependency)])]) CblDB +addPkgs ghcVer db flags pkgs = let + (succs, fails) = partition (canBeAdded ghcVer db flags) pkgs + newDb = foldl addPkg2 db (map (pkgTypeToCblPkg ghcVer db flags) succs) + unsatisfieds = mapMaybe (finalizeToUnsatisfiableDeps ghcVer db flags) fails breaksOthers = mapMaybe (findBreaking db) fails in case (succs, fails) of (_, []) -> Right newDb ([], _) -> Left (unsatisfieds, breaksOthers) - (_, _) -> addPkgs ghcVer newDb fails + (_, _) -> addPkgs ghcVer newDb flags fails -canBeAdded _ db (GhcType n v) = null $ checkDependants db n v -canBeAdded _ db (DistroType n v _) = null $ checkDependants db n v -canBeAdded ghcVer db (RepoType gpd) = let - finable = either (const False) (const True) (finalizePkg ghcVer db gpd) +canBeAdded :: Version -> CblDB -> [(String, FlagAssignment)] -> PkgType -> Bool +canBeAdded _ db _ (GhcType n v) = null $ checkDependants db n v +canBeAdded _ db _ (DistroType n v _) = null $ checkDependants db n v +canBeAdded ghcVer db flags pkg@(RepoType gpd) = finable && depsOK + 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 v = P.pkgVersion $ package $ packageDescription gpd depsOK = null $ checkDependants db n v - in finable && depsOK -pkgTypeToCblPkg _ _ (GhcType n v) = createGhcPkg n v -pkgTypeToCblPkg _ _ (DistroType n v r) = createDistroPkg n v r -pkgTypeToCblPkg ghcVer db (RepoType gpd) = fromJust $ case finalizePkg ghcVer db gpd of - Right (pd, fa) -> Just $ createCblPkg pd fa - Left _ -> Nothing +pkgTypeToCblPkg _ _ _ (GhcType n v) = createGhcPkg n v +pkgTypeToCblPkg _ _ _ (DistroType n v r) = createDistroPkg n v r +pkgTypeToCblPkg ghcVer db flags pkg@(RepoType gpd) = + let fa = fromMaybe [] $ lookup (getName pkg) flags + in fromJust $ case finalizePkg ghcVer db fa gpd of + Right (pd, fa) -> Just $ createCblPkg pd fa + Left _ -> Nothing -finalizeToUnsatisfiableDeps ghcVer db (RepoType gpd) = case finalizePkg ghcVer db gpd of - Left ds -> Just (((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd, ds) - _ -> Nothing -finalizeToUnsatisfiableDeps _ _ _ = Nothing +finalizeToUnsatisfiableDeps 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) + _ -> Nothing +finalizeToUnsatisfiableDeps _ _ _ _ = Nothing + findBreaking db (GhcType n v) = let d = checkDependants db n v in if null d @@ -123,3 +128,7 @@ in if null d then Nothing else Just ((n, v), d) + +combineFlags a b = zip keys $ mapMaybe (uncurry mappend . (\ k -> (lookup k a, lookup k b))) keys + where + keys = nub $ map fst (a ++ b) diff --git a/src/BuildPkgs.hs b/src/BuildPkgs.hs --- a/src/BuildPkgs.hs +++ b/src/BuildPkgs.hs @@ -23,6 +23,6 @@ buildPkgs :: Command () buildPkgs = do - db <- cfgGet dbFile >>= liftIO . readDb - pkgs <- cfgGet $ pkgs . optsCmd + db <- optGet dbFile >>= liftIO . readDb + pkgs <- optGet $ pkgs . optsCmd liftIO $ mapM_ putStrLn $ transitiveDependants db pkgs diff --git a/src/BumpPkgs.hs b/src/BumpPkgs.hs --- a/src/BumpPkgs.hs +++ b/src/BumpPkgs.hs @@ -23,11 +23,11 @@ bumpPkgs :: Command () bumpPkgs = do - dbFn <- cfgGet dbFile + dbFn <- optGet dbFile db <- liftIO $ readDb dbFn - dR <- cfgGet dryRun - pkgs <- cfgGet $ pkgs . optsCmd - incl <- cfgGet $ inclusive . optsCmd + dR <- optGet dryRun + pkgs <- optGet $ pkgs . optsCmd + incl <- optGet $ inclusive . optsCmd let bpkgs = transDependants db incl pkgs let newDb = foldl bumpRelease db bpkgs liftIO $ if dR diff --git a/src/ConvertDB.hs b/src/ConvertDB.hs --- a/src/ConvertDB.hs +++ b/src/ConvertDB.hs @@ -27,8 +27,8 @@ convertDb :: Command () convertDb = do - inDbFn <- cfgGet $ inDbFile . optsCmd - outDbFn <- cfgGet $ outDbFile . optsCmd + inDbFn <- optGet $ inDbFile . optsCmd + outDbFn <- optGet $ outDbFile . optsCmd newDb <- liftIO $ liftM (map doConvert) (ODB.readDb inDbFn) liftIO $ NDB.saveDb newDb outDbFn diff --git a/src/ListPkgs.hs b/src/ListPkgs.hs --- a/src/ListPkgs.hs +++ b/src/ListPkgs.hs @@ -26,12 +26,12 @@ listPkgs :: Command () listPkgs = do - lG <- cfgGet $ listGhc . optsCmd - lD <- cfgGet $ listDistro . optsCmd - lR <- cfgGet $ noListRepo . optsCmd - lH <- cfgGet $ hackageFmt . optsCmd - ps <- cfgGet $ pkgs . optsCmd - db <- cfgGet dbFile >>= liftIO . readDb + lG <- optGet $ listGhc . optsCmd + lD <- optGet $ listDistro . optsCmd + lR <- optGet $ noListRepo . optsCmd + lH <- optGet $ hackageFmt . optsCmd + ps <- optGet $ pkgs . optsCmd + db <- optGet dbFile >>= liftIO . readDb let allPkgs = filter (pkgFilter lG lD lR) db let pkgsToList = if null ps then allPkgs diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -43,12 +43,12 @@ cmdAddPkgOpts = CmdAdd <$> strOption (long "patchdir" <> value "patches" <> help "Location of patches (patches)") - <*> nullOption (long "ghc-version" <> reader readerGhcVersion <> value ghcDefVersion <> help "GHC version to use") - <*> many (nullOption (short 'g' <> long "ghc-pkg" <> OA.reader strPairArg <> metavar "PKG,VER" <> help "GHC base package (multiple)")) - <*> many (nullOption (short 'd' <> long "distro-pkg" <> OA.reader strTripleArg <> metavar "PKG,VER,REL" <> help "Distro package (multiple)")) - <*> many (strOption (short 'u' <> long "cbl-url" <> metavar "URL" <> help "URL of CABAL file (multiple)")) - <*> many (strOption (short 'f' <> long "cbl-file" <> metavar "FILE" <> help "CABAL file (multiple)")) - <*> many (argument strPairArg (metavar "PKGNAME,VERSION ...")) + <*> option readerGhcVersion (long "ghc-version" <> value ghcDefVersion <> help "GHC version to use") + <*> many (option ghcPkgArgReader (short 'g' <> long "ghc-pkg" <> metavar "PKG,VER" <> help "GHC base package (multiple)")) + <*> many (option distroPkgArgReader (short 'd' <> long "distro-pkg" <> metavar "PKG,VER,REL" <> help "Distro package (multiple)")) + <*> many (option strCblFileArg (short 'f' <> long "cbl-file" <> metavar "FILE[:flag,-flag]" <> help "CABAL file (multiple)")) + <*> many (argument strCblPkgArg (metavar "PKGNAME,VERSION[:flag,-flag] ...")) + cmdAddPkgCmd = command "add" (info (helper <*> cmdAddPkgOpts) (fullDesc <> progDesc "Add a package to the database")) @@ -88,13 +88,13 @@ (fullDesc <> progDesc "List packages in repo")) cmdUrlsOpts = CmdUrls - <$> some (argument strPairArg (metavar "PKGNAME,VERSION ...")) + <$> some (argument (strPairArg ',') (metavar "PKGNAME,VERSION ...")) cmdUrlsCmd = command "urls" (info (helper <*> cmdUrlsOpts) (fullDesc <> progDesc "List urls of CABAL files for the given packages")) cmdPkgBuildOpts = CmdPkgBuild - <$> nullOption (long "ghc-version" <> reader readerGhcVersion <> value ghcDefVersion <> help "GHC version to use in PKGBUILD") - <*> option (long "ghc-release" <> value 1 <> help "GHC release to use in PKGBUILD") + <$> option readerGhcVersion (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") <*> strOption (long "patchdir" <> value "patches" <> help "Location of patches (patches)") <*> some (argument Just (metavar "PKGNAME ...")) cmdPkgBuildCmd = command "pkgbuild" (info (helper <*> cmdPkgBuildOpts) diff --git a/src/PkgBuild.hs b/src/PkgBuild.hs --- a/src/PkgBuild.hs +++ b/src/PkgBuild.hs @@ -31,19 +31,20 @@ pkgBuild :: Command () pkgBuild = do - db <- cfgGet dbFile >>= liftIO . readDb - pD <- cfgGet $ patchDir . optsCmd - pkgs <- cfgGet $ pkgs . optsCmd - ghcVersion <- cfgGet $ ghcVer . optsCmd - ghcRelease <- cfgGet $ ghcRel . optsCmd - void $ mapM (runErrorT . generatePkgBuild ghcVersion ghcRelease db pD) pkgs >>= exitOnErrors + 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 -generatePkgBuild ghcVer ghcRel db patchDir pkg = let +generatePkgBuild ghcVer ghcRel db appDir patchDir pkg = let appendPkgVer = pkg ++ "," ++ display (pkgVersion $ fromJust $ lookupPkg db pkg) in do - maybe (throwError $ "Unknown package: " ++ pkg) (const $ return ()) (lookupPkg db pkg) - genericPkgDesc <- withTempDirErrT "/tmp/cblrepo." (readCabal patchDir appendPkgVer) - pkgDescAndFlags <- either (const $ throwError ("Failed to finalize package: " ++ pkg)) return (finalizePkg ghcVer db genericPkgDesc) + 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) let archPkg = translate ghcVer ghcRel db (snd pkgDescAndFlags) (fst pkgDescAndFlags) archPkgWPatches <- liftIO $ addPatches patchDir archPkg archPkgWHash <- withTempDirErrT "/tmp/cblrepo." (addHashes archPkgWPatches) diff --git a/src/Remove.hs b/src/Remove.hs --- a/src/Remove.hs +++ b/src/Remove.hs @@ -28,10 +28,10 @@ -- {{{1 remove remove :: Command () remove = do - dbFn <- cfgGet dbFile + dbFn <- optGet dbFile db <- liftIO $ readDb dbFn - pkgs <- cfgGet $ pkgs . optsCmd - dR <- cfgGet dryRun + pkgs <- optGet $ pkgs . optsCmd + dR <- optGet dryRun liftIO $ either (\ s -> putStrLn s >> exitFailure) (\ newDb -> unless dR $ saveDb newDb dbFn) diff --git a/src/Sync.hs b/src/Sync.hs --- a/src/Sync.hs +++ b/src/Sync.hs @@ -23,5 +23,5 @@ sync :: Command () sync = do - aD <- cfgGet appDir + aD <- optGet appDir liftIO $ getFromURL indexUrl (aD indexFileName) diff --git a/src/Updates.hs b/src/Updates.hs --- a/src/Updates.hs +++ b/src/Updates.hs @@ -31,9 +31,9 @@ updates :: Command () updates = do - db <- cfgGet dbFile >>= liftIO . readDb - aD <- cfgGet appDir - aCS <- cfgGet $ idxStyle .optsCmd + db <- optGet dbFile >>= liftIO . readDb + aD <- optGet appDir + aCS <- optGet $ idxStyle .optsCmd entries <- liftIO $ liftM (Tar.read . GZip.decompress) (readIndexFile aD) let nonBasePkgs = filter (not . isBasePkg) db let pkgsNVers = map (pkgName &&& pkgVersion) nonBasePkgs diff --git a/src/Urls.hs b/src/Urls.hs --- a/src/Urls.hs +++ b/src/Urls.hs @@ -22,7 +22,7 @@ urls :: Command () urls = do - pkgs <- cfgGet $ pkgVers . optsCmd + pkgs <- optGet $ pkgVers . optsCmd liftIO $ mapM_ (putStrLn . createUrl) pkgs createUrl (pkg, ver) = "http://hackage.haskell.org/packages/archive/" ++ pkg ++ "/" ++ ver ++ "/" ++ pkg ++ ".cabal" diff --git a/src/Util/Misc.hs b/src/Util/Misc.hs --- a/src/Util/Misc.hs +++ b/src/Util/Misc.hs @@ -26,7 +26,6 @@ import Control.Monad.Error import Control.Monad.Reader import Data.Either -import Data.List import Data.Version import Distribution.Compiler import Distribution.Package as P @@ -79,13 +78,71 @@ Just (v, "") -> return v _ -> fail $ "cannot parse value `" ++ arg ++ "`" --- {{{1 command line argument type +splitOnElem :: Eq a => a -> [a] -> [[a]] +splitOnElem e l = + let p@(a, b) = break (== e) l + in case p of + (_, []) -> [a] + (_, _) -> a : splitOnElem e (tail b) +strPairArg :: Monad m => Char -> String -> m (String, String) +strPairArg c s = + case splitOnElem c s of + [a, b] -> return (a, b) + _ -> error $ "Failed to parse pair: " ++ s + +strTripleArg :: Monad m => Char -> String -> m (String, String, String) +strTripleArg c s = + case splitOnElem c s of + [a, b, c] -> return (a, b, c) + _ -> error $ "Failed to parse triple: " ++ s + +ghcPkgArgReader :: String -> ReadM (String, Version) +ghcPkgArgReader s = do + (pkgName, verStr) <- strPairArg ',' s + case simpleParse verStr of + Nothing -> fail $ "Failed to parse version in " ++ s + Just v -> return (pkgName, v) + +distroPkgArgReader :: String -> ReadM (String, Version, String) +distroPkgArgReader s = do + (pkgName, verStr, revStr) <- strTripleArg ',' s + case simpleParse verStr of + Nothing -> fail $ "Failed to parse version in " ++ s + Just v -> return (pkgName, v, revStr) + +strCblFileArg :: String -> ReadM (FilePath, FlagAssignment) +strCblFileArg s = let + flagReader ('-':cs) = (FlagName cs, False) + flagReader cs = (FlagName cs, True) + (fn:fs) = splitOnElem ':' s + fa = if null fs then [] else map flagReader (splitOnElem ',' $ head fs) + in return (fn, fa) + +strCblPkgArg :: Monad m => String -> m (String, String, FlagAssignment) +strCblPkgArg s = let + flagReader ('-':cs) = (FlagName cs, False) + flagReader cs = (FlagName cs, True) + (vi:fs) = splitOnElem ':' s + fa = if null fs then [] else map flagReader (splitOnElem ',' $ head fs) + in do + (pkgName, version) <- strPairArg ',' vi + if null fs + then do + (pkgName, version) <- strPairArg ',' vi + return (pkgName, version, []) + else return (pkgName, version, fa) + +-- Helper for grabbing things out of the options +optGet :: MonadReader o m => (o -> s) -> m s +optGet f = liftM f ask + +-- {{{1 command line argument type data Cmds = CmdAdd - { patchDir :: FilePath, ghcVer :: Version, cmdAddGhcPkgs :: [(String,String)] - , cmdAddDistroPkgs :: [(String, String, String)], cmdAddUrlCbls :: [String] - , cmdAddFileCbls :: [FilePath], cmdAddCbls :: [(String, String)] } + { patchDir :: FilePath, ghcVer :: Version, cmdAddGhcPkgs :: [(String, Version)] + , cmdAddDistroPkgs :: [(String, Version, String)], cmdAddFileCbls :: [(FilePath, FlagAssignment)] + , cmdAddCbls :: [(String, String, FlagAssignment)] } | CmdBuildPkgs { pkgs :: [String] } | CmdBumpPkgs { inclusive :: Bool, pkgs :: [String] } | CmdSync { unused :: Bool } @@ -107,16 +164,6 @@ , optsCmd :: Cmds } deriving (Show) -strPairArg s = let - (s0, s1) = break (== ',') s - in if null s1 then error "Missing version" else 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 getFromURL url fn = do (ec, _, er) <- readProcessWithExitCode "curl" ["-f", "-L", "-o", fn, url] "" @@ -145,27 +192,21 @@ -- {{{1 package descriptions -- {{{2 readCabal -data LocType = Url | Idx | File +data LocType = Idx | File -- | Read in a Cabal file. -readCabalFromUrl = readCabal readCabalFromFile = readCabal -readCabalFromIdx pd (p, v) = readCabal pd (p ++ "," ++ v) +readCabalFromIdx ad pd (p, v) = readCabal ad pd (p ++ "," ++ v) -readCabal :: FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription -readCabal patchDir loc tmpDir = let +readCabal :: FilePath -> FilePath -> String -> FilePath -> ErrorT String IO GenericPackageDescription +readCabal appDir patchDir loc tmpDir = let locType - | isInfixOf "://" loc = Url | ',' `elem` loc = Idx | otherwise = File copyCabal tmpDir loc = copyFile loc fn >> return fn where fn = tmpDir takeFileName loc - downloadCabal tmpDir loc = getFromURL loc fn >> return fn - where - fn = tmpDir takeFileName loc - extractCabal tmpDir loc = let (p, _: v) = span (/= ',') loc path = p v p ++ ".cabal" @@ -184,8 +225,7 @@ _ -> Nothing in do - aD <- liftIO $ getAppUserDataDirectory "cblrepo" - es <- liftM (Tar.read . GZip.decompress) (liftIO $ readIndexFile aD) + es <- liftM (Tar.read . GZip.decompress) (liftIO $ readIndexFile appDir) e <- maybe (throwError $ "No entry for " ++ pkgStr) return (esFindEntry path es) @@ -204,17 +244,16 @@ cblFn <- case locType of File -> liftIO $ copyCabal tmpDir loc Idx -> extractCabal tmpDir loc - Url -> liftIO $ downloadCabal tmpDir loc pn <- liftIO $ extractName cblFn let patchFn = patchDir pn <.> "cabal" applyPatchIfExist cblFn patchFn liftIO $ readPackageDescription silent cblFn -- {{{2 finalising -finalizePkg ghcVersion db gpd = let +finalizePkg ghcVersion db fa gpd = let n = ((\ (P.PackageName n) -> n ) . P.pkgName . package . packageDescription) gpd in finalizePackageDescription - [] -- no flags + fa (checkAgainstDb db n) (Platform X86_64 buildOS) -- platform (CompilerId GHC ghcVersion) -- compiler version diff --git a/src/Versions.hs b/src/Versions.hs --- a/src/Versions.hs +++ b/src/Versions.hs @@ -30,9 +30,9 @@ versions :: Command () versions = do - aD <- cfgGet appDir - l <- cfgGet $ latest . optsCmd - pkgs <- cfgGet $ pkgs . optsCmd + aD <- optGet appDir + l <- optGet $ latest . optsCmd + pkgs <- optGet $ pkgs . optsCmd let printFunc = if l then printLatestVersion else printAllVersions liftIO $ do es <- liftM (Tar.read . GZip.decompress) (readIndexFile aD)