1{-# LANGUAGE NoImplicitPrelude #-}
2-- | A sourcemap maps a package name to how it should be built,
3-- including source code, flags, options, etc. This module contains
4-- various stages of source map construction. See the
5-- @build_overview.md@ doc for details on these stages.
6module Stack.Types.SourceMap
7  ( -- * Different source map types
8    SMWanted (..)
9  , SMActual (..)
10  , Target (..)
11  , PackageType (..)
12  , SMTargets (..)
13  , SourceMap (..)
14    -- * Helper types
15  , FromSnapshot (..)
16  , DepPackage (..)
17  , ProjectPackage (..)
18  , CommonPackage (..)
19  , GlobalPackageVersion (..)
20  , GlobalPackage (..)
21  , isReplacedGlobal
22  , SourceMapHash (..)
23  , smRelDir
24  ) where
25
26import qualified Data.Text as T
27import qualified Pantry.SHA256 as SHA256
28import Path
29import Stack.Prelude
30import Stack.Types.Compiler
31import Stack.Types.NamedComponent
32import Distribution.PackageDescription (GenericPackageDescription)
33
34-- | Common settings for both dependency and project package.
35data CommonPackage = CommonPackage
36  { cpGPD :: !(IO GenericPackageDescription)
37  , cpName :: !PackageName
38  , cpFlags :: !(Map FlagName Bool)
39  -- ^ overrides default flags
40  , cpGhcOptions :: ![Text] -- also lets us know if we're doing profiling
41  , cpCabalConfigOpts :: ![Text]
42  , cpHaddocks :: !Bool
43  }
44
45-- | Flag showing if package comes from a snapshot
46-- needed to ignore dependency bounds between such packages
47data FromSnapshot
48    = FromSnapshot
49    | NotFromSnapshot
50    deriving (Show)
51
52-- | A view of a dependency package, specified in stack.yaml
53data DepPackage = DepPackage
54  { dpCommon :: !CommonPackage
55  , dpLocation :: !PackageLocation
56  , dpHidden :: !Bool
57  -- ^ Should the package be hidden after registering?
58  -- Affects the script interpreter's module name import parser.
59  , dpFromSnapshot :: !FromSnapshot
60  -- ^ Needed to ignore bounds between snapshot packages
61  -- See https://github.com/commercialhaskell/stackage/issues/3185
62  }
63
64-- | A view of a project package needed for resolving components
65data ProjectPackage = ProjectPackage
66  { ppCommon :: !CommonPackage
67  , ppCabalFP    :: !(Path Abs File)
68  , ppResolvedDir :: !(ResolvedPath Dir)
69  }
70
71-- | A view of a package installed in the global package database also
72-- could include marker for a replaced global package (could be replaced
73-- because of a replaced dependency)
74data GlobalPackage
75  = GlobalPackage !Version
76  | ReplacedGlobalPackage ![PackageName]
77  deriving Eq
78
79isReplacedGlobal :: GlobalPackage -> Bool
80isReplacedGlobal (ReplacedGlobalPackage _) = True
81isReplacedGlobal (GlobalPackage _) = False
82
83-- | A source map with information on the wanted (but not actual)
84-- compiler. This is derived by parsing the @stack.yaml@ file for
85-- @packages@, @extra-deps@, their configuration (e.g., flags and
86-- options), and parsing the snapshot it refers to. It does not
87-- include global packages or any information from the command line.
88--
89-- Invariant: a @PackageName@ appears in either 'smwProject' or
90-- 'smwDeps', but not both.
91data SMWanted = SMWanted
92  { smwCompiler :: !WantedCompiler
93  , smwProject :: !(Map PackageName ProjectPackage)
94  , smwDeps :: !(Map PackageName DepPackage)
95  , smwSnapshotLocation :: !RawSnapshotLocation
96  -- ^ Where this snapshot is loaded from.
97  }
98
99-- | Adds in actual compiler information to 'SMWanted', in particular
100-- the contents of the global package database.
101--
102-- Invariant: a @PackageName@ appears in only one of the @Map@s.
103data SMActual global = SMActual
104  { smaCompiler :: !ActualCompiler
105  , smaProject :: !(Map PackageName ProjectPackage)
106  , smaDeps :: !(Map PackageName DepPackage)
107  , smaGlobal :: !(Map PackageName global)
108  }
109
110newtype GlobalPackageVersion = GlobalPackageVersion Version
111
112-- | How a package is intended to be built
113data Target
114  = TargetAll !PackageType
115  -- ^ Build all of the default components.
116  | TargetComps !(Set NamedComponent)
117  -- ^ Only build specific components
118
119data PackageType = PTProject | PTDependency
120  deriving (Eq, Show)
121
122-- | Builds on an 'SMActual' by resolving the targets specified on the
123-- command line, potentially adding in new dependency packages in the
124-- process.
125data SMTargets = SMTargets
126  { smtTargets :: !(Map PackageName Target)
127  , smtDeps :: !(Map PackageName DepPackage)
128  }
129
130-- | The final source map, taking an 'SMTargets' and applying all
131-- command line flags and GHC options.
132data SourceMap = SourceMap
133  { smTargets :: !SMTargets
134    -- ^ Doesn't need to be included in the hash, does not affect the
135    -- source map.
136  , smCompiler :: !ActualCompiler
137    -- ^ Need to hash the compiler version _and_ its installation
138    -- path.  Ideally there would be some kind of output from GHC
139    -- telling us some unique ID for the compiler itself.
140  , smProject :: !(Map PackageName ProjectPackage)
141    -- ^ Doesn't need to be included in hash, doesn't affect any of
142    -- the packages that get stored in the snapshot database.
143  , smDeps :: !(Map PackageName DepPackage)
144    -- ^ Need to hash all of the immutable dependencies, can ignore
145    -- the mutable dependencies.
146  , smGlobal :: !(Map PackageName GlobalPackage)
147    -- ^ Doesn't actually need to be hashed, implicitly captured by
148    -- smCompiler. Can be broken if someone installs new global
149    -- packages. We can document that as not supported, _or_ we could
150    -- actually include all of this in the hash and make Stack more
151    -- resilient.
152  }
153
154-- | A unique hash for the immutable portions of a 'SourceMap'.
155newtype SourceMapHash = SourceMapHash SHA256
156
157-- | Returns relative directory name with source map's hash
158smRelDir :: (MonadThrow m) => SourceMapHash -> m (Path Rel Dir)
159smRelDir (SourceMapHash smh) = parseRelDir $ T.unpack $ SHA256.toHexText smh
160