1 files changed, 52 insertions, 5 deletions
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index a785836..758c5f9 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -8,7 +8,9 @@ module Erebos.Object.Internal (
     refDigestFromByteString, hashToRefDigest,
     copyRef, partialRef, partialRefFromDigest,
 
-    Object, PartialObject, Object'(..), RecItem, RecItem'(..),
+    Object, PartialObject, Object'(..),
+    RecItem, RecItem'(..),
+    DirItem, DirItem'(..),
     serializeObject, deserializeObject, deserializeObjects,
     ioLoadObject, ioLoadBytes,
     storeRawBytes, lazyLoadBytes,
@@ -134,6 +136,10 @@ copyObject' _ (Blob bs) = return $ return $ Blob bs
 copyObject' st (Rec rs) = fmap Rec . sequence <$> mapM (\( n, item ) -> fmap ( n, ) <$> copyRecItem' st item) rs
 copyObject' _ (OnDemand size dgst) = return $ return $ OnDemand size dgst
 copyObject' _ (Chunked size dgsts) = return $ return $ Chunked size dgsts
+copyObject' st (Dir items) = fmap Dir . sequence <$> mapM copyItem items
+  where
+    copyItem (DirItem d m f) = do d' <- copyRef' st d; m' <- copyRef' st m;
+                                  return $ DirItem <$> d' <*> m' <*> pure f
 copyObject' _ ZeroObject = return $ return ZeroObject
 copyObject' _ (UnknownObject otype content) = return $ return $ UnknownObject otype content
 
