summaryrefslogtreecommitdiff
path: root/src/Erebos
diff options
context:
space:
mode:
Diffstat (limited to 'src/Erebos')
-rw-r--r--src/Erebos/Storage.hs30
1 files changed, 4 insertions, 26 deletions
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs
index 50e0241..88f3132 100644
--- a/src/Erebos/Storage.hs
+++ b/src/Erebos/Storage.hs
@@ -31,14 +31,14 @@ module Erebos.Storage (
StorableText(..), StorableDate(..), StorableUUID(..),
storeBlob, storeRec, storeZero,
- storeEmpty, storeInt, storeNum, storeText, storeBinary, storeDate, storeUUID, storeJson, storeRef, storeRawRef,
- storeMbEmpty, storeMbInt, storeMbNum, storeMbText, storeMbBinary, storeMbDate, storeMbUUID, storeMbJson, storeMbRef, storeMbRawRef,
+ storeEmpty, storeInt, storeNum, storeText, storeBinary, storeDate, storeUUID, storeRef, storeRawRef,
+ storeMbEmpty, storeMbInt, storeMbNum, storeMbText, storeMbBinary, storeMbDate, storeMbUUID, storeMbRef, storeMbRawRef,
storeZRef,
LoadRec,
loadBlob, loadRec, loadZero,
- loadEmpty, loadInt, loadNum, loadText, loadBinary, loadDate, loadUUID, loadJson, loadRef, loadRawRef,
- loadMbEmpty, loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbUUID, loadMbJson, loadMbRef, loadMbRawRef,
+ loadEmpty, loadInt, loadNum, loadText, loadBinary, loadDate, loadUUID, loadRef, loadRawRef,
+ loadMbEmpty, loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbUUID, loadMbRef, loadMbRawRef,
loadTexts, loadBinaries, loadRefs, loadRawRefs,
loadZRef,
@@ -69,7 +69,6 @@ import Control.Monad.Writer
import Crypto.Hash
-import qualified Data.Aeson as J
import Data.ByteString (ByteString)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
@@ -192,7 +191,6 @@ copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM copyItem rs
RecBinary x -> return $ return $ RecBinary x
RecDate x -> return $ return $ RecDate x
RecUUID x -> return $ return $ RecUUID x
- RecJson x -> return $ return $ RecJson x
RecRef x -> fmap RecRef <$> copyRef' st x
copyObject' _ ZeroObject = return $ return ZeroObject
@@ -226,7 +224,6 @@ data RecItem' c
| RecBinary ByteString
| RecDate ZonedTime
| RecUUID UUID
- | RecJson J.Value
| RecRef (Ref' c)
deriving (Show)
@@ -261,7 +258,6 @@ serializeRecItem name (RecText x) = [name, BC.pack ":t", BC.singleton ' ', escap
serializeRecItem name (RecBinary x) = [name, BC.pack ":b ", showHex x, BC.singleton '\n']
serializeRecItem name (RecDate x) = [name, BC.pack ":d", BC.singleton ' ', BC.pack (formatTime defaultTimeLocale "%s %z" x), BC.singleton '\n']
serializeRecItem name (RecUUID x) = [name, BC.pack ":u", BC.singleton ' ', U.toASCIIBytes x, BC.singleton '\n']
-serializeRecItem name (RecJson x) = [name, BC.pack ":j", BC.singleton ' '] ++ BL.toChunks (J.encode x) ++ [BC.singleton '\n']
serializeRecItem name (RecRef x) = [name, BC.pack ":r ", showRef x, BC.singleton '\n']
lazyLoadObject :: forall c. StorageCompleteness c => Ref' c -> LoadResult c (Object' c)
@@ -326,7 +322,6 @@ unsafeDeserializeObject st bytes =
"b" -> RecBinary <$> readHex content
"d" -> RecDate <$> parseTimeM False defaultTimeLocale "%s %z" (BC.unpack content)
"u" -> RecUUID <$> U.fromASCIIBytes content
- "j" -> RecJson <$> J.decode (BL.fromStrict content)
"r" -> RecRef . Ref st <$> readRefDigest content
_ -> Nothing
return (name, val)
@@ -697,12 +692,6 @@ storeUUID name x = tell [return [(BC.pack name, RecUUID $ toUUID x)]]
storeMbUUID :: StorableUUID a => String -> Maybe a -> StoreRec c
storeMbUUID name = maybe (return ()) (storeUUID name)
-storeJson :: J.ToJSON a => String -> a -> StoreRec c
-storeJson name x = tell [return [(BC.pack name, RecJson $ J.toJSON x)]]
-
-storeMbJson :: J.ToJSON a => String -> Maybe a -> StoreRec c
-storeMbJson name = maybe (return ()) (storeJson name)
-
storeRef :: Storable a => StorageCompleteness c => String -> a -> StoreRec c
storeRef name x = do
s <- ask
@@ -823,17 +812,6 @@ loadMbUUID name = asks (lookup (BC.pack name) . snd) >>= \case
Just (RecUUID x) -> return $ Just $ fromUUID x
Just _ -> throwError $ "Expecting type UUID of record item '"++name++"'"
-loadJson :: J.FromJSON a => String -> LoadRec a
-loadJson name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbJson name
-
-loadMbJson :: J.FromJSON a => String -> LoadRec (Maybe a)
-loadMbJson name = asks (lookup (BC.pack name) . snd) >>= \case
- Nothing -> return Nothing
- Just (RecJson v) -> case J.fromJSON v of
- J.Error err -> throwError err
- J.Success x -> return (Just x)
- Just _ -> throwError $ "Expecting type JSON of record item '"++name++"'"
-
loadRawRef :: String -> LoadRec Ref
loadRawRef name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbRawRef name