{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | Cache information about previous builds

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
  -- Exported for testing

  , 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 ( (</>), filename, parent, parseRelFile )
import           Path.IO
                   ( ensureDir, ignoringAbsence, listDir, makeRelative
                   , removeFile
                   )
import           Stack.Constants ( bindirSuffix, relDirInstalledPackages )
import           Stack.Constants.Config
                   ( buildCachesDir, configCabalMod, configPackageProjectRoot
                   , configSetupConfigMod, testSuccessFile
                   )
import           Stack.Prelude
import           Stack.Storage.Project
                   ( ConfigCacheKey, configCacheKey, deactiveConfigCache
                   , loadConfigCache, saveConfigCache
                   )
import           Stack.Storage.User
                   ( PrecompiledCacheKey, loadPrecompiledCache
                   , precompiledCacheKey, savePrecompiledCache
                   )
import           Stack.Types.Build
                   ( BuildCache (..), ConfigCache, FileCacheInfo
                   , InstallLocation (..), Installed (..), PrecompiledCache (..)
                   )
import           Stack.Types.Cache ( ConfigCacheType (..) )
import           Stack.Types.CompilerPaths ( cabalVersionL )
import           Stack.Types.Config ( stackRootL )
import           Stack.Types.ConfigureOpts
                   ( BaseConfigOpts (..), ConfigureOpts (..) )
import           Stack.Types.EnvConfig
                   ( EnvConfig (..), HasEnvConfig (..), actualCompilerVersionL
                   , installationRootDeps, installationRootLocal
                   , platformGhcRelDir
                   )
import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
import           Stack.Types.NamedComponent ( NamedComponent (..) )
import           Stack.Types.SourceMap ( smRelDir )
import           System.PosixCompat.Files
                   ( modificationTime, getFileStatus, setFileTimes )

-- | Directory containing files to mark an executable as installed

exeInstalledDir :: (HasEnvConfig env)
                => InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir :: forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
Snap = (Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstalledPackages) (Path Abs Dir -> Path Abs Dir)
-> RIO env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootDeps
exeInstalledDir InstallLocation
Local = (Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirInstalledPackages) (Path Abs Dir -> Path Abs Dir)
-> RIO env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal

-- | Get all of the installed executables

getInstalledExes :: (HasEnvConfig env)
                 => InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes :: forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
loc = do
  Path Abs Dir
dir <- InstallLocation -> RIO env (Path Abs Dir)
forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
  ([Path Abs Dir]
_, [Path Abs File]
files) <- IO ([Path Abs Dir], [Path Abs File])
-> RIO env ([Path Abs Dir], [Path Abs File])
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ([Path Abs Dir], [Path Abs File])
 -> RIO env ([Path Abs Dir], [Path Abs File]))
-> IO ([Path Abs Dir], [Path Abs File])
-> RIO env ([Path Abs Dir], [Path Abs File])
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ([Path Abs Dir], [Path Abs File]))
-> IO ([Path Abs Dir], [Path Abs File])
-> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOException -> m a) -> m a -> m a
handleIO (IO ([Path Abs Dir], [Path Abs File])
-> IOException -> IO ([Path Abs Dir], [Path Abs File])
forall a b. a -> b -> a
const (IO ([Path Abs Dir], [Path Abs File])
 -> IOException -> IO ([Path Abs Dir], [Path Abs File]))
-> IO ([Path Abs Dir], [Path Abs File])
-> IOException
-> IO ([Path Abs Dir], [Path Abs File])
forall a b. (a -> b) -> a -> b
$ ([Path Abs Dir], [Path Abs File])
-> IO ([Path Abs Dir], [Path Abs File])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])) (IO ([Path Abs Dir], [Path Abs File])
 -> IO ([Path Abs Dir], [Path Abs File]))
-> IO ([Path Abs Dir], [Path Abs File])
-> IO ([Path Abs Dir], [Path Abs File])
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> IO ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
  [PackageIdentifier] -> RIO env [PackageIdentifier]
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageIdentifier] -> RIO env [PackageIdentifier])
-> [PackageIdentifier] -> RIO env [PackageIdentifier]
forall a b. (a -> b) -> a -> b
$
    [[PackageIdentifier]] -> [PackageIdentifier]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PackageIdentifier]] -> [PackageIdentifier])
