{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors      #-}
{-# LANGUAGE OverloadedRecordDot   #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | Build-specific types.


module Stack.Types.Build
  ( InstallLocation (..)
  , Installed (..)
  , psVersion
  , Task (..)
  , taskAnyMissing
  , taskIsTarget
  , taskLocation
  , taskProvides
  , taskTargetIsMutable
  , taskTypeLocation
  , taskTypePackageIdentifier
  , LocalPackage (..)
  , Plan (..)
  , TestOpts (..)
  , BenchmarkOpts (..)
  , FileWatchOpts (..)
  , BuildOpts (..)
  , BuildSubset (..)
  , defaultBuildOpts
  , TaskType (..)
  , installLocationIsMutable
  , TaskConfigOpts (..)
  , BuildCache (..)
  , ConfigCache (..)
  , configureOpts
  , CachePkgSrc (..)
  , toCachePkgSrc
  , FileCacheInfo (..)
  , PrecompiledCache (..)
  , ExcludeTHLoading (..)
  , ConvertPathsToAbsolute (..)
  , KeepOutputOpen (..)
  ) where

import           Data.Aeson ( ToJSON, FromJSON )
import qualified Data.ByteString as S
import           Data.List as L
import qualified Data.Map as Map
import qualified Data.Text as T
import           Database.Persist.Sql
                   ( PersistField (..), PersistFieldSql (..)
                   , PersistValue (PersistText), SqlType (SqlString)
                   )
import           Path ( parent )
import qualified RIO.Set as Set
import           Stack.BuildOpts ( defaultBuildOpts )
import           Stack.Prelude
import           Stack.Types.BuildOpts
                   ( BenchmarkOpts (..), BuildOpts (..), TestOpts (..) )
import           Stack.Types.BuildOptsCLI
                   ( BuildSubset (..), FileWatchOpts (..) )
import           Stack.Types.ConfigureOpts ( ConfigureOpts, configureOpts )
import           Stack.Types.GhcPkgId ( GhcPkgId )
import           Stack.Types.IsMutable ( IsMutable (..) )
import           Stack.Types.Package
                   ( FileCacheInfo (..), InstallLocation (..), Installed (..)
                   , LocalPackage (..), Package (..), PackageSource (..)
                   , packageIdentifier, psVersion
                   )

-- | Package dependency oracle.

newtype PkgDepsOracle
  = PkgDeps PackageName
  deriving (PkgDepsOracle -> PkgDepsOracle -> Bool
(PkgDepsOracle -> PkgDepsOracle -> Bool)
-> (PkgDepsOracle -> PkgDepsOracle -> Bool) -> Eq PkgDepsOracle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PkgDepsOracle -> PkgDepsOracle -> Bool
== :: PkgDepsOracle -> PkgDepsOracle -> Bool
$c/= :: PkgDepsOracle -> PkgDepsOracle -> Bool
/= :: PkgDepsOracle -> PkgDepsOracle -> Bool
Eq, PkgDepsOracle -> ()
(PkgDepsOracle -> ()) -> NFData PkgDepsOracle
forall a. (a -> ()) -> NFData a
$crnf :: PkgDepsOracle -> ()
rnf :: PkgDepsOracle -> ()
NFData, Int -> PkgDepsOracle -> ShowS
[PkgDepsOracle] -> ShowS
PkgDepsOracle -> String
(Int -> PkgDepsOracle -> ShowS)
-> (PkgDepsOracle -> String)
-> ([PkgDepsOracle] -> ShowS)
-> Show PkgDepsOracle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PkgDepsOracle -> ShowS
showsPrec :: Int -> PkgDepsOracle -> ShowS
$cshow :: PkgDepsOracle -> String
show :: PkgDepsOracle -> String
$cshowList :: [PkgDepsOracle] -> ShowS
showList :: [PkgDepsOracle] -> ShowS
Show, Typeable)

-- | Stored on disk to know whether the files have changed.

newtype BuildCache = BuildCache
  { BuildCache -> Map String FileCacheInfo
times :: Map FilePath FileCacheInfo
    -- ^ Modification times of files.

  }
  deriving (BuildCache -> BuildCache -> Bool
(BuildCache -> BuildCache -> Bool)
-> (BuildCache -> BuildCache -> Bool) -> Eq BuildCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BuildCache -> BuildCache -> Bool
== :: BuildCache -> BuildCache -> Bool
$c/= :: BuildCache -> BuildCache -> Bool
/= :: BuildCache -> BuildCache -> Bool
Eq, Value -> Parser [BuildCache]
Value -> Parser BuildCache
(Value -> Parser BuildCache)
-> (Value -> Parser [BuildCache]) -> FromJSON BuildCache
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser BuildCache
parseJSON :: Value -> Parser BuildCache
$cparseJSONList :: Value -> Parser [BuildCache]
parseJSONList :: Value -> Parser [BuildCache]
FromJSON, (forall x. BuildCache -> Rep BuildCache x)
-> (forall x. Rep BuildCache x -> BuildCache) -> Generic BuildCache
forall x. Rep BuildCache x -> BuildCache
forall x. BuildCache -> Rep BuildCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BuildCache -> Rep BuildCache x
from :: forall x. BuildCache -> Rep BuildCache x
$cto :: forall x. Rep BuildCache x -> BuildCache
to :: forall x. Rep BuildCache x -> BuildCache
Generic, Int -> BuildCache -> ShowS
[BuildCache] -> ShowS
BuildCache -> String
(Int -> BuildCache -> ShowS)
-> (BuildCache -> String)
-> ([BuildCache] -> ShowS)
-> Show BuildCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BuildCache -> ShowS
showsPrec :: Int -> BuildCache -> ShowS
$cshow :: BuildCache -> String
show :: BuildCache -> String
$cshowList :: [BuildCache] -> ShowS
showList :: [BuildCache] -> ShowS
Show, [BuildCache] -> Value
[BuildCache] -> Encoding
BuildCache -> Value
BuildCache -> Encoding
(BuildCache -> Value)
-> (BuildCache -> Encoding)
-> ([BuildCache] -> Value)
-> ([BuildCache] -> Encoding)
-> ToJSON BuildCache
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: BuildCache -> Value
toJSON :: BuildCache -> Value
$ctoEncoding :: BuildCache -> Encoding
toEncoding :: BuildCache -> Encoding
$ctoJSONList :: [BuildCache] -> Value
toJSONList :: [BuildCache] -> Value
$ctoEncodingList :: [BuildCache] -> Encoding
toEncodingList :: [BuildCache] -> Encoding
ToJSON, Typeable)

instance NFData BuildCache

-- | Stored on disk to know whether the flags have changed.

data ConfigCache = ConfigCache
  { ConfigCache -> ConfigureOpts
configureOpts :: !ConfigureOpts
    -- ^ All Cabal configure options used for this package.

  , ConfigCache -> Set GhcPkgId
deps :: !(Set GhcPkgId)
    -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take

    -- the complete GhcPkgId (only a PackageIdentifier) in the configure

    -- options, just using the previous value is insufficient to know if

    -- dependencies have changed.

  , ConfigCache -> Set ByteString
components :: !(Set S.ByteString)
    -- ^ The components to be built. It's a bit of a hack to include this in

    -- here, as it's not a configure option (just a build option), but this

    -- is a convenient way to force compilation when the components change.

  , ConfigCache -> Bool
buildHaddocks :: !Bool
    -- ^ Are haddocks to be built?

  , ConfigCache -> CachePkgSrc
pkgSrc :: !CachePkgSrc
  , ConfigCache -> Text
pathEnvVar :: !Text
  -- ^ Value of the PATH env var, see

  -- <https://github.com/commercialhaskell/stack/issues/3138>

  }
  deriving (Typeable ConfigCache
Typeable ConfigCache =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ConfigCache -> c ConfigCache)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ConfigCache)
-> (ConfigCache -> Constr)
-> (ConfigCache -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ConfigCache))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ConfigCache))
-> ((forall b. Data b => b -> b) -> ConfigCache -> ConfigCache)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ConfigCache -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ConfigCache -> r)
-> (forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ConfigCache -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache)
-> Data ConfigCache
ConfigCache -> Constr
ConfigCache -> DataType
(forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ConfigCache -> c ConfigCache
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ConfigCache
$ctoConstr :: ConfigCache -> Constr
toConstr :: ConfigCache -> Constr
$cdataTypeOf :: ConfigCache -> DataType
dataTypeOf :: ConfigCache -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ConfigCache)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ConfigCache)
$cgmapT :: (forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
gmapT :: (forall b. Data b => b -> b) -> ConfigCache -> ConfigCache
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ConfigCache -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ConfigCache -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ConfigCache -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ConfigCache -> m ConfigCache
Data, ConfigCache -> ConfigCache -> Bool
(ConfigCache -> ConfigCache -> Bool)
-> (ConfigCache -> ConfigCache -> Bool) -> Eq ConfigCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigCache -> ConfigCache -> Bool
== :: ConfigCache -> ConfigCache -> Bool
$c/= :: ConfigCache -> ConfigCache -> Bool
/= :: ConfigCache -> ConfigCache -> Bool
Eq, (forall x. ConfigCache -> Rep ConfigCache x)
-> (forall x. Rep ConfigCache x -> ConfigCache)
-> Generic ConfigCache
forall x. Rep ConfigCache x -> ConfigCache
forall x. ConfigCache -> Rep ConfigCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfigCache -> Rep ConfigCache x
from :: forall x. ConfigCache -> Rep ConfigCache x
$cto :: forall x. Rep ConfigCache x -> ConfigCache
to :: forall x. Rep ConfigCache x -> ConfigCache
Generic, Int -> ConfigCache -> ShowS
[ConfigCache] -> ShowS
ConfigCache -> String
(Int -> ConfigCache -> ShowS)
-> (ConfigCache -> String)
-> ([ConfigCache] -> ShowS)
-> Show ConfigCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigCache -> ShowS
showsPrec :: Int -> ConfigCache -> ShowS
$cshow :: ConfigCache -> String
show :: ConfigCache -> String
$cshowList :: [ConfigCache] -> ShowS
showList :: [ConfigCache] -> ShowS
Show, Typeable)

