summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2019-05-01 23:57:57 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2019-05-02 20:59:56 +0200
commit1c318c639bde0a1ed5520193044534860fc49b84 (patch)
tree0c22176abe4b15df7b29722e3e46b0676b7a659e
parent72b0141750f2ca3393fb2b45eb8a4dfc95d9c2b4 (diff)
Storage: serialization/deserialization without refs
-rw-r--r--src/Storage.hs40
1 files changed, 25 insertions, 15 deletions
diff --git a/src/Storage.hs b/src/Storage.hs
index 44e1491..3e12506 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -6,6 +6,7 @@ module Storage (
readRef, showRef,
Object(..), RecItem(..),
+ serializeObject, deserializeObject,
storeRawBytes, lazyLoadBytes,
Head,
@@ -162,12 +163,17 @@ data RecItem = RecInt Integer
| RecRef Ref
deriving (Show)
+serializeObject :: Object -> BL.ByteString
+serializeObject = \case
+ Blob cnt -> BL.fromChunks [BC.pack "blob ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
+ Rec rec -> let cnt = BL.fromChunks $ concatMap (uncurry serializeRecItem) rec
+ in BL.fromChunks [BC.pack "rec ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt
+ ZeroObject -> BL.empty
+
storeObject :: Storage -> Object -> IO Ref
storeObject storage = \case
- Blob cnt -> storeRawBytes storage $ BL.fromChunks [BC.pack "blob ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
- Rec rec -> let cnt = BL.fromChunks $ concatMap (uncurry serializeRecItem) rec
- in storeRawBytes storage $ BL.fromChunks [BC.pack "rec ", BC.pack (show $ BL.length cnt), BC.singleton '\n'] `BL.append` cnt
ZeroObject -> return $ zeroRef storage
+ obj -> storeRawBytes storage $ serializeObject obj
storeRawBytes :: Storage -> BL.ByteString -> IO Ref
storeRawBytes st raw = do
@@ -199,20 +205,24 @@ lazyLoadObject' ref@(Ref st rhash) = unsafePerformIO $ do
file <- decompress <$> (BL.readFile $ refPath ref)
let Ref _ chash = Ref st $ hash file
when (chash /= rhash) $ error $ "Hash mismatch on object " ++ BC.unpack (showRef ref) {- TODO throw -}
-
- obj <- case BLC.break (=='\n') file of
- (line, rest) | Just (otype, len) <- splitObjPrefix line -> do
- let content = BL.toStrict $ BL.drop 1 rest
- guard $ B.length content == len
- case otype of
- _ | otype == BC.pack "blob" -> return $ Blob content
- | otype == BC.pack "rec" -> maybe (error $ "Malformed record item in " ++ BC.unpack (showRef ref))
- (return . Rec) $ sequence $ map parseRecLine $ BC.lines content
- | otherwise -> error $ "Unknown object type of " ++ BC.unpack (showRef ref) {- TODO throw -}
- _ -> error $ "Malformed object " ++ BC.unpack (showRef ref) {- TODO throw -}
-
+ let obj = case runExcept $ deserializeObject st file of
+ Left err -> error $ err ++ ", ref " ++ BC.unpack (showRef ref) {- TODO throw -}
+ Right x -> x
return (obj, file)
+deserializeObject :: Storage -> BL.ByteString -> Except String Object
+deserializeObject _ bytes | BL.null bytes = return ZeroObject
+deserializeObject st bytes =
+ case BLC.break (=='\n') bytes of
+ (line, rest) | Just (otype, len) <- splitObjPrefix line -> do
+ let content = BL.toStrict $ BL.drop 1 rest
+ guard $ B.length content == len
+ case otype of
+ _ | otype == BC.pack "blob" -> return $ Blob content
+ | otype == BC.pack "rec" -> maybe (throwError $ "Malformed record item ")
+ (return . Rec) $ sequence $ map parseRecLine $ BC.lines content
+ | otherwise -> throwError $ "Unknown object type"
+ _ -> throwError $ "Malformed object"
where splitObjPrefix line = do
[otype, tlen] <- return $ BLC.words line
(len, rest) <- BLC.readInt tlen