-> [[PackageIdentifier]] -> [PackageIdentifier]
forall a b. (a -> b) -> a -> b
$
    Map PackageName [PackageIdentifier] -> [[PackageIdentifier]]
forall k a. Map k a -> [a]
M.elems (Map PackageName [PackageIdentifier] -> [[PackageIdentifier]])
-> Map PackageName [PackageIdentifier] -> [[PackageIdentifier]]
forall a b. (a -> b) -> a -> b
$
    -- If there are multiple install records (from a Stack version before

    -- https://github.com/commercialhaskell/stack/issues/2373 was fixed), then

    -- we don't know which is correct - ignore them.

    ([PackageIdentifier] -> [PackageIdentifier] -> [PackageIdentifier])
-> [(PackageName, [PackageIdentifier])]
-> Map PackageName [PackageIdentifier]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (\[PackageIdentifier]
_ [PackageIdentifier]
_ -> []) ([(PackageName, [PackageIdentifier])]
 -> Map PackageName [PackageIdentifier])
-> [(PackageName, [PackageIdentifier])]
-> Map PackageName [PackageIdentifier]
forall a b. (a -> b) -> a -> b
$
    (PackageIdentifier -> (PackageName, [PackageIdentifier]))
-> [PackageIdentifier] -> [(PackageName, [PackageIdentifier])]
forall a b. (a -> b) -> [a] -> [b]
map (\PackageIdentifier
x -> (PackageIdentifier -> PackageName
pkgName PackageIdentifier
x, [PackageIdentifier
x])) ([PackageIdentifier] -> [(PackageName, [PackageIdentifier])])
-> [PackageIdentifier] -> [(PackageName, [PackageIdentifier])]
forall a b. (a -> b) -> a -> b
$
    (Path Abs File -> Maybe PackageIdentifier)
-> [Path Abs File] -> [PackageIdentifier]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe PackageIdentifier
parsePackageIdentifier (String -> Maybe PackageIdentifier)
-> (Path Abs File -> String)
-> Path Abs File
-> Maybe PackageIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Rel File -> String)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename) [Path Abs File]
files

-- | Mark the given executable as installed

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 <- InstallLocation -> RIO env (Path Abs Dir)
forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
  Path Abs Dir -> RIO env ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir Path Abs Dir
dir
  Path Rel File
ident' <- String -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> RIO env (Path Rel File))
-> String -> RIO env (Path Rel File)
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
  let fp :: Path Abs File
fp = Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
ident'
  -- Remove old install records for this package.

  -- TODO: This is a bit in-efficient. Put all this metadata into one file?

  [PackageIdentifier]
installed <- InstallLocation -> RIO env [PackageIdentifier]
forall env.
HasEnvConfig env =>
InstallLocation -> RIO env [PackageIdentifier]
getInstalledExes InstallLocation
loc
  [PackageIdentifier]
