summaryrefslogtreecommitdiff
path: root/src/Storage.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Storage.hs')
-rw-r--r--src/Storage.hs8
1 files changed, 7 insertions, 1 deletions
diff --git a/src/Storage.hs b/src/Storage.hs
index 92a1e1f..f73c420 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -35,7 +35,7 @@ module Storage (
loadBlob, loadRec, loadZero,
loadInt, loadNum, loadText, loadBinary, loadDate, loadUUID, loadJson, loadRef, loadRawRef,
loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbUUID, loadMbJson, loadMbRef, loadMbRawRef,
- loadBinaries, loadRefs, loadRawRefs,
+ loadTexts, loadBinaries, loadRefs, loadRawRefs,
loadZRef,
Stored,
@@ -720,6 +720,12 @@ loadMbText name = asks (lookup (BC.pack name) . snd) >>= \case
Just (RecText x) -> Just <$> fromText x
Just _ -> throwError $ "Expecting type text of record item '"++name++"'"
+loadTexts :: StorableText a => String -> LoadRec [a]
+loadTexts name = do
+ items <- map snd . filter ((BC.pack name ==) . fst) <$> asks snd
+ forM items $ \case RecText x -> fromText x
+ _ -> throwError $ "Expecting type text of record item '"++name++"'"
+
loadBinary :: BA.ByteArray a => String -> LoadRec a
loadBinary name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbBinary name