{-# LANGUAGE NoImplicitPrelude #-}
-- | A sourcemap maps a package name to how it should be built,
-- including source code, flags, options, etc. This module contains
-- various stages of source map construction. See the
-- @build_overview.md@ doc for details on these stages.
module Stack.Types.SourceMap
  ( -- * Different source map types
    SMWanted (..)
  , SMActual (..)
  , Target (..)
  , PackageType (..)
  , SMTargets (..)
  , SourceMap (..)
    -- * Helper types
  , FromSnapshot (..)
  , DepPackage (..)
  , ProjectPackage (..)
  , CommonPackage (..)
  , GlobalPackageVersion (..)
  , GlobalPackage (..)
  , isReplacedGlobal
  , SourceMapHash (..)
  , smRelDir
  ) where

import qualified Data.Text as T
import qualified Pantry.SHA256 as SHA256
import Path
import Stack.Prelude
import Stack.Types.Compiler
import Stack.Types.NamedComponent
import Distribution.PackageDescription (GenericPackageDescription)

-- | Common settings for both dependency and project package.
data CommonPackage = CommonPackage
  { CommonPackage -> IO GenericPackageDescription
cpGPD :: !(IO GenericPackageDescription)
  , CommonPackage -> PackageName
cpName :: !PackageName
  , CommonPackage -> Map FlagName Bool
cpFlags :: !(Map FlagName Bool)
  -- ^ overrides default flags
  , CommonPackage -> [Text]
cpGhcOptions :: ![Text] -- also lets us know if we're doing profiling
  , CommonPackage -> [Text]
cpCabalConfigOpts :: ![Text]
  , CommonPackage -> Bool
cpHaddocks :: !Bool
  }

-- | Flag showing if package comes from a snapshot
-- needed to ignore dependency bounds between such packages
data FromSnapshot
    = FromSnapshot
    | NotFromSnapshot
    deriving (Int -> FromSnapshot -> ShowS
[FromSnapshot] -> ShowS
FromSnapshot -> String
(Int -> FromSnapshot -> ShowS)
-> (FromSnapshot -> String)
-> ([FromSnapshot] -> ShowS)
-> Show FromSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromSnapshot] -> ShowS
$cshowList :: [FromSnapshot] -> ShowS
show :: FromSnapshot -> String
$cshow :: FromSnapshot -> String
showsPrec :: Int -> FromSnapshot -> ShowS
$cshowsPrec :: Int -> FromSnapshot -> ShowS
Show)

-- | A view of a dependency package, specified in stack.yaml
data DepPackage = DepPackage
  { DepPackage -> CommonPackage
dpCommon :: !CommonPackage
  , DepPackage -> PackageLocation
dpLocation :: !PackageLocation
  , DepPackage -> Bool
dpHidden :: !Bool
  -- ^ Should the package be hidden after registering?
  -- Affects the script interpreter's module name import parser.
  , DepPackage -> FromSnapshot
dpFromSnapshot :: !FromSnapshot
  -- ^ Needed to ignore bounds between snapshot packages
  -- See https://github.com/commercialhaskell/stackage/issues/3185
  }

-- | A view of a project package needed for resolving components
data ProjectPackage = ProjectPackage
  { ProjectPackage -> CommonPackage
ppCommon :: !CommonPackage
  , ProjectPackage -> Path Abs File
ppCabalFP    :: !(Path Abs File)
  , ProjectPackage -> ResolvedPath Dir
ppResolvedDir :: !(ResolvedPath Dir)
  }

-- | A view of a package installed in the global package database also
-- could include marker for a replaced global package (could be replaced
-- because of a replaced dependency)
data GlobalPackage
  = GlobalPackage !Version
  | ReplacedGlobalPackage ![PackageName]
  deriving GlobalPackage -> GlobalPackage -> Bool
(GlobalPackage -> GlobalPackage -> Bool)
-> (GlobalPackage -> GlobalPackage -> Bool) -> Eq GlobalPackage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalPackage -> GlobalPackage -> Bool
$c/= :: GlobalPackage -> GlobalPackage -> Bool
== :: GlobalPackage -> GlobalPackage -> Bool
$c== :: GlobalPackage -> GlobalPackage -> Bool
Eq

isReplacedGlobal :: GlobalPackage -> Bool
isReplacedGlobal :: GlobalPackage -> Bool
isReplacedGlobal (ReplacedGlobalPackage [PackageName]
_) = Bool
True
isReplacedGlobal (GlobalPackage Version
_) = Bool
False