instance NFData ConfigCache

data CachePkgSrc
  = CacheSrcUpstream
  | CacheSrcLocal FilePath
  deriving (Typeable CachePkgSrc
Typeable CachePkgSrc =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CachePkgSrc)
-> (CachePkgSrc -> Constr)
-> (CachePkgSrc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CachePkgSrc))
-> ((forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r)
-> (forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc)
-> Data CachePkgSrc
CachePkgSrc -> Constr
CachePkgSrc -> DataType
(forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CachePkgSrc -> c CachePkgSrc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CachePkgSrc
$ctoConstr :: CachePkgSrc -> Constr
toConstr :: CachePkgSrc -> Constr
$cdataTypeOf :: CachePkgSrc -> DataType
dataTypeOf :: CachePkgSrc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CachePkgSrc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CachePkgSrc)
$cgmapT :: (forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
gmapT :: (forall b. Data b => b -> b) -> CachePkgSrc -> CachePkgSrc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CachePkgSrc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CachePkgSrc -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CachePkgSrc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CachePkgSrc -> m CachePkgSrc
Data, CachePkgSrc -> CachePkgSrc -> Bool
(CachePkgSrc -> CachePkgSrc -> Bool)
-> (CachePkgSrc -> CachePkgSrc -> Bool) -> Eq CachePkgSrc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CachePkgSrc -> CachePkgSrc -> Bool
== :: CachePkgSrc -> CachePkgSrc -> Bool
$c/= :: CachePkgSrc -> CachePkgSrc -> Bool
/= :: CachePkgSrc -> CachePkgSrc -> Bool
Eq, (forall x. CachePkgSrc -> Rep CachePkgSrc x)
-> (forall x. Rep CachePkgSrc x -> CachePkgSrc)
-> Generic CachePkgSrc
forall x. Rep CachePkgSrc x -> CachePkgSrc
forall x. CachePkgSrc -> Rep CachePkgSrc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CachePkgSrc -> Rep CachePkgSrc x
from :: forall x. CachePkgSrc -> Rep CachePkgSrc x
$cto :: forall x. Rep CachePkgSrc x -> CachePkgSrc
to :: forall x. Rep CachePkgSrc x -> CachePkgSrc
Generic, ReadPrec [CachePkgSrc]
ReadPrec CachePkgSrc
Int -> ReadS CachePkgSrc
ReadS [CachePkgSrc]
(Int -> ReadS CachePkgSrc)
-> ReadS [CachePkgSrc]
-> ReadPrec CachePkgSrc
-> ReadPrec [CachePkgSrc]
-> Read CachePkgSrc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CachePkgSrc
readsPrec :: Int -> ReadS CachePkgSrc
$creadList :: ReadS [CachePkgSrc]
readList :: ReadS [CachePkgSrc]
$creadPrec :: ReadPrec CachePkgSrc
readPrec :: ReadPrec CachePkgSrc
$creadListPrec :: ReadPrec [CachePkgSrc]
readListPrec :: ReadPrec [CachePkgSrc]
Read, Int -> CachePkgSrc -> ShowS
[CachePkgSrc] -> ShowS
CachePkgSrc -> String
(Int -> CachePkgSrc -> ShowS)
-> (CachePkgSrc -> String)
-> ([CachePkgSrc] -> ShowS)
-> Show CachePkgSrc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachePkgSrc -> ShowS
showsPrec :: Int -> CachePkgSrc -> ShowS
$cshow :: CachePkgSrc -> String
show :: CachePkgSrc -> String
$cshowList :: [CachePkgSrc] -> ShowS
showList :: [CachePkgSrc] -> ShowS
Show, Typeable)

instance NFData CachePkgSrc

instance PersistField CachePkgSrc where
  toPersistValue :: CachePkgSrc -> PersistValue
toPersistValue CachePkgSrc
CacheSrcUpstream = Text -> PersistValue
PersistText Text
"upstream"
  toPersistValue (CacheSrcLocal String
fp) = Text -> PersistValue
PersistText (Text
"local:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
fp)
  fromPersistValue :: PersistValue -> Either Text CachePkgSrc
fromPersistValue (PersistText Text
t) =
    if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"upstream"
      then CachePkgSrc -> Either Text CachePkgSrc
forall a b. b -> Either a b
Right CachePkgSrc
CacheSrcUpstream
      else case Text -> Text -> Maybe Text
T.stripPrefix Text
"local:" Text
t of
        Just Text
fp -> CachePkgSrc -> Either Text CachePkgSrc
forall a b. b -> Either a b
Right (CachePkgSrc -> Either Text CachePkgSrc)
-> CachePkgSrc -> Either Text CachePkgSrc
forall a b. (a -> b) -> a -> b
$ String -> CachePkgSrc
CacheSrcLocal (Text -> String
T.unpack Text
fp)
        Maybe Text
Nothing -> Text -> Either Text CachePkgSrc
forall a b. a -> Either a b
Left (Text -> Either Text CachePkgSrc)
-> Text -> Either Text CachePkgSrc
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected CachePkgSrc value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  fromPersistValue PersistValue
_ = Text -> Either Text CachePkgSrc
forall a b. a -> Either a b
Left Text
"Unexpected CachePkgSrc type"

instance PersistFieldSql CachePkgSrc where
  sqlType :: Proxy CachePkgSrc -> SqlType
sqlType Proxy CachePkgSrc
_ = SqlType
SqlString

toCachePkgSrc :: PackageSource -> CachePkgSrc
toCachePkgSrc :: PackageSource -> CachePkgSrc
toCachePkgSrc (PSFilePath LocalPackage
lp) =
  String -> CachePkgSrc
CacheSrcLocal (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent LocalPackage
lp.cabalFP))
toCachePkgSrc PSRemote{} = CachePkgSrc
CacheSrcUpstream