-> (PackageIdentifier -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((PackageIdentifier -> Bool)
-> [PackageIdentifier] -> [PackageIdentifier]
forall a. (a -> Bool) -> [a] -> [a]
filter (\PackageIdentifier
x -> PackageIdentifier -> PackageName
pkgName PackageIdentifier
ident PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier -> PackageName
pkgName PackageIdentifier
x) [PackageIdentifier]
installed)
        (InstallLocation -> PackageIdentifier -> RIO env ()
forall env.
HasEnvConfig env =>
InstallLocation -> PackageIdentifier -> RIO env ()
markExeNotInstalled InstallLocation
loc)
  -- TODO consideration for the future: list all of the executables installed,

  -- and invalidate this file in getInstalledExes if they no longer exist

  Path Abs File -> Builder -> RIO env ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Installed"

-- | Mark the given executable as not 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 <- InstallLocation -> RIO env (Path Abs Dir)
forall env.
HasEnvConfig env =>
InstallLocation -> RIO env (Path Abs Dir)
exeInstalledDir InstallLocation
loc
  Path Rel File
ident' <- String -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> RIO env (Path Rel File))
-> String -> RIO env (Path Rel File)
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> String
packageIdentifierString PackageIdentifier
ident
  IO () -> RIO env ()
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (Path Abs File -> IO ()
forall (m :: * -> *) b. MonadIO m => Path b File -> m ()
removeFile (Path Abs File -> IO ()) -> Path Abs File -> IO ()
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
dir Path Abs Dir -> Path Rel File -> Path Abs File
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 <- Path Abs Dir -> m (Path Abs Dir)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs Dir)
buildCachesDir Path Abs Dir
dir
  SourceMapHash
smh <- Getting SourceMapHash env SourceMapHash -> m SourceMapHash
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting SourceMapHash env SourceMapHash -> m SourceMapHash)
-> Getting SourceMapHash env SourceMapHash -> m SourceMapHash
forall a b. (a -> b) -> a -> b
$ (EnvConfig -> Const SourceMapHash EnvConfig)
-> env -> Const SourceMapHash env
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL((EnvConfig -> Const SourceMapHash EnvConfig)
 -> env -> Const SourceMapHash env)
-> ((SourceMapHash -> Const SourceMapHash SourceMapHash)
    -> EnvConfig -> Const SourceMapHash EnvConfig)
-> Getting SourceMapHash env SourceMapHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EnvConfig -> SourceMapHash)
-> SimpleGetter EnvConfig SourceMapHash
forall s a. (s -> a) -> SimpleGetter s a
to EnvConfig -> SourceMapHash
envConfigSourceMapHash
  Path Rel Dir
smDirName <- SourceMapHash -> m (Path Rel Dir)
forall (m :: * -> *).
MonadThrow m =>
SourceMapHash -> m (Path Rel Dir)
smRelDir SourceMapHash
smh
  let nonLibComponent :: String -> Text -> String
nonLibComponent String
prefix Text
name = String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name
  Path Rel File
cacheFileName <- String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> m (Path Rel File)) -> String -> m (Path Rel File)
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
  Path Abs File -> m (Path Abs File)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
cachesDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
smDirName Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
cacheFileName

-- | Try to read the dirtiness cache for the given package directory.

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 <- Path Abs Dir -> NamedComponent -> RIO env (Path Abs File)
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
  Path Abs Dir -> RIO env ()
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m ()
ensureDir (Path Abs Dir -> RIO env ()) -> Path Abs Dir -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
fp
  (SomeException -> Maybe (Map String FileCacheInfo))
-> (BuildCache -> Maybe (Map String FileCacheInfo))
-> Either SomeException BuildCache
-> Maybe (Map String FileCacheInfo)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Map String FileCacheInfo)
-> SomeException -> Maybe (Map String FileCacheInfo)
forall a b. a -> b -> a
const Maybe (Map String FileCacheInfo)
forall a. Maybe a
Nothing) (Map String FileCacheInfo -> Maybe (Map String FileCacheInfo)
forall a. a -> Maybe a
Just (Map String FileCacheInfo -> Maybe (Map String FileCacheInfo))
-> (BuildCache -> Map String FileCacheInfo)
-> BuildCache
-> Maybe (Map String FileCacheInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildCache -> Map String FileCacheInfo
buildCacheTimes) (Either SomeException BuildCache
 -> Maybe (Map String FileCacheInfo))
-> RIO env (Either SomeException BuildCache)
-> RIO env (Maybe (Map String FileCacheInfo))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    IO (Either SomeException BuildCache)
-> RIO env (Either SomeException BuildCache)
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BuildCache -> IO (Either SomeException BuildCache)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either SomeException a)
tryAny (String -> IO BuildCache
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)))

-- | Try to read the dirtiness cache for the given package directory.

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 =
  ConfigCacheKey -> RIO env (Maybe ConfigCache)
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> RIO env (Maybe ConfigCache)
loadConfigCache (ConfigCacheKey -> RIO env (Maybe ConfigCache))
-> ConfigCacheKey -> RIO env (Maybe ConfigCache)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
dir ConfigCacheType
ConfigCacheTypeConfig

