{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-identities #-}
module Stack.Storage.User
( initUserStorage
, PrecompiledCacheKey
, PrecompiledCacheParent (..)
, precompiledCacheKey
, loadPrecompiledCache
, savePrecompiledCache
, loadDockerImageExeCache
, saveDockerImageExeCache
, loadCompilerPaths
, saveCompilerPaths
, upgradeChecksSince
, logUpgradeCheck
) where
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Time.Clock ( UTCTime )
import Database.Persist.Sqlite
( Entity (..), SqlBackend, Unique, (=.), (==.), (>=.), count
, deleteBy, getBy, insert, insert_, selectList, update
, upsert
)
import Database.Persist.TH
( mkMigrate, mkPersist, persistLowerCase, share
, sqlSettings
)
import Distribution.Text ( simpleParse, display )
import Foreign.C.Types ( CTime (..) )
import Pantry.SQLite ( initStorage, withStorage_ )
import Path ( (</>), mkRelFile, parseRelFile )
import Path.IO ( resolveFile', resolveDir' )
import qualified RIO.FilePath as FP
import Stack.Prelude
import Stack.Storage.Util
( handleMigrationException, setUpdateDiff, updateCollection )
import Stack.Types.Cache ( Action (..), PrecompiledCache (..) )
import Stack.Types.Compiler ( ActualCompiler, compilerVersionText )
import Stack.Types.CompilerBuild ( CompilerBuild )
import Stack.Types.CompilerPaths
( CompilerPaths (..), GhcPkgExe (..) )
import Stack.Types.Config ( Config (..), HasConfig (..) )
import Stack.Types.Storage ( UserStorage (..) )
import System.Posix.Types ( COff (..) )
import System.PosixCompat.Files
( fileSize, getFileStatus, modificationTime )
data StorageUserException
= CompilerFileMetadataMismatch
| GlobalPackageCacheFileMetadataMismatch
| GlobalDumpParseFailure
| CompilerCacheArchitectureInvalid Text
deriving Int -> StorageUserException -> ShowS
[StorageUserException] -> ShowS
StorageUserException -> String
(Int -> StorageUserException -> ShowS)
-> (StorageUserException -> String)
-> ([StorageUserException] -> ShowS)
-> Show StorageUserException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageUserException -> ShowS
showsPrec :: Int -> StorageUserException -> ShowS
$cshow :: StorageUserException -> String
show :: StorageUserException -> String
$cshowList :: [StorageUserException] -> ShowS
showList :: [StorageUserException] -> ShowS
Show
instance Exception StorageUserException where
displayException :: StorageUserException -> String
displayException StorageUserException
CompilerFileMetadataMismatch =
String
"Error: [S-8196]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Compiler file metadata mismatch, ignoring cache."
displayException StorageUserException
GlobalPackageCacheFileMetadataMismatch =
String
"Error: [S-5378]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Global package cache file metadata mismatch, ignoring cache."
displayException StorageUserException
GlobalDumpParseFailure =
String
"Error: [S-2673]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Global dump did not parse correctly."
displayException
(CompilerCacheArchitectureInvalid Text
compilerCacheArch) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Error: [S-8441]\n"
, String
"Invalid arch: "
, Text -> String
forall a. Show a => a -> String
show Text
compilerCacheArch
]