-- | A type representing tasks to perform when building.

data Task = Task
  { Task -> TaskType
taskType        :: !TaskType
    -- ^ The task type, telling us how to build this

  , Task -> TaskConfigOpts
configOpts      :: !TaskConfigOpts
    -- ^ A set of the package identifiers of dependencies for which 'GhcPkgId'

    -- are missing and a function which yields configure options, given a

    -- dictionary of those identifiers and their 'GhcPkgId'.

  , Task -> Bool
buildHaddocks   :: !Bool
  , Task -> Map PackageIdentifier GhcPkgId
present         :: !(Map PackageIdentifier GhcPkgId)
    -- ^ A dictionary of the package identifiers of already-installed

    -- dependencies, and their 'GhcPkgId'.

  , Task -> Bool
allInOne        :: !Bool
    -- ^ indicates that the package can be built in one step

  , Task -> CachePkgSrc
cachePkgSrc     :: !CachePkgSrc
  , Task -> Bool
buildTypeConfig :: !Bool
    -- ^ Is the build type of this package Configure. Check out

    -- ensureConfigureScript in Stack.Build.Execute for the motivation

  }
  deriving Int -> Task -> ShowS
[Task] -> ShowS
Task -> String
(Int -> Task -> ShowS)
-> (Task -> String) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Task -> ShowS
showsPrec :: Int -> Task -> ShowS
$cshow :: Task -> String
show :: Task -> String
$cshowList :: [Task] -> ShowS
showList :: [Task] -> ShowS
Show