-- | Try to read the mod time of the Cabal file from the last build

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 <- Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String)
-> RIO env (Path Abs File) -> RIO env String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configCabalMod Path Abs Dir
dir
  String -> RIO env (Maybe CTime)
forall (m :: * -> *). MonadIO m => String -> m (Maybe CTime)
tryGetFileMod String
fp

-- | Try to read the mod time of setup-config file from the last build

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 <- Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String)
-> RIO env (Path Abs File) -> RIO env String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
  String -> RIO env (Maybe CTime)
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 =
  IO (Maybe CTime) -> m (Maybe CTime)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CTime) -> m (Maybe CTime))
-> IO (Maybe CTime) -> m (Maybe CTime)
forall a b. (a -> b) -> a -> b
$ (IOException -> Maybe CTime)
-> (FileStatus -> Maybe CTime)
-> Either IOException FileStatus
-> Maybe CTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe CTime -> IOException -> Maybe CTime
forall a b. a -> b -> a
const Maybe CTime
forall a. Maybe a
Nothing) (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) (Either IOException FileStatus -> Maybe CTime)
-> IO (Either IOException FileStatus) -> IO (Maybe CTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    IO FileStatus -> IO (Either IOException FileStatus)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> IO FileStatus
getFileStatus String
fp)

-- | Try to read the project root from the last build of a package

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 <- Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String)
-> RIO env (Path Abs File) -> RIO env String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configPackageProjectRoot Path Abs Dir
dir
  String -> RIO env (Maybe ByteString)
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 =
  IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ (IOException -> Maybe ByteString)
-> (ByteString -> Maybe ByteString)
-> Either IOException ByteString
-> Maybe ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe ByteString -> IOException -> Maybe ByteString
forall a b. a -> b -> a
const Maybe ByteString
forall a. Maybe a
Nothing) ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Either IOException ByteString -> Maybe ByteString)
-> IO (Either IOException ByteString) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    IO ByteString -> IO (Either IOException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary String
fp)

-- | Write the dirtiness cache for this package's files.

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 <- Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs File -> String)
-> RIO env (Path Abs File) -> RIO env String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs Dir -> NamedComponent -> RIO env (Path Abs File)
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
  IO () -> RIO env ()
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ String -> BuildCache -> IO ()
forall a. ToJSON a => String -> a -> IO ()
Yaml.encodeFile String
fp BuildCache
    { buildCacheTimes :: Map String FileCacheInfo
buildCacheTimes = Map String FileCacheInfo
times
    }

-- | Write the dirtiness cache for this package's configuration.

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 =
  ConfigCacheKey -> ConfigCache -> RIO env ()
forall env.
(HasBuildConfig env, HasLogFunc env) =>
ConfigCacheKey -> ConfigCache -> RIO env ()
saveConfigCache (Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey Path Abs Dir
dir ConfigCacheType
ConfigCacheTypeConfig)

-- | See 'tryGetCabalMod'

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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configCabalMod Path Abs Dir
dir
  Path Abs File -> Builder -> RIO env ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Just used for its modification time"
  IO () -> RIO env ()
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ String -> CTime -> CTime -> IO ()
setFileTimes (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) CTime
x CTime
x

-- | See 'tryGetSetupConfigMod'

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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
  RIO env () -> RIO env ()
forall (m :: * -> *) a. (MonadIO m, MonadCatch m) => m a -> m ()
ignoringAbsence (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ Path Abs File -> RIO env ()
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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configSetupConfigMod Path Abs Dir
dir
  Path Abs File -> Builder -> RIO env ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp Builder
"Just used for its modification time"
  IO () -> RIO env ()
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO env ()) -> IO () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ String -> CTime -> CTime -> IO ()
setFileTimes (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp) CTime
x CTime
x

-- | See 'tryGetPackageProjectRoot'

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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
configPackageProjectRoot Path Abs Dir
dir
  Path Abs File -> Builder -> RIO env ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp (ByteString -> Builder
byteString ByteString
projectRoot)

