Add support for returning package-db stack

1 files changed, 14 insertions, 0 deletions

diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
index 9d08b71..35af775 100644
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -96,6 +96,7 @@ usage = do
      ++"         | ghc-pkg-options [--with-inplace]\n"
      ++"         | ghc-merged-pkg-options [--with-inplace]\n"
      ++"         | ghc-lang-options [--with-inplace]\n"
+     ++"         | package-db-stack\n"
      ++"         | entrypoints\n"
      ++"         | source-dirs\n"
      ++"         ) ...\n"
@@ -108,6 +109,7 @@ commands = [ "print-bli"
            , "ghc-src-options"
            , "ghc-pkg-options"
            , "ghc-lang-options"
+           , "package-db-stack"
            , "entrypoints"
            , "source-dirs"]
 
@@ -221,6 +223,18 @@ main = do
                    }
       return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
 
+    "package-db-stack":[] -> do
+      let
+          pkgDbStr GlobalPackageDB = "G"
+          pkgDbStr UserPackageDB   = "U"
+          pkgDbStr (SpecificPackageDB s) = "S" ++ s
+
+      res <- map (\(c, opts) -> (c, map pkgDbStr $ ghcOptPackageDBs opts))
+         <$> componentOptions' lvd False [] (\_ _ x -> return x) id
+
+      -- TODO: Setup.hs has access to the sandbox as well: ghc-mod#478
+      return $ Just $ ChResponseCompList $ (res :: [(ChComponentName, [String])]) ++ [(ChSetupHsName, [])]
+
     "entrypoints":[] -> do
       eps <- componentsMap lbi v distdir $ \c clbi bi ->
                return $ componentEntrypoints c