module Erebos.Storage (
    Storage, PartialStorage, StorageCompleteness,
    openStorage, memoryStorage,
    deriveEphemeralStorage, derivePartialStorage,

    Ref, PartialRef, RefDigest,
    refDigest,
    readRef, showRef, showRefDigest,
    refDigestFromByteString, hashToRefDigest,
    copyRef, partialRef, partialRefFromDigest,

    Object, PartialObject, Object'(..), RecItem, RecItem'(..),
    serializeObject, deserializeObject, deserializeObjects,
    ioLoadObject, ioLoadBytes,
    storeRawBytes, lazyLoadBytes,
    storeObject,
    collectObjects, collectStoredObjects,

    Head, HeadType(..),
    HeadTypeID, mkHeadTypeID,
    headId, headStorage, headRef, headObject, headStoredObject,
    loadHeads, loadHead, reloadHead,
    storeHead, replaceHead, updateHead, updateHead_,

    WatchedHead,
    watchHead, watchHeadWith, unwatchHead,

    MonadStorage(..),

    Storable(..), ZeroStorable(..),
    StorableText(..), StorableDate(..), StorableUUID(..),

    Store, StoreRec,
    evalStore, evalStoreObject,
    storeBlob, storeRec, storeZero,
    storeEmpty, storeInt, storeNum, storeText, storeBinary, storeDate, storeUUID, storeRef, storeRawRef,
    storeMbEmpty, storeMbInt, storeMbNum, storeMbText, storeMbBinary, storeMbDate, storeMbUUID, storeMbRef, storeMbRawRef,
    storeZRef,

    Load, LoadRec,
    evalLoad,
    loadCurrentRef, loadCurrentObject,
    loadRecCurrentRef, loadRecItems,

    loadBlob, loadRec, loadZero,
    loadEmpty, loadInt, loadNum, loadText, loadBinary, loadDate, loadUUID, loadRef, loadRawRef,
    loadMbEmpty, loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbUUID, loadMbRef, loadMbRawRef,
    loadTexts, loadBinaries, loadRefs, loadRawRefs,
    loadZRef,

    Stored,
    fromStored, storedRef,
    wrappedStore, wrappedLoad,
    copyStored,
    unsafeMapStored,

    StoreInfo(..), makeStoreInfo,

    StoredHistory,
    fromHistory, fromHistoryAt, storedFromHistory, storedHistoryList,
    beginHistory, modifyHistory,
) where

import Control.Applicative
import Control.Arrow
import Control.Concurrent
import Control.Exception
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer

import Crypto.Hash

import Data.ByteString (ByteString)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import Data.Char
import Data.Function
import qualified Data.HashTable.IO as HT
import Data.List
import qualified Data.Map as M
import Data.Maybe
import Data.Ratio
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Text.Encoding.Error
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format
import Data.Time.LocalTime
import Data.Typeable
import Data.UUID (UUID)
import qualified Data.UUID as U
import qualified Data.UUID.V4 as U

import System.Directory
import System.FilePath
import System.INotify
import System.IO.Error
import System.IO.Unsafe

import Erebos.Storage.Internal


type Storage = Storage' Complete
type PartialStorage = Storage' Partial

openStorage :: FilePath -> IO Storage
openStorage :: FilePath -> IO Storage
openStorage FilePath
path = do
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/objects"
    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/heads"
    MVar ([(HeadTypeID, INotify)], WatchList Complete)
watchers <- ([(HeadTypeID, INotify)], WatchList Complete)
-> IO (MVar ([(HeadTypeID, INotify)], WatchList Complete))
forall a. a -> IO (MVar a)
newMVar ([], WatchID -> [WatchListItem Complete] -> WatchList Complete
forall (c :: * -> *). WatchID -> [WatchListItem c] -> WatchList c
WatchList WatchID
1 [])
    MVar (HashTable RealWorld RefDigest Generation)
refgen <- HashTable RealWorld RefDigest Generation
-> IO (MVar (HashTable RealWorld RefDigest Generation))
forall a. a -> IO (MVar a)
newMVar (HashTable RealWorld RefDigest Generation
 -> IO (MVar (HashTable RealWorld RefDigest Generation)))
-> IO (HashTable RealWorld RefDigest Generation)
-> IO (MVar (HashTable RealWorld RefDigest Generation))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (HashTable RealWorld RefDigest Generation)
IO (IOHashTable HashTable RefDigest Generation)
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
HT.new
    MVar (HashTable RealWorld RefDigest [RefDigest])
refroots <- HashTable RealWorld RefDigest [RefDigest]
-> IO (MVar (HashTable RealWorld RefDigest [RefDigest]))
forall a. a -> IO (MVar a)
newMVar (HashTable RealWorld RefDigest [RefDigest]
 -> IO (MVar (HashTable RealWorld RefDigest [RefDigest])))
-> IO (HashTable RealWorld RefDigest [RefDigest])
-> IO (MVar (HashTable RealWorld RefDigest [RefDigest]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (HashTable RealWorld RefDigest [RefDigest])
IO (IOHashTable HashTable RefDigest [RefDigest])
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
HT.new
    Storage -> IO Storage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Storage -> IO Storage) -> Storage -> IO Storage
forall a b. (a -> b) -> a -> b
$ Storage
        { stBacking :: StorageBacking Complete
stBacking = FilePath
-> MVar ([(HeadTypeID, INotify)], WatchList Complete)
-> StorageBacking Complete
forall (c :: * -> *).
FilePath
-> MVar ([(HeadTypeID, INotify)], WatchList c) -> StorageBacking c
StorageDir FilePath
path MVar ([(HeadTypeID, INotify)], WatchList Complete)
watchers
        , stParent :: Maybe Storage
stParent = Maybe Storage
forall a. Maybe a
Nothing
        , stRefGeneration :: MVar (IOHashTable HashTable RefDigest Generation)
stRefGeneration = MVar (HashTable RealWorld RefDigest Generation)
MVar (IOHashTable HashTable RefDigest Generation)
refgen
        , stRefRoots :: MVar (IOHashTable HashTable RefDigest [RefDigest])
stRefRoots = MVar (HashTable RealWorld RefDigest [RefDigest])
MVar (IOHashTable HashTable RefDigest [RefDigest])
refroots
        }

memoryStorage' :: IO (Storage' c')
memoryStorage' :: forall (c' :: * -> *). IO (Storage' c')
memoryStorage' = do
    StorageBacking c'
