diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 1 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 15 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Types.hs | 16 |
3 files changed, 31 insertions, 1 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 7c3261f..6344b42 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -42,6 +42,7 @@ module Distribution.Helper ( -- ** Unit queries , Unit -- abstract + , uComponentName , UnitId -- abstract , UnitInfo(..) , unitInfo diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index 49bc7f2..6b6d401 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -49,6 +49,8 @@ import CabalHelper.Compiletime.Program.GHC import CabalHelper.Compiletime.Cabal ( CabalSourceDir(..), UnpackedCabalVersion, CabalVersion'(..), unpackCabalV1 ) import CabalHelper.Compiletime.Process +import CabalHelper.Shared.InterfaceTypes + ( ChComponentName(..), ChLibraryName(..) ) import CabalHelper.Shared.Common ( parseVer, trim, appCacheDir, panicIO ) @@ -248,8 +250,10 @@ planUnits plan = do , uPId=CP.PkgId pkg_name _ } = do cabal_file <- Cabal.findCabalFile pkgdir + let comp_names = Map.keys comps let uiV2Components = map (Text.unpack . CP.dispCompNameTarget pkg_name) $ Map.keys comps + let uiV2ComponentNames = map cpCompNameToChComponentName comp_names return $ Just $ Right $ Unit { uUnitId = UnitId $ Text.unpack (coerce (CP.uId u)) , uPackageDir = pkgdir @@ -261,3 +265,14 @@ planUnits plan = do return $ Just $ Left u takeunit _ = return $ Nothing + +cpCompNameToChComponentName :: CP.CompName -> ChComponentName +cpCompNameToChComponentName cn = + case cn of + CP.CompNameSetup -> ChSetupHsName + CP.CompNameLib -> ChLibName ChMainLibName + (CP.CompNameSubLib name) -> ChLibName $ ChSubLibName $ Text.unpack name + (CP.CompNameFLib name) -> ChFLibName $ Text.unpack name + (CP.CompNameExe name) -> ChExeName $ Text.unpack name + (CP.CompNameTest name) -> ChTestName $ Text.unpack name + (CP.CompNameBench name) -> ChBenchName $ Text.unpack name diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index 491c205..3c6ff73 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -154,11 +154,25 @@ data UnitImpl pt where UnitImplV1 :: UnitImpl 'V1 UnitImplV2 :: - { uiV2Components :: ![String] + { uiV2ComponentNames :: ![ChComponentName] + , uiV2Components :: ![String] } -> UnitImpl 'V2 UnitImplStack :: UnitImpl 'Stack +-- | This returns the component a 'Unit' corresponds to. This information is +-- only available if the correspondence happens to be unique and known before +-- querying setup-config for the respective project type. Currently this only +-- applies to @pt=@'V2'. +-- +-- This is intended to be used as an optimization, to allow reducing the number +-- of helper invocations for clients that don't need to know the entire project +-- structure. +uComponentName :: Unit pt -> Maybe ChComponentName +uComponentName Unit { uImpl=UnitImplV2 { uiV2ComponentNames=[comp] } } = + Just comp +uComponentName _ = + Nothing newtype UnitId = UnitId String deriving (Eq, Ord, Read, Show) |