{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ConstraintKinds #-}
module Stack.Build.Source
( projectLocalPackages
, localDependencies
, loadCommonPackage
, loadLocalPackage
, loadSourceMap
, getLocalFlags
, addUnlistedToBuildCache
, hashSourceMapData
) where
import Stack.Prelude
import qualified Pantry.SHA256 as SHA256
import qualified Data.ByteString as S
import Data.ByteString.Builder (toLazyByteString)
import Conduit (ZipSink (..), withSourceFile)
import qualified Data.Conduit.List as CL
import qualified Distribution.PackageDescription as C
import Data.List
import qualified Data.Map as Map
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import Foreign.C.Types (CTime)
import Stack.Build.Cache
import Stack.Build.Haddock (shouldHaddockDeps)
import Stack.Build.Target
import Stack.Package
import Stack.SourceMap
import Stack.Types.Build
import Stack.Types.Config
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.SourceMap
import System.FilePath (takeFileName)
import System.IO.Error (isDoesNotExistError)
import System.PosixCompat.Files (modificationTime, getFileStatus)
projectLocalPackages :: HasEnvConfig env
=> RIO env [LocalPackage]
projectLocalPackages :: RIO env [LocalPackage]
projectLocalPackages = do
SourceMap
sm <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
-> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
[ProjectPackage]
-> (ProjectPackage -> RIO env LocalPackage)
-> RIO env [LocalPackage]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Map PackageName ProjectPackage -> [ProjectPackage]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Map PackageName ProjectPackage -> [ProjectPackage])
-> Map PackageName ProjectPackage -> [ProjectPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName ProjectPackage
smProject SourceMap
sm) ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage
localDependencies :: HasEnvConfig env => RIO env [LocalPackage]
localDependencies :: RIO env [LocalPackage]
localDependencies = do
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting BuildOpts env BuildOpts -> RIO env BuildOpts)
-> Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall a b. (a -> b) -> a -> b
$ (Config -> Const BuildOpts Config) -> env -> Const BuildOpts env
forall env. HasConfig env => Lens' env Config
configL((Config -> Const BuildOpts Config) -> env -> Const BuildOpts env)
-> ((BuildOpts -> Const BuildOpts BuildOpts)
-> Config -> Const BuildOpts Config)
-> Getting BuildOpts env BuildOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> BuildOpts) -> SimpleGetter Config BuildOpts
forall s a. (s -> a) -> SimpleGetter s a
to Config -> BuildOpts
configBuild
SourceMap
sourceMap <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMap env SourceMap -> RIO env SourceMap)
-> Getting SourceMap env SourceMap -> RIO env SourceMap
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env
forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL ((EnvConfig -> Const SourceMap EnvConfig)
-> env -> Const SourceMap env)
-> ((SourceMap -> Const SourceMap SourceMap)
-> EnvConfig -> Const SourceMap EnvConfig)
-> Getting SourceMap env SourceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnvConfig -> SourceMap) -> SimpleGetter EnvConfig SourceMap
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMap
envConfigSourceMap
[DepPackage]
-> (DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM (Map PackageName DepPackage -> [DepPackage]
forall k a. Map k a -> [a]
Map.elems (Map PackageName DepPackage -> [DepPackage])
-> Map PackageName DepPackage -> [DepPackage]
forall a b. (a -> b) -> a -> b
$ SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sourceMap) ((DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage])
-> (DepPackage -> RIO env (Maybe LocalPackage))
-> RIO env [LocalPackage]
forall a b. (a -> b) -> a -> b
$ \dp :: DepPackage
dp ->
case DepPackage -> PackageLocation
dpLocation DepPackage
dp of
PLMutable dir :: ResolvedPath Dir
dir -> do
ProjectPackage
pp <- PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PrintWarnings -> ResolvedPath Dir -> Bool -> RIO env ProjectPackage
mkProjectPackage PrintWarnings
YesPrintWarnings ResolvedPath Dir
dir (BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts)
LocalPackage -> Maybe LocalPackage
forall a. a -> Maybe a
Just (LocalPackage -> Maybe LocalPackage)
-> RIO env LocalPackage -> RIO env (Maybe LocalPackage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectPackage -> RIO env LocalPackage
forall env.
(HasBuildConfig env, HasSourceMap env) =>
ProjectPackage -> RIO env LocalPackage
loadLocalPackage ProjectPackage
pp
_ -> Maybe LocalPackage -> RIO env (Maybe LocalPackage)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LocalPackage
forall a. Maybe a
Nothing
loadSourceMap :: HasBuildConfig env
=> SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap :: SMTargets
-> BuildOptsCLI
-> SMActual DumpedGlobalPackage
-> RIO env SourceMap
loadSourceMap smt :: SMTargets
smt boptsCli :: BuildOptsCLI
boptsCli sma :: SMActual DumpedGlobalPackage
sma = do
BuildConfig
bconfig <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
let compiler :: ActualCompiler
compiler = SMActual DumpedGlobalPackage -> ActualCompiler
forall global. SMActual global -> ActualCompiler
smaCompiler SMActual DumpedGlobalPackage
sma
project :: Map PackageName ProjectPackage
project = (ProjectPackage -> ProjectPackage)
-> Map PackageName ProjectPackage -> Map PackageName ProjectPackage
forall a b k. (a -> b) -> Map k a -> Map k b
M.map ProjectPackage -> ProjectPackage
applyOptsFlagsPP (Map PackageName ProjectPackage -> Map PackageName ProjectPackage)
-> Map PackageName ProjectPackage -> Map PackageName ProjectPackage
forall a b. (a -> b) -> a -> b
$ SMActual DumpedGlobalPackage -> Map PackageName ProjectPackage
forall global. SMActual global -> Map PackageName ProjectPackage
smaProject SMActual DumpedGlobalPackage
sma
bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild (BuildConfig -> Config
bcConfig BuildConfig
bconfig)
applyOptsFlagsPP :: ProjectPackage -> ProjectPackage
applyOptsFlagsPP p :: ProjectPackage
p@ProjectPackage{ppCommon :: ProjectPackage -> CommonPackage
ppCommon = CommonPackage
c} =
ProjectPackage
p{ppCommon :: CommonPackage
ppCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (PackageName -> Map PackageName Target -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName Target
smtTargets SMTargets
smt)) Bool
True CommonPackage
c}
deps0 :: Map PackageName DepPackage
deps0 = SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt Map PackageName DepPackage
-> Map PackageName DepPackage -> Map PackageName DepPackage
forall a. Semigroup a => a -> a -> a
<> SMActual DumpedGlobalPackage -> Map PackageName DepPackage
forall global. SMActual global -> Map PackageName DepPackage
smaDeps SMActual DumpedGlobalPackage
sma
deps :: Map PackageName DepPackage
deps = (DepPackage -> DepPackage)
-> Map PackageName DepPackage -> Map PackageName DepPackage
forall a b k. (a -> b) -> Map k a -> Map k b
M.map DepPackage -> DepPackage
applyOptsFlagsDep Map PackageName DepPackage
deps0
applyOptsFlagsDep :: DepPackage -> DepPackage
applyOptsFlagsDep d :: DepPackage
d@DepPackage{dpCommon :: DepPackage -> CommonPackage
dpCommon = CommonPackage
c} =
DepPackage
d{dpCommon :: CommonPackage
dpCommon = Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags (PackageName -> Map PackageName DepPackage -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member (CommonPackage -> PackageName
cpName CommonPackage
c) (SMTargets -> Map PackageName DepPackage
smtDeps SMTargets
smt)) Bool
False CommonPackage
c}
applyOptsFlags :: Bool -> Bool -> CommonPackage -> CommonPackage
applyOptsFlags isTarget :: Bool
isTarget isProjectPackage :: Bool
isProjectPackage common :: CommonPackage
common =
let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
flags :: Map FlagName Bool
flags = BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags BuildOptsCLI
boptsCli PackageName
name
ghcOptions :: [Text]
ghcOptions =
BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bconfig BuildOptsCLI
boptsCli Bool
isTarget Bool
isProjectPackage
cabalConfigOpts :: [Text]
cabalConfigOpts =
BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts BuildConfig
bconfig (CommonPackage -> PackageName
cpName CommonPackage
common) Bool
isTarget Bool
isProjectPackage
in CommonPackage
common
{ cpFlags :: Map FlagName Bool
cpFlags =
if Map FlagName Bool -> Bool
forall k a. Map k a -> Bool
M.null Map FlagName Bool
flags
then CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common
else Map FlagName Bool
flags
, cpGhcOptions :: [Text]
cpGhcOptions =
[Text]
ghcOptions [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpGhcOptions CommonPackage
common
, cpCabalConfigOpts :: [Text]
cpCabalConfigOpts =
[Text]
cabalConfigOpts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common
, cpHaddocks :: Bool
cpHaddocks =
if Bool
isTarget
then BuildOpts -> Bool
boptsHaddock BuildOpts
bopts
else BuildOpts -> Bool
shouldHaddockDeps BuildOpts
bopts
}
packageCliFlags :: Map PackageName (Map FlagName Bool)
packageCliFlags = [(PackageName, Map FlagName Bool)]
-> Map PackageName (Map FlagName Bool)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PackageName, Map FlagName Bool)]
-> Map PackageName (Map FlagName Bool))
-> [(PackageName, Map FlagName Bool)]
-> Map PackageName (Map FlagName Bool)
forall a b. (a -> b) -> a -> b
$
((ApplyCLIFlag, Map FlagName Bool)
-> Maybe (PackageName, Map FlagName Bool))
-> [(ApplyCLIFlag, Map FlagName Bool)]
-> [(PackageName, Map FlagName Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ApplyCLIFlag, Map FlagName Bool)
-> Maybe (PackageName, Map FlagName Bool)
forall b. (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags ([(ApplyCLIFlag, Map FlagName Bool)]
-> [(PackageName, Map FlagName Bool)])
-> [(ApplyCLIFlag, Map FlagName Bool)]
-> [(PackageName, Map FlagName Bool)]
forall a b. (a -> b) -> a -> b
$
Map ApplyCLIFlag (Map FlagName Bool)
-> [(ApplyCLIFlag, Map FlagName Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList (BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli)
maybeProjectFlags :: (ApplyCLIFlag, b) -> Maybe (PackageName, b)
maybeProjectFlags (ACFByName name :: PackageName
name, fs :: b
fs) = (PackageName, b) -> Maybe (PackageName, b)
forall a. a -> Maybe a
Just (PackageName
name, b
fs)
maybeProjectFlags _ = Maybe (PackageName, b)
forall a. Maybe a
Nothing
globals :: Map PackageName GlobalPackage
globals = Map PackageName DumpedGlobalPackage
-> Set PackageName -> Map PackageName GlobalPackage
pruneGlobals (SMActual DumpedGlobalPackage -> Map PackageName DumpedGlobalPackage
forall global. SMActual global -> Map PackageName global
smaGlobal SMActual DumpedGlobalPackage
sma) (Map PackageName DepPackage -> Set PackageName
forall k a. Map k a -> Set k
Map.keysSet Map PackageName DepPackage
deps)
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug "Checking flags"
Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> RIO env ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Map PackageName (Map FlagName Bool)
-> FlagSource
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> m ()
checkFlagsUsedThrowing Map PackageName (Map FlagName Bool)
packageCliFlags FlagSource
FSCommandLine Map PackageName ProjectPackage
project Map PackageName DepPackage
deps
Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug "SourceMap constructed"
SourceMap -> RIO env SourceMap
forall (m :: * -> *) a. Monad m => a -> m a
return
$WSourceMap :: SMTargets
-> ActualCompiler
-> Map PackageName ProjectPackage
-> Map PackageName DepPackage
-> Map PackageName GlobalPackage
-> SourceMap
SourceMap
{ smTargets :: SMTargets
smTargets = SMTargets
smt
, smCompiler :: ActualCompiler
smCompiler = ActualCompiler
compiler
, smProject :: Map PackageName ProjectPackage
smProject = Map PackageName ProjectPackage
project
, smDeps :: Map PackageName DepPackage
smDeps = Map PackageName DepPackage
deps
, smGlobal :: Map PackageName GlobalPackage
smGlobal = Map PackageName GlobalPackage
globals
}
hashSourceMapData
:: (HasBuildConfig env, HasCompiler env)
=> BuildOptsCLI
-> SourceMap
-> RIO env SourceMapHash
hashSourceMapData :: BuildOptsCLI -> SourceMap -> RIO env SourceMapHash
hashSourceMapData boptsCli :: BuildOptsCLI
boptsCli sm :: SourceMap
sm = do
Builder
compilerPath <- Utf8Builder -> Builder
getUtf8Builder (Utf8Builder -> Builder)
-> (Path Abs File -> Utf8Builder) -> Path Abs File -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8Builder
forall a. IsString a => String -> a
fromString (String -> Utf8Builder)
-> (Path Abs File -> String) -> Path Abs File -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> Builder)
-> RIO env (Path Abs File) -> RIO env Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env (Path Abs File)
forall env. HasCompiler env => RIO env (Path Abs File)
getCompilerPath
Builder
compilerInfo <- RIO env Builder
forall env. (HasConfig env, HasCompiler env) => RIO env Builder
getCompilerInfo
[Builder]
immDeps <- [DepPackage]
-> (DepPackage -> RIO env Builder) -> RIO env [Builder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map PackageName DepPackage -> [DepPackage]
forall k a. Map k a -> [a]
Map.elems (SourceMap -> Map PackageName DepPackage
smDeps SourceMap
sm)) DepPackage -> RIO env Builder
forall env. HasConfig env => DepPackage -> RIO env Builder
depPackageHashableContent
BuildConfig
bc <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
let
bootGhcOpts :: [Utf8Builder]
bootGhcOpts = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions BuildConfig
bc BuildOptsCLI
boptsCli Bool
False Bool
False)
hashedContent :: ByteString
hashedContent = Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder
compilerPath Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
compilerInfo Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
bootGhcOpts) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
immDeps
SourceMapHash -> RIO env SourceMapHash
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceMapHash -> RIO env SourceMapHash)
-> SourceMapHash -> RIO env SourceMapHash
forall a b. (a -> b) -> a -> b
$ SHA256 -> SourceMapHash
SourceMapHash (ByteString -> SHA256
SHA256.hashLazyBytes ByteString
hashedContent)
depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder
depPackageHashableContent :: DepPackage -> RIO env Builder
depPackageHashableContent DepPackage {..} = do
case PackageLocation
dpLocation of
PLMutable _ -> Builder -> RIO env Builder
forall (m :: * -> *) a. Monad m => a -> m a
return ""
PLImmutable pli :: PackageLocationImmutable
pli -> do
let flagToBs :: (FlagName, Bool) -> p
flagToBs (f :: FlagName
f, enabled :: Bool
enabled) =
if Bool
enabled
then ""
else "-" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> String -> p
forall a. IsString a => String -> a
fromString (FlagName -> String
C.unFlagName FlagName
f)
flags :: [Utf8Builder]
flags = ((FlagName, Bool) -> Utf8Builder)
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map (FlagName, Bool) -> Utf8Builder
forall p. (IsString p, Semigroup p) => (FlagName, Bool) -> p
flagToBs ([(FlagName, Bool)] -> [Utf8Builder])
-> [(FlagName, Bool)] -> [Utf8Builder]
forall a b. (a -> b) -> a -> b
$ Map FlagName Bool -> [(FlagName, Bool)]
forall k a. Map k a -> [(k, a)]
Map.toList (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
dpCommon)
ghcOptions :: [Utf8Builder]
ghcOptions = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpGhcOptions CommonPackage
dpCommon)
cabalConfigOpts :: [Utf8Builder]
cabalConfigOpts = (Text -> Utf8Builder) -> [Text] -> [Utf8Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
dpCommon)
haddocks :: Builder
haddocks = if CommonPackage -> Bool
cpHaddocks CommonPackage
dpCommon then "haddocks" else ""
hash :: Builder
hash = PackageLocationImmutable -> Builder
immutableLocSha PackageLocationImmutable
pli
Builder -> RIO env Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> RIO env Builder) -> Builder -> RIO env Builder
forall a b. (a -> b) -> a -> b
$ Builder
hash Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
haddocks Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
flags) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
ghcOptions) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
Utf8Builder -> Builder
getUtf8Builder ([Utf8Builder] -> Utf8Builder
forall a. Monoid a => [a] -> a
mconcat [Utf8Builder]
cabalConfigOpts)
getLocalFlags
:: BuildOptsCLI
-> PackageName
-> Map FlagName Bool
getLocalFlags :: BuildOptsCLI -> PackageName -> Map FlagName Bool
getLocalFlags boptsCli :: BuildOptsCLI
boptsCli name :: PackageName
name = [Map FlagName Bool] -> Map FlagName Bool
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
[ Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty (PackageName -> ApplyCLIFlag
ACFByName PackageName
name) Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
, Map FlagName Bool
-> ApplyCLIFlag
-> Map ApplyCLIFlag (Map FlagName Bool)
-> Map FlagName Bool
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Map FlagName Bool
forall k a. Map k a
Map.empty ApplyCLIFlag
ACFAllProjectPackages Map ApplyCLIFlag (Map FlagName Bool)
cliFlags
]
where
cliFlags :: Map ApplyCLIFlag (Map FlagName Bool)
cliFlags = BuildOptsCLI -> Map ApplyCLIFlag (Map FlagName Bool)
boptsCLIFlags BuildOptsCLI
boptsCli
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts :: BuildConfig -> PackageName -> Bool -> Bool -> [Text]
loadCabalConfigOpts bconfig :: BuildConfig
bconfig name :: PackageName
name isTarget :: Bool
isTarget isLocal :: Bool
isLocal = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKEverything (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
, if Bool
isLocal
then [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKLocals (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
else []
, if Bool
isTarget
then [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] CabalConfigKey
CCKTargets (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
else []
, [Text] -> CabalConfigKey -> Map CabalConfigKey [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] (PackageName -> CabalConfigKey
CCKPackage PackageName
name) (Config -> Map CabalConfigKey [Text]
configCabalConfigOpts Config
config)
]
where
config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig
generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
generalGhcOptions bconfig :: BuildConfig
bconfig boptsCli :: BuildOptsCLI
boptsCli isTarget :: Bool
isTarget isLocal :: Bool
isLocal = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOEverything (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
, if Bool
isLocal
then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOLocals (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
else []
, if Bool
isTarget
then [Text] -> ApplyGhcOptions -> Map ApplyGhcOptions [Text] -> [Text]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ApplyGhcOptions
AGOTargets (Config -> Map ApplyGhcOptions [Text]
configGhcOptionsByCat Config
config)
else []
, [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["-fhpc"] | Bool
isLocal Bool -> Bool -> Bool
&& TestOpts -> Bool
toCoverage (BuildOpts -> TestOpts
boptsTestOpts BuildOpts
bopts)]
, if BuildOpts -> Bool
boptsLibProfile BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeProfile BuildOpts
bopts
then ["-fprof-auto","-fprof-cafs"]
else []
, if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ BuildOpts -> Bool
boptsLibStrip BuildOpts
bopts Bool -> Bool -> Bool
|| BuildOpts -> Bool
boptsExeStrip BuildOpts
bopts
then ["-g"]
else []
, if Bool
includeExtraOptions
then BuildOptsCLI -> [Text]
boptsCLIGhcOptions BuildOptsCLI
boptsCli
else []
]
where
bopts :: BuildOpts
bopts = Config -> BuildOpts
configBuild Config
config
config :: Config
config = Getting Config BuildConfig Config -> BuildConfig -> Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config BuildConfig Config
forall env. HasConfig env => Lens' env Config
configL BuildConfig
bconfig
includeExtraOptions :: Bool
includeExtraOptions =
case Config -> ApplyGhcOptions
configApplyGhcOptions Config
config of
AGOTargets -> Bool
isTarget
AGOLocals -> Bool
isLocal
AGOEverything -> Bool
True
splitComponents :: [NamedComponent]
-> (Set Text, Set Text, Set Text)
splitComponents :: [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents =
([Text] -> [Text])
-> ([Text] -> [Text])
-> ([Text] -> [Text])
-> [NamedComponent]
-> (Set Text, Set Text, Set Text)
forall a a a.
(Ord a, Ord a, Ord a) =>
([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [Text]
forall a. a -> a
id [Text] -> [Text]
forall a. a -> a
id [Text] -> [Text]
forall a. a -> a
id
where
go :: ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c [] = ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
a [], [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
b [], [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [Text] -> [a]
c [])
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c (CLib:xs :: [NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c (CInternalLib x :: Text
x:xs :: [NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c (CExe x :: Text
x:xs :: [NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go ([Text] -> [a]
a ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [Text] -> [a]
b [Text] -> [a]
c [NamedComponent]
xs
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c (CTest x :: Text
x:xs :: [NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a ([Text] -> [a]
b ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [Text] -> [a]
c [NamedComponent]
xs
go a :: [Text] -> [a]
a b :: [Text] -> [a]
b c :: [Text] -> [a]
c (CBench x :: Text
x:xs :: [NamedComponent]
xs) = ([Text] -> [a])
-> ([Text] -> [a])
-> ([Text] -> [a])
-> [NamedComponent]
-> (Set a, Set a, Set a)
go [Text] -> [a]
a [Text] -> [a]
b ([Text] -> [a]
c ([Text] -> [a]) -> ([Text] -> [Text]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:)) [NamedComponent]
xs
loadCommonPackage ::
forall env. (HasBuildConfig env, HasSourceMap env)
=> CommonPackage
-> RIO env Package
loadCommonPackage :: CommonPackage -> RIO env Package
loadCommonPackage common :: CommonPackage
common = do
PackageConfig
config <- Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
GenericPackageDescription
gpkg <- IO GenericPackageDescription -> RIO env GenericPackageDescription
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GenericPackageDescription -> RIO env GenericPackageDescription)
-> IO GenericPackageDescription
-> RIO env GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ CommonPackage -> IO GenericPackageDescription
cpGPD CommonPackage
common
Package -> RIO env Package
forall (m :: * -> *) a. Monad m => a -> m a
return (Package -> RIO env Package) -> Package -> RIO env Package
forall a b. (a -> b) -> a -> b
$ PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
loadLocalPackage ::
forall env. (HasBuildConfig env, HasSourceMap env)
=> ProjectPackage
-> RIO env LocalPackage
loadLocalPackage :: ProjectPackage -> RIO env LocalPackage
loadLocalPackage pp :: ProjectPackage
pp = do
SourceMap
sm <- Getting SourceMap env SourceMap -> RIO env SourceMap
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceMap env SourceMap
forall env. HasSourceMap env => Lens' env SourceMap
sourceMapL
let common :: CommonPackage
common = ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp
BuildOpts
bopts <- Getting BuildOpts env BuildOpts -> RIO env BuildOpts
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildOpts env BuildOpts
forall s. HasConfig s => Lens' s BuildOpts
buildOptsL
Maybe Curator
mcurator <- Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator))
-> Getting (Maybe Curator) env (Maybe Curator)
-> RIO env (Maybe Curator)
forall a b. (a -> b) -> a -> b
$ (BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL((BuildConfig -> Const (Maybe Curator) BuildConfig)
-> env -> Const (Maybe Curator) env)
-> ((Maybe Curator -> Const (Maybe Curator) (Maybe Curator))
-> BuildConfig -> Const (Maybe Curator) BuildConfig)
-> Getting (Maybe Curator) env (Maybe Curator)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BuildConfig -> Maybe Curator)
-> SimpleGetter BuildConfig (Maybe Curator)
forall s a. (s -> a) -> SimpleGetter s a
to BuildConfig -> Maybe Curator
bcCurator
PackageConfig
config <- Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
forall env.
(HasBuildConfig env, HasSourceMap env) =>
Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig (CommonPackage -> Map FlagName Bool
cpFlags CommonPackage
common) (CommonPackage -> [Text]
cpGhcOptions CommonPackage
common) (CommonPackage -> [Text]
cpCabalConfigOpts CommonPackage
common)
GenericPackageDescription
gpkg <- ProjectPackage -> RIO env GenericPackageDescription
forall (m :: * -> *).
MonadIO m =>
ProjectPackage -> m GenericPackageDescription
ppGPD ProjectPackage
pp
let name :: PackageName
name = CommonPackage -> PackageName
cpName CommonPackage
common
mtarget :: Maybe Target
mtarget = PackageName -> Map PackageName Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name (SMTargets -> Map PackageName Target
smtTargets (SMTargets -> Map PackageName Target)
-> SMTargets -> Map PackageName Target
forall a b. (a -> b) -> a -> b
$ SourceMap -> SMTargets
smTargets SourceMap
sm)
(exeCandidates :: Set Text
exeCandidates, testCandidates :: Set Text
testCandidates, benchCandidates :: Set Text
benchCandidates) =
case Maybe Target
mtarget of
Just (TargetComps comps :: Set NamedComponent
comps) -> [NamedComponent] -> (Set Text, Set Text, Set Text)
splitComponents ([NamedComponent] -> (Set Text, Set Text, Set Text))
-> [NamedComponent] -> (Set Text, Set Text, Set Text)
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> [NamedComponent]
forall a. Set a -> [a]
Set.toList Set NamedComponent
comps
Just (TargetAll _packageType :: PackageType
_packageType) ->
( Package -> Set Text
packageExes Package
pkg
, if BuildOpts -> Bool
boptsTests BuildOpts
bopts Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipTest) Maybe Curator
mcurator
then Map Text TestSuiteInterface -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg)
else Set Text
forall a. Set a
Set.empty
, if BuildOpts -> Bool
boptsBenchmarks BuildOpts
bopts Bool -> Bool -> Bool
&& Bool -> (Curator -> Bool) -> Maybe Curator -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember PackageName
name (Set PackageName -> Bool)
-> (Curator -> Set PackageName) -> Curator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curator -> Set PackageName
curatorSkipBenchmark) Maybe Curator
mcurator
then Package -> Set Text
packageBenchmarks Package
pkg
else Set Text
forall a. Set a
Set.empty
)
Nothing -> (Set Text, Set Text, Set Text)
forall a. Monoid a => a
mempty
isWanted :: Bool
isWanted = case Maybe Target
mtarget of
Nothing -> Bool
False
Just _ ->
let hasLibrary :: Bool
hasLibrary =
case Package -> PackageLibraries
packageLibraries Package
pkg of
NoLibraries -> Bool
False
HasLibraries _ -> Bool
True
in Bool
hasLibrary
Bool -> Bool -> Bool
|| Bool -> Bool
not (Set NamedComponent -> Bool
forall a. Set a -> Bool
Set.null Set NamedComponent
nonLibComponents)
Bool -> Bool -> Bool
|| Bool -> Bool
not (Set Text -> Bool
forall a. Set a -> Bool
Set.null (Set Text -> Bool) -> Set Text -> Bool
forall a b. (a -> b) -> a -> b
$ Package -> Set Text
packageInternalLibraries Package
pkg)
filterSkippedComponents :: Set Text -> Set Text
filterSkippedComponents = (Text -> Bool) -> Set Text -> Set Text
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildOpts -> [Text]
boptsSkipComponents BuildOpts
bopts))
(exes :: Set Text
exes, tests :: Set Text
tests, benches :: Set Text
benches) = (Set Text -> Set Text
filterSkippedComponents Set Text
exeCandidates,
Set Text -> Set Text
filterSkippedComponents Set Text
testCandidates,
Set Text -> Set Text
filterSkippedComponents Set Text
benchCandidates)
nonLibComponents :: Set NamedComponent
nonLibComponents = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents Set Text
exes Set Text
tests Set Text
benches
toComponents :: Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents e :: Set Text
e t :: Set Text
t b :: Set Text
b = [Set NamedComponent] -> Set NamedComponent
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
[ (Text -> NamedComponent) -> Set Text -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CExe Set Text
e
, (Text -> NamedComponent) -> Set Text -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CTest Set Text
t
, (Text -> NamedComponent) -> Set Text -> Set NamedComponent
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Text -> NamedComponent
CBench Set Text
b
]
btconfig :: PackageConfig
btconfig = PackageConfig
config
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
tests
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
benches
}
testconfig :: PackageConfig
testconfig = PackageConfig
config
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
True
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
}
benchconfig :: PackageConfig
benchconfig = PackageConfig
config
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
True
}
pkg :: Package
pkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
config GenericPackageDescription
gpkg
btpkg :: Maybe Package
btpkg
| Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
tests Bool -> Bool -> Bool
&& Set Text -> Bool
forall a. Set a -> Bool
Set.null Set Text
benches = Maybe Package
forall a. Maybe a
Nothing
| Bool
otherwise = Package -> Maybe Package
forall a. a -> Maybe a
Just (PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
btconfig GenericPackageDescription
gpkg)
testpkg :: Package
testpkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
testconfig GenericPackageDescription
gpkg
benchpkg :: Package
benchpkg = PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
benchconfig GenericPackageDescription
gpkg
MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles <- RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith (RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith
EnvConfig (Map NamedComponent (Set (Path Abs File)))))
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO
env
(MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File))))
forall a b. (a -> b) -> a -> b
$ (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> Map NamedComponent (Set (Path Abs File))
forall a b. (a, b) -> a
fst ((Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> Map NamedComponent (Set (Path Abs File)))
-> RIO
EnvConfig
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package
-> Path Abs File
-> Set NamedComponent
-> RIO
EnvConfig
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg (ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp) Set NamedComponent
nonLibComponents
MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults <- RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
forall (m :: * -> *) env a.
MonadIO m =>
RIO env a -> m (MemoizedWith env a)
memoizeRefWith (RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> RIO
env
(MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
forall a b. (a -> b) -> a -> b
$ do
Map NamedComponent (Set (Path Abs File))
componentFiles' <- MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> RIO EnvConfig (Map NamedComponent (Set (Path Abs File)))
forall env (m :: * -> *) a.
(HasEnvConfig env, MonadReader env m, MonadIO m) =>
MemoizedWith EnvConfig a -> m a
runMemoizedWith MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
[(NamedComponent, Set (Path Abs File))]
-> ((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map NamedComponent (Set (Path Abs File))
-> [(NamedComponent, Set (Path Abs File))]
forall k a. Map k a -> [(k, a)]
Map.toList Map NamedComponent (Set (Path Abs File))
componentFiles') (((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))])
-> ((NamedComponent, Set (Path Abs File))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo)))
-> RIO
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
forall a b. (a -> b) -> a -> b
$ \(component :: NamedComponent
component, files :: Set (Path Abs File)
files) -> do
Maybe (Map String FileCacheInfo)
mbuildCache <- Path Abs Dir
-> NamedComponent
-> RIO EnvConfig (Maybe (Map String FileCacheInfo))
forall env.
HasEnvConfig env =>
Path Abs Dir
-> NamedComponent -> RIO env (Maybe (Map String FileCacheInfo))
tryGetBuildCache (ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) NamedComponent
component
(Set String, Map String FileCacheInfo)
checkCacheResult <- Map String FileCacheInfo
-> [Path Abs File]
-> RIO EnvConfig (Set String, Map String FileCacheInfo)
forall (m :: * -> *).
MonadIO m =>
Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache
(Map String FileCacheInfo
-> Maybe (Map String FileCacheInfo) -> Map String FileCacheInfo
forall a. a -> Maybe a -> a
fromMaybe Map String FileCacheInfo
forall k a. Map k a
Map.empty Maybe (Map String FileCacheInfo)
mbuildCache)
(Set (Path Abs File) -> [Path Abs File]
forall a. Set a -> [a]
Set.toList Set (Path Abs File)
files)
(NamedComponent, (Set String, Map String FileCacheInfo))
-> RIO
EnvConfig (NamedComponent, (Set String, Map String FileCacheInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedComponent
component, (Set String, Map String FileCacheInfo)
checkCacheResult)
let dirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles = do
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults' <- MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
let allDirtyFiles :: Set String
allDirtyFiles = [Set String] -> Set String
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set String] -> Set String) -> [Set String] -> Set String
forall a b. (a -> b) -> a -> b
$ ((NamedComponent, (Set String, Map String FileCacheInfo))
-> Set String)
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [Set String]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, (x :: Set String
x, _)) -> Set String
x) [(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults'
Maybe (Set String) -> MemoizedWith EnvConfig (Maybe (Set String))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Set String) -> MemoizedWith EnvConfig (Maybe (Set String)))
-> Maybe (Set String)
-> MemoizedWith EnvConfig (Maybe (Set String))
forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not (Set String -> Bool
forall a. Set a -> Bool
Set.null Set String
allDirtyFiles)
then let tryStripPrefix :: String -> String
tryStripPrefix y :: String
y =
String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
y (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir -> String) -> Path Abs Dir -> String
forall a b. (a -> b) -> a -> b
$ ProjectPackage -> Path Abs Dir
ppRoot ProjectPackage
pp) String
y)
in Set String -> Maybe (Set String)
forall a. a -> Maybe a
Just (Set String -> Maybe (Set String))
-> Set String -> Maybe (Set String)
forall a b. (a -> b) -> a -> b
$ (String -> String) -> Set String -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map String -> String
tryStripPrefix Set String
allDirtyFiles
else Maybe (Set String)
forall a. Maybe a
Nothing
newBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches =
[(NamedComponent, Map String FileCacheInfo)]
-> Map NamedComponent (Map String FileCacheInfo)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NamedComponent, Map String FileCacheInfo)]
-> Map NamedComponent (Map String FileCacheInfo))
-> ([(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [(NamedComponent, Map String FileCacheInfo)])
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> Map NamedComponent (Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NamedComponent, (Set String, Map String FileCacheInfo))
-> (NamedComponent, Map String FileCacheInfo))
-> [(NamedComponent, (Set String, Map String FileCacheInfo))]
-> [(NamedComponent, Map String FileCacheInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\(c :: NamedComponent
c, (_, cache :: Map String FileCacheInfo
cache)) -> (NamedComponent
c, Map String FileCacheInfo
cache))
([(NamedComponent, (Set String, Map String FileCacheInfo))]
-> Map NamedComponent (Map String FileCacheInfo))
-> MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
-> MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MemoizedWith
EnvConfig
[(NamedComponent, (Set String, Map String FileCacheInfo))]
checkCacheResults
LocalPackage -> RIO env LocalPackage
forall (m :: * -> *) a. Monad m => a -> m a
return $WLocalPackage :: Package
-> Set NamedComponent
-> Set NamedComponent
-> Bool
-> Map PackageName VersionRange
-> Map PackageName VersionRange
-> Maybe Package
-> Path Abs File
-> Bool
-> Bool
-> MemoizedWith EnvConfig (Maybe (Set String))
-> MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
-> MemoizedWith
EnvConfig (Map NamedComponent (Set (Path Abs File)))
-> LocalPackage
LocalPackage
{ lpPackage :: Package
lpPackage = Package
pkg
, lpTestDeps :: Map PackageName VersionRange
lpTestDeps = DepValue -> VersionRange
dvVersionRange (DepValue -> VersionRange)
-> Map PackageName DepValue -> Map PackageName VersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map PackageName DepValue
packageDeps Package
testpkg
, lpBenchDeps :: Map PackageName VersionRange
lpBenchDeps = DepValue -> VersionRange
dvVersionRange (DepValue -> VersionRange)
-> Map PackageName DepValue -> Map PackageName VersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Package -> Map PackageName DepValue
packageDeps Package
benchpkg
, lpTestBench :: Maybe Package
lpTestBench = Maybe Package
btpkg
, lpComponentFiles :: MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
lpComponentFiles = MemoizedWith EnvConfig (Map NamedComponent (Set (Path Abs File)))
componentFiles
, lpBuildHaddocks :: Bool
lpBuildHaddocks = CommonPackage -> Bool
cpHaddocks (ProjectPackage -> CommonPackage
ppCommon ProjectPackage
pp)
, lpForceDirty :: Bool
lpForceDirty = BuildOpts -> Bool
boptsForceDirty BuildOpts
bopts
, lpDirtyFiles :: MemoizedWith EnvConfig (Maybe (Set String))
lpDirtyFiles = MemoizedWith EnvConfig (Maybe (Set String))
dirtyFiles
, lpNewBuildCaches :: MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
lpNewBuildCaches = MemoizedWith
EnvConfig (Map NamedComponent (Map String FileCacheInfo))
newBuildCaches
, lpCabalFile :: Path Abs File
lpCabalFile = ProjectPackage -> Path Abs File
ppCabalFP ProjectPackage
pp
, lpWanted :: Bool
lpWanted = Bool
isWanted
, lpComponents :: Set NamedComponent
lpComponents = Set NamedComponent
nonLibComponents
, lpUnbuildable :: Set NamedComponent
lpUnbuildable = Set Text -> Set Text -> Set Text -> Set NamedComponent
toComponents
(Set Text
exes Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageExes Package
pkg)
(Set Text
tests Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map Text TestSuiteInterface -> Set Text
forall k a. Map k a -> Set k
Map.keysSet (Package -> Map Text TestSuiteInterface
packageTests Package
pkg))
(Set Text
benches Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Package -> Set Text
packageBenchmarks Package
pkg)
}
checkBuildCache :: forall m. (MonadIO m)
=> Map FilePath FileCacheInfo
-> [Path Abs File]
-> m (Set FilePath, Map FilePath FileCacheInfo)
checkBuildCache :: Map String FileCacheInfo
-> [Path Abs File] -> m (Set String, Map String FileCacheInfo)
checkBuildCache oldCache :: Map String FileCacheInfo
oldCache files :: [Path Abs File]
files = do
Map String (Maybe CTime)
fileTimes <- ([(String, Maybe CTime)] -> Map String (Maybe CTime))
-> m [(String, Maybe CTime)] -> m (Map String (Maybe CTime))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [(String, Maybe CTime)] -> Map String (Maybe CTime)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (m [(String, Maybe CTime)] -> m (Map String (Maybe CTime)))
-> m [(String, Maybe CTime)] -> m (Map String (Maybe CTime))
forall a b. (a -> b) -> a -> b
$ [Path Abs File]
-> (Path Abs File -> m (String, Maybe CTime))
-> m [(String, Maybe CTime)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Abs File]
files ((Path Abs File -> m (String, Maybe CTime))
-> m [(String, Maybe CTime)])
-> (Path Abs File -> m (String, Maybe CTime))
-> m [(String, Maybe CTime)]
forall a b. (a -> b) -> a -> b
$ \fp :: Path Abs File
fp -> do
Maybe CTime
mmodTime <- IO (Maybe CTime) -> m (Maybe CTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO (Maybe CTime)
forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
getModTimeMaybe (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp))
(String, Maybe CTime) -> m (String, Maybe CTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp, Maybe CTime
mmodTime)
(Map String (Set String, Map String FileCacheInfo)
-> (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([(Set String, Map String FileCacheInfo)]
-> (Set String, Map String FileCacheInfo)
forall a. Monoid a => [a] -> a
mconcat ([(Set String, Map String FileCacheInfo)]
-> (Set String, Map String FileCacheInfo))
-> (Map String (Set String, Map String FileCacheInfo)
-> [(Set String, Map String FileCacheInfo)])
-> Map String (Set String, Map String FileCacheInfo)
-> (Set String, Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Set String, Map String FileCacheInfo)
-> [(Set String, Map String FileCacheInfo)]
forall k a. Map k a -> [a]
Map.elems) (m (Map String (Set String, Map String FileCacheInfo))
-> m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
-> m (Set String, Map String FileCacheInfo)
forall a b. (a -> b) -> a -> b
$ Map String (m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Map String (m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo)))
-> Map String (m (Set String, Map String FileCacheInfo))
-> m (Map String (Set String, Map String FileCacheInfo))
forall a b. (a -> b) -> a -> b
$
(String
-> Maybe CTime
-> FileCacheInfo
-> Maybe (m (Set String, Map String FileCacheInfo)))
-> (Map String (Maybe CTime)
-> Map String (m (Set String, Map String FileCacheInfo)))
-> (Map String FileCacheInfo
-> Map String (m (Set String, Map String FileCacheInfo)))
-> Map String (Maybe CTime)
-> Map String FileCacheInfo
-> Map String (m (Set String, Map String FileCacheInfo))
forall k a b c.
Ord k =>
(k -> a -> b -> Maybe c)
-> (Map k a -> Map k c)
-> (Map k b -> Map k c)
-> Map k a
-> Map k b
-> Map k c
Map.mergeWithKey
(\fp :: String
fp mmodTime :: Maybe CTime
mmodTime fci :: FileCacheInfo
fci -> m (Set String, Map String FileCacheInfo)
-> Maybe (m (Set String, Map String FileCacheInfo))
forall a. a -> Maybe a
Just (String
-> Maybe CTime
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe CTime
mmodTime (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
((String -> Maybe CTime -> m (Set String, Map String FileCacheInfo))
-> Map String (Maybe CTime)
-> Map String (m (Set String, Map String FileCacheInfo))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\fp :: String
fp mmodTime :: Maybe CTime
mmodTime -> String
-> Maybe CTime
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe CTime
mmodTime Maybe FileCacheInfo
forall a. Maybe a
Nothing))
((String
-> FileCacheInfo -> m (Set String, Map String FileCacheInfo))
-> Map String FileCacheInfo
-> Map String (m (Set String, Map String FileCacheInfo))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\fp :: String
fp fci :: FileCacheInfo
fci -> String
-> Maybe CTime
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go String
fp Maybe CTime
forall a. Maybe a
Nothing (FileCacheInfo -> Maybe FileCacheInfo
forall a. a -> Maybe a
Just FileCacheInfo
fci)))
Map String (Maybe CTime)
fileTimes
Map String FileCacheInfo
oldCache
where
go :: FilePath -> Maybe CTime -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo)
go :: String
-> Maybe CTime
-> Maybe FileCacheInfo
-> m (Set String, Map String FileCacheInfo)
go fp :: String
fp _ _ | String -> String
takeFileName String
fp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "cabal_macros.h" = (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set String
forall a. Set a
Set.empty, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
go fp :: String
fp (Just modTime' :: CTime
modTime') (Just fci :: FileCacheInfo
fci)
| FileCacheInfo -> CTime
fciModTime FileCacheInfo
fci CTime -> CTime -> Bool
forall a. Eq a => a -> a -> Bool
== CTime
modTime' = (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set String
forall a. Set a
Set.empty, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
fci)
| Bool
otherwise = do
FileCacheInfo
newFci <- CTime -> String -> m FileCacheInfo
forall (m :: * -> *).
MonadIO m =>
CTime -> String -> m FileCacheInfo
calcFci CTime
modTime' String
fp
let isDirty :: Bool
isDirty =
FileCacheInfo -> FileSize
fciSize FileCacheInfo
fci FileSize -> FileSize -> Bool
forall a. Eq a => a -> a -> Bool
/= FileCacheInfo -> FileSize
fciSize FileCacheInfo
newFci Bool -> Bool -> Bool
||
FileCacheInfo -> SHA256
fciHash FileCacheInfo
fci SHA256 -> SHA256 -> Bool
forall a. Eq a => a -> a -> Bool
/= FileCacheInfo -> SHA256
fciHash FileCacheInfo
newFci
newDirty :: Set String
newDirty = if Bool
isDirty then String -> Set String
forall a. a -> Set a
Set.singleton String
fp else Set String
forall a. Set a
Set.empty
(Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Set String
newDirty, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
newFci)
go fp :: String
fp Nothing _ = (Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, Map String FileCacheInfo
forall k a. Map k a
Map.empty)
go fp :: String
fp (Just modTime' :: CTime
modTime') Nothing = do
FileCacheInfo
newFci <- CTime -> String -> m FileCacheInfo
forall (m :: * -> *).
MonadIO m =>
CTime -> String -> m FileCacheInfo
calcFci CTime
modTime' String
fp
(Set String, Map String FileCacheInfo)
-> m (Set String, Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Set String
forall a. a -> Set a
Set.singleton String
fp, String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp FileCacheInfo
newFci)
addUnlistedToBuildCache
:: HasEnvConfig env
=> CTime
-> Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map FilePath a)
-> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache :: CTime
-> Package
-> Path Abs File
-> Set NamedComponent
-> Map NamedComponent (Map String a)
-> RIO
env
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
addUnlistedToBuildCache preBuildTime :: CTime
preBuildTime pkg :: Package
pkg cabalFP :: Path Abs File
cabalFP nonLibComponents :: Set NamedComponent
nonLibComponents buildCaches :: Map NamedComponent (Map String a)
buildCaches = do
(componentFiles :: Map NamedComponent (Set (Path Abs File))
componentFiles, warnings :: [PackageWarning]
warnings) <- Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall env.
HasEnvConfig env =>
Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets Package
pkg Path Abs File
cabalFP Set NamedComponent
nonLibComponents
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results <- [(NamedComponent, Set (Path Abs File))]
-> ((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map NamedComponent (Set (Path Abs File))
-> [(NamedComponent, Set (Path Abs File))]
forall k a. Map k a -> [(k, a)]
M.toList Map NamedComponent (Set (Path Abs File))
componentFiles) (((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])])
-> ((NamedComponent, Set (Path Abs File))
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning]))
-> RIO
env
[((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
forall a b. (a -> b) -> a -> b
$ \(component :: NamedComponent
component, files :: Set (Path Abs File)
files) -> do
let buildCache :: Map String a
buildCache = Map String a
-> NamedComponent
-> Map NamedComponent (Map String a)
-> Map String a
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Map String a
forall k a. Map k a
M.empty NamedComponent
component Map NamedComponent (Map String a)
buildCaches
newFiles :: [String]
newFiles =
Set String -> [String]
forall a. Set a -> [a]
Set.toList (Set String -> [String]) -> Set String -> [String]
forall a b. (a -> b) -> a -> b
$
(Path Abs File -> String) -> Set (Path Abs File) -> Set String
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Path Abs File -> String
forall b t. Path b t -> String
toFilePath Set (Path Abs File)
files Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map String a -> Set String
forall k a. Map k a -> Set k
Map.keysSet Map String a
buildCache
[Map String FileCacheInfo]
addBuildCache <- (String -> RIO env (Map String FileCacheInfo))
-> [String] -> RIO env [Map String FileCacheInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> RIO env (Map String FileCacheInfo)
forall (m :: * -> *).
MonadIO m =>
String -> m (Map String FileCacheInfo)
addFileToCache [String]
newFiles
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> RIO
env
((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedComponent
component, [Map String FileCacheInfo]
addBuildCache), [PackageWarning]
warnings)
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
-> RIO
env
(Map NamedComponent [Map String FileCacheInfo], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(NamedComponent, [Map String FileCacheInfo])]
-> Map NamedComponent [Map String FileCacheInfo]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> (NamedComponent, [Map String FileCacheInfo]))
-> [((NamedComponent, [Map String FileCacheInfo]),
[PackageWarning])]
-> [(NamedComponent, [Map String FileCacheInfo])]
forall a b. (a -> b) -> [a] -> [b]
map ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> (NamedComponent, [Map String FileCacheInfo])
forall a b. (a, b) -> a
fst [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results), (((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> [PackageWarning])
-> [((NamedComponent, [Map String FileCacheInfo]),
[PackageWarning])]
-> [PackageWarning]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])
-> [PackageWarning]
forall a b. (a, b) -> b
snd [((NamedComponent, [Map String FileCacheInfo]), [PackageWarning])]
results)
where
addFileToCache :: String -> m (Map String FileCacheInfo)
addFileToCache fp :: String
fp = do
Maybe CTime
mmodTime <- String -> m (Maybe CTime)
forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
getModTimeMaybe String
fp
case Maybe CTime
mmodTime of
Nothing -> Map String FileCacheInfo -> m (Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String FileCacheInfo
forall k a. Map k a
Map.empty
Just modTime' :: CTime
modTime' ->
if CTime
modTime' CTime -> CTime -> Bool
forall a. Ord a => a -> a -> Bool
< CTime
preBuildTime
then String -> FileCacheInfo -> Map String FileCacheInfo
forall k a. k -> a -> Map k a
Map.singleton String
fp (FileCacheInfo -> Map String FileCacheInfo)
-> m FileCacheInfo -> m (Map String FileCacheInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CTime -> String -> m FileCacheInfo
forall (m :: * -> *).
MonadIO m =>
CTime -> String -> m FileCacheInfo
calcFci CTime
modTime' String
fp
else Map String FileCacheInfo -> m (Map String FileCacheInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String FileCacheInfo
forall k a. Map k a
Map.empty
getPackageFilesForTargets
:: HasEnvConfig env
=> Package
-> Path Abs File
-> Set NamedComponent
-> RIO env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets :: Package
-> Path Abs File
-> Set NamedComponent
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
getPackageFilesForTargets pkg :: Package
pkg cabalFP :: Path Abs File
cabalFP nonLibComponents :: Set NamedComponent
nonLibComponents = do
(components' :: Map NamedComponent (Map ModuleName (Path Abs File))
components',compFiles :: Map NamedComponent [DotCabalPath]
compFiles,otherFiles :: Set (Path Abs File)
otherFiles,warnings :: [PackageWarning]
warnings) <-
GetPackageFiles
-> Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
GetPackageFiles
-> forall env.
HasEnvConfig env =>
Path Abs File
-> RIO
env
(Map NamedComponent (Map ModuleName (Path Abs File)),
Map NamedComponent [DotCabalPath], Set (Path Abs File),
[PackageWarning])
getPackageFiles (Package -> GetPackageFiles
packageFiles Package
pkg) Path Abs File
cabalFP
let necessaryComponents :: Set NamedComponent
necessaryComponents = NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => a -> Set a -> Set a
Set.insert NamedComponent
CLib (Set NamedComponent -> Set NamedComponent)
-> Set NamedComponent -> Set NamedComponent
forall a b. (a -> b) -> a -> b
$ (NamedComponent -> Bool)
-> Set NamedComponent -> Set NamedComponent
forall a. (a -> Bool) -> Set a -> Set a
Set.filter NamedComponent -> Bool
isCInternalLib (Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
components')
components :: Set NamedComponent
components = Set NamedComponent
necessaryComponents Set NamedComponent -> Set NamedComponent -> Set NamedComponent
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set NamedComponent
nonLibComponents
componentsFiles :: Map NamedComponent (Set (Path Abs File))
componentsFiles =
([DotCabalPath] -> Set (Path Abs File))
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File))
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\files :: [DotCabalPath]
files -> Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Path Abs File)
otherFiles ((DotCabalPath -> Path Abs File)
-> Set DotCabalPath -> Set (Path Abs File)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map DotCabalPath -> Path Abs File
dotCabalGetPath (Set DotCabalPath -> Set (Path Abs File))
-> Set DotCabalPath -> Set (Path Abs File)
forall a b. (a -> b) -> a -> b
$ [DotCabalPath] -> Set DotCabalPath
forall a. Ord a => [a] -> Set a
Set.fromList [DotCabalPath]
files)) (Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File)))
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$
(NamedComponent -> [DotCabalPath] -> Bool)
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\component :: NamedComponent
component _ -> NamedComponent
component NamedComponent -> Set NamedComponent -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set NamedComponent
components) Map NamedComponent [DotCabalPath]
compFiles
(Map NamedComponent (Set (Path Abs File)), [PackageWarning])
-> RIO
env (Map NamedComponent (Set (Path Abs File)), [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Set (Path Abs File))
componentsFiles, [PackageWarning]
warnings)
getModTimeMaybe :: MonadIO m => FilePath -> m (Maybe CTime)
getModTimeMaybe :: String -> m (Maybe CTime)
getModTimeMaybe fp :: String
fp =
IO (Maybe CTime) -> m (Maybe CTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Maybe CTime)
-> (IOError -> IO (Maybe CTime)) -> IO (Maybe CTime)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
((FileStatus -> Maybe CTime) -> IO FileStatus -> IO (Maybe CTime)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(CTime -> Maybe CTime
forall a. a -> Maybe a
Just (CTime -> Maybe CTime)
-> (FileStatus -> CTime) -> FileStatus -> Maybe CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> CTime
modificationTime)
(String -> IO FileStatus
getFileStatus String
fp))
(\e :: IOError
e ->
if IOError -> Bool
isDoesNotExistError IOError
e
then Maybe CTime -> IO (Maybe CTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTime
forall a. Maybe a
Nothing
else IOError -> IO (Maybe CTime)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM IOError
e))
calcFci :: MonadIO m => CTime -> FilePath -> m FileCacheInfo
calcFci :: CTime -> String -> m FileCacheInfo
calcFci modTime' :: CTime
modTime' fp :: String
fp = IO FileCacheInfo -> m FileCacheInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileCacheInfo -> m FileCacheInfo)
-> IO FileCacheInfo -> m FileCacheInfo
forall a b. (a -> b) -> a -> b
$
String
-> (ConduitM () ByteString IO () -> IO FileCacheInfo)
-> IO FileCacheInfo
forall (m :: * -> *) (n :: * -> *) i a.
(MonadUnliftIO m, MonadIO n) =>
String -> (ConduitM i ByteString n () -> m a) -> m a
withSourceFile String
fp ((ConduitM () ByteString IO () -> IO FileCacheInfo)
-> IO FileCacheInfo)
-> (ConduitM () ByteString IO () -> IO FileCacheInfo)
-> IO FileCacheInfo
forall a b. (a -> b) -> a -> b
$ \src :: ConduitM () ByteString IO ()
src -> do
(size :: Word
size, digest :: SHA256
digest) <- ConduitT () Void IO (Word, SHA256) -> IO (Word, SHA256)
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void IO (Word, SHA256) -> IO (Word, SHA256))
-> ConduitT () Void IO (Word, SHA256) -> IO (Word, SHA256)
forall a b. (a -> b) -> a -> b
$ ConduitM () ByteString IO ()
src ConduitM () ByteString IO ()
-> ConduitM ByteString Void IO (Word, SHA256)
-> ConduitT () Void IO (Word, SHA256)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ZipSink ByteString IO (Word, SHA256)
-> ConduitM ByteString Void IO (Word, SHA256)
forall i (m :: * -> *) r. ZipSink i m r -> Sink i m r
getZipSink
((,)
(Word -> SHA256 -> (Word, SHA256))
-> ZipSink ByteString IO Word
-> ZipSink ByteString IO (SHA256 -> (Word, SHA256))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sink ByteString IO Word -> ZipSink ByteString IO Word
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink ((Word -> ByteString -> Word) -> Word -> Sink ByteString IO Word
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold
(\x :: Word
x y :: ByteString
y -> Word
x Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
y))
0)
ZipSink ByteString IO (SHA256 -> (Word, SHA256))
-> ZipSink ByteString IO SHA256
-> ZipSink ByteString IO (Word, SHA256)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sink ByteString IO SHA256 -> ZipSink ByteString IO SHA256
forall i (m :: * -> *) r. Sink i m r -> ZipSink i m r
ZipSink Sink ByteString IO SHA256
forall (m :: * -> *) o. Monad m => ConduitT ByteString o m SHA256
SHA256.sinkHash)
FileCacheInfo -> IO FileCacheInfo
forall (m :: * -> *) a. Monad m => a -> m a
return $WFileCacheInfo :: CTime -> FileSize -> SHA256 -> FileCacheInfo
FileCacheInfo
{ fciModTime :: CTime
fciModTime = CTime
modTime'
, fciSize :: FileSize
fciSize = Word -> FileSize
FileSize Word
size
, fciHash :: SHA256
fciHash = SHA256
digest
}
getPackageConfig
:: (HasBuildConfig env, HasSourceMap env)
=> Map FlagName Bool
-> [Text]
-> [Text]
-> RIO env PackageConfig
getPackageConfig :: Map FlagName Bool -> [Text] -> [Text] -> RIO env PackageConfig
getPackageConfig flags :: Map FlagName Bool
flags ghcOptions :: [Text]
ghcOptions cabalConfigOpts :: [Text]
cabalConfigOpts = do
Platform
platform <- Getting Platform env Platform -> RIO env Platform
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Platform env Platform
forall env. HasPlatform env => Lens' env Platform
platformL
ActualCompiler
compilerVersion <- Getting ActualCompiler env ActualCompiler -> RIO env ActualCompiler
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ActualCompiler env ActualCompiler
forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
PackageConfig -> RIO env PackageConfig
forall (m :: * -> *) a. Monad m => a -> m a
return $WPackageConfig :: Bool
-> Bool
-> Map FlagName Bool
-> [Text]
-> [Text]
-> ActualCompiler
-> Platform
-> PackageConfig
PackageConfig
{ packageConfigEnableTests :: Bool
packageConfigEnableTests = Bool
False
, packageConfigEnableBenchmarks :: Bool
packageConfigEnableBenchmarks = Bool
False
, packageConfigFlags :: Map FlagName Bool
packageConfigFlags = Map FlagName Bool
flags
, packageConfigGhcOptions :: [Text]
packageConfigGhcOptions = [Text]
ghcOptions
, packageConfigCabalConfigOpts :: [Text]
packageConfigCabalConfigOpts = [Text]
cabalConfigOpts
, packageConfigCompilerVersion :: ActualCompiler
packageConfigCompilerVersion = ActualCompiler
compilerVersion
, packageConfigPlatform :: Platform
packageConfigPlatform = Platform
platform
}