diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Erebos/Storage.hs | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs index 2e60f4e..65210f9 100644 --- a/src/Erebos/Storage.hs +++ b/src/Erebos/Storage.hs @@ -226,6 +226,7 @@ copyObject' :: forall c c'. (StorageCompleteness c, StorageCompleteness c') => S copyObject' _ (Blob bs) = return $ return $ Blob bs copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM (\( n, item ) -> fmap ( n, ) <$> copyRecItem' st item) rs copyObject' _ ZeroObject = return $ return ZeroObject +copyObject' _ (UnknownObject otype content) = return $ return $ UnknownObject otype content copyRef :: forall c c' m. (StorageCompleteness c, StorageCompleteness c', MonadIO m) => Storage' c' -> Ref' c -> m (LoadResult c (Ref' c')) copyRef st ref' = liftIO $ returnLoadResult <$> copyRef' st ref' @@ -247,6 +248,7 @@ data Object' c = Blob ByteString | Rec [(ByteString, RecItem' c)] | ZeroObject + | UnknownObject ByteString ByteString deriving (Show) type Object = Object' Complete @@ -271,6 +273,7 @@ serializeObject = \case 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 + UnknownObject otype cnt -> BL.fromChunks [ otype, BC.singleton ' ', BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ] -- |Serializes and stores object data without ony dependencies, so is safe only -- if all the referenced objects are already stored or reference is partial. @@ -329,7 +332,7 @@ unsafeDeserializeObject st bytes = _ | otype == BC.pack "blob" -> return $ Blob content | otype == BC.pack "rec" -> maybe (throwError $ "Malformed record item ") (return . Rec) $ sequence $ map parseRecLine $ mergeCont [] $ BC.lines content - | otherwise -> throwError $ "Unknown object type" + | otherwise -> return $ UnknownObject otype content _ -> throwError $ "Malformed object" where splitObjPrefix line = do [otype, tlen] <- return $ BLC.words line @@ -610,6 +613,7 @@ class Storable a => ZeroStorable a where data Store = StoreBlob ByteString | StoreRec (forall c. StorageCompleteness c => Storage' c -> [IO [(ByteString, RecItem' c)]]) | StoreZero + | StoreUnknown ByteString ByteString evalStore :: StorageCompleteness c => Storage' c -> Store -> IO (Ref' c) evalStore st = unsafeStoreObject st <=< evalStoreObject st @@ -618,6 +622,7 @@ evalStoreObject :: StorageCompleteness c => Storage' c -> Store -> IO (Object' c evalStoreObject _ (StoreBlob x) = return $ Blob x evalStoreObject s (StoreRec f) = Rec . concat <$> sequence (f s) evalStoreObject _ StoreZero = return ZeroObject +evalStoreObject _ (StoreUnknown otype content) = return $ UnknownObject otype content newtype StoreRecM c a = StoreRecM (ReaderT (Storage' c) (Writer [IO [(ByteString, RecItem' c)]]) a) deriving (Functor, Applicative, Monad) @@ -652,6 +657,7 @@ instance Storable Object where Rec xs' <- copyObject st (Rec xs) return xs' store' ZeroObject = StoreZero + store' (UnknownObject otype content) = StoreUnknown otype content load' = loadCurrentObject |