diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2017-11-29 20:57:56 +0200 |
---|---|---|
committer | Daniel Gröber <dxld@darkboxed.org> | 2018-01-18 14:10:26 +0100 |
commit | 93a139b03320e00316411cd9220ad7c304ad55c6 (patch) | |
tree | a45f22edc231b7b1273c0db807768de495a35471 | |
parent | 8156b93666d574f9e3012d29bb1e3f2dd28f7102 (diff) |
Passes test.
But we get a "missing-home-module" warning, based on the extra include dirs, and
content being seen as part of the component.
-rw-r--r-- | src/CabalHelper/Runtime/Main.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/src/CabalHelper/Runtime/Main.hs b/src/CabalHelper/Runtime/Main.hs index 2f0075b..99170fe 100644 --- a/src/CabalHelper/Runtime/Main.hs +++ b/src/CabalHelper/Runtime/Main.hs @@ -459,7 +459,8 @@ componentsMap lbi _v _distdir f = do componentOptions' (lbi, v, distdir) inplaceFlag flags rf f = do let pd = localPkgDescr lbi includeDirs <- componentsMap lbi v distdir $ \_c clbi bi -> do - return (componentUnitId clbi, (componentInternalDeps clbi, hsSourceDirs bi)) + return (componentUnitId clbi + , (componentInternalDeps clbi, hsSourceDirs bi,componentIncludes clbi)) let includeDirMap = Map.fromList $ map snd includeDirs -- putStrLn $ "componentGhcOptions':includeDirMap=" ++ show includeDirMap @@ -500,7 +501,7 @@ removeInplaceDeps :: Verbosity -> LocalBuildInfo -> PackageDescription -> ComponentLocalBuildInfo - -> Map.Map UnitId ([UnitId],[FilePath]) + -> Map.Map UnitId ([UnitId],[FilePath], [(OpenUnitId, ModuleRenaming)]) -> (ComponentLocalBuildInfo, GhcOptions) removeInplaceDeps _v lbi pd clbi includeDirs = let removeInplace c = @@ -520,35 +521,40 @@ removeInplaceDeps _v lbi pd clbi includeDirs = let libbi = libBuildInfo lib liboutdir = componentOutDir lbi (CLib lib) (_,libclbi') = removeInplace libclbi - extraIncludes = recursiveIncludeDirs includeDirs (componentUnitId libclbi) + (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId libclbi) + (_,extraDeps) = partition (isInplaceCompInc libclbi) extraDeps' opts = (componentGhcOptions normal lbi libbi libclbi' liboutdir) { ghcOptPackageDBs = [] } in - opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes } + opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes + , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps } (_,Just (exe,execlbi)) | hasIdeps -> let exebi = buildInfo exe exeoutdir = componentOutDir lbi (CExe exe) (_,execlbi') = removeInplace execlbi - extraIncludes = recursiveIncludeDirs includeDirs (componentUnitId execlbi) + (extraIncludes,extraDeps') = recursiveIncludeDirs includeDirs (componentUnitId execlbi) + (_,extraDeps) = partition (isInplaceCompInc execlbi) extraDeps' opts = (componentGhcOptions normal lbi exebi execlbi' exeoutdir) { ghcOptPackageDBs = [] } in - opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes } + opts { ghcOptSourcePath = ghcOptSourcePath opts <> toNubListR extraIncludes + , ghcOptPackages = ghcOptPackages opts <> toNubListR extraDeps } _ -> mempty in (clbi', libopts) -- in error $ "removeInplaceDeps:(clbi')=" ++ show (clbi' ) -- TODO: Is this valid? It assumes a tree, will never return for a graph -recursiveIncludeDirs :: Map.Map UnitId ([UnitId],[FilePath]) -> UnitId -> [FilePath] -recursiveIncludeDirs includeDirs unit = go [] [unit] +recursiveIncludeDirs :: Map.Map UnitId ([UnitId],[FilePath], [(OpenUnitId, ModuleRenaming)]) + -> UnitId -> ([FilePath],[(OpenUnitId, ModuleRenaming)]) +recursiveIncludeDirs includeDirs unit = go ([],[]) [unit] where go acc [] = acc - go acc (u:us) = case Map.lookup u includeDirs of - Nothing -> go acc us - Just (us',fps) -> go (acc++fps) (us++us') + go (acp,acd) (u:us) = case Map.lookup u includeDirs of + Nothing -> go (acp,acd) us + Just (us',fps,pds) -> go (acp++fps,acd++pds) (us++us') initialBuildStepsForAllComponents distdir pd lbi v = initialBuildSteps distdir pd lbi v |