{-# Language OverloadedStrings, BlockArguments, BangPatterns #-}
module Cryptol.Project.Cache where

import           Data.Map.Strict                  (Map)
import qualified Data.Map.Strict                  as Map
import qualified Data.Set                         as Set
import qualified Data.Text                        as Text
import qualified Data.Text.Encoding               as Text
import qualified Data.ByteString                  as BS
import           Data.Set                         (Set)
import           System.Directory
import           System.IO
import           System.FilePath                  as FP
import           System.IO.Error
import qualified Toml
import qualified Toml.Schema                      as Toml
import qualified Crypto.Hash.SHA256               as SHA256
import           Cryptol.ModuleSystem.Fingerprint ( Fingerprint )
import           Cryptol.ModuleSystem.Env

-- | This is something to identify a particular cache state.
-- We use a hash of the cache file at the moment.
type CacheId = BS.ByteString

emptyCacheId :: CacheId
emptyCacheId :: CacheId
emptyCacheId = CacheId
BS.empty

-- | The load cache. This is what persists across invocations.
newtype LoadCache = LoadCache
  { LoadCache -> Map CacheModulePath CacheEntry
cacheModules :: Map CacheModulePath CacheEntry
  }
  deriving (Int -> LoadCache -> ShowS
[LoadCache] -> ShowS
LoadCache -> String
(Int -> LoadCache -> ShowS)
-> (LoadCache -> String)
-> ([LoadCache] -> ShowS)
-> Show LoadCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoadCache -> ShowS
showsPrec :: Int -> LoadCache -> ShowS
$cshow :: LoadCache -> String
show :: LoadCache -> String
$cshowList :: [LoadCache] -> ShowS
showList :: [LoadCache] -> ShowS
Show, ReadPrec [LoadCache]
ReadPrec LoadCache
Int -> ReadS LoadCache
ReadS [LoadCache]
(Int -> ReadS LoadCache)
-> ReadS [LoadCache]
-> ReadPrec LoadCache
-> ReadPrec [LoadCache]
-> Read LoadCache
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LoadCache
readsPrec :: Int -> ReadS LoadCache
$creadList :: ReadS [LoadCache]
readList :: ReadS [LoadCache]
$creadPrec :: ReadPrec LoadCache
readPrec :: ReadPrec LoadCache
$creadListPrec :: ReadPrec [LoadCache]
readListPrec :: ReadPrec [LoadCache]
Read)

toCacheModulePath :: ModulePath -> CacheModulePath
toCacheModulePath :: ModulePath -> CacheModulePath
toCacheModulePath ModulePath
mpath =
  case ModulePath
mpath of
    InMem String
x CacheId
_ -> String -> CacheModulePath
CacheInMem String
x
    InFile String
x -> String -> CacheModulePath
CacheInFile String
x

data CacheModulePath
  = CacheInMem String -- ^ module name
  | CacheInFile FilePath -- ^ absolute file path
  deriving (Int -> CacheModulePath -> ShowS
[CacheModulePath] -> ShowS
CacheModulePath -> String
(Int -> CacheModulePath -> ShowS)
-> (CacheModulePath -> String)
-> ([CacheModulePath] -> ShowS)
-> Show CacheModulePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheModulePath -> ShowS
showsPrec :: Int -> CacheModulePath -> ShowS
$cshow :: CacheModulePath -> String
show :: CacheModulePath -> String
$cshowList :: [CacheModulePath] -> ShowS
showList :: [CacheModulePath] -> ShowS
Show, ReadPrec [CacheModulePath]
ReadPrec CacheModulePath
Int -> ReadS CacheModulePath
ReadS [CacheModulePath]
(Int -> ReadS CacheModulePath)
-> ReadS [CacheModulePath]
-> ReadPrec CacheModulePath
-> ReadPrec [CacheModulePath]
-> Read CacheModulePath
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CacheModulePath
readsPrec :: Int -> ReadS CacheModulePath
$creadList :: ReadS [CacheModulePath]
readList :: ReadS [CacheModulePath]
$creadPrec :: ReadPrec CacheModulePath
readPrec :: ReadPrec CacheModulePath
$creadListPrec :: ReadPrec [CacheModulePath]
readListPrec :: ReadPrec [CacheModulePath]
Read, Eq CacheModulePath
Eq CacheModulePath =>
(CacheModulePath -> CacheModulePath -> Ordering)
-> (CacheModulePath -> CacheModulePath -> Bool)
-> (CacheModulePath -> CacheModulePath -> Bool)
-> (CacheModulePath -> CacheModulePath -> Bool)
-> (CacheModulePath -> CacheModulePath -> Bool)
-> (CacheModulePath -> CacheModulePath -> CacheModulePath)
-> (CacheModulePath -> CacheModulePath -> CacheModulePath)
-> Ord CacheModulePath
CacheModulePath -> CacheModulePath -> Bool
CacheModulePath -> CacheModulePath -> Ordering
CacheModulePath -> CacheModulePath -> CacheModulePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CacheModulePath -> CacheModulePath -> Ordering
compare :: CacheModulePath -> CacheModulePath -> Ordering
$c< :: CacheModulePath -> CacheModulePath -> Bool
< :: CacheModulePath -> CacheModulePath -> Bool
$c<= :: CacheModulePath -> CacheModulePath -> Bool
<= :: CacheModulePath -> CacheModulePath -> Bool
$c> :: CacheModulePath -> CacheModulePath -> Bool
> :: CacheModulePath -> CacheModulePath -> Bool
$c>= :: CacheModulePath -> CacheModulePath -> Bool
>= :: CacheModulePath -> CacheModulePath -> Bool
$cmax :: CacheModulePath -> CacheModulePath -> CacheModulePath
max :: CacheModulePath -> CacheModulePath -> CacheModulePath
$cmin :: CacheModulePath -> CacheModulePath -> CacheModulePath
min :: CacheModulePath -> CacheModulePath -> CacheModulePath
Ord, CacheModulePath -> CacheModulePath -> Bool
(CacheModulePath -> CacheModulePath -> Bool)
-> (CacheModulePath -> CacheModulePath -> Bool)
-> Eq CacheModulePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheModulePath -> CacheModulePath -> Bool
== :: CacheModulePath -> CacheModulePath -> Bool
$c/= :: CacheModulePath -> CacheModulePath -> Bool
/= :: CacheModulePath -> CacheModulePath -> Bool
Eq)

instance Toml.ToValue LoadCache where
  toValue :: LoadCache -> Value
toValue = LoadCache -> Value
forall a. ToTable a => a -> Value
Toml.defaultTableToValue

instance Toml.ToTable LoadCache where
  toTable :: LoadCache -> Table
toTable LoadCache
x = [(Text, Value)] -> Table
Toml.table [
    Text
"version" Text -> Int -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= (Int
1 :: Int), -- increase this to invalidate old files
                                  -- also look at the `Toml.FromValue` instance
    Text
"modules" Text -> [Table] -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= [
      [(Text, Value)] -> Table
Toml.table ([(Text, Value)] -> Table) -> [(Text, Value)] -> Table
forall a b. (a -> b) -> a -> b
$ [
        case CacheModulePath
k of
          CacheInFile String
a -> Text
"file" Text -> String -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= String
a
          CacheInMem String
a -> Text
"memory" Text -> String -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= String
a,
        Text
"fingerprint" Text -> Fingerprint -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= FullFingerprint -> Fingerprint
moduleFingerprint FullFingerprint
fp,
        Text
"foreign_fingerprints" Text -> [Fingerprint] -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= Set Fingerprint -> [Fingerprint]
forall a. Set a -> [a]
Set.toList (FullFingerprint -> Set Fingerprint
foreignFingerprints FullFingerprint
fp),
        Text
"include_fingerprints" Text -> [Table] -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= [
          [(Text, Value)] -> Table
Toml.table [
            Text
"file" Text -> String -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= String
k1,
            Text
"fingerprint" Text -> Fingerprint -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= Fingerprint
v1
          ]
          | (String
k1, Fingerprint
v1) <- Map String Fingerprint -> [(String, Fingerprint)]
forall k a. Map k a -> [(k, a)]
Map.assocs (FullFingerprint -> Map String Fingerprint
includeFingerprints FullFingerprint
fp)
        ]
      ] [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++
      [ Text
"docstring_result" Text -> Bool -> (Text, Value)
forall a. ToValue a => Text -> a -> (Text, Value)
Toml..= Bool
result
        | Just Bool
result <- [CacheEntry -> Maybe Bool
cacheDocstringResult CacheEntry
v]
      ]
      | (CacheModulePath
k,CacheEntry
v) <- Map CacheModulePath CacheEntry -> [(CacheModulePath, CacheEntry)]
forall k a. Map k a -> [(k, a)]
Map.assocs (LoadCache -> Map CacheModulePath CacheEntry
cacheModules LoadCache
x)
      , let fp :: FullFingerprint
fp = CacheEntry -> FullFingerprint
cacheFingerprint CacheEntry
v
    ]]

instance Toml.FromValue LoadCache where
  fromValue :: forall l. Value' l -> Matcher l LoadCache
fromValue = ParseTable l LoadCache -> Value' l -> Matcher l LoadCache
forall l a. ParseTable l a -> Value' l -> Matcher l a
Toml.parseTableFromValue
   do Int
1 <- Text -> ParseTable l Int
forall a l. FromValue a => Text -> ParseTable l a
Toml.reqKey Text
"version" :: Toml.ParseTable l Int
      [(CacheModulePath, CacheEntry)]
kvs <- Text
-> (Value' l -> Matcher l [(CacheModulePath, CacheEntry)])
-> ParseTable l [(CacheModulePath, CacheEntry)]
forall l a. Text -> (Value' l -> Matcher l a) -> ParseTable l a
Toml.reqKeyOf Text
"modules"
           ((Value' l -> Matcher l [(CacheModulePath, CacheEntry)])
 -> ParseTable l [(CacheModulePath, CacheEntry)])
-> (Value' l -> Matcher l [(CacheModulePath, CacheEntry)])
-> ParseTable l [(CacheModulePath, CacheEntry)]
forall a b. (a -> b) -> a -> b
$ (Int -> Value' l -> Matcher l (CacheModulePath, CacheEntry))
-> Value' l -> Matcher l [(CacheModulePath, CacheEntry)]
forall l a.
(Int -> Value' l -> Matcher l a) -> Value' l -> Matcher l [a]
Toml.listOf \ Int
_ix ->
             ParseTable l (CacheModulePath, CacheEntry)
-> Value' l -> Matcher l (CacheModulePath, CacheEntry)
forall l a. ParseTable l a -> Value' l -> Matcher l a
Toml.parseTableFromValue
             do CacheModulePath
k <- [KeyAlt l CacheModulePath] -> ParseTable l CacheModulePath
forall l a. [KeyAlt l a] -> ParseTable l a
Toml.pickKey [
                    Text
-> (Value' l -> Matcher l CacheModulePath)
-> KeyAlt l CacheModulePath
forall l a. Text -> (Value' l -> Matcher l a) -> KeyAlt l a
Toml.Key Text
"memory" ((String -> CacheModulePath)
-> Matcher l String -> Matcher l CacheModulePath
forall a b. (a -> b) -> Matcher l a -> Matcher l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CacheModulePath
CacheInMem (Matcher l String -> Matcher l CacheModulePath)
-> (Value' l -> Matcher l String)
-> Value' l
-> Matcher l CacheModulePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' l -> Matcher l String
forall l. Value' l -> Matcher l String
forall a l. FromValue a => Value' l -> Matcher l a
Toml.fromValue),
                    Text
-> (Value' l -> Matcher l CacheModulePath)
-> KeyAlt l CacheModulePath
forall l a. Text -> (Value' l -> Matcher l a) -> KeyAlt l a
Toml.Key Text
"file" ((String -> CacheModulePath)
-> Matcher l String -> Matcher l CacheModulePath
forall a b. (a -> b) -> Matcher l a -> Matcher l b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> CacheModulePath
CacheInFile (Matcher l String -> Matcher l CacheModulePath)
-> (Value' l -> Matcher l String)
-> Value' l
-> Matcher l CacheModulePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value' l -> Matcher l String
forall l. Value' l -> Matcher l String
forall a l. FromValue a => Value' l -> Matcher l a
Toml.fromValue)
                  ]
                Fingerprint
fp <- Text -> ParseTable l Fingerprint
forall a l. FromValue a => Text -> ParseTable l a
Toml.reqKey Text
"fingerprint"
                [Fingerprint]
foreigns <- Text -> ParseTable l [Fingerprint]
forall a l. FromValue a => Text -> ParseTable l a
Toml.reqKey Text
"foreign_fingerprints"
                [(String, Fingerprint)]
includes <- Text
-> (Value' l -> Matcher l [(String, Fingerprint)])
-> ParseTable l [(String, Fingerprint)]
forall l a. Text -> (Value' l -> Matcher l a) -> ParseTable l a
Toml.reqKeyOf Text
"include_fingerprints"
                          ((Value' l -> Matcher l [(String, Fingerprint)])
 -> ParseTable l [(String, Fingerprint)])
-> (Value' l -> Matcher l [(String, Fingerprint)])
-> ParseTable l [(String, Fingerprint)]
forall a b. (a -> b) -> a -> b
$ (Int -> Value' l -> Matcher l (String, Fingerprint))
-> Value' l -> Matcher l [(String, Fingerprint)]
forall l a.
(Int -> Value' l -> Matcher l a) -> Value' l -> Matcher l [a]
Toml.listOf \ Int
_ix ->
                            ParseTable l (String, Fingerprint)
-> Value' l -> Matcher l (String, Fingerprint)
forall l a. ParseTable l a -> Value' l -> Matcher l a
Toml.parseTableFromValue
                          (ParseTable l (String, Fingerprint)
 -> Value' l -> Matcher l (String, Fingerprint))
-> ParseTable l (String, Fingerprint)
-> Value' l
-> Matcher l (String, Fingerprint)
forall a b. (a -> b) -> a -> b
$ (,) (String -> Fingerprint -> (String, Fingerprint))
-> ParseTable l String
-> ParseTable l (Fingerprint -> (String, Fingerprint))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ParseTable l String
forall a l. FromValue a => Text -> ParseTable l a
Toml.reqKey Text
"file"
                                ParseTable l (Fingerprint -> (String, Fingerprint))
-> ParseTable l Fingerprint -> ParseTable l (String, Fingerprint)
forall a b.
ParseTable l (a -> b) -> ParseTable l a -> ParseTable l b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ParseTable l Fingerprint
forall a l. FromValue a => Text -> ParseTable l a
Toml.reqKey Text
"fingerprint"
                Maybe Bool
checkResult <- Text -> ParseTable l (Maybe Bool)
forall a l. FromValue a => Text -> ParseTable l (Maybe a)
Toml.optKey Text
"docstring_result"
                (CacheModulePath, CacheEntry)
-> ParseTable l (CacheModulePath, CacheEntry)
forall a. a -> ParseTable l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CacheModulePath
k, CacheEntry
                  { cacheFingerprint :: FullFingerprint
cacheFingerprint = FullFingerprint
                      { moduleFingerprint :: Fingerprint
moduleFingerprint = Fingerprint
fp
                      , foreignFingerprints :: Set Fingerprint
foreignFingerprints = [Fingerprint] -> Set Fingerprint
forall a. Ord a => [a] -> Set a
Set.fromList [Fingerprint]
foreigns
                      , includeFingerprints :: Map String Fingerprint
includeFingerprints = [(String, Fingerprint)] -> Map String Fingerprint
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String, Fingerprint)]
includes
                      }
                  , cacheDocstringResult :: Maybe Bool
cacheDocstringResult = Maybe Bool
checkResult
                  })
      LoadCache -> ParseTable l LoadCache
forall a. a -> ParseTable l a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoadCache {
        cacheModules :: Map CacheModulePath CacheEntry
cacheModules = [(CacheModulePath, CacheEntry)] -> Map CacheModulePath CacheEntry
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CacheModulePath, CacheEntry)]
kvs
        }

data CacheEntry = CacheEntry
  { CacheEntry -> FullFingerprint
cacheFingerprint :: FullFingerprint
    -- ^ Identifier for a module that is part of the project

  , CacheEntry -> Maybe Bool
cacheDocstringResult :: Maybe Bool
    -- ^ `Nothing` means unchecked,
    -- `Just` means checked, and if validation succeeded.
  }
  deriving (Int -> CacheEntry -> ShowS
[CacheEntry] -> ShowS
CacheEntry -> String
(Int -> CacheEntry -> ShowS)
-> (CacheEntry -> String)
-> ([CacheEntry] -> ShowS)
-> Show CacheEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheEntry -> ShowS
showsPrec :: Int -> CacheEntry -> ShowS
$cshow :: CacheEntry -> String
show :: CacheEntry -> String
$cshowList :: [CacheEntry] -> ShowS
showList :: [CacheEntry] -> ShowS
Show, ReadPrec [CacheEntry]
ReadPrec CacheEntry
Int -> ReadS CacheEntry
ReadS [CacheEntry]
(Int -> ReadS CacheEntry)
-> ReadS [CacheEntry]
-> ReadPrec CacheEntry
-> ReadPrec [CacheEntry]
-> Read CacheEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CacheEntry
readsPrec :: Int -> ReadS CacheEntry
$creadList :: ReadS [CacheEntry]
readList :: ReadS [CacheEntry]
$creadPrec :: ReadPrec CacheEntry
readPrec :: ReadPrec CacheEntry
$creadListPrec :: ReadPrec [CacheEntry]
readListPrec :: ReadPrec [CacheEntry]
Read)

-- | The full fingerprint hashes the module, but
-- also the contents of included files and foreign libraries.
data FullFingerprint = FullFingerprint
  { FullFingerprint -> Fingerprint
moduleFingerprint   :: Fingerprint
  , FullFingerprint -> Map String Fingerprint
includeFingerprints :: Map FilePath Fingerprint
  , FullFingerprint -> Set Fingerprint
foreignFingerprints :: Set Fingerprint
  }
  deriving (FullFingerprint -> FullFingerprint -> Bool
(FullFingerprint -> FullFingerprint -> Bool)
-> (FullFingerprint -> FullFingerprint -> Bool)
-> Eq FullFingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FullFingerprint -> FullFingerprint -> Bool
== :: FullFingerprint -> FullFingerprint -> Bool
$c/= :: FullFingerprint -> FullFingerprint -> Bool
/= :: FullFingerprint -> FullFingerprint -> Bool
Eq, Int -> FullFingerprint -> ShowS
[FullFingerprint] -> ShowS
FullFingerprint -> String
(Int -> FullFingerprint -> ShowS)
-> (FullFingerprint -> String)
-> ([FullFingerprint] -> ShowS)
-> Show FullFingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FullFingerprint -> ShowS
showsPrec :: Int -> FullFingerprint -> ShowS
$cshow :: FullFingerprint -> String
show :: FullFingerprint -> String
$cshowList :: [FullFingerprint] -> ShowS
showList :: [FullFingerprint] -> ShowS
Show, ReadPrec [FullFingerprint]
ReadPrec FullFingerprint
Int -> ReadS FullFingerprint
ReadS [FullFingerprint]
(Int -> ReadS FullFingerprint)
-> ReadS [FullFingerprint]
-> ReadPrec FullFingerprint
-> ReadPrec [FullFingerprint]
-> Read FullFingerprint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FullFingerprint
readsPrec :: Int -> ReadS FullFingerprint
$creadList :: ReadS [FullFingerprint]
readList :: ReadS [FullFingerprint]
$creadPrec :: ReadPrec FullFingerprint
readPrec :: ReadPrec FullFingerprint
$creadListPrec :: ReadPrec [FullFingerprint]
readListPrec :: ReadPrec [FullFingerprint]
Read)

-- | Directory where to store the project state.
-- XXX: This should probably be a parameter
metaDir :: FilePath
metaDir :: String
metaDir = String
".cryproject"

loadCachePath :: FilePath
loadCachePath :: String
loadCachePath = String
metaDir String -> ShowS
FP.</> String
"loadcache.toml"

emptyLoadCache :: LoadCache
emptyLoadCache :: LoadCache
emptyLoadCache = LoadCache { cacheModules :: Map CacheModulePath CacheEntry
cacheModules = Map CacheModulePath CacheEntry
forall a. Monoid a => a
mempty }

-- | Load a cache.  Also returns an id for the cache.
-- If there is no cache (or it failed to load), then we return an empty id.
loadLoadCache :: IO (LoadCache, CacheId)
loadLoadCache :: IO (LoadCache, CacheId)
loadLoadCache =
 do CacheId
bytes <- String -> IO CacheId
BS.readFile String
loadCachePath
    let hash :: CacheId
hash = CacheId -> CacheId
SHA256.hash CacheId
bytes
        txt :: Text
txt = CacheId -> Text
Text.decodeUtf8 CacheId
bytes
    case Text -> Result String LoadCache
forall a. FromValue a => Text -> Result String a
Toml.decode Text
txt of
      Toml.Success [String]
_ LoadCache
c -> (LoadCache, CacheId) -> IO (LoadCache, CacheId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadCache
c,CacheId
hash)
      Toml.Failure [String]
_ -> (LoadCache, CacheId) -> IO (LoadCache, CacheId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadCache
emptyLoadCache,CacheId
emptyCacheId)
  IO (LoadCache, CacheId)
-> (IOError -> IO (LoadCache, CacheId)) -> IO (LoadCache, CacheId)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \IOError
_ -> (LoadCache, CacheId) -> IO (LoadCache, CacheId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoadCache
emptyLoadCache,CacheId
emptyCacheId)

-- | Save the cache.  Returns an id for the cache.
saveLoadCache :: LoadCache -> IO BS.ByteString
saveLoadCache :: LoadCache -> IO CacheId
saveLoadCache LoadCache
cache =
  do Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
metaDir
     let txt :: Text
txt = String -> Text
Text.pack (TomlDoc -> String
forall a. Show a => a -> String
show (LoadCache -> TomlDoc
forall a. ToTable a => a -> TomlDoc
Toml.encode LoadCache
cache))
         !bytes :: CacheId
bytes = Text -> CacheId
Text.encodeUtf8 Text
txt
     (String
tmpFile,Handle
h) <- String -> String -> IO (String, Handle)
openBinaryTempFile String
metaDir String
"load-cache-XXXXX.toml"
     Handle -> CacheId -> IO ()
BS.hPut Handle
h CacheId
bytes
     Handle -> IO ()
hClose Handle
h
     String -> String -> IO ()
renameFile String
tmpFile String
loadCachePath
     CacheId -> IO CacheId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CacheId -> CacheId
SHA256.hash CacheId
bytes)