diff options
Diffstat (limited to 'CabalHelper')
| -rw-r--r-- | CabalHelper/Main.hs | 75 | ||||
| -rw-r--r-- | CabalHelper/Types.hs | 5 |
2 files changed, 44 insertions, 36 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) |