-- | Given the IDs of any missing packages, produce the configure options

data TaskConfigOpts = TaskConfigOpts
  { TaskConfigOpts -> Set PackageIdentifier
missing :: !(Set PackageIdentifier)
    -- ^ Dependencies for which we don't yet have an GhcPkgId

  , TaskConfigOpts -> Map PackageIdentifier GhcPkgId -> ConfigureOpts
opts    :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts)
    -- ^ Produce the list of options given the missing @GhcPkgId@s

  }

instance Show TaskConfigOpts where
  show :: TaskConfigOpts -> String
show (TaskConfigOpts Set PackageIdentifier
missing Map PackageIdentifier GhcPkgId -> ConfigureOpts
f) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"Missing: "
    , Set PackageIdentifier -> String
forall a. Show a => a -> String
show Set PackageIdentifier
missing
    , String
". Without those: "
    , ConfigureOpts -> String
forall a. Show a => a -> String
show (ConfigureOpts -> String) -> ConfigureOpts -> String
forall a b. (a -> b) -> a -> b
$ Map PackageIdentifier GhcPkgId -> ConfigureOpts
f Map PackageIdentifier GhcPkgId
forall k a. Map k a
Map.empty
    ]

-- | Type representing different types of task, depending on what is to be

-- built.

data TaskType
  = TTLocalMutable LocalPackage
    -- ^ Building local source code.

  | TTRemotePackage IsMutable Package PackageLocationImmutable
    -- ^ Building something from the package index (upstream).

  deriving Int -> TaskType -> ShowS