-- | Delete the caches for the project.

deleteCaches :: HasEnvConfig env => Path Abs Dir -> RIO env ()
deleteCaches :: forall env. HasEnvConfig env => Path Abs Dir -> RIO env ()
deleteCaches Path Abs Dir
dir =
  {- FIXME confirm that this is acceptable to remove
  bfp <- buildCacheFile dir
  removeFileIfExists bfp
  -}
  ConfigCacheKey -> RIO env ()
forall env. HasBuildConfig env => ConfigCacheKey -> RIO env ()
deactiveConfigCache (ConfigCacheKey -> RIO env ()) -> ConfigCacheKey -> RIO env ()
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 <- RIO env (Path Abs Dir)
forall env. HasEnvConfig env => RIO env (Path Abs Dir)
installationRootLocal
  case Installed
installed of
    Library PackageIdentifier
_ GhcPkgId
gid Maybe (Either License License)
_ ->
      ConfigCacheKey -> RIO env ConfigCacheKey
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigCacheKey -> RIO env ConfigCacheKey)
-> ConfigCacheKey -> RIO env ConfigCacheKey
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 ->
      ConfigCacheKey -> RIO env ConfigCacheKey
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigCacheKey -> RIO env ConfigCacheKey)
-> ConfigCacheKey -> RIO env ConfigCacheKey
forall a b. (a -> b) -> a -> b
$
        Path Abs Dir -> ConfigCacheType -> ConfigCacheKey
configCacheKey
          Path Abs Dir
installationRoot
          (PackageIdentifier -> ConfigCacheType
ConfigCacheTypeFlagExecutable PackageIdentifier
ident)

-- | Loads the flag cache for the given installed extra-deps

tryGetFlagCache :: HasEnvConfig env
                => Installed
                -> RIO env (Maybe ConfigCache)
tryGetFlagCache :: forall env.
HasEnvConfig env =>
Installed -> RIO env (Maybe ConfigCache)
tryGetFlagCache Installed
gid = do
  ConfigCacheKey
key <- Installed -> RIO env ConfigCacheKey
forall env. HasEnvConfig env => Installed -> RIO env ConfigCacheKey
flagCacheKey Installed
gid
  ConfigCacheKey -> RIO env (Maybe ConfigCache)
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 <- Installed -> RIO env ConfigCacheKey
forall env. HasEnvConfig env => Installed -> RIO env ConfigCacheKey
flagCacheKey Installed
gid
  ConfigCacheKey -> ConfigCache -> RIO env ()
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"

-- | Status of a test suite

data TestStatus
  = TSSuccess
  | TSFailure
  | TSUnknown

-- | Mark test suite status

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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
testSuccessFile Path Abs Dir
dir
  Path Abs File -> Builder -> RIO env ()
forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
fp (Builder -> RIO env ()) -> Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$
    case TestStatus
status of
      TestStatus
TSSuccess -> Builder
forall s. IsString s => s
successBS
      TestStatus
TSFailure -> Builder
forall s. IsString s => s
failureBS
      TestStatus
TSUnknown -> Builder
forall s. IsString s => s
unknownBS

-- | Check if the test suite already passed

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 <- Path Abs Dir -> RIO env (Path Abs File)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
Path Abs Dir -> m (Path Abs File)
testSuccessFile Path Abs Dir
dir
  -- we could ensure the file is the right size first, but we're not expected an

  -- attack from the user's filesystem

  Either IOException ByteString
eres <- RIO env ByteString -> RIO env (Either IOException ByteString)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> m (Either IOException a)
tryIO (String -> RIO env ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBinary (String -> RIO env ByteString) -> String -> RIO env ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
fp)
  TestStatus -> RIO env TestStatus
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TestStatus -> RIO env TestStatus)
-> TestStatus -> RIO env TestStatus
forall a b. (a -> b) -> a -> b
$
    case Either IOException ByteString
eres of
      Right ByteString
bs
        | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
successBS -> TestStatus
TSSuccess
        | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall s. IsString s => s
failureBS -> TestStatus
TSFailure
      Either IOException ByteString
_ -> TestStatus
TSUnknown

