module Stack.Build.Cache
( tryGetBuildCache
, tryGetConfigCache
, tryGetCabalMod
, getInstalledExes
, tryGetFlagCache
, deleteCaches
, markExeInstalled
, markExeNotInstalled
, writeFlagCache
, writeBuildCache
, writeConfigCache
, writeCabalMod
, setTestSuccess
, unsetTestSuccess
, checkTestSuccess
, writePrecompiledCache
, readPrecompiledCache
, BuildCache(..)
) where
import Stack.Prelude
import Crypto.Hash (hashWith, SHA256(..))
import Control.Monad.Trans.Maybe
import qualified Data.ByteArray as Mem (convert)
import qualified Data.ByteString.Base64.URL as B64URL
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as S8
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Store as Store
import Data.Store.VersionTagged
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Path
import Path.IO
import Stack.Constants.Config
import Stack.Types.Build
import Stack.Types.BuildPlan
import Stack.Types.Compiler
import Stack.Types.Config
import Stack.Types.GhcPkgId
import Stack.Types.Package
import Stack.Types.PackageIdentifier
import Stack.Types.Version
import qualified System.FilePath as FP
exeInstalledDir :: (MonadReader env m, HasEnvConfig env, MonadThrow m)
=> InstallLocation -> m (Path Abs Dir)
exeInstalledDir Snap = (</> $(mkRelDir "installed-packages")) `liftM` installationRootDeps
exeInstalledDir Local = (</> $(mkRelDir "installed-packages")) `liftM` installationRootLocal
getInstalledExes :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m)
=> InstallLocation -> m [PackageIdentifier]
getInstalledExes loc = do
dir <- exeInstalledDir loc
(_, files) <- liftIO $ handleIO (const $ return ([], [])) $ listDir dir
return $
concat $
M.elems $
M.fromListWith (\_ _ -> []) $
map (\x -> (packageIdentifierName x, [x])) $
mapMaybe (parsePackageIdentifierFromString . toFilePath . filename) files
markExeInstalled :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m)
=> InstallLocation -> PackageIdentifier -> m ()
markExeInstalled loc ident = do
dir <- exeInstalledDir loc
ensureDir dir
ident' <- parseRelFile $ packageIdentifierString ident
let fp = toFilePath $ dir </> ident'
installed <- getInstalledExes loc
forM_ (filter (\x -> packageIdentifierName ident == packageIdentifierName x) installed)
(markExeNotInstalled loc)
liftIO $ B.writeFile fp "Installed"
markExeNotInstalled :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m)
=> InstallLocation -> PackageIdentifier -> m ()
markExeNotInstalled loc ident = do
dir <- exeInstalledDir loc
ident' <- parseRelFile $ packageIdentifierString ident
liftIO $ ignoringAbsence (removeFile $ dir </> ident')
tryGetBuildCache :: (MonadUnliftIO m, MonadReader env m, MonadThrow m, MonadLogger m, HasEnvConfig env)
=> Path Abs Dir -> m (Maybe (Map FilePath FileCacheInfo))
tryGetBuildCache dir = liftM (fmap buildCacheTimes) . $(versionedDecodeFile buildCacheVC) =<< buildCacheFile dir
tryGetConfigCache :: (MonadUnliftIO m, MonadReader env m, MonadThrow m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir -> m (Maybe ConfigCache)
tryGetConfigCache dir = $(versionedDecodeFile configCacheVC) =<< configCacheFile dir
tryGetCabalMod :: (MonadUnliftIO m, MonadReader env m, MonadThrow m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir -> m (Maybe ModTime)
tryGetCabalMod dir = $(versionedDecodeFile modTimeVC) =<< configCabalMod dir
writeBuildCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir -> Map FilePath FileCacheInfo -> m ()
writeBuildCache dir times = do
fp <- buildCacheFile dir
$(versionedEncodeFile buildCacheVC) fp BuildCache
{ buildCacheTimes = times
}
writeConfigCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir
-> ConfigCache
-> m ()
writeConfigCache dir x = do
fp <- configCacheFile dir
$(versionedEncodeFile configCacheVC) fp x
writeCabalMod :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir
-> ModTime
-> m ()
writeCabalMod dir x = do
fp <- configCabalMod dir
$(versionedEncodeFile modTimeVC) fp x
deleteCaches :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m)
=> Path Abs Dir -> m ()
deleteCaches dir = do
cfp <- configCacheFile dir
liftIO $ ignoringAbsence (removeFile cfp)
flagCacheFile :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env)
=> Installed
-> m (Path Abs File)
flagCacheFile installed = do
rel <- parseRelFile $
case installed of
Library _ gid _ -> ghcPkgIdString gid
Executable ident -> packageIdentifierString ident
dir <- flagCacheLocal
return $ dir </> rel
tryGetFlagCache :: (MonadUnliftIO m, MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> Installed
-> m (Maybe ConfigCache)
tryGetFlagCache gid = do
fp <- flagCacheFile gid
$(versionedDecodeFile configCacheVC) fp
writeFlagCache :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m, MonadLogger m)
=> Installed
-> ConfigCache
-> m ()
writeFlagCache gid cache = do
file <- flagCacheFile gid
ensureDir (parent file)
$(versionedEncodeFile configCacheVC) file cache
setTestSuccess :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir
-> m ()
setTestSuccess dir = do
fp <- testSuccessFile dir
$(versionedEncodeFile testSuccessVC) fp True
unsetTestSuccess :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir
-> m ()
unsetTestSuccess dir = do
fp <- testSuccessFile dir
$(versionedEncodeFile testSuccessVC) fp False
checkTestSuccess :: (MonadUnliftIO m, MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> Path Abs Dir
-> m Bool
checkTestSuccess dir =
liftM
(fromMaybe False)
($(versionedDecodeFile testSuccessVC) =<< testSuccessFile dir)
precompiledCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m)
=> PackageLocationIndex FilePath
-> ConfigureOpts
-> Set GhcPkgId
-> m (Maybe (Path Abs File))
precompiledCacheFile loc copts installedPackageIDs = do
ec <- view envConfigL
compiler <- view actualCompilerVersionL >>= parseRelDir . compilerVersionString
cabal <- view cabalVersionL >>= parseRelDir . versionString
let mpkgRaw =
case loc of
PLIndex pir -> Just $ packageIdentifierRevisionString pir
PLOther other -> case other of
PLFilePath _ -> assert False Nothing
PLArchive a -> fmap
(\h -> T.unpack (staticSHA256ToText h) ++ archiveSubdirs a)
(archiveHash a)
PLRepo r -> Just $ T.unpack (repoCommit r) ++ repoSubdirs r
forM mpkgRaw $ \pkgRaw -> do
pkg <-
case parseRelDir pkgRaw of
Just x -> return x
Nothing -> parseRelDir
$ T.unpack
$ TE.decodeUtf8
$ B64URL.encode
$ TE.encodeUtf8
$ T.pack pkgRaw
platformRelDir <- platformGhcRelDir
let input = (coNoDirs copts, installedPackageIDs)
hashPath <- parseRelFile $ S8.unpack $ B64URL.encode
$ Mem.convert $ hashWith SHA256 $ Store.encode input
return $ view stackRootL ec
</> $(mkRelDir "precompiled")
</> platformRelDir
</> compiler
</> cabal
</> pkg
</> hashPath
writePrecompiledCache :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadIO m, MonadLogger m)
=> BaseConfigOpts
-> PackageLocationIndex FilePath
-> ConfigureOpts
-> Set GhcPkgId
-> Installed
-> Set Text
-> m ()
writePrecompiledCache baseConfigOpts loc copts depIDs mghcPkgId exes = do
mfile <- precompiledCacheFile loc copts depIDs
forM_ mfile $ \file -> do
ensureDir (parent file)
ec <- view envConfigL
let stackRootRelative = makeRelative (view stackRootL ec)
mlibpath <-
case mghcPkgId of
Executable _ -> return Nothing
Library _ ipid _ -> liftM Just $ do
ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"
relPath <- stackRootRelative $ bcoSnapDB baseConfigOpts </> ipid'
return $ toFilePath relPath
exes' <- forM (Set.toList exes) $ \exe -> do
name <- parseRelFile $ T.unpack exe
relPath <- stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
return $ toFilePath relPath
$(versionedEncodeFile precompiledCacheVC) file PrecompiledCache
{ pcLibrary = mlibpath
, pcExes = exes'
}
readPrecompiledCache :: forall env. HasEnvConfig env
=> PackageLocationIndex FilePath
-> ConfigureOpts
-> Set GhcPkgId
-> RIO env (Maybe PrecompiledCache)
readPrecompiledCache loc copts depIDs = runMaybeT $
MaybeT (precompiledCacheFile loc copts depIDs) >>=
MaybeT . $(versionedDecodeFile precompiledCacheVC) >>=
lift . mkAbs
where
mkAbs :: PrecompiledCache -> RIO env PrecompiledCache
mkAbs pc0 = do
stackRoot <- view stackRootL
let mkAbs' = (toFilePath stackRoot FP.</>)
return PrecompiledCache
{ pcLibrary = mkAbs' <$> pcLibrary pc0
, pcExes = mkAbs' <$> pcExes pc0
}