[TaskType] -> ShowS
TaskType -> String
(Int -> TaskType -> ShowS)
-> (TaskType -> String) -> ([TaskType] -> ShowS) -> Show TaskType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaskType -> ShowS
showsPrec :: Int -> TaskType -> ShowS
$cshow :: TaskType -> String
show :: TaskType -> String
$cshowList :: [TaskType] -> ShowS
showList :: [TaskType] -> ShowS
Show

-- | Were any of the dependencies missing?


taskAnyMissing :: Task -> Bool
taskAnyMissing :: Task -> Bool
taskAnyMissing Task
task = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set PackageIdentifier -> Bool
forall a. Set a -> Bool
Set.null Task
task.configOpts.missing

-- | A function to yield the package name and version of a given 'TaskType'

-- value.

taskTypePackageIdentifier :: TaskType -> PackageIdentifier
taskTypePackageIdentifier :: TaskType -> PackageIdentifier
taskTypePackageIdentifier (TTLocalMutable LocalPackage
lp) = Package -> PackageIdentifier
packageIdentifier LocalPackage
lp.package
taskTypePackageIdentifier (TTRemotePackage IsMutable
_ Package
p PackageLocationImmutable
_) = Package -> PackageIdentifier
packageIdentifier Package
p

taskIsTarget :: Task -> Bool
taskIsTarget :: Task -> Bool
taskIsTarget Task
t =
  case Task
