diff options
Diffstat (limited to 'src/Storage.hs')
| -rw-r--r-- | src/Storage.hs | 14 | 
1 files changed, 13 insertions, 1 deletions
| diff --git a/src/Storage.hs b/src/Storage.hs index d78d99a..d29056f 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -29,12 +29,14 @@ module Storage (      loadBlob, loadRec, loadZero,      loadInt, loadNum, loadText, loadBinary, loadDate, loadJson, loadRef, -    loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef, loadRefs, +    loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef, +    loadBinaries, loadRefs,      loadZRef,      Stored,      fromStored, storedRef, storedStorage,      wrappedStore, wrappedLoad, +    copyStored,      StoreInfo(..), makeStoreInfo, @@ -631,6 +633,12 @@ loadMbBinary name = asks (lookup (BC.pack name) . snd) >>= \case      Just (RecBinary x) -> return $ Just $ BA.convert x      Just _ -> throwError $ "Expecting type binary of record item '"++name++"'" +loadBinaries :: BA.ByteArray a => String -> LoadRec [a] +loadBinaries name = do +    items <- map snd . filter ((BC.pack name ==) . fst) <$> asks snd +    forM items $ \case RecBinary x -> return $ BA.convert x +                       _ -> throwError $ "Expecting type binary of record item '"++name++"'" +  loadDate :: StorableDate a => String -> LoadRec a  loadDate name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbDate name @@ -719,6 +727,10 @@ wrappedStore st x = do ref <- store st x  wrappedLoad :: Storable a => Ref -> Stored a  wrappedLoad ref = Stored ref (load 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 st (Stored ref' x) = liftIO $ returnLoadResult . fmap (flip Stored x) <$> copyRef' st ref' +  data StoreInfo = StoreInfo      { infoDate :: ZonedTime |