diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 17 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Types.hs | 28 | ||||
| -rw-r--r-- | src/CabalHelper/Shared/InterfaceTypes.hs | 1 |
3 files changed, 32 insertions, 14 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index 964d722..f38d6d5 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -202,7 +202,7 @@ mkQueryEnv projloc distdir = do , qeCacheRef = cr } --- | Construct paths to project configuration files. +-- | Construct paths to project configuration files given where the project is. projConf :: ProjLoc pt -> ProjConf pt projConf (ProjLocCabalFile cabal_file) = ProjConfV1 cabal_file @@ -218,6 +218,11 @@ projConf (ProjLocStackYaml stack_yaml) = ProjConfStack { pcStackYaml = stack_yaml } +-- | Get the current modification-time for each file involved in configuring a +-- project. Optional files in 'ProjConf' are handled by not including them in +-- the result list in 'ProjConfModTimes' if they don\'t exist. This causes the +-- lists to be different if the files end up existing later, which is all we +-- need for cache invalidation. getProjConfModTime :: ProjConf pt -> IO ProjConfModTimes getProjConfModTime ProjConfV1{pcV1CabalFile} = fmap ProjConfModTimes $ mapM getFileModTime @@ -263,14 +268,14 @@ compilerVersion = Query $ \qe -> getProjInfo qe >>= \proj_info -> let someUnit = NonEmpty.head $ piUnits proj_info in -- ^ TODO: ASSUMPTION: Here we assume the compiler version is uniform - -- across all units so here we just pick any one. I'm not sure this is true - -- for Stack. + -- across all units so we just pick any one. I'm not sure this is true for + -- Stack. case piImpl proj_info of ProjInfoV1 -> uiCompilerId <$> getUnitInfo qe someUnit ProjInfoV2 { piV2CompilerId } -> return piV2CompilerId ProjInfoStack {} -> uiCompilerId <$> getUnitInfo qe someUnit --- | All units currently active in a project\'s build plan. +-- | All local units currently active in a project\'s build plan. projectUnits :: Query pt (NonEmpty (Unit pt)) projectUnits = Query $ \qe -> piUnits <$> getProjInfo qe @@ -377,7 +382,9 @@ shallowReconfigureProject QueryEnv return () shallowReconfigureProject QueryEnv { qeProjLoc = ProjLocStackYaml _stack_yaml, .. } = do - -- -- In case we ever need to read the cabal files before the Unit stage, this command regenerates them from package.yaml + -- In case we ever need to read the cabal files before the Unit stage, this + -- command regenerates them from package.yaml + -- -- _ <- liftIO $ qeCallProcess (Just projdir) (stackProgram qePrograms) -- ["build", "--dry-run"] "" return () diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index 0d1ca54..6b7d74a 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -105,12 +105,19 @@ data DistDir (pt :: ProjType) where deriving instance Show (DistDir pt) --- | Environment for running a 'Query' value. The constructor is not exposed in --- the API to allow extending the environment without breaking user code. +-- | Environment for running a 'Query'. The constructor is not exposed in the +-- API to allow extending it with more fields without breaking user code. -- --- To create a 'QueryEnv' use the 'mkQueryEnv' smart constructor. The field --- accessors are exported and may be used to override the defaults filled in by --- 'mkQueryEnv'. See below. +-- To create a 'QueryEnv' use the 'mkQueryEnv' smart constructor instead. The +-- field accessors are exported and may be used to override the defaults filled +-- in by 'mkQueryEnv'. See below. +-- +-- Note that this environment contains an 'IORef' used as a cache. If you want +-- to take advantage of this you should not simply discard the value returned by +-- the smart constructor after one use. +-- +-- If you do not wish to use the built-in caching feel free to discard the +-- 'QueryEnv' value though. type QueryEnv (pt :: ProjType) = QueryEnvI QueryCache pt @@ -157,6 +164,9 @@ newtype DistDirLib = DistDirLib FilePath -- etc.) which are managed by an certain instance of the Cabal build system. We -- may get information on the components in a unit by retriving the -- corresponding 'UnitInfo'. +-- +-- Note that a 'Unit' value is only valid within the 'QueryEnv' context it was +-- created in. However this is not enforced in the API. data Unit pt = Unit { uUnitId :: !UnitId , uPackageDir :: !FilePath @@ -197,7 +207,7 @@ newtype UnitId = UnitId String -- | The information extracted from a 'Unit'\'s on-disk configuration cache. data UnitInfo = UnitInfo { uiUnitId :: !UnitId - -- ^ A unique identifier of this unit within the project. + -- ^ A unique identifier of this unit within the originating project. , uiPackageId :: !(String, Version) -- ^ The package-name and version this unit belongs to. @@ -246,8 +256,8 @@ data ProjConf pt where { pcStackYaml :: !FilePath } -> ProjConf 'Stack --- these are supposed to be opaque, as they are meant to be used only for cache --- invalidation +-- This is supposed to be opaque, as it's only meant to be used only for cache +-- invalidation. newtype ProjConfModTimes = ProjConfModTimes [(FilePath, EpochTime)] deriving (Eq, Show) @@ -278,7 +288,7 @@ instance Show (ProjInfoImpl pt) where show ProjInfoV1 = "ProjInfoV1" show ProjInfoV2 {..} = concat [ "ProjInfoV2 {" - , "piV2Plan = ", show piV2Plan, ", " -- + , "piV2Plan = ", show piV2Plan, ", " , "piV2PlanModTime = ", show piV2PlanModTime, ", " , "piV2CompilerId = ", show piV2CompilerId , "}" diff --git a/src/CabalHelper/Shared/InterfaceTypes.hs b/src/CabalHelper/Shared/InterfaceTypes.hs index 37758bc..87536a5 100644 --- a/src/CabalHelper/Shared/InterfaceTypes.hs +++ b/src/CabalHelper/Shared/InterfaceTypes.hs @@ -91,6 +91,7 @@ data ChComponentInfo = ChComponentInfo , ciNeedsBuildOutput :: NeedsBuildOutput -- ^ If a component has a non-default module renaming (backpack) it cannot -- be built in memory and instead needs proper build output. + -- TODO: This is a ghc-mod legacy thing and has to be removed } deriving (Eq, Ord, Read, Show) -- TODO: we know the source-dir now so we can resolve ChSetupEntrypoint |