t.taskType of
    TTLocalMutable LocalPackage
lp -> LocalPackage
lp.wanted
    TaskType
_ -> Bool
False

-- | A function to yield the relevant database (write-only or mutable) of a

-- given 'TaskType' value.

taskTypeLocation :: TaskType -> InstallLocation
taskTypeLocation :: TaskType -> InstallLocation
taskTypeLocation (TTLocalMutable LocalPackage
_) = InstallLocation
Local
taskTypeLocation (TTRemotePackage IsMutable
Mutable Package
_ PackageLocationImmutable
_) = InstallLocation
Local
taskTypeLocation (TTRemotePackage IsMutable
Immutable Package
_ PackageLocationImmutable
_) = InstallLocation
Snap

-- | A function to yield the relevant database (write-only or mutable) of the

-- given task.

taskLocation :: Task -> InstallLocation
taskLocation :: Task -> InstallLocation
taskLocation = TaskType -> InstallLocation
taskTypeLocation (TaskType -> InstallLocation)
-> (Task -> TaskType) -> Task -> InstallLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.taskType)

-- | A function to yield the package name and version to be built by the given

-- task.

taskProvides :: Task -> PackageIdentifier
taskProvides :: Task -> PackageIdentifier
taskProvides = TaskType -> PackageIdentifier
taskTypePackageIdentifier (TaskType -> PackageIdentifier)
-> (Task -> TaskType) -> Task -> PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.taskType)

taskTargetIsMutable :: Task -> IsMutable
taskTargetIsMutable :: Task -> IsMutable
taskTargetIsMutable Task
task =
  case Task
task.taskType of
    TTLocalMutable LocalPackage
_ -> IsMutable
Mutable
    TTRemotePackage IsMutable
mutable Package
_ PackageLocationImmutable
_ -> IsMutable
mutable

installLocationIsMutable :: InstallLocation -> IsMutable
installLocationIsMutable :: InstallLocation -> IsMutable
installLocationIsMutable InstallLocation
Snap = IsMutable
Immutable
installLocationIsMutable InstallLocation
Local = IsMutable
Mutable

-- | A complete plan of what needs to be built and how to do it

data Plan = Plan
  { Plan -> Map PackageName Task
tasks :: !(Map PackageName Task)
  , Plan -> Map PackageName Task
finals :: !(Map PackageName Task)
    -- ^ Final actions to be taken (test, benchmark, etc)

  , Plan -> Map GhcPkgId (PackageIdentifier, Text)
unregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Text))
    -- ^ Text is reason we're unregistering, for display only

  , Plan -> Map Text InstallLocation
installExes :: !(Map Text InstallLocation)
    -- ^ Executables that should be installed after successful building

  }
  deriving Int -> Plan -> ShowS
[Plan] -> ShowS
Plan -> String
(Int -> Plan -> ShowS)
-> (Plan -> String) -> ([Plan] -> ShowS) -> Show Plan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Plan -> ShowS
showsPrec :: Int -> Plan -> ShowS
$cshow :: Plan -> String
show :: Plan -> String
$cshowList :: [Plan] -> ShowS
showList :: [Plan] -> ShowS
Show