--------------------------------------

-- Precompiled Cache

--

-- Idea is simple: cache information about packages built in other snapshots,

-- and then for identical matches (same flags, config options, dependencies)

-- just copy over the executables and reregister the libraries.

--------------------------------------


-- | The key containing information on the given package/configuration

-- combination. The key contains a hash of the non-directory configure

-- options for quick lookup if there's a match.

--

-- We only pay attention to non-directory options. We don't want to avoid a

-- cache hit just because it was installed in a different directory.

getPrecompiledCacheKey ::
     HasEnvConfig env
  => PackageLocationImmutable
  -> ConfigureOpts
  -> Bool -- ^ build haddocks

  -> RIO env PrecompiledCacheKey
getPrecompiledCacheKey :: forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks = do
  ActualCompiler
compiler <- 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
SimpleGetter env ActualCompiler
actualCompilerVersionL
  Version
cabalVersion <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
SimpleGetter env Version
cabalVersionL

  -- The goal here is to come up with a string representing the package location

  -- which is unique. Luckily @TreeKey@s are exactly that!

  TreeKey
treeKey <- PackageLocationImmutable -> RIO env TreeKey
forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
PackageLocationImmutable -> RIO env TreeKey
getPackageLocationTreeKey PackageLocationImmutable
loc
  let packageKey :: Text
packageKey = Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$ TreeKey -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display TreeKey
treeKey

  Path Rel Dir
platformGhcDir <- RIO env (Path Rel Dir)
forall env (m :: * -> *).
(HasEnvConfig env, MonadReader env m, MonadThrow m) =>
m (Path Rel Dir)
platformGhcRelDir

  -- In Cabal versions 1.22 and later, the configure options contain the

  -- installed package IDs, which is what we need for a unique hash. See also

  -- issue: https://github.com/commercialhaskell/stack/issues/1103

  let input :: [String]
input = ConfigureOpts -> [String]
coNoDirs ConfigureOpts
copts
      optionsHash :: ByteString
optionsHash = Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
Mem.convert (Digest SHA256 -> ByteString) -> Digest SHA256 -> ByteString
forall a b. (a -> b) -> a -> b
$ SHA256 -> ByteString -> Digest SHA256
forall ba alg.
(ByteArrayAccess ba, HashAlgorithm alg) =>
alg -> ba -> Digest alg
hashWith SHA256
SHA256 (ByteString -> Digest SHA256) -> ByteString -> Digest SHA256
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> Text
forall a. Show a => a -> Text
tshow [String]
input

  PrecompiledCacheKey -> RIO env PrecompiledCacheKey
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrecompiledCacheKey -> RIO env PrecompiledCacheKey)
-> PrecompiledCacheKey -> RIO env PrecompiledCacheKey
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

-- | Write out information about a newly built package

writePrecompiledCache ::
     HasEnvConfig env
  => BaseConfigOpts
  -> PackageLocationImmutable
  -> ConfigureOpts
  -> Bool -- ^ build haddocks

  -> Installed -- ^ library

  -> [GhcPkgId] -- ^ sublibraries, in the GhcPkgId format

  -> Set Text -- ^ executables

  -> RIO env ()
writePrecompiledCache :: forall env.
HasEnvConfig env =>
BaseConfigOpts
-> PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Installed
-> [GhcPkgId]
-> Set Text
-> RIO env ()
writePrecompiledCache BaseConfigOpts
baseConfigOpts PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Installed
mghcPkgId [GhcPkgId]
sublibs Set Text
exes = do
  PrecompiledCacheKey
key <- PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks
  EnvConfig
ec <- Getting EnvConfig env EnvConfig -> RIO env EnvConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EnvConfig env EnvConfig
forall env. HasEnvConfig env => Lens' env EnvConfig
Lens' env EnvConfig
envConfigL
  let stackRootRelative :: Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative = Path Abs Dir -> Path Abs File -> RIO env (RelPath (Path Abs File))
