aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CabalHelper/Main.hs75
-rw-r--r--CabalHelper/Types.hs5
-rw-r--r--Distribution/Helper.hs44
3 files changed, 70 insertions, 54 deletions
diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
index 043e57c..528d891 100644
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -94,6 +94,7 @@ usage = do
++" | ghc-options [--with-inplace]\n"
++" | ghc-src-options [--with-inplace]\n"
++" | ghc-pkg-options [--with-inplace]\n"
+ ++" | ghc-merged-pkg-options [--with-inplace]\n"
++" | ghc-lang-options [--with-inplace]\n"
++" | entrypoints\n"
++" | source-dirs\n"
@@ -126,6 +127,7 @@ main = do
v <- maybe silent (const deafening) . lookup "GHC_MOD_DEBUG" <$> getEnvironment
lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir
let pd = localPkgDescr lbi
+ let lvd = (lbi, v, distdir)
let
-- a =<< b $$ c == (a =<< b) $$ c
@@ -173,18 +175,10 @@ main = do
opts = componentGhcOptions normal lbi bi clbi' outdir
in renderGhcOptions' lbi v (opts `mappend` adopts)
- return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
+ return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"ghc-src-options":flags -> do
- res <- componentsMap lbi v distdir $ \c clbi bi -> let
- outdir = componentOutDir lbi c
- (clbi', adopts) = case flags of
- ["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps v lbi pd clbi
- opts = componentGhcOptions normal lbi bi clbi' outdir
- comp = compiler lbi
-
- opts' = mempty {
+ res <- componentOptions lvd flags $ \opts -> mempty {
-- Not really needed but "unexpected package db stack: []"
ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB],
@@ -195,44 +189,43 @@ main = do
ghcOptSourcePathClear = ghcOptSourcePathClear opts,
ghcOptSourcePath = ghcOptSourcePath opts
}
- in renderGhcOptions' lbi v $ opts `mappend` adopts
- return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
+ return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"ghc-pkg-options":flags -> do
- res <- componentsMap lbi v distdir $ \c clbi bi -> let
- comp = compiler lbi
- outdir = componentOutDir lbi c
- (clbi', adopts) = case flags of
- ["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps v lbi pd clbi
- opts = componentGhcOptions normal lbi bi clbi' outdir
+ res <- componentOptions lvd flags $ \opts -> mempty {
+ ghcOptPackageDBs = ghcOptPackageDBs opts,
+ ghcOptPackages = ghcOptPackages opts,
+ ghcOptHideAllPackages = ghcOptHideAllPackages opts
+ }
+ return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
- opts' = mempty {
+ "ghc-merged-pkg-options":flags -> do
+ let pd = localPkgDescr lbi
+ res <- mconcat . map snd <$> (componentsMap lbi v distdir $ \c clbi bi -> let
+ outdir = componentOutDir lbi c
+ opts = componentGhcOptions normal lbi bi clbi outdir
+ comp = compiler lbi
+ opts' = mempty {
ghcOptPackageDBs = ghcOptPackageDBs opts,
ghcOptPackages = ghcOptPackages opts,
ghcOptHideAllPackages = ghcOptHideAllPackages opts
}
- in renderGhcOptions' lbi v $ opts' `mappend` adopts
- return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
- "ghc-lang-options":flags -> do
- res <- componentsMap lbi v distdir $ \c clbi bi -> let
- comp = compiler lbi
- outdir = componentOutDir lbi c
- (clbi', adopts) = case flags of
- ["--with-inplace"] -> (clbi, mempty)
- [] -> removeInplaceDeps v lbi pd clbi
- opts = componentGhcOptions normal lbi bi clbi' outdir
+ in return opts')
+
+ let res' = res { ghcOptPackageDBs = nub $ ghcOptPackageDBs res }
+
+ Just . ChResponseList <$> renderGhcOptions' lbi v res'
- opts' = mempty {
+ "ghc-lang-options":flags -> do
+ res <- componentOptions lvd flags $ \opts -> mempty {
ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB],
ghcOptLanguage = ghcOptLanguage opts,
ghcOptExtensions = ghcOptExtensions opts,
ghcOptExtensionMap = ghcOptExtensionMap opts
}
- in renderGhcOptions' lbi v $ opts' `mappend` adopts
- return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
+ return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"entrypoints":[] -> do
eps <- componentsMap lbi v distdir $ \c clbi bi ->
@@ -244,7 +237,7 @@ main = do
"source-dirs":[] -> do
res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi
- return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])
+ return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])
"print-lbi":[] ->
return $ Just $ ChResponseLbi $ show lbi
@@ -293,6 +286,20 @@ componentsMap lbi v distdir f = do
reverse <$> readIORef lr
+componentOptions (lbi, v, distdir) flags f = do
+ let pd = localPkgDescr lbi
+ componentsMap lbi v distdir $ \c clbi bi -> let
+ outdir = componentOutDir lbi c
+ (clbi', adopts) = case flags of
+ ["--with-inplace"] -> (clbi, mempty)
+ [] -> removeInplaceDeps v lbi pd clbi
+ opts = componentGhcOptions normal lbi bi clbi' outdir
+ comp = compiler lbi
+ opts' = f opts
+
+ in renderGhcOptions' lbi v $ opts' `mappend` adopts
+
+
componentNameToCh CLibName = ChLibName
componentNameToCh (CExeName n) = ChExeName n
componentNameToCh (CTestName n) = ChTestName n
diff --git a/CabalHelper/Types.hs b/CabalHelper/Types.hs
index 0c1ebbe..1f7d364 100644
--- a/CabalHelper/Types.hs
+++ b/CabalHelper/Types.hs
@@ -14,7 +14,7 @@
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
-{-# LANGUAGE DeriveGeneric, DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-}
module CabalHelper.Types where
import GHC.Generics
@@ -31,8 +31,9 @@ data ChComponentName = ChSetupHsName
deriving (Eq, Ord, Read, Show, Generic)
data ChResponse
- = ChResponseStrings [(ChComponentName, [String])]
+ = ChResponseCompList [(ChComponentName, [String])]
| ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]
+ | ChResponseList [String]
| ChResponseLbi String
| ChResponseVersion String Version
deriving (Eq, Ord, Read, Show, Generic)
diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs
index 0ba62cf..f028766 100644
--- a/Distribution/Helper.hs
+++ b/Distribution/Helper.hs
@@ -32,6 +32,7 @@ module Distribution.Helper (
, ghcOptions
, ghcSrcOptions
, ghcPkgOptions
+ , ghcMergedPkgOptions
, ghcLangOptions
-- * Result types
@@ -85,12 +86,13 @@ instance Default Programs where
def = Programs "cabal" "ghc" "ghc-pkg"
data SomeLocalBuildInfo = SomeLocalBuildInfo {
- slbiEntrypoints :: [(ChComponentName, ChEntrypoint)],
- slbiSourceDirs :: [(ChComponentName, [String])],
- slbiGhcOptions :: [(ChComponentName, [String])],
- slbiGhcSrcOptions :: [(ChComponentName, [String])],
- slbiGhcPkgOptions :: [(ChComponentName, [String])],
- slbiGhcLangOptions :: [(ChComponentName, [String])]
+ slbiEntrypoints :: [(ChComponentName, ChEntrypoint)],
+ slbiSourceDirs :: [(ChComponentName, [String])],
+ slbiGhcOptions :: [(ChComponentName, [String])],
+ slbiGhcSrcOptions :: [(ChComponentName, [String])],
+ slbiGhcPkgOptions :: [(ChComponentName, [String])],
+ slbiGhcMergedPkgOptions :: [String],
+ slbiGhcLangOptions :: [(ChComponentName, [String])]
} deriving (Eq, Ord, Read, Show)
-- | Caches helper executable result so it doesn't have to be run more than once
@@ -149,15 +151,19 @@ ghcSrcOptions :: MonadIO m => Query m [(ChComponentName, [String])]
-- access any home modules.
ghcPkgOptions :: MonadIO m => Query m [(ChComponentName, [String])]
+-- | Like @ghcPkgOptions@ but for the whole package not just one component
+ghcMergedPkgOptions :: MonadIO m => Query m [String]
+
-- | Only language related options, i.e. @-XSomeExtension@
ghcLangOptions :: MonadIO m => Query m [(ChComponentName, [String])]
-entrypoints = Query $ slbiEntrypoints `liftM` getSlbi
-sourceDirs = Query $ slbiSourceDirs `liftM` getSlbi
-ghcOptions = Query $ slbiGhcOptions `liftM` getSlbi
-ghcSrcOptions = Query $ slbiGhcSrcOptions `liftM` getSlbi
-ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi
-ghcLangOptions = Query $ slbiGhcLangOptions `liftM` getSlbi
+entrypoints = Query $ slbiEntrypoints `liftM` getSlbi
+sourceDirs = Query $ slbiSourceDirs `liftM` getSlbi
+ghcOptions = Query $ slbiGhcOptions `liftM` getSlbi
+ghcSrcOptions = Query $ slbiGhcSrcOptions `liftM` getSlbi
+ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi
+ghcMergedPkgOptions = Query $ slbiGhcMergedPkgOptions `liftM` getSlbi
+ghcLangOptions = Query $ slbiGhcLangOptions `liftM` getSlbi
-- | Run @cabal configure@
reconfigure :: MonadIO m
@@ -188,6 +194,7 @@ getSomeConfigState = ask >>= \(progs, distdir) -> do
, "ghc-options"
, "ghc-src-options"
, "ghc-pkg-options"
+ , "ghc-merged-pkg-options"
, "ghc-lang-options"
] ++ progArgs
@@ -200,14 +207,15 @@ getSomeConfigState = ask >>= \(progs, distdir) -> do
, " (read failed)"]
let [ Just (ChResponseEntrypoints eps),
- Just (ChResponseStrings srcDirs),
- Just (ChResponseStrings ghcOpts),
- Just (ChResponseStrings ghcSrcOpts),
- Just (ChResponseStrings ghcPkgOpts),
- Just (ChResponseStrings ghcLangOpts) ] = res
+ Just (ChResponseCompList srcDirs),
+ Just (ChResponseCompList ghcOpts),
+ Just (ChResponseCompList ghcSrcOpts),
+ Just (ChResponseCompList ghcPkgOpts),
+ Just (ChResponseList ghcMergedPkgOpts),
+ Just (ChResponseCompList ghcLangOpts) ] = res
return $ SomeLocalBuildInfo
- eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcLangOpts
+ eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcMergedPkgOpts ghcLangOpts
-- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files
-- in the usual place.
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 17:45:35 +0000