From 4a620944be3d9f389aa63ef62c6478c199c329fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 18 Nov 2023 13:22:14 +0100
Subject: Drop JSON type support for record items

---
 src/Erebos/Storage.hs | 30 ++++--------------------------
 1 file changed, 4 insertions(+), 26 deletions(-)

(limited to 'src/Erebos')

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
 
-- 
cgit v1.2.3