forall path (m :: * -> *).
(AnyPath path, MonadThrow m) =>
Path Abs Dir -> path -> m (RelPath path)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> Path Abs File -> m (RelPath (Path Abs File))
makeRelative (Getting (Path Abs Dir) EnvConfig (Path Abs Dir)
-> EnvConfig -> Path Abs Dir
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) EnvConfig (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' EnvConfig (Path Abs Dir)
stackRootL EnvConfig
ec)
  Maybe (Path Rel File)
mlibpath <- case Installed
mghcPkgId of
    Executable PackageIdentifier
_ -> Maybe (Path Rel File) -> RIO env (Maybe (Path Rel File))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Rel File)
forall a. Maybe a
Nothing
    Library PackageIdentifier
_ GhcPkgId
ipid Maybe (Either License License)
_ -> Path Rel File -> Maybe (Path Rel File)
forall a. a -> Maybe a
Just (Path Rel File -> Maybe (Path Rel File))
-> RIO env (Path Rel File) -> RIO env (Maybe (Path Rel File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Path Abs File -> RIO env (Path Rel File))
-> GhcPkgId -> RIO env (Path Rel File)
forall {m :: * -> *} {b}.
MonadThrow m =>
(Path Abs File -> m b) -> GhcPkgId -> m b
pathFromPkgId Path Abs File -> RIO env (Path Rel File)
Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative GhcPkgId
ipid
  [Path Rel File]
sublibpaths <- (GhcPkgId -> RIO env (Path Rel File))
-> [GhcPkgId] -> RIO env [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Path Abs File -> RIO env (Path Rel File))
-> GhcPkgId -> RIO env (Path Rel File)
forall {m :: * -> *} {b}.
MonadThrow m =>
(Path Abs File -> m b) -> GhcPkgId -> m b
pathFromPkgId Path Abs File -> RIO env (Path Rel File)
Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative) [GhcPkgId]
sublibs
  [Path Rel File]
exes' <- [Text]
-> (Text -> RIO env (Path Rel File)) -> RIO env [Path Rel File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Set Text -> [Text]
forall a. Set a -> [a]
Set.toList Set Text
exes) ((Text -> RIO env (Path Rel File)) -> RIO env [Path Rel File])
-> (Text -> RIO env (Path Rel File)) -> RIO env [Path Rel File]
forall a b. (a -> b) -> a -> b
$ \Text
exe -> do
    Path Rel File
name <- String -> RIO env (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> RIO env (Path Rel File))
-> String -> RIO env (Path Rel File)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
exe
    Path Abs File -> RIO env (RelPath (Path Abs File))
stackRootRelative (Path Abs File -> RIO env (RelPath (Path Abs File)))
-> Path Abs File -> RIO env (RelPath (Path Abs File))
forall a b. (a -> b) -> a -> b
$ BaseConfigOpts -> Path Abs Dir
bcoSnapInstallRoot BaseConfigOpts
baseConfigOpts Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
bindirSuffix Path Rel Dir -> Path Rel File -> Path Rel File
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'
        }
  PrecompiledCacheKey -> PrecompiledCache Rel -> RIO env ()
forall env.
(HasConfig env, HasLogFunc env) =>
PrecompiledCacheKey -> PrecompiledCache Rel -> RIO env ()
savePrecompiledCache PrecompiledCacheKey
key PrecompiledCache Rel
precompiled
  -- reuse precompiled cache with haddocks also in case when haddocks are not

  -- required

  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
