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 /src/CabalHelper | |
| 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.
Diffstat (limited to 'src/CabalHelper')
| -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 | 
