Move Stored declaration to Object.Storable module

11 files changed, 112 insertions, 94 deletions

diff --git a/erebos.cabal b/erebos.cabal
index e45b824..da9e78d 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -124,6 +124,7 @@ library
         Erebos.Network.Channel
         Erebos.Network.Protocol
         Erebos.Object.Internal
+        Erebos.Storable.Internal
         Erebos.Storage.Disk
         Erebos.Storage.Internal
         Erebos.Storage.Memory
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index 05717ef..7f0bbbf 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -73,6 +73,7 @@ import Erebos.Object.Internal
 import Erebos.PubKey
 import Erebos.Service
 import Erebos.State
+import Erebos.Storable.Internal
 import Erebos.Storage
 import Erebos.Storage.Key
 import Erebos.Storage.Merge
diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index 799d185..5c81bf5 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -6,7 +6,8 @@ module Erebos.Object.Internal (
     readRef, showRef,
     readRefDigest, showRefDigest,
     refDigestFromByteString, hashToRefDigest,
-    copyRef, partialRef, partialRefFromDigest,
+    copyRef, copyRef', partialRef, partialRefFromDigest,
+    zeroRef,
 
     Object, PartialObject, Object'(..),
     RecItem, RecItem'(..),
@@ -15,9 +16,6 @@ module Erebos.Object.Internal (
     ioLoadObject, ioLoadBytes,
     storeRawBytes, lazyLoadBytes,
     storeObject,
-    collectObjects, collectStoredObjects,
-
-    MonadStorage(..),
 
     Storable(..), ZeroStorable(..),
     StorableText(..), StorableDate(..), StorableUUID(..),
@@ -40,12 +38,6 @@ module Erebos.Object.Internal (
     loadMbEmpty, loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbUUID, loadMbRef, loadMbRawRef, loadMbRawWeak,
     loadTexts, loadBinaries, loadRefs, loadRawRefs, loadRawWeaks,
     loadZRef,
-
-    Stored,
-    fromStored, storedRef,
-    wrappedStore, wrappedLoad,
-    copyStored,
-    unsafeMapStored,
 ) where
 
 import Control.Applicative
@@ -69,8 +61,6 @@ import Data.Char
 import Data.Function
 import Data.Maybe
 import Data.Ratio
-import Data.Set (Set)
-import Data.Set qualified as S
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding
@@ -386,40 +376,10 @@ deserializeObjects st bytes = do (obj, rest) <- deserializeObject st bytes
                                  (obj:) <$> deserializeObjects st rest
 
 
-collectObjects :: Object -> [Object]
-collectObjects obj = obj : map fromStored (fst $ collectOtherStored S.empty obj)
-
-collectStoredObjects :: Stored Object -> [Stored Object]
-collectStoredObjects obj = obj : (fst $ collectOtherStored S.empty $ fromStored obj)
-
-collectOtherStored :: Set RefDigest -> Object -> ([Stored Object], Set RefDigest)
-collectOtherStored seen (Rec items) = foldr helper ([], seen) $ map snd items
-    where helper (RecRef ref) (xs, s) | r <- refDigest ref
-                                      , r `S.notMember` s
-                                      = let o = wrappedLoad ref
-                                            (xs', s') = collectOtherStored (S.insert r s) $ fromStored o
-                                         in ((o : xs') ++ xs, s')
-          helper _          (xs, s) = (xs, s)
-collectOtherStored seen _ = ([], seen)
-
-
 deriving instance StorableUUID HeadID
 deriving instance StorableUUID HeadTypeID
 
 
-class Monad m => MonadStorage m where
-    getStorage :: m Storage
-    mstore :: Storable a => a -> m (Stored a)
-
-    default mstore :: MonadIO m => Storable a => a -> m (Stored a)
-    mstore x = do
-        st <- getStorage
-        wrappedStore st x
-
-instance MonadIO m => MonadStorage (ReaderT Storage m) where
-    getStorage = ask
-
-
 class Storable a where
     store' :: a -> Store
     load' :: Load a
@@ -812,36 +772,6 @@ loadRawWeaks name = mapMaybe p <$> loadRecItems
     p _                                     = Nothing
 
 
-
-instance Storable a => Storable (Stored a) where
-    store st = copyRef st . storedRef
-    store' (Stored _ x) = store' x
-    load' = Stored <$> loadCurrentRef <*> load'
-
-instance ZeroStorable a => ZeroStorable (Stored a) where
-    fromZero st = Stored (zeroRef st) $ fromZero st
-
-fromStored :: Stored a -> a
-fromStored = storedObject'
-
-storedRef :: Stored a -> Ref
-storedRef = storedRef'
-
-wrappedStore :: MonadIO m => Storable a => Storage -> a -> m (Stored a)
-wrappedStore st x = do ref <- liftIO $ store st x
-                       return $ Stored ref x
-
-wrappedLoad :: Storable a => Ref -> Stored a
-wrappedLoad ref = Stored ref (load ref)
-
-copyStored :: forall m a. MonadIO m => Storage -> Stored a -> m (Stored a)
-copyStored st (Stored ref' x) = liftIO $ returnLoadResult . fmap (\r -> Stored r x) <$> copyRef' st ref'
-
--- |Passed function needs to preserve the object representation to be safe
-unsafeMapStored :: (a -> b) -> Stored a -> Stored b
-unsafeMapStored f (Stored ref x) = Stored ref (f x)
-
-
 showRatio :: Rational -> String
 showRatio r = case decimalRatio r of
                    Just (n, 1) -> show n
diff --git a/src/Erebos/Storable.hs b/src/Erebos/Storable.hs
index 055309a..cd0d97d 100644
--- a/src/Erebos/Storable.hs
+++ b/src/Erebos/Storable.hs
@@ -43,3 +43,4 @@ module Erebos.Storable (
 
 import Erebos.Error
 import Erebos.Object.Internal
+import Erebos.Storable.Internal
diff --git a/src/Erebos/Storable/Internal.hs b/src/Erebos/Storable/Internal.hs
new file mode 100644
index 0000000..4ab48a5
--- /dev/null
+++ b/src/Erebos/Storable/Internal.hs
@@ -0,0 +1,100 @@
+module Erebos.Storable.Internal (
+    Storable(..), ZeroStorable(..),
+    StorableText(..), StorableDate(..), StorableUUID(..),
+
+    Stored(..),
+    fromStored, storedRef,
+    storedStorage,
+    wrappedStore, wrappedLoad,
+    copyStored,
+    unsafeMapStored,
+
+    collectObjects, collectStoredObjects,
+
+    MonadStorage(..),
+) where
+
+import Control.Monad.Reader
+
+import Data.Function
+import Data.Set (Set)
+import Data.Set qualified as S
+
+import Erebos.Storage.Internal
+
+import Erebos.Object.Internal
+
+
+data Stored a = Stored
+    { storedRef' :: Ref
+    , storedObject' :: a
+    }
+    deriving (Show)
+
+instance Eq (Stored a) where
+    (==)  =  (==) `on` (refDigest . storedRef')
+
+instance Ord (Stored a) where
+    compare  =  compare `on` (refDigest . storedRef')
+
+instance Storable a => Storable (Stored a) where
+    store st = copyRef st . storedRef
+    store' (Stored _ x) = store' x
+    load' = Stored <$> loadCurrentRef <*> load'
+
+instance ZeroStorable a => ZeroStorable (Stored a) where
+    fromZero st = Stored (zeroRef st) $ fromZero st
+
+fromStored :: Stored a -> a
+fromStored = storedObject'
+
+storedRef :: Stored a -> Ref
+storedRef = storedRef'
+
+storedStorage :: Stored a -> Storage
+storedStorage = refStorage . storedRef'
+
+wrappedStore :: MonadIO m => Storable a => Storage -> a -> m (Stored a)
+wrappedStore st x = do ref <- liftIO $ store st x
+                       return $ Stored ref x
+
+wrappedLoad :: Storable a => Ref -> Stored a
+wrappedLoad ref = Stored ref (load ref)
+
+copyStored :: forall m a. MonadIO m => Storage -> Stored a -> m (Stored a)
+copyStored st (Stored ref' x) = liftIO $ returnLoadResult . fmap (\r -> Stored r x) <$> copyRef' st ref'
+
+-- |Passed function needs to preserve the object representation to be safe
+unsafeMapStored :: (a -> b) -> Stored a -> Stored b
+unsafeMapStored f (Stored ref x) = Stored ref (f x)
+
+collectStoredObjects :: Stored Object -> [ Stored Object ]
+collectStoredObjects obj = obj : (fst $ collectOtherStored S.empty $ fromStored obj)
+
+
+collectObjects :: Object -> [Object]
+collectObjects obj = obj : map fromStored (fst $ collectOtherStored S.empty obj)
+
+collectOtherStored :: Set RefDigest -> Object -> ( [ Stored Object ], Set RefDigest )
+collectOtherStored seen (Rec items) = foldr helper ( [], seen ) $ map snd items
+    where helper (RecRef ref) (xs, s)
+              | r <- refDigest ref
+              , r `S.notMember` s
+              = let o = wrappedLoad ref
+                    (xs', s') = collectOtherStored (S.insert r s) $ fromStored o
+                 in ((o : xs') ++ xs, s')
+          helper _ ( xs, s ) = ( xs, s )
+collectOtherStored seen _ = ( [], seen )
+
+
+class Monad m => MonadStorage m where
+    getStorage :: m Storage
+    mstore :: Storable a => a -> m (Stored a)
+
+    default mstore :: MonadIO m => Storable a => a -> m (Stored a)
+    mstore x = do
+        st <- getStorage
+        wrappedStore st x
+
+instance MonadIO m => MonadStorage (ReaderT Storage m) where
+    getStorage = ask
diff --git a/src/Erebos/Storage.hs b/src/Erebos/Storage.hs
index f1cce84..d9559bc 100644
--- a/src/Erebos/Storage.hs
+++ b/src/Erebos/Storage.hs
@@ -24,6 +24,7 @@ module Erebos.Storage (
 ) where
 
 import Erebos.Object.Internal
+import Erebos.Storable.Internal
 import Erebos.Storage.Disk
 import Erebos.Storage.Head
 import Erebos.Storage.Memory
diff --git a/src/Erebos/Storage/Graph.hs b/src/Erebos/Storage/Graph.hs
index 79e25bc..1312941 100644
--- a/src/Erebos/Storage/Graph.hs
+++ b/src/Erebos/Storage/Graph.hs
@@ -40,7 +40,7 @@ import Data.Set qualified as S
 import System.IO.Unsafe (unsafePerformIO)
 
 import Erebos.Object
-import Erebos.Storable
+import Erebos.Storable.Internal
 import Erebos.Storage.Internal
 import Erebos.Util
 
diff --git a/src/Erebos/Storage/Head.hs b/src/Erebos/Storage/Head.hs
index 285902d..87212f0 100644
--- a/src/Erebos/Storage/Head.hs
+++ b/src/Erebos/Storage/Head.hs
@@ -30,7 +30,7 @@ import Data.Bifunctor
 import Data.Typeable
 
 import Erebos.Object
-import Erebos.Storable
+import Erebos.Storable.Internal
 import Erebos.Storage.Backend
 import Erebos.Storage.Internal
 import Erebos.UUID qualified as U
diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
index 70a69b4..c7255ef 100644
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -19,7 +19,6 @@ module Erebos.Storage.Internal (
 
     Generation(..),
     HeadID(..), HeadTypeID(..),
-    Stored(..), storedStorage,
 ) where
 
 import Control.Arrow
@@ -35,7 +34,6 @@ import Data.ByteArray qualified as BA
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
-import Data.Function
 import Data.HashTable.IO qualified as HT
 import Data.Hashable
 import Data.Kind
@@ -238,21 +236,6 @@ newtype HeadID = HeadID UUID
 newtype HeadTypeID = HeadTypeID UUID
     deriving (Eq, Ord)
 
-data Stored a = Stored
-    { storedRef' :: Ref
-    , storedObject' :: a
-    }
-    deriving (Show)
-
-instance Eq (Stored a) where
-    (==)  =  (==) `on` (refDigest . storedRef')
-
-instance Ord (Stored a) where
-    compare  =  compare `on` (refDigest . storedRef')
-
-storedStorage :: Stored a -> Storage
-storedStorage = refStorage . storedRef'
-
 
 type Complete = Identity
 type Partial = Either RefDigest
diff --git a/src/Erebos/Storage/Key.hs b/src/Erebos/Storage/Key.hs
index b615f16..85ebded 100644
--- a/src/Erebos/Storage/Key.hs
+++ b/src/Erebos/Storage/Key.hs
@@ -11,7 +11,9 @@ import Control.Monad.IO.Class
 import Data.ByteArray
 import Data.Typeable
 
-import Erebos.Storable
+import Erebos.Error
+import Erebos.Object.Internal
+import Erebos.Storable.Internal
 import Erebos.Storage.Internal
 
 class Storable pub => KeyPair sec pub | sec -> pub, pub -> sec where
diff --git a/src/Erebos/Storage/Merge.hs b/src/Erebos/Storage/Merge.hs
index 9de212f..ebb14bd 100644
--- a/src/Erebos/Storage/Merge.hs
+++ b/src/Erebos/Storage/Merge.hs
@@ -24,9 +24,8 @@ module Erebos.Storage.Merge (
 import Data.Kind
 
 import Erebos.Object
-import Erebos.Storable
+import Erebos.Storable.Internal
 import Erebos.Storage.Graph
-import Erebos.Storage.Internal
 
 
 class Storable (Component a) => Mergeable a where