buildHaddocks (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
    PrecompiledCacheKey
key' <- PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
False
    PrecompiledCacheKey -> PrecompiledCache Rel -> RIO env ()
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' <- String -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile (String -> m (Path Rel File)) -> String -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ GhcPkgId -> String
ghcPkgIdString GhcPkgId
ipid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".conf"
    Path Abs File -> m b
stackRootRelative (Path Abs File -> m b) -> Path Abs File -> m b
forall a b. (a -> b) -> a -> b
$ BaseConfigOpts -> Path Abs Dir
bcoSnapDB BaseConfigOpts
baseConfigOpts Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
ipid'

-- | Check the cache for a precompiled package matching the given configuration.

readPrecompiledCache ::
     forall env. HasEnvConfig env
  => PackageLocationImmutable -- ^ target package

  -> ConfigureOpts
  -> Bool -- ^ build haddocks

  -> RIO env (Maybe (PrecompiledCache Abs))
readPrecompiledCache :: forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env (Maybe (PrecompiledCache Abs))
readPrecompiledCache PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks = do
  PrecompiledCacheKey
key <- PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts -> Bool -> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks
  Maybe (PrecompiledCache Rel)
mcache <- PrecompiledCacheKey -> RIO env (Maybe (PrecompiledCache Rel))
forall env.
(HasConfig env, HasLogFunc env) =>
PrecompiledCacheKey -> RIO env (Maybe (PrecompiledCache Rel))
loadPrecompiledCache PrecompiledCacheKey
key
  RIO env (Maybe (PrecompiledCache Abs))
-> (PrecompiledCache Rel -> RIO env (Maybe (PrecompiledCache Abs)))
-> Maybe (PrecompiledCache Rel)
-> RIO env (Maybe (PrecompiledCache Abs))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (PrecompiledCache Abs)
-> RIO env (Maybe (PrecompiledCache Abs))
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PrecompiledCache Abs)
forall a. Maybe a
Nothing) ((PrecompiledCache Abs -> Maybe (PrecompiledCache Abs))
-> RIO env (PrecompiledCache Abs)
-> RIO env (Maybe (PrecompiledCache Abs))
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrecompiledCache Abs -> Maybe (PrecompiledCache Abs)
forall a. a -> Maybe a
Just (RIO env (PrecompiledCache Abs)
 -> RIO env (Maybe (PrecompiledCache Abs)))
-> (PrecompiledCache Rel -> RIO env (PrecompiledCache Abs))
-> PrecompiledCache Rel
-> RIO env (Maybe (PrecompiledCache Abs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
mkAbs) Maybe (PrecompiledCache Rel)
mcache
 where
  -- Since commit ed9ccc08f327bad68dd2d09a1851ce0d055c0422, pcLibrary paths are

  -- stored as relative to the Stack root. Therefore, we need to prepend the

  -- Stack root when checking that the file exists. For the older cached paths,

  -- the file will contain an absolute path, which will make `stackRoot </>`

  -- a no-op.

  mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
  mkAbs :: PrecompiledCache Rel -> RIO env (PrecompiledCache Abs)
mkAbs PrecompiledCache Rel
pc0 = do
    Path Abs Dir
stackRoot <- Getting (Path Abs Dir) env (Path Abs Dir) -> RIO env (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) env (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' env (Path Abs Dir)
stackRootL
    let mkAbs' :: Path Rel t -> Path Abs t
mkAbs' = (Path Abs Dir
stackRoot </>)
    PrecompiledCache Abs -> RIO env (PrecompiledCache Abs)
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrecompiledCache
      { pcLibrary :: Maybe (Path Abs File)
pcLibrary = Path Rel File -> Path Abs File
forall {t}. Path Rel t -> Path Abs t
mkAbs' (Path Rel File -> Path Abs File)
-> Maybe (Path Rel File) -> Maybe (Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrecompiledCache Rel -> Maybe (Path Rel File)
forall base. PrecompiledCache base -> Maybe (Path base File)
pcLibrary PrecompiledCache Rel
pc0
      , pcSubLibs :: [Path Abs File]
pcSubLibs = Path Rel File -> Path Abs File
forall {t}. Path Rel t -> Path Abs t
mkAbs' (Path Rel File -> Path Abs File)
-> [Path Rel File] -> [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrecompiledCache Rel -> [Path Rel File]
forall base. PrecompiledCache base -> [Path base File]
pcSubLibs PrecompiledCache Rel
pc0
      , pcExes :: [Path Abs File]
pcExes = Path Rel File -> Path Abs File
forall {t}. Path Rel t -> Path Abs t
mkAbs' (Path Rel File -> Path Abs File)
-> [Path Rel File] -> [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PrecompiledCache Rel -> [Path Rel File]
forall base. PrecompiledCache base -> [Path base File]
pcExes PrecompiledCache Rel
pc0
      }