{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Stack.Build.Cache
( tryGetBuildCache
, tryGetConfigCache
, tryGetCabalMod
, tryGetSetupConfigMod
, tryGetPackageProjectRoot
, getInstalledExes
, tryGetFlagCache
, deleteCaches
, markExeInstalled
, markExeNotInstalled
, writeFlagCache
, writeBuildCache
, writeConfigCache
, writeCabalMod
, writeSetupConfigMod
, writePackageProjectRoot
, TestStatus (..)
, setTestStatus
, getTestStatus
, writePrecompiledCache
, readPrecompiledCache
, BuildCache (..)
) where
import Crypto.Hash ( hashWith, SHA256 (..) )
import qualified Data.ByteArray as Mem ( convert )
import Data.ByteString.Builder ( byteString )
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Yaml as Yaml
import Foreign.C.Types ( CTime )
import Path
import Path.IO
import Stack.Constants
import Stack.Constants.Config
import Stack.Prelude
import Stack.Storage.Project
import Stack.Storage.User
import Stack.Types.Build
import Stack.Types.Cache
import Stack.Types.Config
import Stack.Types.GhcPkgId
import Stack.Types.NamedComponent
import Stack.Types.SourceMap ( smRelDir )
import System.PosixCompat.Files
( modificationTime, getFileStatus, setFileTimes )
exeInstalledDir :: (HasEnvConfig env)
=> InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir :: forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
Snap = (forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstalledPackages) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
exeInstalledDir InstallLocation
Local = (forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstalledPackages) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
getInstalledExes :: (HasEnvConfig env)
=> InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes :: forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
loc = do
Path Abs Dir
dir <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
([Path Abs Dir]
_, [Path Abs File]
files) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall k a. Map k a -> [a]
M.elems forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (\[PackageIdentifier]
_ [PackageIdentifier]
_ -> []) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\PackageIdentifier
x -> (PackageIdentifier -> PackageName
pkgName PackageIdentifier
x, [PackageIdentifier
x])) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe PackageIdentifier
parsePackageIdentifier forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b File -> Path Rel File
filename) [Path Abs File]
files
markExeInstalled :: (HasEnvConfig env)
=> InstallLocation -> PackageIdentifier -> RIO env ()
markExeInstalled :: forall env.
HasEnvConfig env =>
InstallLocation -> PackageIdentifier -> RIO env ()
markExeInstalled InstallLocation
loc PackageIdentifier
ident = do
Path Abs Dir
dir <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
dir
Path Rel File
ident' <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
let fp :: Path Abs File
fp = Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
ident'
[PackageIdentifier]
installed <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
loc
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. (a -> Bool) -> [a] -> [a]
filter (\PackageIdentifier
x -> PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident forall a. Eq a => a -> a -> Bool
== PackageIdentifier -> PackageName
pkgName PackageIdentifier
x) [PackageIdentifier]
installed)
(forall env.
HasEnvConfig env =>
InstallLocation -> PackageIdentifier -> RIO env ()
markExeNotInstalled InstallLocation
loc)
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Installed"
markExeNotInstalled :: (HasEnvConfig env)
=> InstallLocation -> PackageIdentifier -> RIO env ()
markExeNotInstalled :: forall env.
HasEnvConfig env =>
InstallLocation -> PackageIdentifier -> RIO env ()
markExeNotInstalled InstallLocation
loc PackageIdentifier
ident = do
Path Abs Dir
dir <- forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
Path Rel File
ident' <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
ident')
buildCacheFile :: (HasEnvConfig env, MonadReader env m, MonadThrow m)
=> Path Abs Dir
-> NamedComponent
-> m (Path Abs File)
buildCacheFile :: forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> NamedComponent -> m (Path Abs File)
buildCacheFile Path Abs Dir
dir NamedComponent
component = do
Path Abs Dir
cachesDir <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
buildCachesDir Path Abs Dir
dir
SourceMapHash
smh <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMapHash
envConfigSourceMapHash
Path Rel Dir
smDirName <- forall (m :: * -> *).
MonadThrow m =>
SourceMapHash -> m (Path Rel Dir)
smRelDir SourceMapHash
smh
let nonLibComponent :: String -> Text -> String
nonLibComponent String
prefix Text
name = String
prefix forall a. Semigroup a => a -> a -> a
<> String
"-" forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name
Path Rel File
cacheFileName <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ case NamedComponent
component of
NamedComponent
CLib -> String
"lib"
CInternalLib Text
name -> String -> Text -> String
nonLibComponent String
"internal-lib" Text
name
CExe Text
name -> String -> Text -> String
nonLibComponent String
"exe" Text
name
CTest Text
name -> String -> Text -> String
nonLibComponent String
"test" Text
name
CBench Text
name -> String -> Text -> String
nonLibComponent String
"bench" Text
name
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Abs Dir
cachesDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
smDirName forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
cacheFileName
tryGetBuildCache :: HasEnvConfig env
=> Path Abs Dir
-> NamedComponent
-> RIO env (Maybe (Map FilePath FileCacheInfo))
tryGetBuildCache :: forall env.
HasEnvConfig env =>
Path Abs Dir
-> NamedComponent -> RIO env (Maybe (Map String FileCacheInfo))
tryGetBuildCache Path Abs Dir
dir NamedComponent
component = do
Path Abs File
fp <- forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> NamedComponent -> m (Path Abs File)
buildCacheFile Path Abs Dir
dir NamedComponent
component
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> Path b Dir
parent Path Abs File
fp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCache -> Map String FileCacheInfo
buildCacheTimes) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow (forall b t. Path b t -> String
toFilePath Path Abs File
fp)))
tryGetConfigCache :: HasEnvConfig env
=> Path Abs Dir -> RIO env (Maybe ConfigCache)
tryGetConfigCache :: forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env (Maybe ConfigCache)
tryGetConfigCache Path Abs Dir
dir =
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> RIO env (Maybe ConfigCache)
loadConfigCache forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
dir ConfigCacheType
ConfigCacheTypeConfig
tryGetCabalMod :: HasEnvConfig env
=> Path Abs Dir -> RIO env (Maybe CTime)
tryGetCabalMod :: forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env (Maybe CTime)
tryGetCabalMod Path Abs Dir
dir = do
String
fp <- forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configCabalMod Path Abs Dir
dir
forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
tryGetFileMod String
fp
tryGetSetupConfigMod :: HasEnvConfig env
=> Path Abs Dir -> RIO env (Maybe CTime)
tryGetSetupConfigMod :: forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env (Maybe CTime)
tryGetSetupConfigMod Path Abs Dir
dir = do
String
fp <- forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
tryGetFileMod String
fp
tryGetFileMod :: MonadIO m => FilePath -> m (Maybe CTime)
tryGetFileMod :: forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
tryGetFileMod String
fp =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStatus -> CTime
modificationTime) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> IO FileStatus
getFileStatus String
fp)
tryGetPackageProjectRoot :: HasEnvConfig env
=> Path Abs Dir -> RIO env (Maybe ByteString)
tryGetPackageProjectRoot :: forall env.
HasEnvConfig env =>
Path Abs Dir -> RIO env (Maybe ByteString)
tryGetPackageProjectRoot Path Abs Dir
dir = do
String
fp <- forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configPackageProjectRoot Path Abs Dir
dir
forall (m :: * -> *). MonadIO m => String -> m (Maybe ByteString)
tryReadFileBinary String
fp
tryReadFileBinary :: MonadIO m => FilePath -> m (Maybe ByteString)
tryReadFileBinary :: forall (m :: * -> *). MonadIO m => String -> m (Maybe ByteString)
tryReadFileBinary String
fp =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary String
fp)
writeBuildCache :: HasEnvConfig env
=> Path Abs Dir
-> NamedComponent
-> Map FilePath FileCacheInfo -> RIO env ()
writeBuildCache :: forall env.
HasEnvConfig env =>
Path Abs Dir
-> NamedComponent -> Map String FileCacheInfo -> RIO env ()
writeBuildCache Path Abs Dir
dir NamedComponent
component Map String FileCacheInfo
times = do
String
fp <- forall b t. Path b t -> String
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> NamedComponent -> m (Path Abs File)
buildCacheFile Path Abs Dir
dir NamedComponent
component
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => String -> a -> IO ()
Yaml.encodeFile String
fp BuildCache
{ buildCacheTimes :: Map String FileCacheInfo
buildCacheTimes = Map String FileCacheInfo
times
}
writeConfigCache :: HasEnvConfig env
=> Path Abs Dir
-> ConfigCache
-> RIO env ()
writeConfigCache :: forall env.
HasEnvConfig env =>
Path Abs Dir -> ConfigCache -> RIO env ()
writeConfigCache Path Abs Dir
dir =
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> ConfigCache -> RIO env ()
saveConfigCache (Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
dir ConfigCacheType
ConfigCacheTypeConfig)
writeCabalMod :: HasEnvConfig env
=> Path Abs Dir
-> CTime
-> RIO env ()
writeCabalMod :: forall env. HasEnvConfig env => Path Abs Dir -> CTime -> RIO env ()
writeCabalMod Path Abs Dir
dir CTime
x = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configCabalMod Path Abs Dir
dir
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Just used for its modification time"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> CTime -> CTime -> IO ()
setFileTimes (forall b t. Path b t -> String
toFilePath Path Abs File
fp) CTime
x CTime
x
writeSetupConfigMod
:: HasEnvConfig env
=> Path Abs Dir
-> Maybe CTime
-> RIO env ()
writeSetupConfigMod :: forall env.
HasEnvConfig env =>
Path Abs Dir -> Maybe CTime -> RIO env ()
writeSetupConfigMod Path Abs Dir
dir Maybe CTime
Nothing = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile Path Abs File
fp
writeSetupConfigMod Path Abs Dir
dir (Just CTime
x) = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Just used for its modification time"
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> CTime -> CTime -> IO ()
setFileTimes (forall b t. Path b t -> String
toFilePath Path Abs File
fp) CTime
x CTime
x
writePackageProjectRoot
:: HasEnvConfig env
=> Path Abs Dir
-> ByteString
-> RIO env ()
writePackageProjectRoot :: forall env.
HasEnvConfig env =>
Path Abs Dir -> ByteString -> RIO env ()
writePackageProjectRoot Path Abs Dir
dir ByteString
projectRoot = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
configPackageProjectRoot Path Abs Dir
dir
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp (ByteString -> Builder
byteString ByteString
projectRoot)
deleteCaches :: HasEnvConfig env => Path Abs Dir -> RIO env ()
deleteCaches :: forall env. HasEnvConfig env => Path Abs Dir -> RIO env ()
deleteCaches Path Abs Dir
dir
= forall env. HasBuildConfig env => ConfigCacheKey -> RIO env ()
deactiveConfigCache forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
dir ConfigCacheType
ConfigCacheTypeConfig
flagCacheKey :: (HasEnvConfig env) => Installed -> RIO env ConfigCacheKey
flagCacheKey :: forall env. HasEnvConfig env => Installed -> RIO env ConfigCacheKey
flagCacheKey Installed
installed = do
Path Abs Dir
installationRoot <- forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
case Installed
installed of
Library PackageIdentifier
_ GhcPkgId
gid Maybe (Either License License)
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
installationRoot (GhcPkgId -> ConfigCacheType
ConfigCacheTypeFlagLibrary GhcPkgId
gid)
Executable PackageIdentifier
ident ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey
Path Abs Dir
installationRoot
(PackageIdentifier -> ConfigCacheType
ConfigCacheTypeFlagExecutable PackageIdentifier
ident)
tryGetFlagCache :: HasEnvConfig env
=> Installed
-> RIO env (Maybe ConfigCache)
tryGetFlagCache :: forall env.
HasEnvConfig env =>
Installed -> RIO env (Maybe ConfigCache)
tryGetFlagCache Installed
gid = do
ConfigCacheKey
key <- forall env. HasEnvConfig env => Installed -> RIO env ConfigCacheKey
flagCacheKey Installed
gid
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> RIO env (Maybe ConfigCache)
loadConfigCache ConfigCacheKey
key
writeFlagCache :: HasEnvConfig env
=> Installed
-> ConfigCache
-> RIO env ()
writeFlagCache :: forall env.
HasEnvConfig env =>
Installed -> ConfigCache -> RIO env ()
writeFlagCache Installed
gid ConfigCache
cache = do
ConfigCacheKey
key <- forall env. HasEnvConfig env => Installed -> RIO env ConfigCacheKey
flagCacheKey Installed
gid
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> ConfigCache -> RIO env ()
saveConfigCache ConfigCacheKey
key ConfigCache
cache
successBS, failureBS, unknownBS :: IsString s => s
successBS :: forall s. IsString s => s
successBS = s
"success"
failureBS :: forall s. IsString s => s
failureBS = s
"failure"
unknownBS :: forall s. IsString s => s
unknownBS = s
"unknown"
data TestStatus = TSSuccess | TSFailure | TSUnknown
setTestStatus :: HasEnvConfig env
=> Path Abs Dir
-> TestStatus
-> RIO env ()
setTestStatus :: forall env.
HasEnvConfig env =>
Path Abs Dir -> TestStatus -> RIO env ()
setTestStatus Path Abs Dir
dir TestStatus
status = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
testSuccessFile Path Abs Dir
dir
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp forall a b. (a -> b) -> a -> b
$
case TestStatus
status of
TestStatus
TSSuccess -> forall s. IsString s => s
successBS
TestStatus
TSFailure -> forall s. IsString s => s
failureBS
TestStatus
TSUnknown -> forall s. IsString s => s
unknownBS
getTestStatus :: HasEnvConfig env
=> Path Abs Dir
-> RIO env TestStatus
getTestStatus :: forall env. HasEnvConfig env => Path Abs Dir -> RIO env TestStatus
getTestStatus Path Abs Dir
dir = do
Path Abs File
fp <- forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs File)
testSuccessFile Path Abs Dir
dir
Either IOException ByteString
eres <- forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
toFilePath Path Abs File
fp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
case Either IOException ByteString
eres of
Right ByteString
bs
| ByteString
bs forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
successBS -> TestStatus
TSSuccess
| ByteString
bs forall a. Eq a => a -> a -> Bool
== forall s. IsString s => s
failureBS -> TestStatus
TSFailure
Either IOException ByteString
_ -> TestStatus
TSUnknown
getPrecompiledCacheKey :: HasEnvConfig env
=> PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey :: forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
installedPackageIDs = do
ActualCompiler
compiler <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasSourceMap env => SimpleGetter env ActualCompiler
actualCompilerVersionL
Version
cabalVersion <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
TreeKey
treeKey <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env TreeKey
getPackageLocationTreeKey PackageLocationImmutable
loc
let packageKey :: Text
packageKey = Utf8Builder -> Text
utf8BuilderToText forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display TreeKey
treeKey
Path Rel Dir
platformGhcDir <- forall env (m :: * -> *).
(MonadReader env m, HasEnvConfig env, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir
let input :: ([String], Set GhcPkgId)
input = (ConfigureOpts -> [String]
coNoDirs ConfigureOpts
copts, Set GhcPkgId
installedPackageIDs)
optionsHash :: ByteString
optionsHash = forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Mem.convert forall a b. (a -> b) -> a -> b
$ forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
tshow ([String], Set GhcPkgId)
input
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Path Rel Dir
-> ActualCompiler
-> Version
-> Text
-> ByteString
-> Bool
-> PrecompiledCacheKey
precompiledCacheKey Path Rel Dir
platformGhcDir ActualCompiler
compiler Version
cabalVersion Text
packageKey ByteString
optionsHash Bool
buildHaddocks
writePrecompiledCache :: HasEnvConfig env
=> BaseConfigOpts
-> PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> Installed
-> [GhcPkgId]
-> Set Text
-> RIO env ()
writePrecompiledCache :: forall env.
HasEnvConfig env =>
BaseConfigOpts
-> PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> Installed
-> [GhcPkgId]
-> Set Text
-> RIO env ()
writePrecompiledCache BaseConfigOpts
baseConfigOpts PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
depIDs Installed
mghcPkgId [GhcPkgId]
sublibs Set Text
exes = do
PrecompiledCacheKey
key <- forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
depIDs
EnvConfig
ec <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasEnvConfig env => Lens' env EnvConfig
envConfigL
let stackRootRelative :: Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative = forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
makeRelative (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL EnvConfig
ec)
Maybe (Path Rel File)
mlibpath <- case Installed
mghcPkgId of
Executable PackageIdentifier
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Library PackageIdentifier
_ GhcPkgId
ipid Maybe (Either License License)
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {b}.
MonadThrow m =>
(Path Abs File -> m b) -> GhcPkgId -> m b
pathFromPkgId Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative GhcPkgId
ipid
[Path Rel File]
sublibpaths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {b}.
MonadThrow m =>
(Path Abs File -> m b) -> GhcPkgId -> m b
pathFromPkgId Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative) [GhcPkgId]
sublibs
[Path Rel File]
exes' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a. Set a -> [a]
Set.toList Set Text
exes) forall a b. (a -> b) -> a -> b
$ \Text
exe -> do
Path Rel File
name <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
exe
Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative forall a b. (a -> b) -> a -> b
$ BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot BaseConfigOpts
baseConfigOpts forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
name
let precompiled :: PrecompiledCache Rel
precompiled = PrecompiledCache
{ pcLibrary :: Maybe (Path Rel File)
pcLibrary = Maybe (Path Rel File)
mlibpath
, pcSubLibs :: [Path Rel File]
pcSubLibs = [Path Rel File]
sublibpaths
, pcExes :: [Path Rel File]
pcExes = [Path Rel File]
exes'
}
forall env.
(HasConfig env, HasLogFunc env) =>
PrecompiledCacheKey -> PrecompiledCache Rel -> RIO env ()
savePrecompiledCache PrecompiledCacheKey
key PrecompiledCache Rel
precompiled
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
buildHaddocks forall a b. (a -> b) -> a -> b
$ do
PrecompiledCacheKey
key' <- forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
False Set GhcPkgId
depIDs
forall env.
(HasConfig env, HasLogFunc env) =>
PrecompiledCacheKey -> PrecompiledCache Rel -> RIO env ()
savePrecompiledCache PrecompiledCacheKey
key' PrecompiledCache Rel
precompiled
where
pathFromPkgId :: (Path Abs File -> m b) -> GhcPkgId -> m b
pathFromPkgId Path Abs File -> m b
stackRootRelative GhcPkgId
ipid = do
Path Rel File
ipid' <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile forall a b. (a -> b) -> a -> b
$ GhcPkgId -> String
ghcPkgIdString GhcPkgId
ipid forall a. [a] -> [a] -> [a]
++ String
".conf"
Path Abs File -> m b
stackRootRelative forall a b. (a -> b) -> a -> b
$ BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
baseConfigOpts forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
ipid'
readPrecompiledCache :: forall env. HasEnvConfig env
=> PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env (Maybe (PrecompiledCache Abs))
readPrecompiledCache :: forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env (Maybe (PrecompiledCache Abs))
readPrecompiledCache PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
depIDs = do
PrecompiledCacheKey
key <- forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
depIDs
Maybe (PrecompiledCache Rel)
mcache <- forall env.
(HasConfig env, HasLogFunc env) =>
PrecompiledCacheKey -> RIO env (Maybe (PrecompiledCache Rel))
loadPrecompiledCache PrecompiledCacheKey
key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
mkAbs) Maybe (PrecompiledCache Rel)
mcache
where
mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
mkAbs PrecompiledCache Rel
pc0 = do
Path Abs Dir
stackRoot <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s. HasConfig s => Lens' s (Path Abs Dir)
stackRootL
let mkAbs' :: Path Rel t -> Path Abs t
mkAbs' = (Path Abs Dir
stackRoot forall b t. Path b Dir -> Path Rel t -> Path b t
</>)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrecompiledCache
{ pcLibrary :: Maybe (Path Abs File)
pcLibrary = forall {t}. Path Rel t -> Path Abs t
mkAbs' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall base. PrecompiledCache base -> Maybe (Path base File)
pcLibrary PrecompiledCache Rel
pc0
, pcSubLibs :: [Path Abs File]
pcSubLibs = forall {t}. Path Rel t -> Path Abs t
mkAbs' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall base. PrecompiledCache base -> [Path base File]
pcSubLibs PrecompiledCache Rel
pc0
, pcExes :: [Path Abs File]
pcExes = forall {t}. Path Rel t -> Path Abs t
mkAbs' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall base. PrecompiledCache base -> [Path base File]
pcExes PrecompiledCache Rel
pc0
}