-- | Information on a compiled package: the library .conf file (if relevant),

-- the sub-libraries (if present) and all of the executable paths.

data PrecompiledCache base = PrecompiledCache
  { forall base. PrecompiledCache base -> Maybe (Path base File)
library :: !(Maybe (Path base File))
    -- ^ .conf file inside the package database

  , forall base. PrecompiledCache base -> [Path base File]
subLibs :: ![Path base File]
    -- ^ .conf file inside the package database, for each of the sub-libraries

  , forall base. PrecompiledCache base -> [Path base File]
exes    :: ![Path base File]
    -- ^ Full paths to executables

  }
  deriving (PrecompiledCache base -> PrecompiledCache base -> Bool
(PrecompiledCache base -> PrecompiledCache base -> Bool)
-> (PrecompiledCache base -> PrecompiledCache base -> Bool)
-> Eq (PrecompiledCache base)
forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
== :: PrecompiledCache base -> PrecompiledCache base -> Bool
$c/= :: forall base. PrecompiledCache base -> PrecompiledCache base -> Bool
/= :: PrecompiledCache base -> PrecompiledCache base -> Bool
Eq, (forall x. PrecompiledCache base -> Rep (PrecompiledCache base) x)
-> (forall x.
    Rep (PrecompiledCache base) x -> PrecompiledCache base)
-> Generic (PrecompiledCache base)
forall x. Rep (PrecompiledCache base) x -> PrecompiledCache base
forall x. PrecompiledCache base -> Rep (PrecompiledCache base) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall base x.
Rep (PrecompiledCache base) x -> PrecompiledCache base
forall base x.
PrecompiledCache base -> Rep (PrecompiledCache base) x
$cfrom :: forall base x.
PrecompiledCache base -> Rep (PrecompiledCache base) x
from :: forall x. PrecompiledCache base -> Rep (PrecompiledCache base) x
$cto :: forall base x.
Rep (PrecompiledCache base) x -> PrecompiledCache base
to :: forall x. Rep (PrecompiledCache base) x -> PrecompiledCache base
Generic, Int -> PrecompiledCache base -> ShowS
[PrecompiledCache base] -> ShowS
PrecompiledCache base -> String
(Int -> PrecompiledCache base -> ShowS)
-> (PrecompiledCache base -> String)
-> ([PrecompiledCache base] -> ShowS)
-> Show (PrecompiledCache base)
forall base. Int -> PrecompiledCache base -> ShowS
forall base. [PrecompiledCache base] -> ShowS
forall base. PrecompiledCache base -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall base. Int -> PrecompiledCache base -> ShowS
showsPrec :: Int -> PrecompiledCache base -> ShowS
$cshow :: forall base. PrecompiledCache base -> String
show :: PrecompiledCache base -> String
$cshowList :: forall base. [PrecompiledCache base] -> ShowS
showList :: [PrecompiledCache base] -> ShowS
Show, Typeable)

instance NFData (PrecompiledCache Abs)

instance NFData (PrecompiledCache Rel)

data ExcludeTHLoading
  = ExcludeTHLoading
  | KeepTHLoading

data ConvertPathsToAbsolute
  = ConvertPathsToAbsolute
  | KeepPathsAsIs

-- | special marker for expected failures in curator builds, using those we need

-- to keep log handle open as build continues further even after a failure

data KeepOutputOpen
  = KeepOpen
  | CloseOnException
  deriving KeepOutputOpen -> KeepOutputOpen -> Bool
(KeepOutputOpen -> KeepOutputOpen -> Bool)
-> (KeepOutputOpen -> KeepOutputOpen -> Bool) -> Eq KeepOutputOpen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeepOutputOpen -> KeepOutputOpen -> Bool
== :: KeepOutputOpen -> KeepOutputOpen -> Bool
$c/= :: KeepOutputOpen -> KeepOutputOpen -> Bool
/= :: KeepOutputOpen -> KeepOutputOpen -> Bool
Eq