aboutsummaryrefslogtreecommitdiff
path: root/src/CabalHelper/Runtime
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2017-12-21 22:31:06 +0200
committerDaniel Gröber <dxld@darkboxed.org>2018-01-18 14:10:26 +0100
commit4cb20eebfcc8b5d9aff91af9b8bd171d9281229d (patch)
treeb425ac289c8cab1bc0cdc09e359ce944402e9967 /src/CabalHelper/Runtime
parenta2908a6f31ea480b2236ff62d76157b2f01ed5b7 (diff)
WIP on addressing review issues
Still need clarity on best way of adding the local package db when it is needed and exists.
Diffstat (limited to 'src/CabalHelper/Runtime')
-rw-r--r--src/CabalHelper/Runtime/Main.hs62
1 files changed, 39 insertions, 23 deletions
diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs
index f922dbe..b17e91d 100644
--- a/src/CabalHelper/Runtime/Main.hs
+++ b/src/CabalHelper/Runtime/Main.hs
@@ -70,11 +70,6 @@ import Distribution.Simple.LocalBuildInfo
, withComponentsLBI
, withLibLBI
, withExeLBI
-
-#if CH_MIN_VERSION_Cabal(2,0,0)
- , allLibModules
- , componentBuildDir
-#endif
)
import Distribution.Simple.GHC
( componentGhcOptions
@@ -86,6 +81,7 @@ import Distribution.Simple.Program.GHC
import Distribution.Simple.Setup
( ConfigFlags(..)
, Flag(..)
+ , fromFlagOrDefault
)
import Distribution.Simple.Build
( initialBuildSteps
@@ -154,6 +150,10 @@ import Distribution.Types.UnqualComponentName
#if CH_MIN_VERSION_Cabal(2,0,0)
-- CPP >= 2.0
+import Distribution.Simple.LocalBuildInfo
+ ( allLibModules
+ , componentBuildDir
+ )
import Distribution.Backpack
( OpenUnitId(..),
OpenModule(..)
@@ -238,7 +238,7 @@ usage = do
++" | ghc-lang-options [--with-inplace]\n"
++" | package-db-stack\n"
++" | entrypoints\n"
- ++" | needsbuildoutput\n"
+ ++" | needs-build-output\n"
++" | source-dirs\n"
++" | licenses\n"
++" ) ...\n"
@@ -257,7 +257,7 @@ commands = [ "print-lbi"
, "ghc-lang-options"
, "package-db-stack"
, "entrypoints"
- , "needsbuildoutput"
+ , "needs-build-output"
, "source-dirs"
, "licenses"]
@@ -411,7 +411,7 @@ main = do
let eps' = eps ++ [(ChSetupHsName, ChSetupEntrypoint)]
return $ Just $ ChResponseEntrypoints eps'
- "needsbuildoutput":[] -> do
+ "needs-build-output":[] -> do
#if CH_MIN_VERSION_Cabal(2,0,0)
includeDirMap <- recursiveDepInfo lbi v distdir
nbs <- componentsMap lbi v distdir $ \c clbi _bi ->
@@ -500,7 +500,15 @@ componentsMap lbi _v _distdir f = do
componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
let pd = localPkgDescr lbi
#if CH_MIN_VERSION_Cabal(2,0,0)
+ let distDir = fromFlagOrDefault ("." </> "dist") (configDistPref $ configFlags lbi)
+ packageDbDir = distDir </> "package.conf.inplace"
+ cd <- getCurrentDirectory
+ -- putStrLn $ "*****************componentOptions':(cd,packageDbDir)=" ++ show (cd,packageDbDir)
+ existsLocalPackageDb <- doesDirectoryExist packageDbDir
includeDirMap <- recursiveDepInfo lbi v distdir
+#else
+ let existsLocalPackageDb = False
+ packageDbDir = "." -- never used
#endif
componentsMap lbi v distdir $ \c clbi bi ->
@@ -518,7 +526,11 @@ componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do
#else
[] -> removeInplaceDeps v lbi pd clbi
#endif
- opts = componentGhcOptions normal lbi bi clbi' outdir
+ opts1 = componentGhcOptions normal lbi bi clbi' outdir
+ opts = if existsLocalPackageDb
+ then opts1 { ghcOptPackageDBs = ghcOptPackageDBs opts1
+ <> [SpecificPackageDB packageDbDir] }
+ else opts1
opts' = f opts
in rf lbi v $ nubPackageFlags $ opts' `mappend` adopts
@@ -552,7 +564,6 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let
-> BuildInfo -> ComponentLocalBuildInfo -> GhcOptions
cleanRecursiveOpts comp libbi libclbi =
let
- -- libbi = libBuildInfo lib
liboutdir = componentOutDir lbi comp
(_,libclbi') = removeInplace libclbi
(extraIncludes,extraDeps',_ems) = recursiveIncludeDirs includeDirs (componentUnitId libclbi)
@@ -569,14 +580,12 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let
NoBuildOutput -> removeInplace clbi
ProduceBuildOutput -> (False, clbi)
libopts =
- -- AZ:TODO: we already have the clbi, use it rather
case (getLibraryClbi pd lbi,getExeClbi pd lbi) of
(Just (lib, libclbi),_) | hasIdeps ->
let
libbi = libBuildInfo lib
opts = cleanRecursiveOpts (CLib lib) libbi libclbi
in
- -- ghcOptInputModules = toNubListR $ allLibModules lib clbi,
opts { ghcOptInputModules = ghcOptInputModules opts <> (toNubListR $ allLibModules lib libclbi) }
(_,Just (exe,execlbi)) | hasIdeps ->
let
@@ -614,26 +623,32 @@ removeInplaceDeps _v lbi pd clbi = let
recursiveDepInfo lbi v distdir = do
includeDirs <- componentsMap lbi v distdir $ \c clbi bi -> do
return (componentUnitId clbi
- , ( componentInternalDeps clbi
- , hsSourceDirs bi
- , componentIncludes clbi
- , componentEntrypoints c))
+ , ( SubDeps
+ { sdComponentInternalDeps = componentInternalDeps clbi
+ , sdHsSourceDirs = hsSourceDirs bi
+ , sdComponentIncludes = componentIncludes clbi
+ , sdComponentEntryPoints = componentEntrypoints c}) )
return $ Map.fromList $ map snd includeDirs
-type SubDeps = ([UnitId], [FilePath], [(OpenUnitId, ModuleRenaming)], ChEntrypoint)
+data SubDeps = SubDeps
+ { sdComponentInternalDeps :: [UnitId]
+ , sdHsSourceDirs :: [FilePath]
+ , sdComponentIncludes :: [(OpenUnitId, ModuleRenaming)]
+ , sdComponentEntryPoints :: ChEntrypoint
+ }
recursiveIncludeDirs :: Map.Map UnitId SubDeps
-> UnitId -> ([FilePath], [(OpenUnitId, ModuleRenaming)]
, ChEntrypoint)
recursiveIncludeDirs includeDirs unit = go ([],[],Nothing) [unit]
where
- go (afp,aci,amep) [] = (afp,aci,maybe (error "recursiveIncludeDirs:no ChEntrypoint") id amep)
+ go (afp,aci,Nothing ) [] = (afp,aci,error "recursiveIncludeDirs:no ChEntrypoint")
+ go (afp,aci,Just amep) [] = (afp,aci,amep)
go acc@(afp,aci,amep) (u:us) = case Map.lookup u includeDirs of
Nothing -> go acc us
- Just (us',sfp,sci,sep) -> go (afp++sfp,aci++sci,combineEp amep sep) (us++us')
+ Just (SubDeps us' sfp sci sep) -> go (afp++sfp,aci++sci,combineEp amep sep) (us++us')
-needsBuildOutput :: Map.Map UnitId SubDeps
- -> UnitId -> NeedsBuildOutput
+needsBuildOutput :: Map.Map UnitId SubDeps -> UnitId -> NeedsBuildOutput
needsBuildOutput includeDirs unit = go [unit]
where
isIndef (IndefFullUnitId _ _) = True
@@ -641,7 +656,7 @@ needsBuildOutput includeDirs unit = go [unit]
go [] = NoBuildOutput
go (u:us) = case Map.lookup u includeDirs of
Nothing -> go us
- Just (us',sfp,sci,sep) ->
+ Just (SubDeps us' sfp sci sep) ->
if any (isIndef . fst) sci
then ProduceBuildOutput
else go (us++us')
@@ -758,7 +773,9 @@ componentEntrypoints (CFLib (ForeignLib{..}))
componentEntrypoints (CExe Executable {..})
= ChExeEntrypoint
#if CH_MIN_VERSION_Cabal(2,0,0)
+ --
( head ((hsSourceDirs buildInfo) ++ ["."]) </> modulePath)
+ -- modulePath
#else
modulePath
#endif
@@ -778,7 +795,6 @@ componentEntrypoints (CBench Benchmark {})
isInplaceCompInc :: ComponentLocalBuildInfo -> (OpenUnitId, ModuleRenaming) -> Bool
isInplaceCompInc clbi (DefiniteUnitId uid, _mr) = unDefUnitId uid `elem` componentInternalDeps clbi
isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = False
--- isInplaceCompInc clbi (IndefFullUnitId uid _, _mmr) = unComponentId uid `elem` map unUnitId (componentInternalDeps clbi)
#endif
#if CH_MIN_VERSION_Cabal(2,0,0)