aboutsummaryrefslogtreecommitdiff
path: root/src/CabalHelper/Compiletime/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/CabalHelper/Compiletime/Types.hs')
-rw-r--r--src/CabalHelper/Compiletime/Types.hs180
1 files changed, 179 insertions, 1 deletions
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 843a886..58e90b1 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -34,8 +34,182 @@ import Data.Typeable
import Data.Map.Strict (Map)
import GHC.Generics
import System.Posix.Types
+import CabalHelper.Compiletime.Types.RelativePath
import CabalHelper.Shared.InterfaceTypes
+
+-- | The kind of project being managed by a 'QueryEnv' (pun intended).
+data ProjType
+ = V1 -- ^ @cabal v1-build@ project, see 'DistDirV1'
+ | V2 -- ^ @cabal v2-build@ project, see 'DistDirV2'
+ | Stack -- ^ @stack@ project.
+
+-- | A project directory. The project type of a given directory can be
+-- determined by trying to access a set of marker files. See below.
+data ProjDir (pt :: ProjType) where
+ -- | A @cabal v1-build@ project directory can be identified by one file
+ -- ending in @.cabal@ existing in the directory. More than one such files
+ -- existing is a user error. Note: For this project type the concepts of
+ -- project and package coincide.
+ ProjDirV1 :: FilePath -> ProjDir 'V1
+
+ -- | A @cabal v2-build@ project\'s marker file is called
+ -- @cabal.project@. This configuration file points to the packages that make
+ -- up this project.
+ ProjDirV2 :: FilePath -> ProjDir 'V2
+
+ -- | A @stack@ project\'s marker file is called @stack.yaml@. This
+ -- configuration file points to the packages that make up this project.
+ ProjDirStack :: FilePath -> ProjDir 'Stack
+
+data DistDir (pt :: ProjType) where
+ -- | Build directory for cabal /old-build/ aka. /v1-build/ aka. just
+ -- /build/. Planned to be superceeded by /v2-build/, see 'DistDirV2' for
+ -- that.
+ --
+ -- You can tell a builddir is a /v1/ builddir by looking for a file
+ -- called @setup-config@ directly underneath it.
+ DistDirV1 :: FilePath -> DistDir 'V1
+
+ -- | Build directory for cabal /new-build/ aka. /v2-build/, as of the time
+ -- of this writing it is usually called @dist-newstyle/@ but this will
+ -- presumably change once it becomes the default /build/ command.
+ --
+ -- You can tell a builddir is a /v2/ builddir by trying to access the path
+ -- @cache/plan.json@ directly underneath it.
+ DistDirV2 :: FilePath -> DistDir 'V2
+
+ -- | Build directory for stack, aka. /work-dir/. Optionally override Stack's
+ -- /work-dir/. If you just want to use Stack's default set to @Nothing@
+ DistDirStack :: Maybe RelativePath -> DistDir 'Stack
+
+-- | Environment for running a 'Query' value. The real constructor is
+-- not exposed, use the 'mkQueryEnv' smart constructor instead. The field
+-- accessors are exported and may be used to override the defaults, see below.
+type QueryEnv (proj_type :: ProjType)
+ = QueryEnvI (QueryCache proj_type) proj_type
+
+data QueryEnvI cache (proj_type :: ProjType) = QueryEnv
+ { qeReadProcess
+ :: Maybe FilePath -> FilePath -> [String] -> String -> IO String
+ -- ^ Field accessor for 'QueryEnv'. Function used to to start
+ -- processes. Useful if you need to, for example, redirect standard error
+ -- output away from the user\'s terminal.
+
+ , qePrograms :: Programs
+ -- ^ Field accessor for 'QueryEnv'.
+
+ , qeProjectDir :: ProjDir proj_type
+ -- ^ Field accessor for 'QueryEnv'. Defines path to the project directory,
+ -- i.e. a directory containing a @cabal.project@ file
+
+ , qeDistDir :: DistDir proj_type
+ -- ^ Field accessor for 'QueryEnv'. Defines path to the @dist/@ or
+ -- @dist-newstyle/@ directory, aka. /builddir/ in Cabal terminology.
+
+ , qeCacheRef :: IORef cache
+ -- ^ Cache for query results, only accessible when type parameter @cache@ is
+ -- instantiated and not forall quantified.
+ }
+
+data QueryCache pt = QueryCache
+ { qcProjInfo :: !(Maybe (ProjInfo pt))
+ , qcUnitInfos :: !(Map DistDirLib UnitInfo)
+ }
+
+newtype DistDirLib = DistDirLib FilePath
+ deriving (Eq, Ord, Read, Show)
+
+-- | Abstractly speaking a Unit consists of a set of components (exes, libs,
+-- tests etc.) which are managed by an instance of the Cabal build system. The
+-- distinction between a Unit and a set of components is somewhat hard to
+-- explain if you're not already familliar with the concept from
+-- cabal-install. Luckily for most purposes the details may be ignored.
+--
+-- We merely use the concept of a Unit for caching purposes. It is necessary to
+-- extract the information on all components in a Unit at the same time as we
+-- must load all of it into memory before extracting any of it.
+--
+-- As opposed to components, different 'Unit's can be queried independently
+-- since their on-disk information is stored separately.
+data Unit = Unit
+ { uUnitId :: !UnitId
+ , uPackageDir :: !FilePath
+ , uDistDir :: !DistDirLib
+ }
+
+newtype UnitId = UnitId String
+ deriving (Eq, Ord, Read, Show)
+
+-- | The information extracted from a 'Unit's on-disk configuration.
+data UnitInfo = UnitInfo
+ { uiUnitId :: !UnitId
+ -- ^ A unique identifier of this init within the project.
+
+ , uiComponents :: !(Map ChComponentName ChComponentInfo)
+ -- ^ The components of the unit: libraries, executables, test-suites,
+ -- benchmarks and so on.
+
+ , uiCompilerVersion :: !(String, Version)
+ -- ^ The version of GHC the unit is configured to use
+
+ , uiPackageDbStack :: !([ChPkgDb])
+ -- ^ List of package databases to use.
+
+ , uiPackageFlags :: !([(String, Bool)])
+ -- ^ Flag definitions from cabal file
+
+ , uiConfigFlags :: ![(String, Bool)]
+ -- ^ Flag assignments from active configuration
+
+ , uiNonDefaultConfigFlags :: ![(String, Bool)]
+ -- ^ Flag assignments from setup-config which differ from the default
+ -- setting. This can also include flags which cabal decided to modify,
+ -- i.e. don't rely on these being the flags set by the user directly.
+
+ , uiModTimes :: !UnitModTimes
+ } deriving (Eq, Ord, Read, Show)
+
+data ProjInfo pt where
+ ProjInfoV1 ::
+ { piV1ProjConfModTimes :: !(ProjConfModTimes 'V1)
+ } -> ProjInfo 'V1
+
+ ProjInfoV2 ::
+ { piV2ProjConfModTimes :: !(ProjConfModTimes 'V2)
+ , piV2Plan :: !PlanJson
+ , piV2PlanModTime :: !EpochTime
+ } -> ProjInfo 'V2
+
+ ProjInfoStack ::
+ { piStackProjConfModTimes :: !(ProjConfModTimes 'Stack)
+ , piStackUnits :: ![Unit]
+ , piStackProjPaths :: !StackProjPaths
+ } -> ProjInfo 'Stack
+
+data ProjConfModTimes pt where
+ ProjConfModTimesV1
+ :: !(FilePath, EpochTime) -> ProjConfModTimes 'V1
+ ProjConfModTimesV2
+ :: !([(FilePath, EpochTime)]) -> ProjConfModTimes 'V2
+ ProjConfModTimesStack
+ :: !(FilePath, EpochTime) -> ProjConfModTimes 'Stack
+
+deriving instance Eq (ProjConfModTimes pt)
+
+data UnitModTimes = UnitModTimes
+ { umtCabalFile :: !(FilePath, EpochTime)
+ , umtSetupConfig :: !(FilePath, EpochTime)
+ } deriving (Eq, Ord, Read, Show)
+
+newtype CabalFile = CabalFile FilePath
+
+data StackProjPaths = StackProjPaths
+ { sppGlobalPkgDb :: !PackageDbDir
+ , sppSnapPkgDb :: !PackageDbDir
+ , sppLocalPkgDb :: !PackageDbDir
+ }
+
type Verbose = (?verbose :: Bool)
type Progs = (?progs :: Programs)
-- TODO: rname to `CompEnv` or something
@@ -49,6 +223,9 @@ data Programs = Programs {
-- | The path to the @cabal@ program.
cabalProgram :: FilePath,
+ -- | The path to the @stack@ program.
+ stackProgram :: FilePath,
+
-- | The path to the @ghc@ program.
ghcProgram :: FilePath,
@@ -60,7 +237,8 @@ data Programs = Programs {
-- | By default all programs use their unqualified names, i.e. they will be
-- searched for on @PATH@.
defaultPrograms :: Programs
-defaultPrograms = Programs "cabal" "ghc" "ghc-pkg"
+defaultPrograms = Programs "cabal" "stack" "ghc" "ghc-pkg"
+
data CompileOptions = CompileOptions
{ oVerbose :: Bool
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 00:03:56 +0000