aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2018-10-26 04:16:46 +0200
committerDaniel Gröber <dxld@darkboxed.org>2018-10-27 20:48:56 +0200
commitc747047f0be63af991c0175829220411302e7e62 (patch)
tree49d0b4104b1f72a1518519a53b1903ab5e9829ec /src
parent783eadafe6e6333123add96d2fc0276c8b4cc1d9 (diff)
Fix listCabalVersions logic bug
The 'mdb' argument is supposed to be interpreted as "use the global db" when it's 'Nothing'.
Diffstat (limited to 'src')
-rw-r--r--src/CabalHelper/Compiletime/Compile.hs22
1 files changed, 10 insertions, 12 deletions
diff --git a/src/CabalHelper/Compiletime/Compile.hs b/src/CabalHelper/Compiletime/Compile.hs
index 431043b..6403aca 100644
--- a/src/CabalHelper/Compiletime/Compile.hs
+++ b/src/CabalHelper/Compiletime/Compile.hs
@@ -681,18 +681,16 @@ errorInstallCabal cabalVer = panicIO $ printf "\
listCabalVersions' :: Env => Maybe PackageDbDir -> MaybeT IO [Version]
listCabalVersions' mdb = do
- case mdb of
- Nothing -> mzero
- Just (PackageDbDir db_path) -> do
- exists <- liftIO $ doesDirectoryExist db_path
- case exists of
- False -> mzero
- True -> MaybeT $ logIOError "listCabalVersions'" $ Just <$> do
- let mdbopt = ("--package-conf="++) <$> unPackageDbDir <$> mdb
- args = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
-
- catMaybes . map (fmap snd . parsePkgId . fromString) . words
- <$> readProcess' (ghcProgram ?cprogs) args ""
+ let mdb_path = unPackageDbDir <$> mdb
+ exists <- fromMaybe True <$>
+ traverse (liftIO . doesDirectoryExist) mdb_path
+ case exists of
+ True -> MaybeT $ logIOError "listCabalVersions" $ Just <$> do
+ let mdbopt = ("--package-conf="++) <$> mdb_path
+ args = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
+ catMaybes . map (fmap snd . parsePkgId . fromString) . words
+ <$> readProcess' (ghcPkgProgram ?cprogs) args ""
+ _ -> mzero
cabalVersionExistsInPkgDb :: Env => Version -> PackageDbDir -> IO Bool
cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do