@@ -158,6 +164,7 @@ data Object' c
     | Rec [ ( ByteString, RecItem' c ) ]
     | OnDemand Word64 RefDigest
     | Chunked Word64 [ RefDigest ]
+    | Dir [ DirItem' c ]
     | ZeroObject
     | UnknownObject ByteString ByteString
     deriving (Show)
@@ -180,6 +187,16 @@ data RecItem' c
 
 type RecItem = RecItem' Complete
 
+data DirItem' c = DirItem
+    { dirItemData :: Ref' c
+    , dirItemMetadata :: Ref' c
+    , dirItemFilename :: Text
+    }
+    deriving (Show)
+
+type DirItem = DirItem' Complete
+
+
 serializeObject :: Object' c -> BL.ByteString
 serializeObject = \case
     Blob cnt -> BL.fromChunks [BC.pack "blob ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt]
@@ -192,6 +209,9 @@ serializeObject = \case
     Chunked size dgsts ->
         let cnt = BC.unlines $ BC.pack (show size) : map showRefDigest dgsts
          in BL.fromChunks [ BC.pack "chunked ", BC.pack (show $ B.length cnt), BC.singleton '\n', cnt ]
+    Dir items ->
+        let cnt = BL.fromChunks $ map (\(DirItem d m f) -> BC.concat [ showRef d, BC.singleton ' ', showRef m, BC.singleton ' ', serializeText f, BC.singleton '\n' ]) items
+         in BL.fromChunks [ BC.pack "dir ", 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 ]
 
@@ -218,10 +238,7 @@ serializeRecItem :: ByteString -> RecItem' c -> [ByteString]
 serializeRecItem name (RecEmpty) = [name, BC.pack ":e", BC.singleton ' ', BC.singleton '\n']
 serializeRecItem name (RecInt x) = [name, BC.pack ":i", BC.singleton ' ', BC.pack (show x), BC.singleton '\n']
 serializeRecItem name (RecNum x) = [name, BC.pack ":n", BC.singleton ' ', BC.pack (showRatio x), BC.singleton '\n']
-serializeRecItem name (RecText x) = [name, BC.pack ":t", BC.singleton ' ', escaped, BC.singleton '\n']
-    where escaped = BC.concatMap escape $ encodeUtf8 x
-          escape '\n' = BC.pack "\n\t"
-          escape c    = BC.singleton c
+serializeRecItem name (RecText x) = [name, BC.pack ":t", BC.singleton ' ', serializeText x, BC.singleton '\n']
 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']
@@ -229,6 +246,12 @@ serializeRecItem name (RecRef x) = [name, BC.pack ":r ", showRef x, BC.singleton
 serializeRecItem name (RecWeak x) = [name, BC.pack ":w ", showRefDigest x, BC.singleton '\n']
 serializeRecItem name (RecUnknown t x) = [ name, BC.singleton ':', t, BC.singleton ' ', x, BC.singleton '\n' ]
 
+serializeText :: Text -> ByteString
+serializeText = BC.concatMap escape . encodeUtf8
+  where
+    escape '\n' = BC.pack "\n\t"
+    escape c    = BC.singleton c
+
 lazyLoadObject :: forall c. StorageCompleteness c => Ref' c -> LoadResult c (Object' c)
 lazyLoadObject = returnLoadResult . unsafePerformIO . ioLoadObject
 
@@ -268,6 +291,9 @@ unsafeDeserializeObject st bytes =
                 | otype == BC.pack "chunked"
                 , Just chunked <- parseChunked st content
                     -> return chunked
+                | otype == BC.pack "dir"
+                , Just dir <- parseDir st content
+                    -> return dir
                 | otherwise
                     -> return $ UnknownObject otype content
         _ -> throwOtherError $ "malformed object"
@@ -339,6 +365,22 @@ parseChunked _ body = do
             newline <- BC.elemIndex '\n' bs
             (B.take newline bs :) <$> strictLines (B.drop (newline + 1) bs)
 
+parseDir :: Storage' c -> ByteString -> Maybe (Object' c)
+parseDir st body = Dir <$> parseDirBody st body
+
+parseDirBody :: Storage' c -> ByteString -> Maybe [ DirItem' c ]
+parseDirBody _ body | B.null body = Just []
+parseDirBody st body = do
+    space1 <- BC.elemIndex ' ' body
+    space2 <- BC.elemIndex ' ' $ B.drop (space1 + 1) body
+    ( filenameB, remainingBody ) <- parseTabEscapedLines $ B.drop (space1 + space2 + 2) body
+    let dataRefB = B.take space1 body
+        metaRefB = B.take space2 $ B.drop (space1 + 1) body
+        filename = decodeUtf8With lenientDecode filenameB
+    dataRef <- Ref st <$> readRefDigest dataRefB
+    metaRef <- Ref st <$> readRefDigest metaRefB
+    (DirItem dataRef metaRef filename :) <$> parseDirBody st remainingBody
+
 
 deserializeObject :: PartialStorage -> BL.ByteString -> Except ErebosError (PartialObject, BL.ByteString)
 deserializeObject = unsafeDeserializeObject
@@ -400,6 +442,7 @@ data Store
     | StoreRec (forall c. StorageCompleteness c => Storage' c -> [ IO [ ( ByteString, RecItem' c ) ]])
     | StoreOnDemand Word64 RefDigest
     | StoreChunked Word64 [ RefDigest ]
+    | StoreDir (forall c. StorageCompleteness c => Storage' c -> IO [ DirItem' c ])
     | StoreZero
     | StoreUnknown ByteString ByteString
 
@@ -411,6 +454,7 @@ evalStoreObject _ (StoreBlob x) = return $ Blob x
 evalStoreObject s (StoreRec f) = Rec . concat <$> sequence (f s)
 evalStoreObject _ (StoreOnDemand size dgst) = return $ OnDemand size dgst
 evalStoreObject _ (StoreChunked size dgsts) = return $ Chunked size dgsts
+evalStoreObject s (StoreDir f) = Dir <$> f s
 evalStoreObject _ StoreZero = return ZeroObject
 evalStoreObject _ (StoreUnknown otype content) = return $ UnknownObject otype content
 
@@ -449,6 +493,9 @@ instance Storable Object where
         return xs'
     store' (OnDemand size dgst) = StoreOnDemand size dgst
     store' (Chunked size dgsts) = StoreChunked size dgsts
+    store' (Dir items) = StoreDir $ \st -> do
+        Dir items' <- copyObject st (Dir items)
+        return items'
     store' ZeroObject = StoreZero
     store' (UnknownObject otype content) = StoreUnknown otype content