Add 'uComponentName' query

2 files changed, 30 insertions, 1 deletions

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)