{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-- | 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
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 )

-- | 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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` 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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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 (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
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

                    -> Set GhcPkgId -- ^ dependencies

                    -> 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 <- 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 :: * -> *).
(MonadReader env m, HasEnvConfig env, 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.

  -- Unfortunately, earlier Cabals don't have the information, so we must

  -- supplement it with the installed package IDs directly.

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

  let input :: ([String], Set GhcPkgId)
input = (ConfigureOpts -> [String]
coNoDirs ConfigureOpts
copts, Set GhcPkgId
installedPackageIDs)
      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], Set GhcPkgId) -> Text
forall a. Show a => a -> Text
tshow ([String], Set GhcPkgId)
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

                      -> Set GhcPkgId -- ^ dependencies

                      -> Installed -- ^ library

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

                      -> Set Text -- ^ executables

                      -> 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 <- PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
buildHaddocks Set GhcPkgId
depIDs
  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
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
forall env.
HasEnvConfig env =>
PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
getPrecompiledCacheKey PackageLocationImmutable
loc ConfigureOpts
copts Bool
False Set GhcPkgId
depIDs
    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

                     -> Set GhcPkgId -- ^ dependencies

                     -> 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 <- PackageLocationImmutable
-> ConfigureOpts
-> Bool
-> Set GhcPkgId
-> RIO env PrecompiledCacheKey
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 <- 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 Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</>)
      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
        }