-- | A source map with information on the wanted (but not actual)
-- compiler. This is derived by parsing the @stack.yaml@ file for
-- @packages@, @extra-deps@, their configuration (e.g., flags and
-- options), and parsing the snapshot it refers to. It does not
-- include global packages or any information from the command line.
--
-- Invariant: a @PackageName@ appears in either 'smwProject' or
-- 'smwDeps', but not both.
data SMWanted = SMWanted
  { SMWanted -> WantedCompiler
smwCompiler :: !WantedCompiler
  , SMWanted -> Map PackageName ProjectPackage
smwProject :: !(Map PackageName ProjectPackage)
  , SMWanted -> Map PackageName DepPackage
smwDeps :: !(Map PackageName DepPackage)
  , SMWanted -> RawSnapshotLocation
smwSnapshotLocation :: !RawSnapshotLocation
  -- ^ Where this snapshot is loaded from.
  }

-- | Adds in actual compiler information to 'SMWanted', in particular
-- the contents of the global package database.
--
-- Invariant: a @PackageName@ appears in only one of the @Map@s.
data SMActual global = SMActual
  { SMActual global -> ActualCompiler
smaCompiler :: !ActualCompiler
  , SMActual global -> Map PackageName ProjectPackage
smaProject :: !(Map PackageName ProjectPackage)
  , SMActual global -> Map PackageName DepPackage
smaDeps :: !(Map PackageName DepPackage)
  , SMActual global -> Map PackageName global
smaGlobal :: !(Map PackageName global)
  }

newtype GlobalPackageVersion = GlobalPackageVersion Version

-- | How a package is intended to be built
data Target
  = TargetAll !PackageType
  -- ^ Build all of the default components.
  | TargetComps !(Set NamedComponent)
  -- ^ Only build specific components

data PackageType = PTProject | PTDependency
  deriving (PackageType -> PackageType -> Bool
(PackageType -> PackageType -> Bool)
-> (PackageType -> PackageType -> Bool) -> Eq PackageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageType -> PackageType -> Bool
$c/= :: PackageType -> PackageType -> Bool
== :: PackageType -> PackageType -> Bool
$c== :: PackageType -> PackageType -> Bool
Eq, Int -> PackageType -> ShowS
[PackageType] -> ShowS
PackageType -> String
(Int -> PackageType -> ShowS)
-> (PackageType -> String)
-> ([PackageType] -> ShowS)
-> Show PackageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageType] -> ShowS
$cshowList :: [PackageType] -> ShowS
show :: PackageType -> String
$cshow :: PackageType -> String
showsPrec :: Int -> PackageType -> ShowS
$cshowsPrec :: Int -> PackageType -> ShowS
Show)

-- | Builds on an 'SMActual' by resolving the targets specified on the
-- command line, potentially adding in new dependency packages in the
-- process.
data SMTargets = SMTargets
  { SMTargets -> Map PackageName Target
smtTargets :: !(Map PackageName Target)
  , SMTargets -> Map PackageName DepPackage
smtDeps :: !(Map PackageName DepPackage)
  }

-- | The final source map, taking an 'SMTargets' and applying all
-- command line flags and GHC options.
data SourceMap = SourceMap
  { SourceMap -> SMTargets
smTargets :: !SMTargets
    -- ^ Doesn't need to be included in the hash, does not affect the
    -- source map.
  , SourceMap -> ActualCompiler
smCompiler :: !ActualCompiler
    -- ^ Need to hash the compiler version _and_ its installation
    -- path.  Ideally there would be some kind of output from GHC
    -- telling us some unique ID for the compiler itself.
  , SourceMap -> Map PackageName ProjectPackage
smProject :: !(Map PackageName ProjectPackage)
    -- ^ Doesn't need to be included in hash, doesn't affect any of
    -- the packages that get stored in the snapshot database.
  , SourceMap -> Map PackageName DepPackage
smDeps :: !(Map PackageName DepPackage)
    -- ^ Need to hash all of the immutable dependencies, can ignore
    -- the mutable dependencies.
  , SourceMap -> Map PackageName GlobalPackage
smGlobal :: !(Map PackageName GlobalPackage)
    -- ^ Doesn't actually need to be hashed, implicitly captured by
    -- smCompiler. Can be broken if someone installs new global
    -- packages. We can document that as not supported, _or_ we could
    -- actually include all of this in the hash and make Stack more
    -- resilient.
  }

-- | A unique hash for the immutable portions of a 'SourceMap'.
newtype SourceMapHash = SourceMapHash SHA256

-- | Returns relative directory name with source map's hash
smRelDir :: (MonadThrow m) => SourceMapHash -> m (Path Rel Dir)
smRelDir :: SourceMapHash -> m (Path Rel Dir)
smRelDir (SourceMapHash SHA256
smh) = String -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (String -> m (Path Rel Dir)) -> String -> m (Path Rel Dir)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SHA256 -> Text
SHA256.toHexText SHA256
smh