backing <- MVar [((HeadTypeID, HeadID), Ref' c')]
-> MVar (Map RefDigest ByteString)
-> MVar (Map RefDigest ScrubbedBytes)
-> MVar (WatchList c')
-> StorageBacking c'
forall (c :: * -> *).
MVar [((HeadTypeID, HeadID), Ref' c)]
-> MVar (Map RefDigest ByteString)
-> MVar (Map RefDigest ScrubbedBytes)
-> MVar (WatchList c)
-> StorageBacking c
StorageMemory (MVar [((HeadTypeID, HeadID), Ref' c')]
 -> MVar (Map RefDigest ByteString)
 -> MVar (Map RefDigest ScrubbedBytes)
 -> MVar (WatchList c')
 -> StorageBacking c')
-> IO (MVar [((HeadTypeID, HeadID), Ref' c')])
-> IO
     (MVar (Map RefDigest ByteString)
      -> MVar (Map RefDigest ScrubbedBytes)
      -> MVar (WatchList c')
      -> StorageBacking c')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [((HeadTypeID, HeadID), Ref' c')]
-> IO (MVar [((HeadTypeID, HeadID), Ref' c')])
forall a. a -> IO (MVar a)
newMVar [] IO
  (MVar (Map RefDigest ByteString)
   -> MVar (Map RefDigest ScrubbedBytes)
   -> MVar (WatchList c')
   -> StorageBacking c')
-> IO (MVar (Map RefDigest ByteString))
-> IO
     (MVar (Map RefDigest ScrubbedBytes)
      -> MVar (WatchList c') -> StorageBacking c')
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map RefDigest ByteString -> IO (MVar (Map RefDigest ByteString))
forall a. a -> IO (MVar a)
newMVar Map RefDigest ByteString
forall k a. Map k a
M.empty IO
  (MVar (Map RefDigest ScrubbedBytes)
   -> MVar (WatchList c') -> StorageBacking c')
-> IO (MVar (Map RefDigest ScrubbedBytes))
-> IO (MVar (WatchList c') -> StorageBacking c')
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map RefDigest ScrubbedBytes
-> IO (MVar (Map RefDigest ScrubbedBytes))
forall a. a -> IO (MVar a)
newMVar Map RefDigest ScrubbedBytes
forall k a. Map k a
M.empty IO (MVar (WatchList c') -> StorageBacking c')
-> IO (MVar (WatchList c')) -> IO (StorageBacking c')
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WatchList c' -> IO (MVar (WatchList c'))
forall a. a -> IO (MVar a)
newMVar (WatchID -> [WatchListItem c'] -> WatchList c'
forall (c :: * -> *). WatchID -> [WatchListItem c] -> WatchList c
WatchList WatchID
1 [])
    MVar (HashTable RealWorld RefDigest Generation)
refgen <- HashTable RealWorld RefDigest Generation
-> IO (MVar (HashTable RealWorld RefDigest Generation))
forall a. a -> IO (MVar a)
newMVar (HashTable RealWorld RefDigest Generation
 -> IO (MVar (HashTable RealWorld RefDigest Generation)))
-> IO (HashTable RealWorld RefDigest Generation)
-> IO (MVar (HashTable RealWorld RefDigest Generation))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (HashTable RealWorld RefDigest Generation)
IO (IOHashTable HashTable RefDigest Generation)
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
HT.new
    MVar (HashTable RealWorld RefDigest [RefDigest])
refroots <- HashTable RealWorld RefDigest [RefDigest]
-> IO (MVar (HashTable RealWorld RefDigest [RefDigest]))
forall a. a -> IO (MVar a)
newMVar (HashTable RealWorld RefDigest [RefDigest]
 -> IO (MVar (HashTable RealWorld RefDigest [RefDigest])))
-> IO (HashTable RealWorld RefDigest [RefDigest])
-> IO (MVar (HashTable RealWorld RefDigest [RefDigest]))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (HashTable RealWorld RefDigest [RefDigest])
IO (IOHashTable HashTable RefDigest [RefDigest])
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
HT.new
    Storage' c' -> IO (Storage' c')
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Storage' c' -> IO (Storage' c'))
-> Storage' c' -> IO (Storage' c')
forall a b. (a -> b) -> a -> b
$ Storage
        { stBacking :: StorageBacking c'
stBacking = StorageBacking c'
backing
        , stParent :: Maybe Storage
stParent = Maybe Storage
forall a. Maybe a
Nothing
        , stRefGeneration :: MVar (IOHashTable HashTable RefDigest Generation)
stRefGeneration = MVar (HashTable RealWorld RefDigest Generation)
MVar (IOHashTable HashTable RefDigest Generation)
refgen
        , stRefRoots :: MVar (IOHashTable HashTable RefDigest [RefDigest])
stRefRoots = MVar (HashTable RealWorld RefDigest [RefDigest])
MVar (IOHashTable HashTable RefDigest [RefDigest])
refroots
        }

memoryStorage :: IO Storage
memoryStorage :: IO Storage
memoryStorage = IO Storage
forall (c' :: * -> *). IO (Storage' c')
memoryStorage'

deriveEphemeralStorage :: Storage -> IO Storage
deriveEphemeralStorage :: Storage -> IO Storage
deriveEphemeralStorage Storage
parent = do
    Storage
st <- IO Storage
memoryStorage
    Storage -> IO Storage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Storage -> IO Storage) -> Storage -> IO Storage
forall a b. (a -> b) -> a -> b
$ Storage
st { stParent = Just parent }

derivePartialStorage :: Storage -> IO PartialStorage
derivePartialStorage :: Storage -> IO PartialStorage
derivePartialStorage Storage
parent = do
    PartialStorage
st <- IO PartialStorage
forall (c' :: * -> *). IO (Storage' c')
memoryStorage'
    PartialStorage -> IO PartialStorage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PartialStorage -> IO PartialStorage)
-> PartialStorage -> IO PartialStorage
forall a b. (a -> b) -> a -> b
$ PartialStorage
st { stParent = Just parent }

type Ref = Ref' Complete
type PartialRef = Ref' Partial

zeroRef :: Storage' c -> Ref' c
zeroRef :: forall (c :: * -> *). Storage' c -> Ref' c
zeroRef Storage' c
s = Storage' c -> RefDigest -> Ref' c
forall (c :: * -> *). Storage' c -> RefDigest -> Ref' c
Ref Storage' c
s (Digest Blake2b_256 -> RefDigest
RefDigest Digest Blake2b_256
h)
    where h :: Digest Blake2b_256
h = case ByteString -> Maybe (Digest Blake2b_256)
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
ba -> Maybe (Digest a)
digestFromByteString (ByteString -> Maybe (Digest Blake2b_256))
-> ByteString -> Maybe (Digest Blake2b_256)
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (Blake2b_256 -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (Blake2b_256 -> Int) -> Blake2b_256 -> Int
forall a b. (a -> b) -> a -> b
$ Digest Blake2b_256 -> Blake2b_256
forall a. Digest a -> a
digestAlgo Digest Blake2b_256
h) Word8
0 of
                   Maybe (Digest Blake2b_256)
Nothing -> FilePath -> Digest Blake2b_256
forall a. HasCallStack => FilePath -> a
error (FilePath -> Digest Blake2b_256) -> FilePath -> Digest Blake2b_256
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to create zero hash"
                   Just Digest Blake2b_256
h' -> Digest Blake2b_256
h'
          digestAlgo :: Digest a -> a
          digestAlgo :: forall a. Digest a -> a
digestAlgo = Digest a -> a
forall a. HasCallStack => a
undefined

isZeroRef :: Ref' c -> Bool
isZeroRef :: forall (c :: * -> *). Ref' c -> Bool
isZeroRef (Ref Storage' c
_ RefDigest
h) = (Word8 -> Bool) -> [Word8] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
==Word8
0) ([Word8] -> Bool) -> [Word8] -> Bool
forall a b. (a -> b) -> a -> b
$ RefDigest -> [Word8]
forall a. ByteArrayAccess a => a -> [Word8]
BA.unpack RefDigest
h


refFromDigest :: Storage' c -> RefDigest -> IO (Maybe (Ref' c))
refFromDigest :: forall (c :: * -> *).
Storage' c -> RefDigest -> IO (Maybe (Ref' c))
refFromDigest Storage' c
st RefDigest
dgst = (ByteString -> Ref' c) -> Maybe ByteString -> Maybe (Ref' c)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ref' c -> ByteString -> Ref' c
forall a b. a -> b -> a
const (Ref' c -> ByteString -> Ref' c) -> Ref' c -> ByteString -> Ref' c
forall a b. (a -> b) -> a -> b
$ Storage' c -> RefDigest -> Ref' c
forall (c :: * -> *). Storage' c -> RefDigest -> Ref' c
Ref Storage' c
st RefDigest
dgst) (Maybe ByteString -> Maybe (Ref' c))
-> IO (Maybe ByteString) -> IO (Maybe (Ref' c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage' c -> RefDigest -> IO (Maybe ByteString)
forall (c :: * -> *).
Storage' c -> RefDigest -> IO (Maybe ByteString)
ioLoadBytesFromStorage Storage' c
st RefDigest
dgst

readRef :: Storage -> ByteString -> IO (Maybe Ref)
readRef :: Storage -> ByteString -> IO (Maybe Ref)
readRef Storage
s ByteString
b =
    case ByteString -> Maybe RefDigest
readRefDigest ByteString
b of
         Maybe RefDigest
Nothing -> Maybe Ref -> IO (Maybe Ref)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Ref
forall a. Maybe a
Nothing
         Just RefDigest
dgst -> Storage -> RefDigest -> IO (Maybe Ref)
forall (c :: * -> *).
Storage' c -> RefDigest -> IO (Maybe (Ref' c))
refFromDigest Storage
s RefDigest
dgst

copyRef' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => Storage' c' -> Ref' c -> IO (c (Ref' c'))
copyRef' :: forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Ref' c -> IO (c (Ref' c'))
copyRef' Storage' c'
st ref' :: Ref' c
ref'@(Ref Storage' c
_ RefDigest
dgst) = Storage' c' -> RefDigest -> IO (Maybe (Ref' c'))
forall (c :: * -> *).
Storage' c -> RefDigest -> IO (Maybe (Ref' c))
refFromDigest Storage' c'
st RefDigest
dgst IO (Maybe (Ref' c'))
-> (Maybe (Ref' c') -> IO (c (Ref' c'))) -> IO (c (Ref' c'))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Just Ref' c'
ref -> c (Ref' c') -> IO (c (Ref' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (Ref' c') -> IO (c (Ref' c')))
-> c (Ref' c') -> IO (c (Ref' c'))
forall a b. (a -> b) -> a -> b
$ Ref' c' -> c (Ref' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref' c'
ref
                                                                Maybe (Ref' c')
Nothing  -> IO (c (Ref' c'))
doCopy
    where doCopy :: IO (c (Ref' c'))
doCopy = do c (Object' c)
mbobj' <- Ref' c -> IO (c (Object' c))
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> IO (c (Object' c))
ioLoadObject Ref' c
ref'
                      c (c (Object' c'))
mbobj <- c (IO (c (Object' c'))) -> IO (c (c (Object' c')))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => c (m a) -> m (c a)
sequence (c (IO (c (Object' c'))) -> IO (c (c (Object' c'))))
-> c (IO (c (Object' c'))) -> IO (c (c (Object' c')))
forall a b. (a -> b) -> a -> b
$ Storage' c' -> Object' c -> IO (c (Object' c'))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (c (Object' c'))
copyObject' Storage' c'
st (Object' c -> IO (c (Object' c')))
-> c (Object' c) -> c (IO (c (Object' c')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c (Object' c)
mbobj'
                      c (IO (Ref' c')) -> IO (c (Ref' c'))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => c (m a) -> m (c a)
sequence (c (IO (Ref' c')) -> IO (c (Ref' c')))
-> c (IO (Ref' c')) -> IO (c (Ref' c'))
forall a b. (a -> b) -> a -> b
$ Storage' c' -> Object' c' -> IO (Ref' c')
forall (c :: * -> *). Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject Storage' c'
st (Object' c' -> IO (Ref' c')) -> c (Object' c') -> c (IO (Ref' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c (c (Object' c')) -> c (Object' c')
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join c (c (Object' c'))
mbobj

copyObject' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => Storage' c' -> Object' c -> IO (c (Object' c'))
copyObject' :: forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (c (Object' c'))
copyObject' Storage' c'
_ (Blob ByteString
bs) = c (Object' c') -> IO (c (Object' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (Object' c') -> IO (c (Object' c')))
-> c (Object' c') -> IO (c (Object' c'))
forall a b. (a -> b) -> a -> b
$ Object' c' -> c (Object' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c' -> c (Object' c')) -> Object' c' -> c (Object' c')
forall a b. (a -> b) -> a -> b
$ ByteString -> Object' c'
forall (c :: * -> *). ByteString -> Object' c
Blob ByteString
bs
copyObject' Storage' c'
st (Rec [(ByteString, RecItem' c)]
rs) = ([(ByteString, RecItem' c')] -> Object' c')
-> c [(ByteString, RecItem' c')] -> c (Object' c')
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ByteString, RecItem' c')] -> Object' c'
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec (c [(ByteString, RecItem' c')] -> c (Object' c'))
-> ([c (ByteString, RecItem' c')] -> c [(ByteString, RecItem' c')])
-> [c (ByteString, RecItem' c')]
-> c (Object' c')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c (ByteString, RecItem' c')] -> c [(ByteString, RecItem' c')]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([c (ByteString, RecItem' c')] -> c (Object' c'))
-> IO [c (ByteString, RecItem' c')] -> IO (c (Object' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, RecItem' c) -> IO (c (ByteString, RecItem' c')))
-> [(ByteString, RecItem' c)] -> IO [c (ByteString, RecItem' c')]
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 (ByteString, RecItem' c) -> IO (c (ByteString, RecItem' c'))
copyItem [(ByteString, RecItem' c)]
rs
    where copyItem :: (ByteString, RecItem' c) -> IO (c (ByteString, RecItem' c'))
          copyItem :: (ByteString, RecItem' c) -> IO (c (ByteString, RecItem' c'))
copyItem (ByteString
n, RecItem' c
item) = (RecItem' c' -> (ByteString, RecItem' c'))
-> c (RecItem' c') -> c (ByteString, RecItem' c')
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString
n,) (c (RecItem' c') -> c (ByteString, RecItem' c'))
-> IO (c (RecItem' c')) -> IO (c (ByteString, RecItem' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case RecItem' c
item of
              RecItem' c
RecEmpty -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ RecItem' c'
forall (c :: * -> *). RecItem' c
RecEmpty
              RecInt Integer
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ Integer -> RecItem' c'
forall (c :: * -> *). Integer -> RecItem' c
RecInt Integer
x
              RecNum Rational
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ Rational -> RecItem' c'
forall (c :: * -> *). Rational -> RecItem' c
RecNum Rational
x
              RecText Text
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ Text -> RecItem' c'
forall (c :: * -> *). Text -> RecItem' c
RecText Text
x
              RecBinary ByteString
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ ByteString -> RecItem' c'
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary ByteString
x
              RecDate ZonedTime
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ ZonedTime -> RecItem' c'
forall (c :: * -> *). ZonedTime -> RecItem' c
RecDate ZonedTime
x
              RecUUID UUID
x -> c (RecItem' c') -> IO (c (RecItem' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (RecItem' c') -> IO (c (RecItem' c')))
-> c (RecItem' c') -> IO (c (RecItem' c'))
forall a b. (a -> b) -> a -> b
$ RecItem' c' -> c (RecItem' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c' -> c (RecItem' c')) -> RecItem' c' -> c (RecItem' c')
forall a b. (a -> b) -> a -> b
$ UUID -> RecItem' c'
forall (c :: * -> *). UUID -> RecItem' c
RecUUID UUID
x
              RecRef Ref' c
x -> (Ref' c' -> RecItem' c') -> c (Ref' c') -> c (RecItem' c')
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref' c' -> RecItem' c'
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (c (Ref' c') -> c (RecItem' c'))
-> IO (c (Ref' c')) -> IO (c (RecItem' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage' c' -> Ref' c -> IO (c (Ref' c'))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Ref' c -> IO (c (Ref' c'))
copyRef' Storage' c'
st Ref' c
x
copyObject' Storage' c'
_ Object' c
ZeroObject = c (Object' c') -> IO (c (Object' c'))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (Object' c') -> IO (c (Object' c')))
-> c (Object' c') -> IO (c (Object' c'))
forall a b. (a -> b) -> a -> b
$ Object' c' -> c (Object' c')
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return Object' c'
forall (c :: * -> *). Object' c
ZeroObject

copyRef :: forall c c' m. (StorageCompleteness c, StorageCompleteness c', MonadIO m) => Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
copyRef :: forall (c :: * -> *) (c' :: * -> *) (m :: * -> *).
(StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
copyRef Storage' c'
st Ref' c
ref' = IO (LoadResult c (Ref' c')) -> m (LoadResult c (Ref' c'))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (LoadResult c (Ref' c')) -> m (LoadResult c (Ref' c')))
-> IO (LoadResult c (Ref' c')) -> m (LoadResult c (Ref' c'))
forall a b. (a -> b) -> a -> b
$ c (Ref' c') -> LoadResult c (Ref' c')
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (c (Ref' c') -> LoadResult c (Ref' c'))
-> IO (c (Ref' c')) -> IO (LoadResult c (Ref' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage' c' -> Ref' c -> IO (c (Ref' c'))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Ref' c -> IO (c (Ref' c'))
copyRef' Storage' c'
st Ref' c
ref'

copyObject :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => Storage' c' -> Object' c -> IO (LoadResult c (Object' c'))
copyObject :: forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (LoadResult c (Object' c'))
copyObject Storage' c'
st Object' c
obj' = c (Object' c') -> LoadResult c (Object' c')
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (c (Object' c') -> LoadResult c (Object' c'))
-> IO (c (Object' c')) -> IO (LoadResult c (Object' c'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage' c' -> Object' c -> IO (c (Object' c'))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (c (Object' c'))
copyObject' Storage' c'
st Object' c
obj'

partialRef :: PartialStorage -> Ref -> PartialRef
partialRef :: PartialStorage -> Ref -> PartialRef
partialRef PartialStorage
st (Ref Storage
_ RefDigest
dgst) = PartialStorage -> RefDigest -> PartialRef
forall (c :: * -> *). Storage' c -> RefDigest -> Ref' c
Ref PartialStorage
st RefDigest
dgst

partialRefFromDigest :: PartialStorage -> RefDigest -> PartialRef
partialRefFromDigest :: PartialStorage -> RefDigest -> PartialRef
partialRefFromDigest PartialStorage
st RefDigest
dgst = PartialStorage -> RefDigest -> PartialRef
forall (c :: * -> *). Storage' c -> RefDigest -> Ref' c
Ref PartialStorage
st RefDigest
dgst


data Object' c
    = Blob ByteString
    | Rec [(ByteString, RecItem' c)]
    | ZeroObject
    deriving (Int -> Object' c -> FilePath -> FilePath
[Object' c] -> FilePath -> FilePath
Object' c -> FilePath
(Int -> Object' c -> FilePath -> FilePath)
-> (Object' c -> FilePath)
-> ([Object' c] -> FilePath -> FilePath)
-> Show (Object' c)
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
forall (c :: * -> *). Int -> Object' c -> FilePath -> FilePath
forall (c :: * -> *). [Object' c] -> FilePath -> FilePath
forall (c :: * -> *). Object' c -> FilePath
$cshowsPrec :: forall (c :: * -> *). Int -> Object' c -> FilePath -> FilePath
showsPrec :: Int -> Object' c -> FilePath -> FilePath
$cshow :: forall (c :: * -> *). Object' c -> FilePath
show :: Object' c -> FilePath
$cshowList :: forall (c :: * -> *). [Object' c] -> FilePath -> FilePath
showList :: [Object' c] -> FilePath -> FilePath
Show)

type Object = Object' Complete
type PartialObject = Object' Partial

data RecItem' c
    = RecEmpty
    | RecInt Integer
    | RecNum Rational
    | RecText Text
    | RecBinary ByteString
    | RecDate ZonedTime
    | RecUUID UUID
    | RecRef (Ref' c)
    deriving (Int -> RecItem' c -> FilePath -> FilePath
[RecItem' c] -> FilePath -> FilePath
RecItem' c -> FilePath
(Int -> RecItem' c -> FilePath -> FilePath)
-> (RecItem' c -> FilePath)
-> ([RecItem' c] -> FilePath -> FilePath)
-> Show (RecItem' c)
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
forall (c :: * -> *). Int -> RecItem' c -> FilePath -> FilePath
forall (c :: * -> *). [RecItem' c] -> FilePath -> FilePath
forall (c :: * -> *). RecItem' c -> FilePath
$cshowsPrec :: forall (c :: * -> *). Int -> RecItem' c -> FilePath -> FilePath
showsPrec :: Int -> RecItem' c -> FilePath -> FilePath
$cshow :: forall (c :: * -> *). RecItem' c -> FilePath
show :: RecItem' c -> FilePath
$cshowList :: forall (c :: * -> *). [RecItem' c] -> FilePath -> FilePath
showList :: [RecItem' c] -> FilePath -> FilePath
Show)

type RecItem = RecItem' Complete

serializeObject :: Object' c -> BL.ByteString
serializeObject :: forall (c :: * -> *). Object' c -> ByteString
serializeObject = \case
    Blob ByteString
cnt -> [ByteString] -> ByteString
BL.fromChunks [FilePath -> ByteString
BC.pack FilePath
"blob ", FilePath -> ByteString
BC.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
cnt), Char -> ByteString
BC.singleton Char
'\n', ByteString
cnt]
    Rec [(ByteString, RecItem' c)]
rec -> let cnt :: ByteString
cnt = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ByteString, RecItem' c) -> [ByteString])
-> [(ByteString, RecItem' c)] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ByteString -> RecItem' c -> [ByteString])
-> (ByteString, RecItem' c) -> [ByteString]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> RecItem' c -> [ByteString]
forall (c :: * -> *). ByteString -> RecItem' c -> [ByteString]
serializeRecItem) [(ByteString, RecItem' c)]
rec
                in [ByteString] -> ByteString
BL.fromChunks [FilePath -> ByteString
BC.pack FilePath
"rec ", FilePath -> ByteString
BC.pack (Int64 -> FilePath
forall a. Show a => a -> FilePath
show (Int64 -> FilePath) -> Int64 -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BL.length ByteString
cnt), Char -> ByteString
BC.singleton Char
'\n'] ByteString -> ByteString -> ByteString
`BL.append` ByteString
cnt
    Object' c
ZeroObject -> ByteString
BL.empty

-- |Serializes and stores object data without ony dependencies, so is safe only
-- if all the referenced objects are already stored or reference is partial.
unsafeStoreObject :: Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject :: forall (c :: * -> *). Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject Storage' c
storage = \case
    Object' c
ZeroObject -> Ref' c -> IO (Ref' c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref' c -> IO (Ref' c)) -> Ref' c -> IO (Ref' c)
forall a b. (a -> b) -> a -> b
$ Storage' c -> Ref' c
forall (c :: * -> *). Storage' c -> Ref' c
zeroRef Storage' c
storage
    Object' c
obj -> Storage' c -> ByteString -> IO (Ref' c)
forall (c :: * -> *). Storage' c -> ByteString -> IO (Ref' c)
unsafeStoreRawBytes Storage' c
storage (ByteString -> IO (Ref' c)) -> ByteString -> IO (Ref' c)
forall a b. (a -> b) -> a -> b
$ Object' c -> ByteString
forall (c :: * -> *). Object' c -> ByteString
serializeObject Object' c
obj

storeObject :: PartialStorage -> PartialObject -> IO PartialRef
storeObject :: PartialStorage -> PartialObject -> IO PartialRef
storeObject = PartialStorage -> PartialObject -> IO PartialRef
forall (c :: * -> *). Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject

storeRawBytes :: PartialStorage -> BL.ByteString -> IO PartialRef
storeRawBytes :: PartialStorage -> ByteString -> IO PartialRef
storeRawBytes = PartialStorage -> ByteString -> IO PartialRef
forall (c :: * -> *). Storage' c -> ByteString -> IO (Ref' c)
unsafeStoreRawBytes

serializeRecItem :: ByteString -> RecItem' c -> [ByteString]
serializeRecItem :: forall (c :: * -> *). ByteString -> RecItem' c -> [ByteString]
serializeRecItem ByteString
name (RecItem' c
RecEmpty) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":e", Char -> ByteString
BC.singleton Char
' ', Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecInt Integer
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":i", Char -> ByteString
BC.singleton Char
' ', FilePath -> ByteString
BC.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
x), Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecNum Rational
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":n", Char -> ByteString
BC.singleton Char
' ', FilePath -> ByteString
BC.pack (Rational -> FilePath
showRatio Rational
x), Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecText Text
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":t", Char -> ByteString
BC.singleton Char
' ', ByteString
escaped, Char -> ByteString
BC.singleton Char
'\n']
    where escaped :: ByteString
escaped = (Char -> ByteString) -> ByteString -> ByteString
BC.concatMap Char -> ByteString
escape (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
x
          escape :: Char -> ByteString
escape Char
'\n' = FilePath -> ByteString
BC.pack FilePath
"\n\t"
          escape Char
c    = Char -> ByteString
BC.singleton Char
c
serializeRecItem ByteString
name (RecBinary ByteString
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":b ", ByteString -> ByteString
forall ba. ByteArrayAccess ba => ba -> ByteString
showHex ByteString
x, Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecDate ZonedTime
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":d", Char -> ByteString
BC.singleton Char
' ', FilePath -> ByteString
BC.pack (TimeLocale -> FilePath -> ZonedTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%s %z" ZonedTime
x), Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecUUID UUID
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":u", Char -> ByteString
BC.singleton Char
' ', UUID -> ByteString
U.toASCIIBytes UUID
x, Char -> ByteString
BC.singleton Char
'\n']
serializeRecItem ByteString
name (RecRef Ref' c
x) = [ByteString
name, FilePath -> ByteString
BC.pack FilePath
":r ", Ref' c -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref' c
x, Char -> ByteString
BC.singleton Char
'\n']

lazyLoadObject :: forall c. StorageCompleteness c => Ref' c -> LoadResult c (Object' c)
lazyLoadObject :: forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c (Object' c)
lazyLoadObject = c (Object' c) -> LoadResult c (Object' c)
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (c (Object' c) -> LoadResult c (Object' c))
-> (Ref' c -> c (Object' c)) -> Ref' c -> LoadResult c (Object' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (c (Object' c)) -> c (Object' c)
forall a. IO a -> a
unsafePerformIO (IO (c (Object' c)) -> c (Object' c))
-> (Ref' c -> IO (c (Object' c))) -> Ref' c -> c (Object' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref' c -> IO (c (Object' c))
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> IO (c (Object' c))
ioLoadObject

ioLoadObject :: forall c. StorageCompleteness c => Ref' c -> IO (c (Object' c))
ioLoadObject :: forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> IO (c (Object' c))
ioLoadObject Ref' c
ref | Ref' c -> Bool
forall (c :: * -> *). Ref' c -> Bool
isZeroRef Ref' c
ref = c (Object' c) -> IO (c (Object' c))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (Object' c) -> IO (c (Object' c)))
-> c (Object' c) -> IO (c (Object' c))
forall a b. (a -> b) -> a -> b
$ Object' c -> c (Object' c)
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return Object' c
forall (c :: * -> *). Object' c
ZeroObject
ioLoadObject ref :: Ref' c
ref@(Ref Storage' c
st RefDigest
rhash) = do
    c ByteString
file' <- Ref' c -> IO (c ByteString)
forall (compl :: * -> *).
StorageCompleteness compl =>
Ref' compl -> IO (compl ByteString)
ioLoadBytes Ref' c
ref
    c (Object' c) -> IO (c (Object' c))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (Object' c) -> IO (c (Object' c)))
-> c (Object' c) -> IO (c (Object' c))
forall a b. (a -> b) -> a -> b
$ do
        ByteString
file <- c ByteString
file'
        let chash :: RefDigest
chash = ByteString -> RefDigest
hashToRefDigest ByteString
file
        Bool -> c () -> c ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RefDigest
chash RefDigest -> RefDigest -> Bool
forall a. Eq a => a -> a -> Bool
/= RefDigest
rhash) (c () -> c ()) -> c () -> c ()
forall a b. (a -> b) -> a -> b
$ FilePath -> c ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> c ()) -> FilePath -> c ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Hash mismatch on object " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
BC.unpack (Ref' c -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref' c
ref) {- TODO throw -}
        Object' c -> c (Object' c)
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c -> c (Object' c)) -> Object' c -> c (Object' c)
forall a b. (a -> b) -> a -> b
$ case Except FilePath (Object' c, ByteString)
-> Either FilePath (Object' c, ByteString)
forall e a. Except e a -> Either e a
runExcept (Except FilePath (Object' c, ByteString)
 -> Either FilePath (Object' c, ByteString))
-> Except FilePath (Object' c, ByteString)
-> Either FilePath (Object' c, ByteString)
forall a b. (a -> b) -> a -> b
$ Storage' c -> ByteString -> Except FilePath (Object' c, ByteString)
forall (c :: * -> *).
Storage' c -> ByteString -> Except FilePath (Object' c, ByteString)
unsafeDeserializeObject Storage' c
st ByteString
file of
                      Left FilePath
err -> FilePath -> Object' c
forall a. HasCallStack => FilePath -> a
error (FilePath -> Object' c) -> FilePath -> Object' c
forall a b. (a -> b) -> a -> b
$ FilePath
err FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
", ref " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
BC.unpack (Ref' c -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref' c
ref) {- TODO throw -}
                      Right (Object' c
x, ByteString
rest) | ByteString -> Bool
BL.null ByteString
rest -> Object' c
x
                                      | Bool
otherwise -> FilePath -> Object' c
forall a. HasCallStack => FilePath -> a
error (FilePath -> Object' c) -> FilePath -> Object' c
forall a b. (a -> b) -> a -> b
$ FilePath
"Superfluous content after " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ByteString -> FilePath
BC.unpack (Ref' c -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref' c
ref) {- TODO throw -}

lazyLoadBytes :: forall c. StorageCompleteness c => Ref' c -> LoadResult c BL.ByteString
lazyLoadBytes :: forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c ByteString
lazyLoadBytes Ref' c
ref | Ref' c -> Bool
forall (c :: * -> *). Ref' c -> Bool
isZeroRef Ref' c
ref = c ByteString -> LoadResult c ByteString
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (ByteString -> c ByteString
forall a. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BL.empty :: c BL.ByteString)
lazyLoadBytes Ref' c
ref = c ByteString -> LoadResult c ByteString
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (c ByteString -> LoadResult c ByteString)
-> c ByteString -> LoadResult c ByteString
forall a b. (a -> b) -> a -> b
$ IO (c ByteString) -> c ByteString
forall a. IO a -> a
unsafePerformIO (IO (c ByteString) -> c ByteString)
-> IO (c ByteString) -> c ByteString
forall a b. (a -> b) -> a -> b
$ Ref' c -> IO (c ByteString)
forall (compl :: * -> *).
StorageCompleteness compl =>
Ref' compl -> IO (compl ByteString)
ioLoadBytes Ref' c
ref

unsafeDeserializeObject :: Storage' c -> BL.ByteString -> Except String (Object' c, BL.ByteString)
unsafeDeserializeObject :: forall (c :: * -> *).
Storage' c -> ByteString -> Except FilePath (Object' c, ByteString)
unsafeDeserializeObject Storage' c
_  ByteString
bytes | ByteString -> Bool
BL.null ByteString
bytes = (Object' c, ByteString)
-> ExceptT FilePath Complete (Object' c, ByteString)
forall a. a -> ExceptT FilePath Complete a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c
forall (c :: * -> *). Object' c
ZeroObject, ByteString
bytes)
unsafeDeserializeObject Storage' c
st ByteString
bytes =
    case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BLC.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n') ByteString
bytes of
        (ByteString
line, ByteString
rest) | Just (ByteString
otype, Int
len) <- ByteString -> Maybe (ByteString, Int)
splitObjPrefix ByteString
line -> do
            let (ByteString
content, ByteString
next) = (ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> ByteString
BL.toStrict ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> (ByteString, ByteString)
BL.splitAt (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BL.drop Int64
1 ByteString
rest
            Bool -> ExceptT FilePath Complete ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ExceptT FilePath Complete ())
-> Bool -> ExceptT FilePath Complete ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
content Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
            (,ByteString
next) (Object' c -> (Object' c, ByteString))
-> ExceptT FilePath Complete (Object' c)
-> ExceptT FilePath Complete (Object' c, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ByteString
otype of
                 ByteString
_ | ByteString
otype ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BC.pack FilePath
"blob" -> Object' c -> ExceptT FilePath Complete (Object' c)
forall a. a -> ExceptT FilePath Complete a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c -> ExceptT FilePath Complete (Object' c))
-> Object' c -> ExceptT FilePath Complete (Object' c)
forall a b. (a -> b) -> a -> b
$ ByteString -> Object' c
forall (c :: * -> *). ByteString -> Object' c
Blob ByteString
content
                   | ByteString
otype ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BC.pack FilePath
"rec" -> ExceptT FilePath Complete (Object' c)
-> ([(ByteString, RecItem' c)]
    -> ExceptT FilePath Complete (Object' c))
-> Maybe [(ByteString, RecItem' c)]
-> ExceptT FilePath Complete (Object' c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> ExceptT FilePath Complete (Object' c)
forall a. FilePath -> ExceptT FilePath Complete a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ExceptT FilePath Complete (Object' c))
-> FilePath -> ExceptT FilePath Complete (Object' c)
forall a b. (a -> b) -> a -> b
$ FilePath
"Malformed record item ")
                                                   (Object' c -> ExceptT FilePath Complete (Object' c)
forall a. a -> ExceptT FilePath Complete a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c -> ExceptT FilePath Complete (Object' c))
-> ([(ByteString, RecItem' c)] -> Object' c)
-> [(ByteString, RecItem' c)]
-> ExceptT FilePath Complete (Object' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, RecItem' c)] -> Object' c
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec) (Maybe [(ByteString, RecItem' c)]
 -> ExceptT FilePath Complete (Object' c))
-> Maybe [(ByteString, RecItem' c)]
-> ExceptT FilePath Complete (Object' c)
forall a b. (a -> b) -> a -> b
$ [Maybe (ByteString, RecItem' c)]
-> Maybe [(ByteString, RecItem' c)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Maybe (ByteString, RecItem' c)]
 -> Maybe [(ByteString, RecItem' c)])
-> [Maybe (ByteString, RecItem' c)]
-> Maybe [(ByteString, RecItem' c)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (ByteString, RecItem' c))
-> [ByteString] -> [Maybe (ByteString, RecItem' c)]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Maybe (ByteString, RecItem' c)
parseRecLine ([ByteString] -> [Maybe (ByteString, RecItem' c)])
-> [ByteString] -> [Maybe (ByteString, RecItem' c)]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString] -> [ByteString]
mergeCont [] ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BC.lines ByteString
content
                   | Bool
otherwise -> FilePath -> ExceptT FilePath Complete (Object' c)
forall a. FilePath -> ExceptT FilePath Complete a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ExceptT FilePath Complete (Object' c))
-> FilePath -> ExceptT FilePath Complete (Object' c)
forall a b. (a -> b) -> a -> b
$ FilePath
"Unknown object type"
        (ByteString, ByteString)
_ -> FilePath -> ExceptT FilePath Complete (Object' c, ByteString)
forall a. FilePath -> ExceptT FilePath Complete a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ExceptT FilePath Complete (Object' c, ByteString))
-> FilePath -> ExceptT FilePath Complete (Object' c, ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath
"Malformed object"
    where splitObjPrefix :: ByteString -> Maybe (ByteString, Int)
splitObjPrefix ByteString
line = do
              [ByteString
otype, ByteString
tlen] <- [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> Maybe [ByteString])
-> [ByteString] -> Maybe [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
BLC.words ByteString
line
              (Int
len, ByteString
rest) <- ByteString -> Maybe (Int, ByteString)
BLC.readInt ByteString
tlen
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
BL.null ByteString
rest
              (ByteString, Int) -> Maybe (ByteString, Int)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.toStrict ByteString
otype, Int
len)

          mergeCont :: [ByteString] -> [ByteString] -> [ByteString]
mergeCont [ByteString]
cs (ByteString
a:ByteString
b:[ByteString]
rest) | Just (Char
'\t', ByteString
b') <- ByteString -> Maybe (Char, ByteString)
BC.uncons ByteString
b = [ByteString] -> [ByteString] -> [ByteString]
mergeCont (ByteString
b'ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:FilePath -> ByteString
BC.pack FilePath
"\n"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
cs) (ByteString
aByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
rest)
          mergeCont [ByteString]
cs (ByteString
a:[ByteString]
rest) = [ByteString] -> ByteString
B.concat (ByteString
a ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
cs) ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString] -> [ByteString]
mergeCont [] [ByteString]
rest
          mergeCont [ByteString]
_ [] = []

          parseRecLine :: ByteString -> Maybe (ByteString, RecItem' c)
parseRecLine ByteString
line = do
              Int
colon <- Char -> ByteString -> Maybe Int
BC.elemIndex Char
':' ByteString
line
              Int
space <- Char -> ByteString -> Maybe Int
BC.elemIndex Char
' ' ByteString
line
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
colon Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
space
              let name :: ByteString
name = Int -> ByteString -> ByteString
B.take Int
colon ByteString
line
                  itype :: ByteString
itype = Int -> ByteString -> ByteString
B.take (Int
spaceInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
colonInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Int
colonInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ByteString
line
                  content :: ByteString
content = Int -> ByteString -> ByteString
B.drop (Int
spaceInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ByteString
line

              RecItem' c
val <- case ByteString -> FilePath
BC.unpack ByteString
itype of
                          FilePath
"e" -> do Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.null ByteString
content
                                    RecItem' c -> Maybe (RecItem' c)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return RecItem' c
forall (c :: * -> *). RecItem' c
RecEmpty
                          FilePath
"i" -> do (Integer
num, ByteString
rest) <- ByteString -> Maybe (Integer, ByteString)
BC.readInteger ByteString
content
                                    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
B.null ByteString
rest
                                    RecItem' c -> Maybe (RecItem' c)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c -> Maybe (RecItem' c))
-> RecItem' c -> Maybe (RecItem' c)
forall a b. (a -> b) -> a -> b
$ Integer -> RecItem' c
forall (c :: * -> *). Integer -> RecItem' c
RecInt Integer
num
                          FilePath
"n" -> Rational -> RecItem' c
forall (c :: * -> *). Rational -> RecItem' c
RecNum (Rational -> RecItem' c) -> Maybe Rational -> Maybe (RecItem' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Rational
parseRatio ByteString
content
                          FilePath
"t" -> RecItem' c -> Maybe (RecItem' c)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RecItem' c -> Maybe (RecItem' c))
-> RecItem' c -> Maybe (RecItem' c)
forall a b. (a -> b) -> a -> b
$ Text -> RecItem' c
forall (c :: * -> *). Text -> RecItem' c
RecText (Text -> RecItem' c) -> Text -> RecItem' c
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
content
                          FilePath
"b" -> ByteString -> RecItem' c
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary (ByteString -> RecItem' c)
-> Maybe ByteString -> Maybe (RecItem' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe ByteString
forall ba. ByteArray ba => ByteString -> Maybe ba
readHex ByteString
content
                          FilePath
"d" -> ZonedTime -> RecItem' c
forall (c :: * -> *). ZonedTime -> RecItem' c
RecDate (ZonedTime -> RecItem' c) -> Maybe ZonedTime -> Maybe (RecItem' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> TimeLocale -> FilePath -> FilePath -> Maybe ZonedTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> FilePath -> FilePath -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale FilePath
"%s %z" (ByteString -> FilePath
BC.unpack ByteString
content)
                          FilePath
"u" -> UUID -> RecItem' c
forall (c :: * -> *). UUID -> RecItem' c
RecUUID (UUID -> RecItem' c) -> Maybe UUID -> Maybe (RecItem' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe UUID
U.fromASCIIBytes ByteString
content
                          FilePath
"r" -> Ref' c -> RecItem' c
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef (Ref' c -> RecItem' c)
-> (RefDigest -> Ref' c) -> RefDigest -> RecItem' c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Storage' c -> RefDigest -> Ref' c
forall (c :: * -> *). Storage' c -> RefDigest -> Ref' c
Ref Storage' c
st (RefDigest -> RecItem' c) -> Maybe RefDigest -> Maybe (RecItem' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe RefDigest
readRefDigest ByteString
content
                          FilePath
_   -> Maybe (RecItem' c)
forall a. Maybe a
Nothing
              (ByteString, RecItem' c) -> Maybe (ByteString, RecItem' c)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
name, RecItem' c
val)

deserializeObject :: PartialStorage -> BL.ByteString -> Except String (PartialObject, BL.ByteString)
deserializeObject :: PartialStorage
-> ByteString -> Except FilePath (PartialObject, ByteString)
deserializeObject = PartialStorage
-> ByteString -> Except FilePath (PartialObject, ByteString)
forall (c :: * -> *).
Storage' c -> ByteString -> Except FilePath (Object' c, ByteString)
unsafeDeserializeObject

deserializeObjects :: PartialStorage -> BL.ByteString -> Except String [PartialObject]
deserializeObjects :: PartialStorage -> ByteString -> Except FilePath [PartialObject]
deserializeObjects PartialStorage
_  ByteString
bytes | ByteString -> Bool
BL.null ByteString
bytes = [PartialObject] -> Except FilePath [PartialObject]
forall a. a -> ExceptT FilePath Complete a
forall (m :: * -> *) a. Monad m => a -> m a
return []
deserializeObjects PartialStorage
st ByteString
bytes = do (PartialObject
obj, ByteString
rest) <- PartialStorage
-> ByteString -> Except FilePath (PartialObject, ByteString)
deserializeObject PartialStorage
st ByteString
bytes
                                 (PartialObject
objPartialObject -> [PartialObject] -> [PartialObject]
forall a. a -> [a] -> [a]
:) ([PartialObject] -> [PartialObject])
-> Except FilePath [PartialObject]
-> Except FilePath [PartialObject]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PartialStorage -> ByteString -> Except FilePath [PartialObject]
deserializeObjects PartialStorage
st ByteString
rest


collectObjects :: Object -> [Object]
collectObjects :: Object -> [Object]
collectObjects Object
obj = Object
obj Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: (Stored Object -> Object) -> [Stored Object] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map Stored Object -> Object
forall a. Stored a -> a
fromStored (([Stored Object], Set RefDigest) -> [Stored Object]
forall a b. (a, b) -> a
fst (([Stored Object], Set RefDigest) -> [Stored Object])
-> ([Stored Object], Set RefDigest) -> [Stored Object]
forall a b. (a -> b) -> a -> b
$ Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
collectOtherStored Set RefDigest
forall a. Set a
S.empty Object
obj)

collectStoredObjects :: Stored Object -> [Stored Object]
collectStoredObjects :: Stored Object -> [Stored Object]
collectStoredObjects Stored Object
obj = Stored Object
obj Stored Object -> [Stored Object] -> [Stored Object]
forall a. a -> [a] -> [a]
: (([Stored Object], Set RefDigest) -> [Stored Object]
forall a b. (a, b) -> a
fst (([Stored Object], Set RefDigest) -> [Stored Object])
-> ([Stored Object], Set RefDigest) -> [Stored Object]
forall a b. (a -> b) -> a -> b
$ Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
collectOtherStored Set RefDigest
forall a. Set a
S.empty (Object -> ([Stored Object], Set RefDigest))
-> Object -> ([Stored Object], Set RefDigest)
forall a b. (a -> b) -> a -> b
$ Stored Object -> Object
forall a. Stored a -> a
fromStored Stored Object
obj)

collectOtherStored :: Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
collectOtherStored :: Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
collectOtherStored Set RefDigest
seen (Rec [(ByteString, RecItem' Complete)]
items) = (RecItem' Complete
 -> ([Stored Object], Set RefDigest)
 -> ([Stored Object], Set RefDigest))
-> ([Stored Object], Set RefDigest)
-> [RecItem' Complete]
-> ([Stored Object], Set RefDigest)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RecItem' Complete
-> ([Stored Object], Set RefDigest)
-> ([Stored Object], Set RefDigest)
helper ([], Set RefDigest
seen) ([RecItem' Complete] -> ([Stored Object], Set RefDigest))
-> [RecItem' Complete] -> ([Stored Object], Set RefDigest)
forall a b. (a -> b) -> a -> b
$ ((ByteString, RecItem' Complete) -> RecItem' Complete)
-> [(ByteString, RecItem' Complete)] -> [RecItem' Complete]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, RecItem' Complete) -> RecItem' Complete
forall a b. (a, b) -> b
snd [(ByteString, RecItem' Complete)]
items
    where helper :: RecItem' Complete
-> ([Stored Object], Set RefDigest)
-> ([Stored Object], Set RefDigest)
helper (RecRef Ref
ref) ([Stored Object]
xs, Set RefDigest
s) | RefDigest
r <- Ref -> RefDigest
forall (c :: * -> *). Ref' c -> RefDigest
refDigest Ref
ref
                                      , RefDigest
r RefDigest -> Set RefDigest -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set RefDigest
s
                                      = let o :: Stored Object
o = Ref -> Stored Object
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
ref
                                            ([Stored Object]
xs', Set RefDigest
s') = Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
collectOtherStored (RefDigest -> Set RefDigest -> Set RefDigest
forall a. Ord a => a -> Set a -> Set a
S.insert RefDigest
r Set RefDigest
s) (Object -> ([Stored Object], Set RefDigest))
-> Object -> ([Stored Object], Set RefDigest)
forall a b. (a -> b) -> a -> b
$ Stored Object -> Object
forall a. Stored a -> a
fromStored Stored Object
o
                                         in ((Stored Object
o Stored Object -> [Stored Object] -> [Stored Object]
forall a. a -> [a] -> [a]
: [Stored Object]
xs') [Stored Object] -> [Stored Object] -> [Stored Object]
forall a. [a] -> [a] -> [a]
++ [Stored Object]
xs, Set RefDigest
s')
          helper RecItem' Complete
_          ([Stored Object]
xs, Set RefDigest
s) = ([Stored Object]
xs, Set RefDigest
s)
collectOtherStored Set RefDigest
seen Object
_ = ([], Set RefDigest
seen)


type Head = Head' Complete

headId :: Head a -> HeadID
headId :: forall a. Head a -> HeadID
headId (Head HeadID
uuid Stored' Complete a
_) = HeadID
uuid

headStorage :: Head a -> Storage
headStorage :: forall a. Head a -> Storage
headStorage = Ref -> Storage
forall (c :: * -> *). Ref' c -> Storage' c
refStorage (Ref -> Storage) -> (Head a -> Ref) -> Head a -> Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Head a -> Ref
forall a. Head a -> Ref
headRef

headRef :: Head a -> Ref
headRef :: forall a. Head a -> Ref
headRef (Head HeadID
_ Stored' Complete a
sx) = Stored' Complete a -> Ref
forall a. Stored a -> Ref
storedRef Stored' Complete a
sx

headObject :: Head a -> a
headObject :: forall a. Head a -> a
headObject (Head HeadID
_ Stored' Complete a
sx) = Stored' Complete a -> a
forall a. Stored a -> a
fromStored Stored' Complete a
sx

headStoredObject :: Head a -> Stored a
headStoredObject :: forall a. Head a -> Stored a
headStoredObject (Head HeadID
_ Stored' Complete a
sx) = Stored' Complete a
sx

deriving instance StorableUUID HeadID
deriving instance StorableUUID HeadTypeID

mkHeadTypeID :: String -> HeadTypeID
mkHeadTypeID :: FilePath -> HeadTypeID
mkHeadTypeID = HeadTypeID -> (UUID -> HeadTypeID) -> Maybe UUID -> HeadTypeID
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> HeadTypeID
forall a. HasCallStack => FilePath -> a
error FilePath
"Invalid head type ID") UUID -> HeadTypeID
HeadTypeID (Maybe UUID -> HeadTypeID)
-> (FilePath -> Maybe UUID) -> FilePath -> HeadTypeID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe UUID
U.fromString

class Storable a => HeadType a where
    headTypeID :: proxy a -> HeadTypeID


headTypePath :: FilePath -> HeadTypeID -> FilePath
headTypePath :: FilePath -> HeadTypeID -> FilePath
headTypePath FilePath
spath (HeadTypeID UUID
tid) = FilePath
spath FilePath -> FilePath -> FilePath
</> FilePath
"heads" FilePath -> FilePath -> FilePath
</> UUID -> FilePath
U.toString UUID
tid

headPath :: FilePath -> HeadTypeID -> HeadID -> FilePath
headPath :: FilePath -> HeadTypeID -> HeadID -> FilePath
headPath FilePath
spath HeadTypeID
tid (HeadID UUID
hid) = FilePath -> HeadTypeID -> FilePath
headTypePath FilePath
spath HeadTypeID
tid FilePath -> FilePath -> FilePath
</> UUID -> FilePath
U.toString UUID
hid

loadHeads :: forall a m. MonadIO m => HeadType a => Storage -> m [Head a]
loadHeads :: forall a (m :: * -> *).
(MonadIO m, HeadType a) =>
Storage -> m [Head a]
loadHeads s :: Storage
s@(Storage { stBacking :: forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking = StorageDir { dirPath :: forall (c :: * -> *). StorageBacking c -> FilePath
dirPath = FilePath
spath }}) = IO [Head a] -> m [Head a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Head a] -> m [Head a]) -> IO [Head a] -> m [Head a]
forall a b. (a -> b) -> a -> b
$ do
    let hpath :: FilePath
hpath = FilePath -> HeadTypeID -> FilePath
headTypePath FilePath
spath (HeadTypeID -> FilePath) -> HeadTypeID -> FilePath
forall a b. (a -> b) -> a -> b
$ forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy

    [FilePath]
files <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
hpath FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
        (IOError -> Maybe ())
-> (() -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust (\IOError
e -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (IOError -> Bool
isDoesNotExistError IOError
e)) (IO [FilePath] -> () -> IO [FilePath]
forall a b. a -> b -> a
const (IO [FilePath] -> () -> IO [FilePath])
-> IO [FilePath] -> () -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
        (FilePath -> IO [FilePath]
getDirectoryContents FilePath
hpath)
    ([Maybe (Head a)] -> [Head a])
-> IO [Maybe (Head a)] -> IO [Head a]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe (Head a)] -> [Head a]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe (Head a)] -> IO [Head a])
-> IO [Maybe (Head a)] -> IO [Head a]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> (FilePath -> IO (Maybe (Head a))) -> IO [Maybe (Head a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
files ((FilePath -> IO (Maybe (Head a))) -> IO [Maybe (Head a)])
-> (FilePath -> IO (Maybe (Head a))) -> IO [Maybe (Head a)]
forall a b. (a -> b) -> a -> b
$ \FilePath
hname -> do
        case FilePath -> Maybe UUID
U.fromString FilePath
hname of
             Just UUID
hid -> do
                 (ByteString
h:[ByteString]
_) <- ByteString -> [ByteString]
BC.lines (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile (FilePath
hpath FilePath -> FilePath -> FilePath
</> FilePath
hname)
                 Just Ref
ref <- Storage -> ByteString -> IO (Maybe Ref)
readRef Storage
s ByteString
h
                 Maybe (Head a) -> IO (Maybe (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Head a) -> IO (Maybe (Head a)))
-> Maybe (Head a) -> IO (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just (Head a -> Maybe (Head a)) -> Head a -> Maybe (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head (UUID -> HeadID
HeadID UUID
hid) (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
ref
             Maybe UUID
Nothing -> Maybe (Head a) -> IO (Maybe (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Head a)
forall a. Maybe a
Nothing
loadHeads Storage { stBacking :: forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking = StorageMemory { memHeads :: forall (c :: * -> *).
StorageBacking c -> MVar [((HeadTypeID, HeadID), Ref' c)]
memHeads = MVar [((HeadTypeID, HeadID), Ref)]
theads } } = IO [Head a] -> m [Head a]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Head a] -> m [Head a]) -> IO [Head a] -> m [Head a]
forall a b. (a -> b) -> a -> b
$ do
    let toHead :: ((HeadTypeID, HeadID), Ref) -> Maybe (Head a)
toHead ((HeadTypeID
tid, HeadID
hid), Ref
ref) | HeadTypeID
tid HeadTypeID -> HeadTypeID -> Bool
forall a. Eq a => a -> a -> Bool
== forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy = Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just (Head a -> Maybe (Head a)) -> Head a -> Maybe (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
ref
                                 | Bool
otherwise                  = Maybe (Head a)
forall a. Maybe a
Nothing
    [Maybe (Head a)] -> [Head a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Head a)] -> [Head a])
-> ([((HeadTypeID, HeadID), Ref)] -> [Maybe (Head a)])
-> [((HeadTypeID, HeadID), Ref)]
-> [Head a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((HeadTypeID, HeadID), Ref) -> Maybe (Head a))
-> [((HeadTypeID, HeadID), Ref)] -> [Maybe (Head a)]
forall a b. (a -> b) -> [a] -> [b]
map ((HeadTypeID, HeadID), Ref) -> Maybe (Head a)
toHead ([((HeadTypeID, HeadID), Ref)] -> [Head a])
-> IO [((HeadTypeID, HeadID), Ref)] -> IO [Head a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [((HeadTypeID, HeadID), Ref)]
-> IO [((HeadTypeID, HeadID), Ref)]
forall a. MVar a -> IO a
readMVar MVar [((HeadTypeID, HeadID), Ref)]
theads

loadHead :: forall a m. (HeadType a, MonadIO m) => Storage -> HeadID -> m (Maybe (Head a))
loadHead :: forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Storage -> HeadID -> m (Maybe (Head a))
loadHead s :: Storage
s@(Storage { stBacking :: forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking = StorageDir { dirPath :: forall (c :: * -> *). StorageBacking c -> FilePath
dirPath = FilePath
spath }}) HeadID
hid = IO (Maybe (Head a)) -> m (Maybe (Head a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Head a)) -> m (Maybe (Head a)))
-> IO (Maybe (Head a)) -> m (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ do
    (IOError -> Maybe ())
-> (() -> IO (Maybe (Head a)))
-> IO (Maybe (Head a))
-> IO (Maybe (Head a))
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> Bool
isDoesNotExistError) (IO (Maybe (Head a)) -> () -> IO (Maybe (Head a))
forall a b. a -> b -> a
const (IO (Maybe (Head a)) -> () -> IO (Maybe (Head a)))
-> IO (Maybe (Head a)) -> () -> IO (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ Maybe (Head a) -> IO (Maybe (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Head a)
forall a. Maybe a
Nothing) (IO (Maybe (Head a)) -> IO (Maybe (Head a)))
-> IO (Maybe (Head a)) -> IO (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ do
        (ByteString
h:[ByteString]
_) <- ByteString -> [ByteString]
BC.lines (ByteString -> [ByteString]) -> IO ByteString -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile (FilePath -> HeadTypeID -> HeadID -> FilePath
headPath FilePath
spath (forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy) HeadID
hid)
        Just Ref
ref <- Storage -> ByteString -> IO (Maybe Ref)
readRef Storage
s ByteString
h
        Maybe (Head a) -> IO (Maybe (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Head a) -> IO (Maybe (Head a)))
-> Maybe (Head a) -> IO (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just (Head a -> Maybe (Head a)) -> Head a -> Maybe (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
ref
loadHead Storage { stBacking :: forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking = StorageMemory { memHeads :: forall (c :: * -> *).
StorageBacking c -> MVar [((HeadTypeID, HeadID), Ref' c)]
memHeads = MVar [((HeadTypeID, HeadID), Ref)]
theads } } HeadID
hid = IO (Maybe (Head a)) -> m (Maybe (Head a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Head a)) -> m (Maybe (Head a)))
-> IO (Maybe (Head a)) -> m (Maybe (Head a))
forall a b. (a -> b) -> a -> b
$ do
    (Ref -> Head a) -> Maybe Ref -> Maybe (Head a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a)
-> (Ref -> Stored' Complete a) -> Ref -> Head a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad) (Maybe Ref -> Maybe (Head a))
-> ([((HeadTypeID, HeadID), Ref)] -> Maybe Ref)
-> [((HeadTypeID, HeadID), Ref)]
-> Maybe (Head a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeadTypeID, HeadID) -> [((HeadTypeID, HeadID), Ref)] -> Maybe Ref
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy, HeadID
hid) ([((HeadTypeID, HeadID), Ref)] -> Maybe (Head a))
-> IO [((HeadTypeID, HeadID), Ref)] -> IO (Maybe (Head a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [((HeadTypeID, HeadID), Ref)]
-> IO [((HeadTypeID, HeadID), Ref)]
forall a. MVar a -> IO a
readMVar MVar [((HeadTypeID, HeadID), Ref)]
theads

reloadHead :: (HeadType a, MonadIO m) => Head a -> m (Maybe (Head a))
reloadHead :: forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Head a -> m (Maybe (Head a))
reloadHead (Head HeadID
hid (Stored (Ref Storage
st RefDigest
_) a
_)) = Storage -> HeadID -> m (Maybe (Head' Complete a))
forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Storage -> HeadID -> m (Maybe (Head a))
loadHead Storage
st HeadID
hid

storeHead :: forall a m. MonadIO m => HeadType a => Storage -> a -> m (Head a)
storeHead :: forall a (m :: * -> *).
(MonadIO m, HeadType a) =>
Storage -> a -> m (Head a)
storeHead Storage
st a
obj = IO (Head a) -> m (Head a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Head a) -> m (Head a)) -> IO (Head a) -> m (Head a)
forall a b. (a -> b) -> a -> b
$ do
    let tid :: HeadTypeID
tid = forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy
    HeadID
hid <- UUID -> HeadID
HeadID (UUID -> HeadID) -> IO UUID -> IO HeadID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
U.nextRandom
    Stored a
stored <- Storage -> a -> IO (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
obj
    case Storage -> StorageBacking Complete
forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking Storage
st of
         StorageDir { dirPath :: forall (c :: * -> *). StorageBacking c -> FilePath
dirPath = FilePath
spath } -> do
             Right () <- FilePath
-> Maybe ByteString
-> ByteString
-> IO (Either (Maybe ByteString) ())
writeFileChecked (FilePath -> HeadTypeID -> HeadID -> FilePath
headPath FilePath
spath HeadTypeID
tid HeadID
hid) Maybe ByteString
forall a. Maybe a
Nothing (ByteString -> IO (Either (Maybe ByteString) ()))
-> ByteString -> IO (Either (Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$
                 Ref -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef (Stored a -> Ref
forall a. Stored a -> Ref
storedRef Stored a
stored) ByteString -> ByteString -> ByteString
`B.append` Char -> ByteString
BC.singleton Char
'\n'
             () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         StorageMemory { memHeads :: forall (c :: * -> *).
StorageBacking c -> MVar [((HeadTypeID, HeadID), Ref' c)]
memHeads = MVar [((HeadTypeID, HeadID), Ref)]
theads } -> do
             MVar [((HeadTypeID, HeadID), Ref)]
-> ([((HeadTypeID, HeadID), Ref)]
    -> IO [((HeadTypeID, HeadID), Ref)])
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [((HeadTypeID, HeadID), Ref)]
theads (([((HeadTypeID, HeadID), Ref)]
  -> IO [((HeadTypeID, HeadID), Ref)])
 -> IO ())
-> ([((HeadTypeID, HeadID), Ref)]
    -> IO [((HeadTypeID, HeadID), Ref)])
-> IO ()
forall a b. (a -> b) -> a -> b
$ [((HeadTypeID, HeadID), Ref)] -> IO [((HeadTypeID, HeadID), Ref)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([((HeadTypeID, HeadID), Ref)] -> IO [((HeadTypeID, HeadID), Ref)])
-> ([((HeadTypeID, HeadID), Ref)] -> [((HeadTypeID, HeadID), Ref)])
-> [((HeadTypeID, HeadID), Ref)]
-> IO [((HeadTypeID, HeadID), Ref)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((HeadTypeID
tid, HeadID
hid), Stored a -> Ref
forall a. Stored a -> Ref
storedRef Stored a
stored) ((HeadTypeID, HeadID), Ref)
-> [((HeadTypeID, HeadID), Ref)] -> [((HeadTypeID, HeadID), Ref)]
forall a. a -> [a] -> [a]
:)
    Head a -> IO (Head a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Head a -> IO (Head a)) -> Head a -> IO (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid Stored a
stored

replaceHead :: forall a m. (HeadType a, MonadIO m) => Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
replaceHead :: forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
replaceHead prev :: Head a
prev@(Head HeadID
hid Stored' Complete a
pobj) Stored' Complete a
stored' = IO (Either (Maybe (Head a)) (Head a))
-> m (Either (Maybe (Head a)) (Head a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (Maybe (Head a)) (Head a))
 -> m (Either (Maybe (Head a)) (Head a)))
-> IO (Either (Maybe (Head a)) (Head a))
-> m (Either (Maybe (Head a)) (Head a))
forall a b. (a -> b) -> a -> b
$ do
    let st :: Storage
st = Head a -> Storage
forall a. Head a -> Storage
headStorage Head a
prev
        tid :: HeadTypeID
tid = forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy
    Stored' Complete a
stored <- Storage
-> Stored' Complete a
-> IO (LoadResult Complete (Stored' Complete a))
forall (c :: * -> *) (c' :: * -> *) (m :: * -> *) a.
(StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a))
copyStored Storage
st Stored' Complete a
stored'
    case Storage -> StorageBacking Complete
forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking Storage
st of
         StorageDir { dirPath :: forall (c :: * -> *). StorageBacking c -> FilePath
dirPath = FilePath
spath } -> do
             let filename :: FilePath
filename = FilePath -> HeadTypeID -> HeadID -> FilePath
headPath FilePath
spath HeadTypeID
tid HeadID
hid
                 showRefL :: Ref' c -> ByteString
showRefL Ref' c
r = Ref' c -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref' c
r ByteString -> ByteString -> ByteString
`B.append` Char -> ByteString
BC.singleton Char
'\n'

             FilePath
-> Maybe ByteString
-> ByteString
-> IO (Either (Maybe ByteString) ())
writeFileChecked FilePath
filename (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Ref -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRefL (Ref -> ByteString) -> Ref -> ByteString
forall a b. (a -> b) -> a -> b
$ Head a -> Ref
forall a. Head a -> Ref
headRef Head a
prev) (Ref -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRefL (Ref -> ByteString) -> Ref -> ByteString
forall a b. (a -> b) -> a -> b
$ Stored' Complete a -> Ref
forall a. Stored a -> Ref
storedRef Stored' Complete a
stored) IO (Either (Maybe ByteString) ())
-> (Either (Maybe ByteString) ()
    -> IO (Either (Maybe (Head a)) (Head a)))
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                 Left Maybe ByteString
Nothing -> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe (Head a)) (Head a)
 -> IO (Either (Maybe (Head a)) (Head a)))
-> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. (a -> b) -> a -> b
$ Maybe (Head a) -> Either (Maybe (Head a)) (Head a)
forall a b. a -> Either a b
Left Maybe (Head a)
forall a. Maybe a
Nothing
                 Left (Just ByteString
bs) -> do Just Ref
oref <- Storage -> ByteString -> IO (Maybe Ref)
readRef Storage
st (ByteString -> IO (Maybe Ref)) -> ByteString -> IO (Maybe Ref)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BC.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\n') ByteString
bs
                                      Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe (Head a)) (Head a)
 -> IO (Either (Maybe (Head a)) (Head a)))
-> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. (a -> b) -> a -> b
$ Maybe (Head a) -> Either (Maybe (Head a)) (Head a)
forall a b. a -> Either a b
Left (Maybe (Head a) -> Either (Maybe (Head a)) (Head a))
-> Maybe (Head a) -> Either (Maybe (Head a)) (Head a)
forall a b. (a -> b) -> a -> b
$ Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just (Head a -> Maybe (Head a)) -> Head a -> Maybe (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
oref
                 Right () -> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe (Head a)) (Head a)
 -> IO (Either (Maybe (Head a)) (Head a)))
-> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. (a -> b) -> a -> b
$ Head a -> Either (Maybe (Head a)) (Head a)
forall a b. b -> Either a b
Right (Head a -> Either (Maybe (Head a)) (Head a))
-> Head a -> Either (Maybe (Head a)) (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid Stored' Complete a
stored

         StorageMemory { memHeads :: forall (c :: * -> *).
StorageBacking c -> MVar [((HeadTypeID, HeadID), Ref' c)]
memHeads = MVar [((HeadTypeID, HeadID), Ref)]
theads, memWatchers :: forall (c :: * -> *). StorageBacking c -> MVar (WatchList c)
memWatchers = MVar (WatchList Complete)
twatch } -> do
             Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
res <- MVar [((HeadTypeID, HeadID), Ref)]
-> ([((HeadTypeID, HeadID), Ref)]
    -> IO
         ([((HeadTypeID, HeadID), Ref)],
          Either (Maybe (Head a)) (Head a, [Ref -> IO ()])))
-> IO (Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar [((HeadTypeID, HeadID), Ref)]
theads (([((HeadTypeID, HeadID), Ref)]
  -> IO
       ([((HeadTypeID, HeadID), Ref)],
        Either (Maybe (Head a)) (Head a, [Ref -> IO ()])))
 -> IO (Either (Maybe (Head a)) (Head a, [Ref -> IO ()])))
-> ([((HeadTypeID, HeadID), Ref)]
    -> IO
         ([((HeadTypeID, HeadID), Ref)],
          Either (Maybe (Head a)) (Head a, [Ref -> IO ()])))
-> IO (Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
forall a b. (a -> b) -> a -> b
$ \[((HeadTypeID, HeadID), Ref)]
hs -> do
                 [Ref -> IO ()]
ws <- (WatchListItem Complete -> Ref -> IO ())
-> [WatchListItem Complete] -> [Ref -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map WatchListItem Complete -> Ref -> IO ()
forall (c :: * -> *). WatchListItem c -> Ref' c -> IO ()
wlFun ([WatchListItem Complete] -> [Ref -> IO ()])
-> (WatchList Complete -> [WatchListItem Complete])
-> WatchList Complete
-> [Ref -> IO ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WatchListItem Complete -> Bool)
-> [WatchListItem Complete] -> [WatchListItem Complete]
forall a. (a -> Bool) -> [a] -> [a]
filter (((HeadTypeID, HeadID) -> (HeadTypeID, HeadID) -> Bool
forall a. Eq a => a -> a -> Bool
==(HeadTypeID
tid, HeadID
hid)) ((HeadTypeID, HeadID) -> Bool)
-> (WatchListItem Complete -> (HeadTypeID, HeadID))
-> WatchListItem Complete
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchListItem Complete -> (HeadTypeID, HeadID)
forall (c :: * -> *). WatchListItem c -> (HeadTypeID, HeadID)
wlHead) ([WatchListItem Complete] -> [WatchListItem Complete])
-> (WatchList Complete -> [WatchListItem Complete])
-> WatchList Complete
-> [WatchListItem Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchList Complete -> [WatchListItem Complete]
forall (c :: * -> *). WatchList c -> [WatchListItem c]
wlList (WatchList Complete -> [Ref -> IO ()])
-> IO (WatchList Complete) -> IO [Ref -> IO ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar (WatchList Complete) -> IO (WatchList Complete)
forall a. MVar a -> IO a
readMVar MVar (WatchList Complete)
twatch
                 ([((HeadTypeID, HeadID), Ref)],
 Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
-> IO
     ([((HeadTypeID, HeadID), Ref)],
      Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([((HeadTypeID, HeadID), Ref)],
  Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
 -> IO
      ([((HeadTypeID, HeadID), Ref)],
       Either (Maybe (Head a)) (Head a, [Ref -> IO ()])))
-> ([((HeadTypeID, HeadID), Ref)],
    Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
-> IO
     ([((HeadTypeID, HeadID), Ref)],
      Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
forall a b. (a -> b) -> a -> b
$ case (((HeadTypeID, HeadID), Ref) -> Bool)
-> [((HeadTypeID, HeadID), Ref)]
-> ([((HeadTypeID, HeadID), Ref)], [((HeadTypeID, HeadID), Ref)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (((HeadTypeID, HeadID) -> (HeadTypeID, HeadID) -> Bool
forall a. Eq a => a -> a -> Bool
==(HeadTypeID
tid, HeadID
hid)) ((HeadTypeID, HeadID) -> Bool)
-> (((HeadTypeID, HeadID), Ref) -> (HeadTypeID, HeadID))
-> ((HeadTypeID, HeadID), Ref)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeadTypeID, HeadID), Ref) -> (HeadTypeID, HeadID)
forall a b. (a, b) -> a
fst) [((HeadTypeID, HeadID), Ref)]
hs of
                     ([] , [((HeadTypeID, HeadID), Ref)]
_  ) -> ([((HeadTypeID, HeadID), Ref)]
hs, Maybe (Head a) -> Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
forall a b. a -> Either a b
Left Maybe (Head a)
forall a. Maybe a
Nothing)
                     (((HeadTypeID, HeadID)
_, Ref
r):[((HeadTypeID, HeadID), Ref)]
_, [((HeadTypeID, HeadID), Ref)]
hs') | Ref
r Ref -> Ref -> Bool
forall a. Eq a => a -> a -> Bool
== Stored' Complete a -> Ref
forall a. Stored a -> Ref
storedRef Stored' Complete a
pobj -> (((HeadTypeID
tid, HeadID
hid), Stored' Complete a -> Ref
forall a. Stored a -> Ref
storedRef Stored' Complete a
stored) ((HeadTypeID, HeadID), Ref)
-> [((HeadTypeID, HeadID), Ref)] -> [((HeadTypeID, HeadID), Ref)]
forall a. a -> [a] -> [a]
: [((HeadTypeID, HeadID), Ref)]
hs',
                                                                  (Head a, [Ref -> IO ()])
-> Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
forall a b. b -> Either a b
Right (HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid Stored' Complete a
stored, [Ref -> IO ()]
ws))
                                     | Bool
otherwise -> ([((HeadTypeID, HeadID), Ref)]
hs, Maybe (Head a) -> Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
forall a b. a -> Either a b
Left (Maybe (Head a)
 -> Either (Maybe (Head a)) (Head a, [Ref -> IO ()]))
-> Maybe (Head a)
-> Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
forall a b. (a -> b) -> a -> b
$ Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just (Head a -> Maybe (Head a)) -> Head a -> Maybe (Head a)
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
r)
             case Either (Maybe (Head a)) (Head a, [Ref -> IO ()])
res of
                  Right (Head a
h, [Ref -> IO ()]
ws) -> ((Ref -> IO ()) -> IO ()) -> [Ref -> IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Ref -> IO ()) -> Ref -> IO ()
forall a b. (a -> b) -> a -> b
$ Head a -> Ref
forall a. Head a -> Ref
headRef Head a
h) [Ref -> IO ()]
ws IO ()
-> IO (Either (Maybe (Head a)) (Head a))
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Head a -> Either (Maybe (Head a)) (Head a)
forall a b. b -> Either a b
Right Head a
h)
                  Left Maybe (Head a)
x -> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe (Head a)) (Head a)
 -> IO (Either (Maybe (Head a)) (Head a)))
-> Either (Maybe (Head a)) (Head a)
-> IO (Either (Maybe (Head a)) (Head a))
forall a b. (a -> b) -> a -> b
$ Maybe (Head a) -> Either (Maybe (Head a)) (Head a)
forall a b. a -> Either a b
Left Maybe (Head a)
x

updateHead :: (HeadType a, MonadIO m) => Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
updateHead :: forall a (m :: * -> *) b.
(HeadType a, MonadIO m) =>
Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
updateHead Head a
h Stored a -> m (Stored a, b)
f = do
    (Stored a
o, b
x) <- Stored a -> m (Stored a, b)
f (Stored a -> m (Stored a, b)) -> Stored a -> m (Stored a, b)
forall a b. (a -> b) -> a -> b
$ Head a -> Stored a
forall a. Head a -> Stored a
headStoredObject Head a
h
    Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Head a -> Stored a -> m (Either (Maybe (Head a)) (Head a))
replaceHead Head a
h Stored a
o m (Either (Maybe (Head a)) (Head a))
-> (Either (Maybe (Head a)) (Head a) -> m (Maybe (Head a), b))
-> m (Maybe (Head a), b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Head a
h' -> (Maybe (Head a), b) -> m (Maybe (Head a), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Head a -> Maybe (Head a)
forall a. a -> Maybe a
Just Head a
h', b
x)
        Left Maybe (Head a)
Nothing -> (Maybe (Head a), b) -> m (Maybe (Head a), b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Head a)
forall a. Maybe a
Nothing, b
x)
        Left (Just Head a
h') -> Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
forall a (m :: * -> *) b.
(HeadType a, MonadIO m) =>
Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
updateHead Head a
h' Stored a -> m (Stored a, b)
f

updateHead_ :: (HeadType a, MonadIO m) => Head a -> (Stored a -> m (Stored a)) -> m (Maybe (Head a))
updateHead_ :: forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Head a -> (Stored a -> m (Stored a)) -> m (Maybe (Head a))
updateHead_ Head a
h = ((Maybe (Head a), ()) -> Maybe (Head a))
-> m (Maybe (Head a), ()) -> m (Maybe (Head a))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Head a), ()) -> Maybe (Head a)
forall a b. (a, b) -> a
fst (m (Maybe (Head a), ()) -> m (Maybe (Head a)))
-> ((Stored a -> m (Stored a)) -> m (Maybe (Head a), ()))
-> (Stored a -> m (Stored a))
-> m (Maybe (Head a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Head a -> (Stored a -> m (Stored a, ())) -> m (Maybe (Head a), ())
forall a (m :: * -> *) b.
(HeadType a, MonadIO m) =>
Head a -> (Stored a -> m (Stored a, b)) -> m (Maybe (Head a), b)
updateHead Head a
h ((Stored a -> m (Stored a, ())) -> m (Maybe (Head a), ()))
-> ((Stored a -> m (Stored a)) -> Stored a -> m (Stored a, ()))
-> (Stored a -> m (Stored a))
-> m (Maybe (Head a), ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Stored a -> (Stored a, ())) -> m (Stored a) -> m (Stored a, ())
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,()) (m (Stored a) -> m (Stored a, ()))
-> (Stored a -> m (Stored a)) -> Stored a -> m (Stored a, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)


data WatchedHead = forall a. WatchedHead Storage WatchID (MVar a)

watchHead :: forall a. HeadType a => Head a -> (Head a -> IO ()) -> IO WatchedHead
watchHead :: forall a.
HeadType a =>
Head a -> (Head a -> IO ()) -> IO WatchedHead
watchHead Head a
h = Head a -> (Head a -> Head a) -> (Head a -> IO ()) -> IO WatchedHead
forall a b.
(HeadType a, Eq b) =>
Head a -> (Head a -> b) -> (b -> IO ()) -> IO WatchedHead
watchHeadWith Head a
h Head a -> Head a
forall a. a -> a
id

watchHeadWith :: forall a b. (HeadType a, Eq b) => Head a -> (Head a -> b) -> (b -> IO ()) -> IO WatchedHead
watchHeadWith :: forall a b.
(HeadType a, Eq b) =>
Head a -> (Head a -> b) -> (b -> IO ()) -> IO WatchedHead
watchHeadWith oh :: Head a
oh@(Head HeadID
hid (Stored (Ref Storage
st RefDigest
_) a
_)) Head a -> b
sel b -> IO ()
cb = do
    MVar b
memo <- IO (MVar b)
forall a. IO (MVar a)
newEmptyMVar
    let tid :: HeadTypeID
tid = forall a (proxy :: * -> *). HeadType a => proxy a -> HeadTypeID
headTypeID @a Proxy a
forall {k} (t :: k). Proxy t
Proxy
        addWatcher :: WatchList Complete -> (WatchList Complete, WatchedHead)
addWatcher WatchList Complete
wl = (WatchList Complete
wl', Storage -> WatchID -> MVar b -> WatchedHead
forall a. Storage -> WatchID -> MVar a -> WatchedHead
WatchedHead Storage
st (WatchList Complete -> WatchID
forall (c :: * -> *). WatchList c -> WatchID
wlNext WatchList Complete
wl) MVar b
memo)
            where wl' :: WatchList Complete
wl' = WatchList Complete
wl { wlNext = wlNext wl + 1
                           , wlList = WatchListItem
                               { wlID = wlNext wl
                               , wlHead = (tid, hid)
                               , wlFun = \Ref
r -> do
                                   let x :: b
x = Head a -> b
sel (Head a -> b) -> Head a -> b
forall a b. (a -> b) -> a -> b
$ HeadID -> Stored' Complete a -> Head a
forall (c :: * -> *) a. HeadID -> Stored' c a -> Head' c a
Head HeadID
hid (Stored' Complete a -> Head a) -> Stored' Complete a -> Head a
forall a b. (a -> b) -> a -> b
$ Ref -> Stored' Complete a
forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
r
                                   MVar b -> (b -> IO b) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar b
memo ((b -> IO b) -> IO ()) -> (b -> IO b) -> IO ()
forall a b. (a -> b) -> a -> b
$ \b
prev -> do
                                       Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
prev) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ b -> IO ()
cb b
x
                                       b -> IO b
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
                               } : wlList wl
                           }

    WatchedHead
watched <- case Storage -> StorageBacking Complete
forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking Storage
st of
         StorageDir { dirPath :: forall (c :: * -> *). StorageBacking c -> FilePath
dirPath = FilePath
spath, dirWatchers :: forall (c :: * -> *).
StorageBacking c -> MVar ([(HeadTypeID, INotify)], WatchList c)
dirWatchers = MVar ([(HeadTypeID, INotify)], WatchList Complete)
mvar } -> MVar ([(HeadTypeID, INotify)], WatchList Complete)
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead))
-> IO WatchedHead
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ([(HeadTypeID, INotify)], WatchList Complete)
mvar ((([(HeadTypeID, INotify)], WatchList Complete)
  -> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead))
 -> IO WatchedHead)
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead))
-> IO WatchedHead
forall a b. (a -> b) -> a -> b
$ \([(HeadTypeID, INotify)]
ilist, WatchList Complete
wl) -> do
             [(HeadTypeID, INotify)]
ilist' <- case HeadTypeID -> [(HeadTypeID, INotify)] -> Maybe INotify
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeadTypeID
tid [(HeadTypeID, INotify)]
ilist of
                 Just INotify
_ -> [(HeadTypeID, INotify)] -> IO [(HeadTypeID, INotify)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(HeadTypeID, INotify)]
ilist
                 Maybe INotify
Nothing -> do
                     INotify
inotify <- IO INotify
initINotify
                     IO WatchDescriptor -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO WatchDescriptor -> IO ()) -> IO WatchDescriptor -> IO ()
forall a b. (a -> b) -> a -> b
$ INotify
-> [EventVariety]
-> ByteString
-> (Event -> IO ())
-> IO WatchDescriptor
addWatch INotify
inotify [EventVariety
Move] (FilePath -> ByteString
BC.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> HeadTypeID -> FilePath
headTypePath FilePath
spath HeadTypeID
tid) ((Event -> IO ()) -> IO WatchDescriptor)
-> (Event -> IO ()) -> IO WatchDescriptor
forall a b. (a -> b) -> a -> b
$ \case
                         MovedIn { filePath :: Event -> ByteString
filePath = ByteString
fpath } | Just HeadID
ihid <- UUID -> HeadID
HeadID (UUID -> HeadID) -> Maybe UUID -> Maybe HeadID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe UUID
U.fromASCIIBytes ByteString
fpath -> do
                             forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Storage -> HeadID -> m (Maybe (Head a))
loadHead @a Storage
st HeadID
ihid IO (Maybe (Head a)) -> (Maybe (Head a) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                                 Just Head a
h -> ((Ref -> IO ()) -> IO ()) -> [Ref -> IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Ref -> IO ()) -> Ref -> IO ()
forall a b. (a -> b) -> a -> b
$ Head a -> Ref
forall a. Head a -> Ref
headRef Head a
h) ([Ref -> IO ()] -> IO ())
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> [Ref -> IO ()])
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WatchListItem Complete -> Ref -> IO ())
-> [WatchListItem Complete] -> [Ref -> IO ()]
forall a b. (a -> b) -> [a] -> [b]
map WatchListItem Complete -> Ref -> IO ()
forall (c :: * -> *). WatchListItem c -> Ref' c -> IO ()
wlFun ([WatchListItem Complete] -> [Ref -> IO ()])
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> [WatchListItem Complete])
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> [Ref -> IO ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WatchListItem Complete -> Bool)
-> [WatchListItem Complete] -> [WatchListItem Complete]
forall a. (a -> Bool) -> [a] -> [a]
filter (((HeadTypeID, HeadID) -> (HeadTypeID, HeadID) -> Bool
forall a. Eq a => a -> a -> Bool
== (HeadTypeID
tid, HeadID
ihid)) ((HeadTypeID, HeadID) -> Bool)
-> (WatchListItem Complete -> (HeadTypeID, HeadID))
-> WatchListItem Complete
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchListItem Complete -> (HeadTypeID, HeadID)
forall (c :: * -> *). WatchListItem c -> (HeadTypeID, HeadID)
wlHead) ([WatchListItem Complete] -> [WatchListItem Complete])
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> [WatchListItem Complete])
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> [WatchListItem Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchList Complete -> [WatchListItem Complete]
forall (c :: * -> *). WatchList c -> [WatchListItem c]
wlList (WatchList Complete -> [WatchListItem Complete])
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> WatchList Complete)
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> [WatchListItem Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(HeadTypeID, INotify)], WatchList Complete) -> WatchList Complete
forall a b. (a, b) -> b
snd (([(HeadTypeID, INotify)], WatchList Complete) -> IO ())
-> IO ([(HeadTypeID, INotify)], WatchList Complete) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MVar ([(HeadTypeID, INotify)], WatchList Complete)
-> IO ([(HeadTypeID, INotify)], WatchList Complete)
forall a. MVar a -> IO a
readMVar MVar ([(HeadTypeID, INotify)], WatchList Complete)
mvar
                                 Maybe (Head a)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                         Event
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     [(HeadTypeID, INotify)] -> IO [(HeadTypeID, INotify)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(HeadTypeID, INotify)] -> IO [(HeadTypeID, INotify)])
-> [(HeadTypeID, INotify)] -> IO [(HeadTypeID, INotify)]
forall a b. (a -> b) -> a -> b
$ (HeadTypeID
tid, INotify
inotify) (HeadTypeID, INotify)
-> [(HeadTypeID, INotify)] -> [(HeadTypeID, INotify)]
forall a. a -> [a] -> [a]
: [(HeadTypeID, INotify)]
ilist
             (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
-> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
 -> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead))
-> (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
-> IO (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
forall a b. (a -> b) -> a -> b
$ (WatchList Complete
 -> ([(HeadTypeID, INotify)], WatchList Complete))
-> (WatchList Complete, WatchedHead)
-> (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([(HeadTypeID, INotify)]
ilist',) ((WatchList Complete, WatchedHead)
 -> (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead))
-> (WatchList Complete, WatchedHead)
-> (([(HeadTypeID, INotify)], WatchList Complete), WatchedHead)
forall a b. (a -> b) -> a -> b
$ WatchList Complete -> (WatchList Complete, WatchedHead)
addWatcher WatchList Complete
wl

         StorageMemory { memWatchers :: forall (c :: * -> *). StorageBacking c -> MVar (WatchList c)
memWatchers = MVar (WatchList Complete)
mvar } -> MVar (WatchList Complete)
-> (WatchList Complete -> IO (WatchList Complete, WatchedHead))
-> IO WatchedHead
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar (WatchList Complete)
mvar ((WatchList Complete -> IO (WatchList Complete, WatchedHead))
 -> IO WatchedHead)
-> (WatchList Complete -> IO (WatchList Complete, WatchedHead))
-> IO WatchedHead
forall a b. (a -> b) -> a -> b
$ (WatchList Complete, WatchedHead)
-> IO (WatchList Complete, WatchedHead)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((WatchList Complete, WatchedHead)
 -> IO (WatchList Complete, WatchedHead))
-> (WatchList Complete -> (WatchList Complete, WatchedHead))
-> WatchList Complete
-> IO (WatchList Complete, WatchedHead)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchList Complete -> (WatchList Complete, WatchedHead)
addWatcher

    b
cur <- Head a -> b
sel (Head a -> b) -> (Maybe (Head a) -> Head a) -> Maybe (Head a) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Head a -> (Head a -> Head a) -> Maybe (Head a) -> Head a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Head a
oh Head a -> Head a
forall a. a -> a
id (Maybe (Head a) -> b) -> IO (Maybe (Head a)) -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Head a -> IO (Maybe (Head a))
forall a (m :: * -> *).
(HeadType a, MonadIO m) =>
Head a -> m (Maybe (Head a))
reloadHead Head a
oh
    b -> IO ()
cb b
cur
    MVar b -> b -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar b
memo b
cur

    WatchedHead -> IO WatchedHead
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WatchedHead
watched

unwatchHead :: WatchedHead -> IO ()
unwatchHead :: WatchedHead -> IO ()
unwatchHead (WatchedHead Storage
st WatchID
wid MVar a
_) = do
    let delWatcher :: WatchList Complete -> WatchList Complete
delWatcher WatchList Complete
wl = WatchList Complete
wl { wlList = filter ((/=wid) . wlID) $ wlList wl }
    case Storage -> StorageBacking Complete
forall (c :: * -> *). Storage' c -> StorageBacking c
stBacking Storage
st of
        StorageDir { dirWatchers :: forall (c :: * -> *).
StorageBacking c -> MVar ([(HeadTypeID, INotify)], WatchList c)
dirWatchers = MVar ([(HeadTypeID, INotify)], WatchList Complete)
mvar } -> MVar ([(HeadTypeID, INotify)], WatchList Complete)
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> IO ([(HeadTypeID, INotify)], WatchList Complete))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar ([(HeadTypeID, INotify)], WatchList Complete)
mvar ((([(HeadTypeID, INotify)], WatchList Complete)
  -> IO ([(HeadTypeID, INotify)], WatchList Complete))
 -> IO ())
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> IO ([(HeadTypeID, INotify)], WatchList Complete))
-> IO ()
forall a b. (a -> b) -> a -> b
$ ([(HeadTypeID, INotify)], WatchList Complete)
-> IO ([(HeadTypeID, INotify)], WatchList Complete)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (([(HeadTypeID, INotify)], WatchList Complete)
 -> IO ([(HeadTypeID, INotify)], WatchList Complete))
-> (([(HeadTypeID, INotify)], WatchList Complete)
    -> ([(HeadTypeID, INotify)], WatchList Complete))
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> IO ([(HeadTypeID, INotify)], WatchList Complete)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WatchList Complete -> WatchList Complete)
-> ([(HeadTypeID, INotify)], WatchList Complete)
-> ([(HeadTypeID, INotify)], WatchList Complete)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second WatchList Complete -> WatchList Complete
delWatcher
        StorageMemory { memWatchers :: forall (c :: * -> *). StorageBacking c -> MVar (WatchList c)
memWatchers = MVar (WatchList Complete)
mvar } -> MVar (WatchList Complete)
-> (WatchList Complete -> IO (WatchList Complete)) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar (WatchList Complete)
mvar ((WatchList Complete -> IO (WatchList Complete)) -> IO ())
-> (WatchList Complete -> IO (WatchList Complete)) -> IO ()
forall a b. (a -> b) -> a -> b
$ WatchList Complete -> IO (WatchList Complete)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WatchList Complete -> IO (WatchList Complete))
-> (WatchList Complete -> WatchList Complete)
-> WatchList Complete
-> IO (WatchList Complete)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WatchList Complete -> WatchList Complete
delWatcher


class Monad m => MonadStorage m where
    getStorage :: m Storage
    mstore :: Storable a => a -> m (Stored a)

    default mstore :: MonadIO m => Storable a => a -> m (Stored a)
    mstore a
x = do
        Storage
st <- m Storage
forall (m :: * -> *). MonadStorage m => m Storage
getStorage
        Storage -> a -> m (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
x

instance MonadIO m => MonadStorage (ReaderT Storage m) where
    getStorage :: ReaderT Storage m Storage
getStorage = ReaderT Storage m Storage
forall r (m :: * -> *). MonadReader r m => m r
ask

instance MonadIO m => MonadStorage (ReaderT (Head a) m) where
    getStorage :: ReaderT (Head a) m Storage
getStorage = (Head a -> Storage) -> ReaderT (Head a) m Storage
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Head a -> Storage) -> ReaderT (Head a) m Storage)
-> (Head a -> Storage) -> ReaderT (Head a) m Storage
forall a b. (a -> b) -> a -> b
$ Head a -> Storage
forall a. Head a -> Storage
headStorage


class Storable a where
    store' :: a -> Store
    load' :: Load a

    store :: StorageCompleteness c => Storage' c -> a -> IO (Ref' c)
    store Storage' c
st = Storage' c -> Store -> IO (Ref' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Store -> IO (Ref' c)
evalStore Storage' c
st (Store -> IO (Ref' c)) -> (a -> Store) -> a -> IO (Ref' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Store
forall a. Storable a => a -> Store
store'
    load :: Ref -> a
    load = Load a -> Ref -> a
forall a. Load a -> Ref -> a
evalLoad Load a
forall a. Storable a => Load a
load'

class Storable a => ZeroStorable a where
    fromZero :: Storage -> a

data Store = StoreBlob ByteString
           | StoreRec (forall c. StorageCompleteness c => Storage' c -> [IO [(ByteString, RecItem' c)]])
           | StoreZero

evalStore :: StorageCompleteness c => Storage' c -> Store -> IO (Ref' c)
evalStore :: forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Store -> IO (Ref' c)
evalStore Storage' c
st = Storage' c -> Object' c -> IO (Ref' c)
forall (c :: * -> *). Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject Storage' c
st (Object' c -> IO (Ref' c))
-> (Store -> IO (Object' c)) -> Store -> IO (Ref' c)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Storage' c -> Store -> IO (Object' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Store -> IO (Object' c)
evalStoreObject Storage' c
st

evalStoreObject :: StorageCompleteness c => Storage' c -> Store -> IO (Object' c)
evalStoreObject :: forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Store -> IO (Object' c)
evalStoreObject Storage' c
_ (StoreBlob ByteString
x) = Object' c -> IO (Object' c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Object' c -> IO (Object' c)) -> Object' c -> IO (Object' c)
forall a b. (a -> b) -> a -> b
$ ByteString -> Object' c
forall (c :: * -> *). ByteString -> Object' c
Blob ByteString
x
evalStoreObject Storage' c
s (StoreRec forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> [IO [(ByteString, RecItem' c)]]
f) = [(ByteString, RecItem' c)] -> Object' c
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec ([(ByteString, RecItem' c)] -> Object' c)
-> ([[(ByteString, RecItem' c)]] -> [(ByteString, RecItem' c)])
-> [[(ByteString, RecItem' c)]]
-> Object' c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(ByteString, RecItem' c)]] -> [(ByteString, RecItem' c)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ByteString, RecItem' c)]] -> Object' c)
-> IO [[(ByteString, RecItem' c)]] -> IO (Object' c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO [(ByteString, RecItem' c)]] -> IO [[(ByteString, RecItem' c)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (Storage' c -> [IO [(ByteString, RecItem' c)]]
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> [IO [(ByteString, RecItem' c)]]
f Storage' c
s)
evalStoreObject Storage' c
_ Store
StoreZero = Object' c -> IO (Object' c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Object' c
forall (c :: * -> *). Object' c
ZeroObject

newtype StoreRecM c a = StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a)
    deriving ((forall a b. (a -> b) -> StoreRecM c a -> StoreRecM c b)
-> (forall a b. a -> StoreRecM c b -> StoreRecM c a)
-> Functor (StoreRecM c)
forall a b. a -> StoreRecM c b -> StoreRecM c a
forall a b. (a -> b) -> StoreRecM c a -> StoreRecM c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (c :: * -> *) a b. a -> StoreRecM c b -> StoreRecM c a
forall (c :: * -> *) a b.
(a -> b) -> StoreRecM c a -> StoreRecM c b
$cfmap :: forall (c :: * -> *) a b.
(a -> b) -> StoreRecM c a -> StoreRecM c b
fmap :: forall a b. (a -> b) -> StoreRecM c a -> StoreRecM c b
$c<$ :: forall (c :: * -> *) a b. a -> StoreRecM c b -> StoreRecM c a
<$ :: forall a b. a -> StoreRecM c b -> StoreRecM c a
Functor, Functor (StoreRecM c)
Functor (StoreRecM c) =>
(forall a. a -> StoreRecM c a)
-> (forall a b.
    StoreRecM c (a -> b) -> StoreRecM c a -> StoreRecM c b)
-> (forall a b c.
    (a -> b -> c) -> StoreRecM c a -> StoreRecM c b -> StoreRecM c c)
-> (forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b)
-> (forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c a)
-> Applicative (StoreRecM c)
forall a. a -> StoreRecM c a
forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c a
forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b
forall a b. StoreRecM c (a -> b) -> StoreRecM c a -> StoreRecM c b
forall a b c.
(a -> b -> c) -> StoreRecM c a -> StoreRecM c b -> StoreRecM c c
forall (c :: * -> *). Functor (StoreRecM c)
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (c :: * -> *) a. a -> StoreRecM c a
forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c a
forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c b
forall (c :: * -> *) a b.
StoreRecM c (a -> b) -> StoreRecM c a -> StoreRecM c b
forall (c :: * -> *) a b c.
(a -> b -> c) -> StoreRecM c a -> StoreRecM c b -> StoreRecM c c
$cpure :: forall (c :: * -> *) a. a -> StoreRecM c a
pure :: forall a. a -> StoreRecM c a
$c<*> :: forall (c :: * -> *) a b.
StoreRecM c (a -> b) -> StoreRecM c a -> StoreRecM c b
<*> :: forall a b. StoreRecM c (a -> b) -> StoreRecM c a -> StoreRecM c b
$cliftA2 :: forall (c :: * -> *) a b c.
(a -> b -> c) -> StoreRecM c a -> StoreRecM c b -> StoreRecM c c
liftA2 :: forall a b c.
(a -> b -> c) -> StoreRecM c a -> StoreRecM c b -> StoreRecM c c
$c*> :: forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c b
*> :: forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b
$c<* :: forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c a
<* :: forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c a
Applicative, Applicative (StoreRecM c)
Applicative (StoreRecM c) =>
(forall a b.
 StoreRecM c a -> (a -> StoreRecM c b) -> StoreRecM c b)
-> (forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b)
-> (forall a. a -> StoreRecM c a)
-> Monad (StoreRecM c)
forall a. a -> StoreRecM c a
forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b
forall a b. StoreRecM c a -> (a -> StoreRecM c b) -> StoreRecM c b
forall (c :: * -> *). Applicative (StoreRecM c)
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (c :: * -> *) a. a -> StoreRecM c a
forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c b
forall (c :: * -> *) a b.
StoreRecM c a -> (a -> StoreRecM c b) -> StoreRecM c b
$c>>= :: forall (c :: * -> *) a b.
StoreRecM c a -> (a -> StoreRecM c b) -> StoreRecM c b
>>= :: forall a b. StoreRecM c a -> (a -> StoreRecM c b) -> StoreRecM c b
$c>> :: forall (c :: * -> *) a b.
StoreRecM c a -> StoreRecM c b -> StoreRecM c b
>> :: forall a b. StoreRecM c a -> StoreRecM c b -> StoreRecM c b
$creturn :: forall (c :: * -> *) a. a -> StoreRecM c a
return :: forall a. a -> StoreRecM c a
Monad)

type StoreRec c = StoreRecM c ()

newtype Load a = Load (ReaderT (Ref, Object) (Except String) a)
    deriving ((forall a b. (a -> b) -> Load a -> Load b)
-> (forall a b. a -> Load b -> Load a) -> Functor Load
forall a b. a -> Load b -> Load a
forall a b. (a -> b) -> Load a -> Load b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Load a -> Load b
fmap :: forall a b. (a -> b) -> Load a -> Load b
$c<$ :: forall a b. a -> Load b -> Load a
<$ :: forall a b. a -> Load b -> Load a
Functor, Functor Load
Functor Load =>
(forall a. a -> Load a)
-> (forall a b. Load (a -> b) -> Load a -> Load b)
-> (forall a b c. (a -> b -> c) -> Load a -> Load b -> Load c)
-> (forall a b. Load a -> Load b -> Load b)
-> (forall a b. Load a -> Load b -> Load a)
-> Applicative Load
forall a. a -> Load a
forall a b. Load a -> Load b -> Load a
forall a b. Load a -> Load b -> Load b
forall a b. Load (a -> b) -> Load a -> Load b
forall a b c. (a -> b -> c) -> Load a -> Load b -> Load c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Load a
pure :: forall a. a -> Load a
$c<*> :: forall a b. Load (a -> b) -> Load a -> Load b
<*> :: forall a b. Load (a -> b) -> Load a -> Load b
$cliftA2 :: forall a b c. (a -> b -> c) -> Load a -> Load b -> Load c
liftA2 :: forall a b c. (a -> b -> c) -> Load a -> Load b -> Load c
$c*> :: forall a b. Load a -> Load b -> Load b
*> :: forall a b. Load a -> Load b -> Load b
$c<* :: forall a b. Load a -> Load b -> Load a
<* :: forall a b. Load a -> Load b -> Load a
Applicative, Applicative Load
Applicative Load =>
(forall a. Load a)
-> (forall a. Load a -> Load a -> Load a)
-> (forall a. Load a -> Load [a])
-> (forall a. Load a -> Load [a])
-> Alternative Load
forall a. Load a
forall a. Load a -> Load [a]
forall a. Load a -> Load a -> Load a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. Load a
empty :: forall a. Load a
$c<|> :: forall a. Load a -> Load a -> Load a
<|> :: forall a. Load a -> Load a -> Load a
$csome :: forall a. Load a -> Load [a]
some :: forall a. Load a -> Load [a]
$cmany :: forall a. Load a -> Load [a]
many :: forall a. Load a -> Load [a]
Alternative, Applicative Load
Applicative Load =>
(forall a b. Load a -> (a -> Load b) -> Load b)
-> (forall a b. Load a -> Load b -> Load b)
-> (forall a. a -> Load a)
-> Monad Load
forall a. a -> Load a
forall a b. Load a -> Load b -> Load b
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Load a -> (a -> Load b) -> Load b
>>= :: forall a b. Load a -> (a -> Load b) -> Load b
$c>> :: forall a b. Load a -> Load b -> Load b
>> :: forall a b. Load a -> Load b -> Load b
$creturn :: forall a. a -> Load a
return :: forall a. a -> Load a
Monad, Monad Load
Alternative Load
(Alternative Load, Monad Load) =>
(forall a. Load a)
-> (forall a. Load a -> Load a -> Load a) -> MonadPlus Load
forall a. Load a
forall a. Load a -> Load a -> Load a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall a. Load a
mzero :: forall a. Load a
$cmplus :: forall a. Load a -> Load a -> Load a
mplus :: forall a. Load a -> Load a -> Load a
MonadPlus, MonadError String)

evalLoad :: Load a -> Ref -> a
evalLoad :: forall a. Load a -> Ref -> a
evalLoad (Load ReaderT (Ref, Object) (ExceptT FilePath Complete) a
f) Ref
ref = (FilePath -> a) -> (a -> a) -> Either FilePath a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> a
forall a. HasCallStack => FilePath -> a
error {- TODO throw -} (FilePath -> a) -> (FilePath -> FilePath) -> FilePath -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> FilePath
BC.unpack (Ref -> ByteString
forall (c :: * -> *). Ref' c -> ByteString
showRef Ref
ref) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": ")FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++)) a -> a
forall a. a -> a
id (Either FilePath a -> a) -> Either FilePath a -> a
forall a b. (a -> b) -> a -> b
$ Except FilePath a -> Either FilePath a
forall e a. Except e a -> Either e a
runExcept (Except FilePath a -> Either FilePath a)
-> Except FilePath a -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ ReaderT (Ref, Object) (ExceptT FilePath Complete) a
-> (Ref, Object) -> Except FilePath a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Ref, Object) (ExceptT FilePath Complete) a
f (Ref
ref, Ref -> LoadResult Complete Object
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c (Object' c)
lazyLoadObject Ref
ref)

loadCurrentRef :: Load Ref
loadCurrentRef :: Load Ref
loadCurrentRef = ReaderT (Ref, Object) (ExceptT FilePath Complete) Ref -> Load Ref
forall a.
ReaderT (Ref, Object) (ExceptT FilePath Complete) a -> Load a
Load (ReaderT (Ref, Object) (ExceptT FilePath Complete) Ref -> Load Ref)
-> ReaderT (Ref, Object) (ExceptT FilePath Complete) Ref
-> Load Ref
forall a b. (a -> b) -> a -> b
$ ((Ref, Object) -> Ref)
-> ReaderT (Ref, Object) (ExceptT FilePath Complete) Ref
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ref, Object) -> Ref
forall a b. (a, b) -> a
fst

loadCurrentObject :: Load Object
loadCurrentObject :: Load Object
loadCurrentObject = ReaderT (Ref, Object) (ExceptT FilePath Complete) Object
-> Load Object
forall a.
ReaderT (Ref, Object) (ExceptT FilePath Complete) a -> Load a
Load (ReaderT (Ref, Object) (ExceptT FilePath Complete) Object
 -> Load Object)
-> ReaderT (Ref, Object) (ExceptT FilePath Complete) Object
-> Load Object
forall a b. (a -> b) -> a -> b
$ ((Ref, Object) -> Object)
-> ReaderT (Ref, Object) (ExceptT FilePath Complete) Object
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ref, Object) -> Object
forall a b. (a, b) -> b
snd

newtype LoadRec a = LoadRec (ReaderT (Ref, [(ByteString, RecItem)]) (Except String) a)
    deriving ((forall a b. (a -> b) -> LoadRec a -> LoadRec b)
-> (forall a b. a -> LoadRec b -> LoadRec a) -> Functor LoadRec
forall a b. a -> LoadRec b -> LoadRec a
forall a b. (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LoadRec a -> LoadRec b
fmap :: forall a b. (a -> b) -> LoadRec a -> LoadRec b
$c<$ :: forall a b. a -> LoadRec b -> LoadRec a
<$ :: forall a b. a -> LoadRec b -> LoadRec a
Functor, Functor LoadRec
Functor LoadRec =>
(forall a. a -> LoadRec a)
-> (forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b)
-> (forall a b c.
    (a -> b -> c) -> LoadRec a -> LoadRec b -> LoadRec c)
-> (forall a b. LoadRec a -> LoadRec b -> LoadRec b)
-> (forall a b. LoadRec a -> LoadRec b -> LoadRec a)
-> Applicative LoadRec
forall a. a -> LoadRec a
forall a b. LoadRec a -> LoadRec b -> LoadRec a
forall a b. LoadRec a -> LoadRec b -> LoadRec b
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall a b c. (a -> b -> c) -> LoadRec a -> LoadRec b -> LoadRec c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> LoadRec a
pure :: forall a. a -> LoadRec a
$c<*> :: forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
<*> :: forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
$cliftA2 :: forall a b c. (a -> b -> c) -> LoadRec a -> LoadRec b -> LoadRec c
liftA2 :: forall a b c. (a -> b -> c) -> LoadRec a -> LoadRec b -> LoadRec c
$c*> :: forall a b. LoadRec a -> LoadRec b -> LoadRec b
*> :: forall a b. LoadRec a -> LoadRec b -> LoadRec b
$c<* :: forall a b. LoadRec a -> LoadRec b -> LoadRec a
<* :: forall a b. LoadRec a -> LoadRec b -> LoadRec a
Applicative, Applicative LoadRec
Applicative LoadRec =>
(forall a. LoadRec a)
-> (forall a. LoadRec a -> LoadRec a -> LoadRec a)
-> (forall a. LoadRec a -> LoadRec [a])
-> (forall a. LoadRec a -> LoadRec [a])
-> Alternative LoadRec
forall a. LoadRec a
forall a. LoadRec a -> LoadRec [a]
forall a. LoadRec a -> LoadRec a -> LoadRec a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall a. LoadRec a
empty :: forall a. LoadRec a
$c<|> :: forall a. LoadRec a -> LoadRec a -> LoadRec a
<|> :: forall a. LoadRec a -> LoadRec a -> LoadRec a
$csome :: forall a. LoadRec a -> LoadRec [a]
some :: forall a. LoadRec a -> LoadRec [a]
$cmany :: forall a. LoadRec a -> LoadRec [a]
many :: forall a. LoadRec a -> LoadRec [a]
Alternative, Applicative LoadRec
Applicative LoadRec =>
(forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b)
-> (forall a b. LoadRec a -> LoadRec b -> LoadRec b)
-> (forall a. a -> LoadRec a)
-> Monad LoadRec
forall a. a -> LoadRec a
forall a b. LoadRec a -> LoadRec b -> LoadRec b
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
>>= :: forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
$c>> :: forall a b. LoadRec a -> LoadRec b -> LoadRec b
>> :: forall a b. LoadRec a -> LoadRec b -> LoadRec b
$creturn :: forall a. a -> LoadRec a
return :: forall a. a -> LoadRec a
Monad, Monad LoadRec
Alternative LoadRec
(Alternative LoadRec, Monad LoadRec) =>
(forall a. LoadRec a)
-> (forall a. LoadRec a -> LoadRec a -> LoadRec a)
-> MonadPlus LoadRec
forall a. LoadRec a
forall a. LoadRec a -> LoadRec a -> LoadRec a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall a. LoadRec a
mzero :: forall a. LoadRec a
$cmplus :: forall a. LoadRec a -> LoadRec a -> LoadRec a
mplus :: forall a. LoadRec a -> LoadRec a -> LoadRec a
MonadPlus, MonadError String)

loadRecCurrentRef :: LoadRec Ref
loadRecCurrentRef :: LoadRec Ref
loadRecCurrentRef = ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  Ref
-> LoadRec Ref
forall a.
ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  a
-> LoadRec a
LoadRec (ReaderT
   (Ref, [(ByteString, RecItem' Complete)])
   (ExceptT FilePath Complete)
   Ref
 -> LoadRec Ref)
-> ReaderT
     (Ref, [(ByteString, RecItem' Complete)])
     (ExceptT FilePath Complete)
     Ref
-> LoadRec Ref
forall a b. (a -> b) -> a -> b
$ ((Ref, [(ByteString, RecItem' Complete)]) -> Ref)
-> ReaderT
     (Ref, [(ByteString, RecItem' Complete)])
     (ExceptT FilePath Complete)
     Ref
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ref, [(ByteString, RecItem' Complete)]) -> Ref
forall a b. (a, b) -> a
fst

loadRecItems :: LoadRec [(ByteString, RecItem)]
loadRecItems :: LoadRec [(ByteString, RecItem' Complete)]
loadRecItems = ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  [(ByteString, RecItem' Complete)]
-> LoadRec [(ByteString, RecItem' Complete)]
forall a.
ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  a
-> LoadRec a
LoadRec (ReaderT
   (Ref, [(ByteString, RecItem' Complete)])
   (ExceptT FilePath Complete)
   [(ByteString, RecItem' Complete)]
 -> LoadRec [(ByteString, RecItem' Complete)])
-> ReaderT
     (Ref, [(ByteString, RecItem' Complete)])
     (ExceptT FilePath Complete)
     [(ByteString, RecItem' Complete)]
-> LoadRec [(ByteString, RecItem' Complete)]
forall a b. (a -> b) -> a -> b
$ ((Ref, [(ByteString, RecItem' Complete)])
 -> [(ByteString, RecItem' Complete)])
-> ReaderT
     (Ref, [(ByteString, RecItem' Complete)])
     (ExceptT FilePath Complete)
     [(ByteString, RecItem' Complete)]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ref, [(ByteString, RecItem' Complete)])
-> [(ByteString, RecItem' Complete)]
forall a b. (a, b) -> b
snd


instance Storable Object where
    store' :: Object -> Store
store' (Blob ByteString
bs) = ByteString -> Store
StoreBlob ByteString
bs
    store' (Rec [(ByteString, RecItem' Complete)]
xs) = (forall (c :: * -> *).
 StorageCompleteness c =>
 Storage' c -> [IO [(ByteString, RecItem' c)]])
-> Store
StoreRec ((forall (c :: * -> *).
  StorageCompleteness c =>
  Storage' c -> [IO [(ByteString, RecItem' c)]])
 -> Store)
-> (forall (c :: * -> *).
    StorageCompleteness c =>
    Storage' c -> [IO [(ByteString, RecItem' c)]])
-> Store
forall a b. (a -> b) -> a -> b
$ \Storage' c
st -> IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]])
-> IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]]
forall a b. (a -> b) -> a -> b
$ do
        Rec [(ByteString, RecItem' c)]
xs' <- Storage' c -> Object -> IO (LoadResult Complete (Object' c))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (LoadResult c (Object' c'))
copyObject Storage' c
st ([(ByteString, RecItem' Complete)] -> Object
forall (c :: * -> *). [(ByteString, RecItem' c)] -> Object' c
Rec [(ByteString, RecItem' Complete)]
xs)
        [(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(ByteString, RecItem' c)]
xs'
    store' Object
ZeroObject = Store
StoreZero

    load' :: Load Object
load' = Load Object
loadCurrentObject

    store :: forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Object -> IO (Ref' c)
store Storage' c
st = Storage' c -> Object' c -> IO (Ref' c)
forall (c :: * -> *). Storage' c -> Object' c -> IO (Ref' c)
unsafeStoreObject Storage' c
st (Object' c -> IO (Ref' c))
-> (Object -> IO (Object' c)) -> Object -> IO (Ref' c)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Storage' c -> Object -> IO (LoadResult Complete (Object' c))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Object' c -> IO (LoadResult c (Object' c'))
copyObject Storage' c
st
    load :: Ref -> Object
load = Ref -> LoadResult Complete Object
Ref -> Object
forall (c :: * -> *).
StorageCompleteness c =>
Ref' c -> LoadResult c (Object' c)
lazyLoadObject

instance Storable ByteString where
    store' :: ByteString -> Store
store' = ByteString -> Store
storeBlob
    load' :: Load ByteString
load' = (ByteString -> ByteString) -> Load ByteString
forall a. (ByteString -> a) -> Load a
loadBlob ByteString -> ByteString
forall a. a -> a
id

instance Storable a => Storable [a] where
    store' :: [a] -> Store
store' []     = Store
storeZero
    store' (a
x:[a]
xs) = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeRef FilePath
"i" a
x
        FilePath -> [a] -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeRef FilePath
"n" [a]
xs

    load' :: Load [a]
load' = Load Object
loadCurrentObject Load Object -> (Object -> Load [a]) -> Load [a]
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Object
ZeroObject -> [a] -> Load [a]
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                Object
_          -> LoadRec [a] -> Load [a]
forall a. LoadRec a -> Load a
loadRec (LoadRec [a] -> Load [a]) -> LoadRec [a] -> Load [a]
forall a b. (a -> b) -> a -> b
$ (:)
                                  (a -> [a] -> [a]) -> LoadRec a -> LoadRec ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> LoadRec a
forall a. Storable a => FilePath -> LoadRec a
loadRef FilePath
"i"
                                  LoadRec ([a] -> [a]) -> LoadRec [a] -> LoadRec [a]
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> LoadRec [a]
forall a. Storable a => FilePath -> LoadRec a
loadRef FilePath
"n"

instance Storable a => ZeroStorable [a] where
    fromZero :: Storage -> [a]
fromZero Storage
_ = []


storeBlob :: ByteString -> Store
storeBlob :: ByteString -> Store
storeBlob = ByteString -> Store
StoreBlob

storeRec :: (forall c. StorageCompleteness c => StoreRec c) -> Store
storeRec :: (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec forall (c :: * -> *). StorageCompleteness c => StoreRec c
sr = (forall (c :: * -> *).
 StorageCompleteness c =>
 Storage' c -> [IO [(ByteString, RecItem' c)]])
-> Store
StoreRec ((forall (c :: * -> *).
  StorageCompleteness c =>
  Storage' c -> [IO [(ByteString, RecItem' c)]])
 -> Store)
-> (forall (c :: * -> *).
    StorageCompleteness c =>
    Storage' c -> [IO [(ByteString, RecItem' c)]])
-> Store
forall a b. (a -> b) -> a -> b
$ do
    let StoreRecM ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
r = StoreRecM c ()
forall (c :: * -> *). StorageCompleteness c => StoreRec c
sr
    Writer [IO [(ByteString, RecItem' c)]] ()
-> [IO [(ByteString, RecItem' c)]]
forall w a. Writer w a -> w
execWriter (Writer [IO [(ByteString, RecItem' c)]] ()
 -> [IO [(ByteString, RecItem' c)]])
-> (Storage' c -> Writer [IO [(ByteString, RecItem' c)]] ())
-> Storage' c
-> [IO [(ByteString, RecItem' c)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> Storage' c -> Writer [IO [(ByteString, RecItem' c)]] ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
r

storeZero :: Store
storeZero :: Store
storeZero = Store
StoreZero


class StorableText a where
    toText :: a -> Text
    fromText :: MonadError String m => Text -> m a

instance StorableText Text where
    toText :: Text -> Text
toText = Text -> Text
forall a. a -> a
id; fromText :: forall (m :: * -> *). MonadError FilePath m => Text -> m Text
fromText = Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance StorableText [Char] where
    toText :: FilePath -> Text
toText = FilePath -> Text
T.pack; fromText :: forall (m :: * -> *). MonadError FilePath m => Text -> m FilePath
fromText = FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> m FilePath)
-> (Text -> FilePath) -> Text -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack


class StorableDate a where
    toDate :: a -> ZonedTime
    fromDate :: ZonedTime -> a

instance StorableDate ZonedTime where
    toDate :: ZonedTime -> ZonedTime
toDate = ZonedTime -> ZonedTime
forall a. a -> a
id; fromDate :: ZonedTime -> ZonedTime
fromDate = ZonedTime -> ZonedTime
forall a. a -> a
id

instance StorableDate UTCTime where
    toDate :: UTCTime -> ZonedTime
toDate = TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
utc
    fromDate :: ZonedTime -> UTCTime
fromDate = ZonedTime -> UTCTime
zonedTimeToUTC

instance StorableDate Day where
    toDate :: Day -> ZonedTime
toDate Day
day = UTCTime -> ZonedTime
forall a. StorableDate a => a -> ZonedTime
toDate (UTCTime -> ZonedTime) -> UTCTime -> ZonedTime
forall a b. (a -> b) -> a -> b
$ Day -> DiffTime -> UTCTime
UTCTime Day
day DiffTime
0
    fromDate :: ZonedTime -> Day
fromDate = UTCTime -> Day
utctDay (UTCTime -> Day) -> (ZonedTime -> UTCTime) -> ZonedTime -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
forall a. StorableDate a => ZonedTime -> a
fromDate


class StorableUUID a where
    toUUID :: a -> UUID
    fromUUID :: UUID -> a

instance StorableUUID UUID where
    toUUID :: UUID -> UUID
toUUID = UUID -> UUID
forall a. a -> a
id; fromUUID :: UUID -> UUID
fromUUID = UUID -> UUID
forall a. a -> a
id


storeEmpty :: String -> StoreRec c
storeEmpty :: forall (c :: * -> *). FilePath -> StoreRec c
storeEmpty FilePath
name = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, RecItem' c
forall (c :: * -> *). RecItem' c
RecEmpty)]]

storeMbEmpty :: String -> Maybe () -> StoreRec c
storeMbEmpty :: forall (c :: * -> *). FilePath -> Maybe () -> StoreRec c
storeMbEmpty FilePath
name = StoreRec c -> (() -> StoreRec c) -> Maybe () -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (StoreRec c -> () -> StoreRec c
forall a b. a -> b -> a
const (StoreRec c -> () -> StoreRec c) -> StoreRec c -> () -> StoreRec c
forall a b. (a -> b) -> a -> b
$ FilePath -> StoreRec c
forall (c :: * -> *). FilePath -> StoreRec c
storeEmpty FilePath
name)

storeInt :: Integral a => String -> a -> StoreRec c
storeInt :: forall a (c :: * -> *). Integral a => FilePath -> a -> StoreRec c
storeInt FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, Integer -> RecItem' c
forall (c :: * -> *). Integer -> RecItem' c
RecInt (Integer -> RecItem' c) -> Integer -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x)]]

storeMbInt :: Integral a => String -> Maybe a -> StoreRec c
storeMbInt :: forall a (c :: * -> *).
Integral a =>
FilePath -> Maybe a -> StoreRec c
storeMbInt FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *). Integral a => FilePath -> a -> StoreRec c
storeInt FilePath
name)

storeNum :: (Real a, Fractional a) => String -> a -> StoreRec c
storeNum :: forall a (c :: * -> *).
(Real a, Fractional a) =>
FilePath -> a -> StoreRec c
storeNum FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, Rational -> RecItem' c
forall (c :: * -> *). Rational -> RecItem' c
RecNum (Rational -> RecItem' c) -> Rational -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> Rational
forall a. Real a => a -> Rational
toRational a
x)]]

storeMbNum :: (Real a, Fractional a) => String -> Maybe a -> StoreRec c
storeMbNum :: forall a (c :: * -> *).
(Real a, Fractional a) =>
FilePath -> Maybe a -> StoreRec c
storeMbNum FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
(Real a, Fractional a) =>
FilePath -> a -> StoreRec c
storeNum FilePath
name)

storeText :: StorableText a => String -> a -> StoreRec c
storeText :: forall a (c :: * -> *).
StorableText a =>
FilePath -> a -> StoreRec c
storeText FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, Text -> RecItem' c
forall (c :: * -> *). Text -> RecItem' c
RecText (Text -> RecItem' c) -> Text -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. StorableText a => a -> Text
toText a
x)]]

storeMbText :: StorableText a => String -> Maybe a -> StoreRec c
storeMbText :: forall a (c :: * -> *).
StorableText a =>
FilePath -> Maybe a -> StoreRec c
storeMbText FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
FilePath -> a -> StoreRec c
storeText FilePath
name)

storeBinary :: BA.ByteArrayAccess a => String -> a -> StoreRec c
storeBinary :: forall a (c :: * -> *).
ByteArrayAccess a =>
FilePath -> a -> StoreRec c
storeBinary FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, ByteString -> RecItem' c
forall (c :: * -> *). ByteString -> RecItem' c
RecBinary (ByteString -> RecItem' c) -> ByteString -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert a
x)]]

storeMbBinary :: BA.ByteArrayAccess a => String -> Maybe a -> StoreRec c
storeMbBinary :: forall a (c :: * -> *).
ByteArrayAccess a =>
FilePath -> Maybe a -> StoreRec c
storeMbBinary FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
ByteArrayAccess a =>
FilePath -> a -> StoreRec c
storeBinary FilePath
name)

storeDate :: StorableDate a => String -> a -> StoreRec c
storeDate :: forall a (c :: * -> *).
StorableDate a =>
FilePath -> a -> StoreRec c
storeDate FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, ZonedTime -> RecItem' c
forall (c :: * -> *). ZonedTime -> RecItem' c
RecDate (ZonedTime -> RecItem' c) -> ZonedTime -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> ZonedTime
forall a. StorableDate a => a -> ZonedTime
toDate a
x)]]

storeMbDate :: StorableDate a => String -> Maybe a -> StoreRec c
storeMbDate :: forall a (c :: * -> *).
StorableDate a =>
FilePath -> Maybe a -> StoreRec c
storeMbDate FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
StorableDate a =>
FilePath -> a -> StoreRec c
storeDate FilePath
name)

storeUUID :: StorableUUID a => String -> a -> StoreRec c
storeUUID :: forall a (c :: * -> *).
StorableUUID a =>
FilePath -> a -> StoreRec c
storeUUID FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [[(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, UUID -> RecItem' c
forall (c :: * -> *). UUID -> RecItem' c
RecUUID (UUID -> RecItem' c) -> UUID -> RecItem' c
forall a b. (a -> b) -> a -> b
$ a -> UUID
forall a. StorableUUID a => a -> UUID
toUUID a
x)]]

storeMbUUID :: StorableUUID a => String -> Maybe a -> StoreRec c
storeMbUUID :: forall a (c :: * -> *).
StorableUUID a =>
FilePath -> Maybe a -> StoreRec c
storeMbUUID FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
StorableUUID a =>
FilePath -> a -> StoreRec c
storeUUID FilePath
name)

storeRef :: Storable a => StorageCompleteness c => String -> a -> StoreRec c
storeRef :: forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeRef FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ do
    Storage' c
s <- ReaderT
  (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) (Storage' c)
forall r (m :: * -> *). MonadReader r m => m r
ask
    [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([IO [(ByteString, RecItem' c)]]
 -> ReaderT
      (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ())
-> [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall a b. (a -> b) -> a -> b
$ (IO [(ByteString, RecItem' c)]
-> [IO [(ByteString, RecItem' c)]]
-> [IO [(ByteString, RecItem' c)]]
forall a. a -> [a] -> [a]
:[]) (IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]])
-> IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]]
forall a b. (a -> b) -> a -> b
$ do
        Ref' c
ref <- Storage' c -> a -> IO (Ref' c)
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
Storage' c -> a -> IO (Ref' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> a -> IO (Ref' c)
store Storage' c
s a
x
        [(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, Ref' c -> RecItem' c
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef Ref' c
ref)]

storeMbRef :: Storable a => StorageCompleteness c => String -> Maybe a -> StoreRec c
storeMbRef :: forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> Maybe a -> StoreRec c
storeMbRef FilePath
name = StoreRec c -> (a -> StoreRec c) -> Maybe a -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeRef FilePath
name)

storeRawRef :: StorageCompleteness c => String -> Ref -> StoreRec c
storeRawRef :: forall (c :: * -> *).
StorageCompleteness c =>
FilePath -> Ref -> StoreRec c
storeRawRef FilePath
name Ref
ref = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ do
    Storage' c
st <- ReaderT
  (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) (Storage' c)
forall r (m :: * -> *). MonadReader r m => m r
ask
    [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([IO [(ByteString, RecItem' c)]]
 -> ReaderT
      (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ())
-> [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall a b. (a -> b) -> a -> b
$ (IO [(ByteString, RecItem' c)]
-> [IO [(ByteString, RecItem' c)]]
-> [IO [(ByteString, RecItem' c)]]
forall a. a -> [a] -> [a]
:[]) (IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]])
-> IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]]
forall a b. (a -> b) -> a -> b
$ do
        Ref' c
ref' <- Storage' c -> Ref -> IO (LoadResult Complete (Ref' c))
forall (c :: * -> *) (c' :: * -> *) (m :: * -> *).
(StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
copyRef Storage' c
st Ref
ref
        [(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath -> ByteString
BC.pack FilePath
name, Ref' c -> RecItem' c
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef Ref' c
ref')]

storeMbRawRef :: StorageCompleteness c => String -> Maybe Ref -> StoreRec c
storeMbRawRef :: forall (c :: * -> *).
StorageCompleteness c =>
FilePath -> Maybe Ref -> StoreRec c
storeMbRawRef FilePath
name = StoreRec c -> (Ref -> StoreRec c) -> Maybe Ref -> StoreRec c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> StoreRec c
forall a. a -> StoreRecM c a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (FilePath -> Ref -> StoreRec c
forall (c :: * -> *).
StorageCompleteness c =>
FilePath -> Ref -> StoreRec c
storeRawRef FilePath
name)

storeZRef :: (ZeroStorable a, StorageCompleteness c) => String -> a -> StoreRec c
storeZRef :: forall a (c :: * -> *).
(ZeroStorable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeZRef FilePath
name a
x = ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall (c :: * -> *) a.
ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a
-> StoreRecM c a
StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
 -> StoreRecM c ())
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
-> StoreRecM c ()
forall a b. (a -> b) -> a -> b
$ do
    Storage' c
s <- ReaderT
  (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) (Storage' c)
forall r (m :: * -> *). MonadReader r m => m r
ask
    [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([IO [(ByteString, RecItem' c)]]
 -> ReaderT
      (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ())
-> [IO [(ByteString, RecItem' c)]]
-> ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) ()
forall a b. (a -> b) -> a -> b
$ (IO [(ByteString, RecItem' c)]
-> [IO [(ByteString, RecItem' c)]]
-> [IO [(ByteString, RecItem' c)]]
forall a. a -> [a] -> [a]
:[]) (IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]])
-> IO [(ByteString, RecItem' c)] -> [IO [(ByteString, RecItem' c)]]
forall a b. (a -> b) -> a -> b
$ do
        Ref' c
ref <- Storage' c -> a -> IO (Ref' c)
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
Storage' c -> a -> IO (Ref' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> a -> IO (Ref' c)
store Storage' c
s a
x
        [(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)])
-> [(ByteString, RecItem' c)] -> IO [(ByteString, RecItem' c)]
forall a b. (a -> b) -> a -> b
$ if Ref' c -> Bool
forall (c :: * -> *). Ref' c -> Bool
isZeroRef Ref' c
ref then []
                                  else [(FilePath -> ByteString
BC.pack FilePath
name, Ref' c -> RecItem' c
forall (c :: * -> *). Ref' c -> RecItem' c
RecRef Ref' c
ref)]


loadBlob :: (ByteString -> a) -> Load a
loadBlob :: forall a. (ByteString -> a) -> Load a
loadBlob ByteString -> a
f = Load Object
loadCurrentObject Load Object -> (Object -> Load a) -> Load a
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Blob ByteString
x -> a -> Load a
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Load a) -> a -> Load a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
f ByteString
x
    Object
_      -> FilePath -> Load a
forall a. FilePath -> Load a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"Expecting blob"

loadRec :: LoadRec a -> Load a
loadRec :: forall a. LoadRec a -> Load a
loadRec (LoadRec ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  a
lrec) = Load Object
loadCurrentObject Load Object -> (Object -> Load a) -> Load a
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Rec [(ByteString, RecItem' Complete)]
rs -> do
        Ref
ref <- Load Ref
loadCurrentRef
        (FilePath -> Load a)
-> (a -> Load a) -> Either FilePath a -> Load a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> Load a
forall a. FilePath -> Load a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> Load a
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath a -> Load a) -> Either FilePath a -> Load a
forall a b. (a -> b) -> a -> b
$ Except FilePath a -> Either FilePath a
forall e a. Except e a -> Either e a
runExcept (Except FilePath a -> Either FilePath a)
-> Except FilePath a -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  a
-> (Ref, [(ByteString, RecItem' Complete)]) -> Except FilePath a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (Ref, [(ByteString, RecItem' Complete)])
  (ExceptT FilePath Complete)
  a
lrec (Ref
ref, [(ByteString, RecItem' Complete)]
rs)
    Object
_ -> FilePath -> Load a
forall a. FilePath -> Load a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"Expecting record"

loadZero :: a -> Load a
loadZero :: forall a. a -> Load a
loadZero a
x = Load Object
loadCurrentObject Load Object -> (Object -> Load a) -> Load a
forall a b. Load a -> (a -> Load b) -> Load b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Object
ZeroObject -> a -> Load a
forall a. a -> Load a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Object
_          -> FilePath -> Load a
forall a. FilePath -> Load a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"Expecting zero"


loadEmpty :: String -> LoadRec ()
loadEmpty :: FilePath -> LoadRec ()
loadEmpty FilePath
name = LoadRec () -> (() -> LoadRec ()) -> Maybe () -> LoadRec ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec ()
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec ()) -> FilePath -> LoadRec ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") () -> LoadRec ()
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> LoadRec ()) -> LoadRec (Maybe ()) -> LoadRec ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe ())
loadMbEmpty FilePath
name

loadMbEmpty :: String -> LoadRec (Maybe ())
loadMbEmpty :: FilePath -> LoadRec (Maybe ())
loadMbEmpty FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe ()))
-> LoadRec (Maybe ())
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe () -> LoadRec (Maybe ())
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing
    Just (RecItem' Complete
RecEmpty) -> Maybe () -> LoadRec (Maybe ())
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Maybe ()
forall a. a -> Maybe a
Just ())
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe ())
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe ())) -> FilePath -> LoadRec (Maybe ())
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type int of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadInt :: Num a => String -> LoadRec a
loadInt :: forall a. Num a => FilePath -> LoadRec a
loadInt FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. Num a => FilePath -> LoadRec (Maybe a)
loadMbInt FilePath
name

loadMbInt :: Num a => String -> LoadRec (Maybe a)
loadMbInt :: forall a. Num a => FilePath -> LoadRec (Maybe a)
loadMbInt FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecInt Integer
x) -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type int of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadNum :: (Real a, Fractional a) => String -> LoadRec a
loadNum :: forall a. (Real a, Fractional a) => FilePath -> LoadRec a
loadNum FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. (Real a, Fractional a) => FilePath -> LoadRec (Maybe a)
loadMbNum FilePath
name

loadMbNum :: (Real a, Fractional a) => String -> LoadRec (Maybe a)
loadMbNum :: forall a. (Real a, Fractional a) => FilePath -> LoadRec (Maybe a)
loadMbNum FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecNum Rational
x) -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Rational -> a
forall a. Fractional a => Rational -> a
fromRational Rational
x)
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type number of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadText :: StorableText a => String -> LoadRec a
loadText :: forall a. StorableText a => FilePath -> LoadRec a
loadText FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. StorableText a => FilePath -> LoadRec (Maybe a)
loadMbText FilePath
name

loadMbText :: StorableText a => String -> LoadRec (Maybe a)
loadMbText :: forall a. StorableText a => FilePath -> LoadRec (Maybe a)
loadMbText FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecText Text
x) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> LoadRec a -> LoadRec (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> LoadRec a
forall a (m :: * -> *).
(StorableText a, MonadError FilePath m) =>
Text -> m a
forall (m :: * -> *). MonadError FilePath m => Text -> m a
fromText Text
x
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type text of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadTexts :: StorableText a => String -> LoadRec [a]
loadTexts :: forall a. StorableText a => FilePath -> LoadRec [a]
loadTexts FilePath
name = do
    [RecItem' Complete]
items <- ((ByteString, RecItem' Complete) -> RecItem' Complete)
-> [(ByteString, RecItem' Complete)] -> [RecItem' Complete]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, RecItem' Complete) -> RecItem' Complete
forall a b. (a, b) -> b
snd ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> ([(ByteString, RecItem' Complete)]
    -> [(ByteString, RecItem' Complete)])
-> [(ByteString, RecItem' Complete)]
-> [RecItem' Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, RecItem' Complete) -> Bool)
-> [(ByteString, RecItem' Complete)]
-> [(ByteString, RecItem' Complete)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> ByteString
BC.pack FilePath
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> Bool)
-> ((ByteString, RecItem' Complete) -> ByteString)
-> (ByteString, RecItem' Complete)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, RecItem' Complete) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec [RecItem' Complete]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems
    [RecItem' Complete]
-> (RecItem' Complete -> LoadRec a) -> LoadRec [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RecItem' Complete]
items ((RecItem' Complete -> LoadRec a) -> LoadRec [a])
-> (RecItem' Complete -> LoadRec a) -> LoadRec [a]
forall a b. (a -> b) -> a -> b
$ \case RecText Text
x -> Text -> LoadRec a
forall a (m :: * -> *).
(StorableText a, MonadError FilePath m) =>
Text -> m a
forall (m :: * -> *). MonadError FilePath m => Text -> m a
fromText Text
x
                       RecItem' Complete
_ -> FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type text of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadBinary :: BA.ByteArray a => String -> LoadRec a
loadBinary :: forall a. ByteArray a => FilePath -> LoadRec a
loadBinary FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. ByteArray a => FilePath -> LoadRec (Maybe a)
loadMbBinary FilePath
name

loadMbBinary :: BA.ByteArray a => String -> LoadRec (Maybe a)
loadMbBinary :: forall a. ByteArray a => FilePath -> LoadRec (Maybe a)
loadMbBinary FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecBinary ByteString
x) -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec (Maybe a)) -> Maybe a -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
x
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type binary of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadBinaries :: BA.ByteArray a => String -> LoadRec [a]
loadBinaries :: forall a. ByteArray a => FilePath -> LoadRec [a]
loadBinaries FilePath
name = do
    [RecItem' Complete]
items <- ((ByteString, RecItem' Complete) -> RecItem' Complete)
-> [(ByteString, RecItem' Complete)] -> [RecItem' Complete]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, RecItem' Complete) -> RecItem' Complete
forall a b. (a, b) -> b
snd ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> ([(ByteString, RecItem' Complete)]
    -> [(ByteString, RecItem' Complete)])
-> [(ByteString, RecItem' Complete)]
-> [RecItem' Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, RecItem' Complete) -> Bool)
-> [(ByteString, RecItem' Complete)]
-> [(ByteString, RecItem' Complete)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> ByteString
BC.pack FilePath
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> Bool)
-> ((ByteString, RecItem' Complete) -> ByteString)
-> (ByteString, RecItem' Complete)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, RecItem' Complete) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec [RecItem' Complete]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems
    [RecItem' Complete]
-> (RecItem' Complete -> LoadRec a) -> LoadRec [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RecItem' Complete]
items ((RecItem' Complete -> LoadRec a) -> LoadRec [a])
-> (RecItem' Complete -> LoadRec a) -> LoadRec [a]
forall a b. (a -> b) -> a -> b
$ \case RecBinary ByteString
x -> a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> LoadRec a) -> a -> LoadRec a
forall a b. (a -> b) -> a -> b
$ ByteString -> a
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
x
                       RecItem' Complete
_ -> FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type binary of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadDate :: StorableDate a => String -> LoadRec a
loadDate :: forall a. StorableDate a => FilePath -> LoadRec a
loadDate FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. StorableDate a => FilePath -> LoadRec (Maybe a)
loadMbDate FilePath
name

loadMbDate :: StorableDate a => String -> LoadRec (Maybe a)
loadMbDate :: forall a. StorableDate a => FilePath -> LoadRec (Maybe a)
loadMbDate FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecDate ZonedTime
x) -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec (Maybe a)) -> Maybe a -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ZonedTime -> a
forall a. StorableDate a => ZonedTime -> a
fromDate ZonedTime
x
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type date of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadUUID :: StorableUUID a => String -> LoadRec a
loadUUID :: forall a. StorableUUID a => FilePath -> LoadRec a
loadUUID FilePath
name = LoadRec a -> (a -> LoadRec a) -> Maybe a -> LoadRec a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec a
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec a) -> FilePath -> LoadRec a
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record iteem '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec a) -> LoadRec (Maybe a) -> LoadRec a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe a)
forall a. StorableUUID a => FilePath -> LoadRec (Maybe a)
loadMbUUID FilePath
name

loadMbUUID :: StorableUUID a => String -> LoadRec (Maybe a)
loadMbUUID :: forall a. StorableUUID a => FilePath -> LoadRec (Maybe a)
loadMbUUID FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe a))
-> LoadRec (Maybe a)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just (RecUUID UUID
x) -> Maybe a -> LoadRec (Maybe a)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> LoadRec (Maybe a)) -> Maybe a -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ UUID -> a
forall a. StorableUUID a => UUID -> a
fromUUID UUID
x
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe a)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe a)) -> FilePath -> LoadRec (Maybe a)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type UUID of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadRawRef :: String -> LoadRec Ref
loadRawRef :: FilePath -> LoadRec Ref
loadRawRef FilePath
name = LoadRec Ref -> (Ref -> LoadRec Ref) -> Maybe Ref -> LoadRec Ref
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> LoadRec Ref
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec Ref) -> FilePath -> LoadRec Ref
forall a b. (a -> b) -> a -> b
$ FilePath
"Missing record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'") Ref -> LoadRec Ref
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Ref -> LoadRec Ref) -> LoadRec (Maybe Ref) -> LoadRec Ref
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> LoadRec (Maybe Ref)
loadMbRawRef FilePath
name

loadMbRawRef :: String -> LoadRec (Maybe Ref)
loadMbRawRef :: FilePath -> LoadRec (Maybe Ref)
loadMbRawRef FilePath
name = (ByteString
-> [(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (FilePath -> ByteString
BC.pack FilePath
name) ([(ByteString, RecItem' Complete)] -> Maybe (RecItem' Complete))
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec (Maybe (RecItem' Complete))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems) LoadRec (Maybe (RecItem' Complete))
-> (Maybe (RecItem' Complete) -> LoadRec (Maybe Ref))
-> LoadRec (Maybe Ref)
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (RecItem' Complete)
Nothing -> Maybe Ref -> LoadRec (Maybe Ref)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Ref
forall a. Maybe a
Nothing
    Just (RecRef Ref
x) -> Maybe Ref -> LoadRec (Maybe Ref)
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref -> Maybe Ref
forall a. a -> Maybe a
Just Ref
x)
    Just RecItem' Complete
_ -> FilePath -> LoadRec (Maybe Ref)
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec (Maybe Ref))
-> FilePath -> LoadRec (Maybe Ref)
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type ref of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadRawRefs :: String -> LoadRec [Ref]
loadRawRefs :: FilePath -> LoadRec [Ref]
loadRawRefs FilePath
name = do
    [RecItem' Complete]
items <- ((ByteString, RecItem' Complete) -> RecItem' Complete)
-> [(ByteString, RecItem' Complete)] -> [RecItem' Complete]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, RecItem' Complete) -> RecItem' Complete
forall a b. (a, b) -> b
snd ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> ([(ByteString, RecItem' Complete)]
    -> [(ByteString, RecItem' Complete)])
-> [(ByteString, RecItem' Complete)]
-> [RecItem' Complete]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, RecItem' Complete) -> Bool)
-> [(ByteString, RecItem' Complete)]
-> [(ByteString, RecItem' Complete)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> ByteString
BC.pack FilePath
name ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==) (ByteString -> Bool)
-> ((ByteString, RecItem' Complete) -> ByteString)
-> (ByteString, RecItem' Complete)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, RecItem' Complete) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, RecItem' Complete)] -> [RecItem' Complete])
-> LoadRec [(ByteString, RecItem' Complete)]
-> LoadRec [RecItem' Complete]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec [(ByteString, RecItem' Complete)]
loadRecItems
    [RecItem' Complete]
-> (RecItem' Complete -> LoadRec Ref) -> LoadRec [Ref]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [RecItem' Complete]
items ((RecItem' Complete -> LoadRec Ref) -> LoadRec [Ref])
-> (RecItem' Complete -> LoadRec Ref) -> LoadRec [Ref]
forall a b. (a -> b) -> a -> b
$ \case RecRef Ref
x -> Ref -> LoadRec Ref
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return Ref
x
                       RecItem' Complete
_ -> FilePath -> LoadRec Ref
forall a. FilePath -> LoadRec a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> LoadRec Ref) -> FilePath -> LoadRec Ref
forall a b. (a -> b) -> a -> b
$ FilePath
"Expecting type ref of record item '"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
nameFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"'"

loadRef :: Storable a => String -> LoadRec a
loadRef :: forall a. Storable a => FilePath -> LoadRec a
loadRef FilePath
name = Ref -> a
forall a. Storable a => Ref -> a
load (Ref -> a) -> LoadRec Ref -> LoadRec a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> LoadRec Ref
loadRawRef FilePath
name

loadMbRef :: Storable a => String -> LoadRec (Maybe a)
loadMbRef :: forall a. Storable a => FilePath -> LoadRec (Maybe a)
loadMbRef FilePath
name = (Ref -> a) -> Maybe Ref -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ref -> a
forall a. Storable a => Ref -> a
load (Maybe Ref -> Maybe a) -> LoadRec (Maybe Ref) -> LoadRec (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> LoadRec (Maybe Ref)
loadMbRawRef FilePath
name

loadRefs :: Storable a => String -> LoadRec [a]
loadRefs :: forall a. Storable a => FilePath -> LoadRec [a]
loadRefs FilePath
name = (Ref -> a) -> [Ref] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Ref -> a
forall a. Storable a => Ref -> a
load ([Ref] -> [a]) -> LoadRec [Ref] -> LoadRec [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> LoadRec [Ref]
loadRawRefs FilePath
name

loadZRef :: ZeroStorable a => String -> LoadRec a
loadZRef :: forall a. ZeroStorable a => FilePath -> LoadRec a
loadZRef FilePath
name = FilePath -> LoadRec (Maybe a)
forall a. Storable a => FilePath -> LoadRec (Maybe a)
loadMbRef FilePath
name LoadRec (Maybe a) -> (Maybe a -> LoadRec a) -> LoadRec a
forall a b. LoadRec a -> (a -> LoadRec b) -> LoadRec b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe a
Nothing -> do Ref Storage
st RefDigest
_ <- LoadRec Ref
loadRecCurrentRef
                                  a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> LoadRec a) -> a -> LoadRec a
forall a b. (a -> b) -> a -> b
$ Storage -> a
forall a. ZeroStorable a => Storage -> a
fromZero Storage
st
                    Just a
x  -> a -> LoadRec a
forall a. a -> LoadRec a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x


type Stored a = Stored' Complete a

instance Storable a => Storable (Stored a) where
    store :: forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> Stored a -> IO (Ref' c)
store Storage' c
st = Storage' c -> Ref -> IO (LoadResult Complete (Ref' c))
forall (c :: * -> *) (c' :: * -> *) (m :: * -> *).
(StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
Storage' c' -> Ref' c -> m (LoadResult c (Ref' c'))
copyRef Storage' c
st (Ref -> IO (Ref' c))
-> (Stored a -> Ref) -> Stored a -> IO (Ref' c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stored a -> Ref
forall a. Stored a -> Ref
storedRef
    store' :: Stored a -> Store
store' (Stored Ref
_ a
x) = a -> Store
forall a. Storable a => a -> Store
store' a
x
    load' :: Load (Stored a)
load' = Ref -> a -> Stored a
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored (Ref -> a -> Stored a) -> Load Ref -> Load (a -> Stored a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Load Ref
loadCurrentRef Load (a -> Stored a) -> Load a -> Load (Stored a)
forall a b. Load (a -> b) -> Load a -> Load b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Load a
forall a. Storable a => Load a
load'

instance ZeroStorable a => ZeroStorable (Stored a) where
    fromZero :: Storage -> Stored a
fromZero Storage
st = Ref -> a -> Stored a
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored (Storage -> Ref
forall (c :: * -> *). Storage' c -> Ref' c
zeroRef Storage
st) (a -> Stored a) -> a -> Stored a
forall a b. (a -> b) -> a -> b
$ Storage -> a
forall a. ZeroStorable a => Storage -> a
fromZero Storage
st

fromStored :: Stored a -> a
fromStored :: forall a. Stored a -> a
fromStored (Stored Ref
_ a
x) = a
x

storedRef :: Stored a -> Ref
storedRef :: forall a. Stored a -> Ref
storedRef (Stored Ref
ref a
_) = Ref
ref

wrappedStore :: MonadIO m => Storable a => Storage -> a -> m (Stored a)
wrappedStore :: forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
x = do Ref
ref <- IO Ref -> m Ref
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ref -> m Ref) -> IO Ref -> m Ref
forall a b. (a -> b) -> a -> b
$ Storage -> a -> IO Ref
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
Storage' c -> a -> IO (Ref' c)
forall (c :: * -> *).
StorageCompleteness c =>
Storage' c -> a -> IO (Ref' c)
store Storage
st a
x
                       Stored a -> m (Stored a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stored a -> m (Stored a)) -> Stored a -> m (Stored a)
forall a b. (a -> b) -> a -> b
$ Ref -> a -> Stored a
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored Ref
ref a
x

wrappedLoad :: Storable a => Ref -> Stored a
wrappedLoad :: forall a. Storable a => Ref -> Stored a
wrappedLoad Ref
ref = Ref -> a -> Stored' Complete a
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored Ref
ref (Ref -> a
forall a. Storable a => Ref -> a
load Ref
ref)

copyStored :: forall c c' m a. (StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
    Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a))
copyStored :: forall (c :: * -> *) (c' :: * -> *) (m :: * -> *) a.
(StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a))
copyStored Storage' c'
st (Stored Ref' c
ref' a
x) = IO (LoadResult c (Stored' c' a)) -> m (LoadResult c (Stored' c' a))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (LoadResult c (Stored' c' a))
 -> m (LoadResult c (Stored' c' a)))
-> IO (LoadResult c (Stored' c' a))
-> m (LoadResult c (Stored' c' a))
forall a b. (a -> b) -> a -> b
$ c (Stored' c' a) -> LoadResult c (Stored' c' a)
forall a. c a -> LoadResult c a
forall (compl :: * -> *) a.
StorageCompleteness compl =>
compl a -> LoadResult compl a
returnLoadResult (c (Stored' c' a) -> LoadResult c (Stored' c' a))
-> (c (Ref' c') -> c (Stored' c' a))
-> c (Ref' c')
-> LoadResult c (Stored' c' a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref' c' -> Stored' c' a) -> c (Ref' c') -> c (Stored' c' a)
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ref' c' -> a -> Stored' c' a) -> a -> Ref' c' -> Stored' c' a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Ref' c' -> a -> Stored' c' a
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored a
x) (c (Ref' c') -> LoadResult c (Stored' c' a))
-> IO (c (Ref' c')) -> IO (LoadResult c (Stored' c' a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Storage' c' -> Ref' c -> IO (c (Ref' c'))
forall (c :: * -> *) (c' :: * -> *).
(StorageCompleteness c, StorageCompleteness c') =>
Storage' c' -> Ref' c -> IO (c (Ref' c'))
copyRef' Storage' c'
st Ref' c
ref'

-- |Passed function needs to preserve the object representation to be safe
unsafeMapStored :: (a -> b) -> Stored a -> Stored b
unsafeMapStored :: forall a b. (a -> b) -> Stored a -> Stored b
unsafeMapStored a -> b
f (Stored Ref
ref a
x) = Ref -> b -> Stored' Complete b
forall (c :: * -> *) a. Ref' c -> a -> Stored' c a
Stored Ref
ref (a -> b
f a
x)


data StoreInfo = StoreInfo
    { StoreInfo -> ZonedTime
infoDate :: ZonedTime
    , StoreInfo -> Maybe Text
infoNote :: Maybe Text
    }
    deriving (Int -> StoreInfo -> FilePath -> FilePath
[StoreInfo] -> FilePath -> FilePath
StoreInfo -> FilePath
(Int -> StoreInfo -> FilePath -> FilePath)
-> (StoreInfo -> FilePath)
-> ([StoreInfo] -> FilePath -> FilePath)
-> Show StoreInfo
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> StoreInfo -> FilePath -> FilePath
showsPrec :: Int -> StoreInfo -> FilePath -> FilePath
$cshow :: StoreInfo -> FilePath
show :: StoreInfo -> FilePath
$cshowList :: [StoreInfo] -> FilePath -> FilePath
showList :: [StoreInfo] -> FilePath -> FilePath
Show)

makeStoreInfo :: IO StoreInfo
makeStoreInfo :: IO StoreInfo
makeStoreInfo = ZonedTime -> Maybe Text -> StoreInfo
StoreInfo
    (ZonedTime -> Maybe Text -> StoreInfo)
-> IO ZonedTime -> IO (Maybe Text -> StoreInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ZonedTime
getZonedTime
    IO (Maybe Text -> StoreInfo) -> IO (Maybe Text) -> IO StoreInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

storeInfoRec :: StoreInfo -> StoreRec c
storeInfoRec :: forall (c :: * -> *). StoreInfo -> StoreRec c
storeInfoRec StoreInfo
info = do
    FilePath -> ZonedTime -> StoreRec c
forall a (c :: * -> *).
StorableDate a =>
FilePath -> a -> StoreRec c
storeDate FilePath
"date" (ZonedTime -> StoreRec c) -> ZonedTime -> StoreRec c
forall a b. (a -> b) -> a -> b
$ StoreInfo -> ZonedTime
infoDate StoreInfo
info
    FilePath -> Maybe Text -> StoreRec c
forall a (c :: * -> *).
StorableText a =>
FilePath -> Maybe a -> StoreRec c
storeMbText FilePath
"note" (Maybe Text -> StoreRec c) -> Maybe Text -> StoreRec c
forall a b. (a -> b) -> a -> b
$ StoreInfo -> Maybe Text
infoNote StoreInfo
info

loadInfoRec :: LoadRec StoreInfo
loadInfoRec :: LoadRec StoreInfo
loadInfoRec = ZonedTime -> Maybe Text -> StoreInfo
StoreInfo
    (ZonedTime -> Maybe Text -> StoreInfo)
-> LoadRec ZonedTime -> LoadRec (Maybe Text -> StoreInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> LoadRec ZonedTime
forall a. StorableDate a => FilePath -> LoadRec a
loadDate FilePath
"date"
    LoadRec (Maybe Text -> StoreInfo)
-> LoadRec (Maybe Text) -> LoadRec StoreInfo
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> LoadRec (Maybe Text)
forall a. StorableText a => FilePath -> LoadRec (Maybe a)
loadMbText FilePath
"note"


data History a = History StoreInfo (Stored a) (Maybe (StoredHistory a))
    deriving (Int -> History a -> FilePath -> FilePath
[History a] -> FilePath -> FilePath
History a -> FilePath
(Int -> History a -> FilePath -> FilePath)
-> (History a -> FilePath)
-> ([History a] -> FilePath -> FilePath)
-> Show (History a)
forall a. Show a => Int -> History a -> FilePath -> FilePath
forall a. Show a => [History a] -> FilePath -> FilePath
forall a. Show a => History a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: forall a. Show a => Int -> History a -> FilePath -> FilePath
showsPrec :: Int -> History a -> FilePath -> FilePath
$cshow :: forall a. Show a => History a -> FilePath
show :: History a -> FilePath
$cshowList :: forall a. Show a => [History a] -> FilePath -> FilePath
showList :: [History a] -> FilePath -> FilePath
Show)

type StoredHistory a = Stored (History a)

instance Storable a => Storable (History a) where
    store' :: History a -> Store
store' (History StoreInfo
si Stored a
x Maybe (StoredHistory a)
prev) = (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
storeRec ((forall (c :: * -> *). StorageCompleteness c => StoreRec c)
 -> Store)
-> (forall (c :: * -> *). StorageCompleteness c => StoreRec c)
-> Store
forall a b. (a -> b) -> a -> b
$ do
        StoreInfo -> StoreRec c
forall (c :: * -> *). StoreInfo -> StoreRec c
storeInfoRec StoreInfo
si
        FilePath -> Maybe (StoredHistory a) -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> Maybe a -> StoreRec c
storeMbRef FilePath
"prev" Maybe (StoredHistory a)
prev
        FilePath -> Stored a -> StoreRec c
forall a (c :: * -> *).
(Storable a, StorageCompleteness c) =>
FilePath -> a -> StoreRec c
storeRef FilePath
"item" Stored a
x

    load' :: Load (History a)
load' = LoadRec (History a) -> Load (History a)
forall a. LoadRec a -> Load a
loadRec (LoadRec (History a) -> Load (History a))
-> LoadRec (History a) -> Load (History a)
forall a b. (a -> b) -> a -> b
$ StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
forall a.
StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
History
        (StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a)
-> LoadRec StoreInfo
-> LoadRec (Stored a -> Maybe (StoredHistory a) -> History a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoadRec StoreInfo
loadInfoRec
        LoadRec (Stored a -> Maybe (StoredHistory a) -> History a)
-> LoadRec (Stored a)
-> LoadRec (Maybe (StoredHistory a) -> History a)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> LoadRec (Stored a)
forall a. Storable a => FilePath -> LoadRec a
loadRef FilePath
"item"
        LoadRec (Maybe (StoredHistory a) -> History a)
-> LoadRec (Maybe (StoredHistory a)) -> LoadRec (History a)
forall a b. LoadRec (a -> b) -> LoadRec a -> LoadRec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> LoadRec (Maybe (StoredHistory a))
forall a. Storable a => FilePath -> LoadRec (Maybe a)
loadMbRef FilePath
"prev"

fromHistory :: StoredHistory a -> a
fromHistory :: forall a. StoredHistory a -> a
fromHistory = Stored a -> a
forall a. Stored a -> a
fromStored (Stored a -> a)
-> (StoredHistory a -> Stored a) -> StoredHistory a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredHistory a -> Stored a
forall a. StoredHistory a -> Stored a
storedFromHistory

fromHistoryAt :: ZonedTime -> StoredHistory a -> Maybe a
fromHistoryAt :: forall a. ZonedTime -> StoredHistory a -> Maybe a
fromHistoryAt ZonedTime
zat = ((ZonedTime, Stored a) -> a)
-> Maybe (ZonedTime, Stored a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Stored a -> a
forall a. Stored a -> a
fromStored (Stored a -> a)
-> ((ZonedTime, Stored a) -> Stored a)
-> (ZonedTime, Stored a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonedTime, Stored a) -> Stored a
forall a b. (a, b) -> b
snd) (Maybe (ZonedTime, Stored a) -> Maybe a)
-> (StoredHistory a -> Maybe (ZonedTime, Stored a))
-> StoredHistory a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ZonedTime, Stored a)] -> Maybe (ZonedTime, Stored a)
forall a. [a] -> Maybe a
listToMaybe ([(ZonedTime, Stored a)] -> Maybe (ZonedTime, Stored a))
-> (StoredHistory a -> [(ZonedTime, Stored a)])
-> StoredHistory a
-> Maybe (ZonedTime, Stored a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ZonedTime, Stored a) -> Bool)
-> [(ZonedTime, Stored a)] -> [(ZonedTime, Stored a)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ((UTCTime
atUTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) (UTCTime -> Bool)
-> ((ZonedTime, Stored a) -> UTCTime)
-> (ZonedTime, Stored a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime)
-> ((ZonedTime, Stored a) -> ZonedTime)
-> (ZonedTime, Stored a)
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZonedTime, Stored a) -> ZonedTime
forall a b. (a, b) -> a
fst) ([(ZonedTime, Stored a)] -> [(ZonedTime, Stored a)])
-> (StoredHistory a -> [(ZonedTime, Stored a)])
-> StoredHistory a
-> [(ZonedTime, Stored a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredHistory a -> [(ZonedTime, Stored a)]
forall a. StoredHistory a -> [(ZonedTime, Stored a)]
storedHistoryTimedList
    where at :: UTCTime
at = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
zat

storedFromHistory :: StoredHistory a -> Stored a
storedFromHistory :: forall a. StoredHistory a -> Stored a
storedFromHistory StoredHistory a
sh = let History StoreInfo
_ Stored a
item Maybe (StoredHistory a)
_ = StoredHistory a -> History a
forall a. Stored a -> a
fromStored StoredHistory a
sh
                        in Stored a
item

storedHistoryList :: StoredHistory a -> [Stored a]
storedHistoryList :: forall a. StoredHistory a -> [Stored a]
storedHistoryList = ((ZonedTime, Stored a) -> Stored a)
-> [(ZonedTime, Stored a)] -> [Stored a]
forall a b. (a -> b) -> [a] -> [b]
map (ZonedTime, Stored a) -> Stored a
forall a b. (a, b) -> b
snd ([(ZonedTime, Stored a)] -> [Stored a])
-> (StoredHistory a -> [(ZonedTime, Stored a)])
-> StoredHistory a
-> [Stored a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoredHistory a -> [(ZonedTime, Stored a)]
forall a. StoredHistory a -> [(ZonedTime, Stored a)]
storedHistoryTimedList

storedHistoryTimedList :: StoredHistory a -> [(ZonedTime, Stored a)]
storedHistoryTimedList :: forall a. StoredHistory a -> [(ZonedTime, Stored a)]
storedHistoryTimedList StoredHistory a
sh = let History StoreInfo
hinfo Stored a
item Maybe (StoredHistory a)
prev = StoredHistory a -> History a
forall a. Stored a -> a
fromStored StoredHistory a
sh
                             in (StoreInfo -> ZonedTime
infoDate StoreInfo
hinfo, Stored a
item) (ZonedTime, Stored a)
-> [(ZonedTime, Stored a)] -> [(ZonedTime, Stored a)]
forall a. a -> [a] -> [a]
: [(ZonedTime, Stored a)]
-> (StoredHistory a -> [(ZonedTime, Stored a)])
-> Maybe (StoredHistory a)
-> [(ZonedTime, Stored a)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] StoredHistory a -> [(ZonedTime, Stored a)]
forall a. StoredHistory a -> [(ZonedTime, Stored a)]
storedHistoryTimedList Maybe (StoredHistory a)
prev

beginHistory :: Storable a => Storage -> StoreInfo -> a -> IO (StoredHistory a)
beginHistory :: forall a.
Storable a =>
Storage -> StoreInfo -> a -> IO (StoredHistory a)
beginHistory Storage
st StoreInfo
si a
x = do Stored a
sx <- Storage -> a -> IO (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st a
x
                          Storage -> History a -> IO (StoredHistory a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st (History a -> IO (StoredHistory a))
-> History a -> IO (StoredHistory a)
forall a b. (a -> b) -> a -> b
$ StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
forall a.
StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
History StoreInfo
si Stored a
sx Maybe (StoredHistory a)
forall a. Maybe a
Nothing

modifyHistory :: Storable a => StoreInfo -> (a -> a) -> StoredHistory a -> IO (StoredHistory a)
modifyHistory :: forall a.
Storable a =>
StoreInfo -> (a -> a) -> StoredHistory a -> IO (StoredHistory a)
modifyHistory StoreInfo
si a -> a
f prev :: StoredHistory a
prev@(Stored (Ref Storage
st RefDigest
_) History a
_) = do
    Stored a
sx <- Storage -> a -> IO (Stored a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st (a -> IO (Stored a)) -> a -> IO (Stored a)
forall a b. (a -> b) -> a -> b
$ a -> a
f (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ StoredHistory a -> a
forall a. StoredHistory a -> a
fromHistory StoredHistory a
prev
    Storage -> History a -> IO (StoredHistory a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Storage -> a -> m (Stored a)
wrappedStore Storage
st (History a -> IO (StoredHistory a))
-> History a -> IO (StoredHistory a)
forall a b. (a -> b) -> a -> b
$ StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
forall a.
StoreInfo -> Stored a -> Maybe (StoredHistory a) -> History a
History StoreInfo
si Stored a
sx (StoredHistory a -> Maybe (StoredHistory a)
forall a. a -> Maybe a
Just StoredHistory a
prev)


showRatio :: Rational -> String
showRatio :: Rational -> FilePath
showRatio Rational
r = case Rational -> Maybe (Integer, Integer)
decimalRatio Rational
r of
                   Just (Integer
n, Integer
1) -> Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
n
                   Just (Integer
n', Integer
d) -> let n :: Integer
n = Integer -> Integer
forall a. Num a => a -> a
abs Integer
n'
                                    in (if Integer
n' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then FilePath
"-" else FilePath
"") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
d) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                                       (((Integer, Integer) -> FilePath)
-> [(Integer, Integer)] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Integer -> FilePath
forall a. Show a => a -> FilePath
show(Integer -> FilePath)
-> ((Integer, Integer) -> Integer)
-> (Integer, Integer)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
10)(Integer -> Integer)
-> ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd) ([(Integer, Integer)] -> FilePath)
-> [(Integer, Integer)] -> FilePath
forall a b. (a -> b) -> a -> b
$ [(Integer, Integer)] -> [(Integer, Integer)]
forall a. [a] -> [a]
reverse ([(Integer, Integer)] -> [(Integer, Integer)])
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Bool)
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>Integer
1)(Integer -> Bool)
-> ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst) ([(Integer, Integer)] -> [(Integer, Integer)])
-> [(Integer, Integer)] -> [(Integer, Integer)]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer] -> [(Integer, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10) Integer
d) ((Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
10) (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
d)))
                   Maybe (Integer, Integer)
Nothing -> Integer -> FilePath
forall a. Show a => a -> FilePath
show (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r)

decimalRatio :: Rational -> Maybe (Integer, Integer)
decimalRatio :: Rational -> Maybe (Integer, Integer)
decimalRatio Rational
r = do
    let n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r
        d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r
        (Integer
c2, Integer
d') = Integer -> Integer -> (Integer, Integer)
takeFactors Integer
2 Integer
d
        (Integer
c5, Integer
d'') = Integer -> Integer -> (Integer, Integer)
takeFactors Integer
5 Integer
d'
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Integer
d'' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
    let m :: Integer
m = if Integer
c2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
c5 then Integer
5 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
c2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
c5)
                       else Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
c5 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
c2)
    (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m, Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
m)

takeFactors :: Integer -> Integer -> (Integer, Integer)
takeFactors :: Integer -> Integer -> (Integer, Integer)
takeFactors Integer
f Integer
n | Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
f Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = let (Integer
c, Integer
n') = Integer -> Integer -> (Integer, Integer)
takeFactors Integer
f (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
f)
                                    in (Integer
cInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1, Integer
n')
                | Bool
otherwise = (Integer
0, Integer
n)

parseRatio :: ByteString -> Maybe Rational
parseRatio :: ByteString -> Maybe Rational
parseRatio ByteString
bs = case (Char -> Char -> Bool) -> ByteString -> [ByteString]
BC.groupBy (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Char -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Char -> Bool
isNumber) ByteString
bs of
                     (ByteString
m:[ByteString]
xs) | ByteString
m ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> ByteString
BC.pack FilePath
"-" -> Rational -> Rational
forall a. Num a => a -> a
negate (Rational -> Rational) -> Maybe Rational -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString] -> Maybe Rational
positive [ByteString]
xs
                     [ByteString]
xs                        -> [ByteString] -> Maybe Rational
positive [ByteString]
xs
    where positive :: [ByteString] -> Maybe Rational
positive = \case
              [ByteString
bx] -> Integer -> Rational
forall a. Num a => Integer -> a
fromInteger (Integer -> Rational)
-> ((Integer, ByteString) -> Integer)
-> (Integer, ByteString)
-> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, ByteString) -> Integer
forall a b. (a, b) -> a
fst ((Integer, ByteString) -> Rational)
-> Maybe (Integer, ByteString) -> Maybe Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Integer, ByteString)
BC.readInteger ByteString
bx
              [ByteString
bx, ByteString
op, ByteString
by] -> do
                  (Integer
x, ByteString
_) <- ByteString -> Maybe (Integer, ByteString)
BC.readInteger ByteString
bx
                  (Integer
y, ByteString
_) <- ByteString -> Maybe (Integer, ByteString)
BC.readInteger ByteString
by
                  case ByteString -> FilePath
BC.unpack ByteString
op of
                       FilePath
"." -> Rational -> Maybe Rational
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ (Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Integer
y Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ ByteString -> Int
BC.length ByteString
by))
                       FilePath
"/" -> Rational -> Maybe Rational
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
y
                       FilePath
_   -> Maybe Rational
forall a. Maybe a
Nothing
              [ByteString]
_ -> Maybe Rational
forall a. Maybe a
Nothing