diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 6 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 41 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Types.hs | 1 | ||||
| -rw-r--r-- | tests/GhcSession.hs | 5 |
4 files changed, 42 insertions, 11 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 55bfbf7..e46293d 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -508,7 +508,11 @@ buildProjectTarget qe mu stage = do SCV2 -> do targets <- return $ case mu of Nothing -> ["all"] - Just Unit{uImpl} -> uiV2Components uImpl + Just Unit{uImpl} -> concat + [ if uiV2OnlyDependencies uImpl + then ["--only-dependencies"] else [] + , uiV2Components uImpl + ] case qeProjLoc of ProjLocV2File {plCabalProjectFile} -> [ "--project-file="++plCabalProjectFile diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index cc05421..25c4cbb 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -40,7 +40,9 @@ import System.FilePath import Text.Printf import Text.Read +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Text as Text import qualified CabalHelper.Compiletime.Cabal as Cabal @@ -276,29 +278,54 @@ planPackages plan = do , pSourceDir = pkgdir , pCabalFile = CabalFile cabal_file , pFlags = [] - , pUnits = fmap (mkUnit pkg { pUnits = () }) units + , pUnits = fmap (\u -> fixBackpackUnit u $ mkUnit pkg { pUnits = () } u) units } return pkg _ -> panicIO "planPackages.mkPackage: Got non-unpacked package src!" + takeBackpackIndefUnitId :: CP.Unit -> Maybe CP.UnitId + takeBackpackIndefUnitId CP.Unit {uId=CP.UnitId uid} + | Text.any (=='+') uid = Just $ CP.UnitId $ Text.takeWhile (/='+') uid + | otherwise = Nothing + + findUnitsDependingOn :: CP.UnitId -> [CP.Unit] + findUnitsDependingOn uid = Map.elems $ + Map.filter (any (Set.member uid . CP.ciLibDeps) . Map.elems . CP.uComps) $ + CP.pjUnits plan + + -- Horrible workaround for https://github.com/haskell/cabal/issues/6201 + fixBackpackUnit plan_unit ch_unit + | Just indef_uid <- takeBackpackIndefUnitId plan_unit = do + let deps = findUnitsDependingOn indef_uid + ch_unit { uImpl = (uImpl ch_unit) + { uiV2Components = concatMap unitTargets deps + , uiV2OnlyDependencies = True + } } + | otherwise = + ch_unit + + unitTargets :: CP.Unit -> [String] + unitTargets CP.Unit {uComps, uPId=CP.PkgId pkg_name _} = + map (Text.unpack . CP.dispCompNameTarget pkg_name) $ + Map.keys uComps + mkUnit :: Package' () -> CP.Unit -> Unit ('Cabal 'CV2) - mkUnit pkg CP.Unit + mkUnit pkg u@CP.Unit { uDistDir=Just distdirv1 , uComps=comps - , uPId = CP.PkgId pkg_name _ + , uPId=CP.PkgId pkg_name _ , uId } = - let comp_names = Map.keys comps in Unit { uUnitId = UnitId $ Text.unpack (coerce uId) , uPackage = pkg , uDistDir = DistDirLib distdirv1 , uImpl = let + comp_names = Map.keys comps uiV2ComponentNames = map cpCompNameToChComponentName comp_names - uiV2Components = - map (Text.unpack . CP.dispCompNameTarget pkg_name) $ - Map.keys comps + uiV2Components = unitTargets u + uiV2OnlyDependencies = False in UnitImplV2 {..} } mkUnit _ _ = diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index 4ea0c54..a269210 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -351,6 +351,7 @@ data UnitImpl pt where UnitImplV2 :: { uiV2ComponentNames :: ![ChComponentName] , uiV2Components :: ![String] + , uiV2OnlyDependencies :: !Bool } -> UnitImpl ('Cabal 'CV2) UnitImplStack :: UnitImpl 'Stack diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index 9fc7899..45fe82e 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -321,12 +321,11 @@ test modProgs (psdImpl -> ProjSetupImpl{..}) topdir tmpdir projdir cabal_file psiSdist progs topdir tmpdir + cs <- concat <$> runQuery (allUnits (Map.elems . uiComponents)) qe + -- TODO: Cludge until we can just build the unit dependencies - -- TODO: Move back under runQuery when we fixed backpack runQuery buildProject qe - cs <- concat <$> runQuery (allUnits (Map.elems . uiComponents)) qe - let pkgdir = takeDirectory cabal_file homedir <- getHomeDirectory let var_table = |