Drop partial version of Stored typeHEADmaster

4 files changed, 20 insertions, 19 deletions

diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index 97ca7a3..fdb587a 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -703,8 +703,6 @@ loadRawWeaks name = mapMaybe p <$> loadRecItems
 
 
 
-type Stored a = Stored' Complete a
-
 instance Storable a => Storable (Stored a) where
     store st = copyRef st . storedRef
     store' (Stored _ x) = store' x
@@ -714,10 +712,10 @@ instance ZeroStorable a => ZeroStorable (Stored a) where
     fromZero st = Stored (zeroRef st) $ fromZero st
 
 fromStored :: Stored a -> a
-fromStored (Stored _ x) = x
+fromStored = storedObject'
 
 storedRef :: Stored a -> Ref
-storedRef (Stored ref _) = ref
+storedRef = storedRef'
 
 wrappedStore :: MonadIO m => Storable a => Storage -> a -> m (Stored a)
 wrappedStore st x = do ref <- liftIO $ store st x
@@ -726,9 +724,8 @@ wrappedStore st x = do ref <- liftIO $ store st x
 wrappedLoad :: Storable a => Ref -> Stored a
 wrappedLoad ref = Stored ref (load ref)
 
-copyStored :: forall c c' m a. (StorageCompleteness c, StorageCompleteness c', MonadIO m) =>
-    Storage' c' -> Stored' c a -> m (LoadResult c (Stored' c' a))
-copyStored st (Stored ref' x) = liftIO $ returnLoadResult . fmap (flip Stored x) <$> copyRef' st 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
diff --git a/src/Erebos/Storage/Head.hs b/src/Erebos/Storage/Head.hs
index 3239fe0..285902d 100644
--- a/src/Erebos/Storage/Head.hs
+++ b/src/Erebos/Storage/Head.hs
@@ -113,7 +113,7 @@ loadHeadRaw st@Storage {..} tid hid = do
 -- | Reload the given head from storage, returning `Head' with updated object,
 -- or `Nothing' if there is no longer head with the particular ID in storage.
 reloadHead :: (HeadType a, MonadIO m) => Head a -> m (Maybe (Head a))
-reloadHead (Head hid (Stored (Ref st _) _)) = loadHead st hid
+reloadHead (Head hid val) = loadHead (storedStorage val) hid
 
 -- | Store a new `Head' of type 'a' in the storage.
 storeHead :: forall a m. MonadIO m => HeadType a => Storage -> a -> m (Head a)
@@ -232,8 +232,8 @@ watchHeadWith
     -> (Head a -> b)  -- ^ Selector function
     -> (b -> IO ())  -- ^ Callback
     -> IO WatchedHead  -- ^ Watched head handle
-watchHeadWith (Head hid (Stored (Ref st _) _)) sel cb = do
-    watchHeadRaw st (headTypeID @a Proxy) hid (sel . Head hid . wrappedLoad) cb
+watchHeadWith (Head hid val) sel cb = do
+    watchHeadRaw (storedStorage val) (headTypeID @a Proxy) hid (sel . Head hid . wrappedLoad) cb
 
 -- | Watch the given head using raw IDs and a selector from `Ref'.
 watchHeadRaw :: forall b. Eq b => Storage -> HeadTypeID -> HeadID -> (Ref -> b) -> (b -> IO ()) -> IO WatchedHead
diff --git a/src/Erebos/Storage/Internal.hs b/src/Erebos/Storage/Internal.hs
index 303beb3..db211bb 100644
--- a/src/Erebos/Storage/Internal.hs
+++ b/src/Erebos/Storage/Internal.hs
@@ -20,7 +20,7 @@ module Erebos.Storage.Internal (
 
     Generation(..),
     HeadID(..), HeadTypeID(..),
-    Stored'(..), storedStorage,
+    Stored(..), storedStorage,
 ) where
 
 import Control.Arrow
@@ -37,6 +37,7 @@ 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
@@ -239,17 +240,20 @@ newtype HeadID = HeadID UUID
 newtype HeadTypeID = HeadTypeID UUID
     deriving (Eq, Ord)
 
-data Stored' c a = Stored (Ref' c) a
+data Stored a = Stored
+    { storedRef' :: Ref
+    , storedObject' :: a
+    }
     deriving (Show)
 
-instance Eq (Stored' c a) where
-    Stored r1 _ == Stored r2 _  =  refDigest r1 == refDigest r2
+instance Eq (Stored a) where
+    (==)  =  (==) `on` (refDigest . storedRef')
 
-instance Ord (Stored' c a) where
-    compare (Stored r1 _) (Stored r2 _) = compare (refDigest r1) (refDigest r2)
+instance Ord (Stored a) where
+    compare  =  compare `on` (refDigest . storedRef')
 
-storedStorage :: Stored' c a -> Storage' c
-storedStorage (Stored (Ref st _) _) = st
+storedStorage :: Stored a -> Storage
+storedStorage = refStorage . storedRef'
 
 
 type Complete = Identity
diff --git a/src/Erebos/Storage/Merge.hs b/src/Erebos/Storage/Merge.hs
index 41725af..a41a65f 100644
--- a/src/Erebos/Storage/Merge.hs
+++ b/src/Erebos/Storage/Merge.hs
@@ -52,7 +52,7 @@ merge xs = mergeSorted $ filterAncestors xs
 
 storeMerge :: (Mergeable a, Storable a) => [Stored (Component a)] -> IO (Stored a)
 storeMerge [] = error "merge: empty list"
-storeMerge xs@(Stored ref _ : _) = wrappedStore (refStorage ref) $ mergeSorted $ filterAncestors xs
+storeMerge xs@(x : _) = wrappedStore (storedStorage x) $ mergeSorted $ filterAncestors xs
 
 previous :: Storable a => Stored a -> [Stored a]
 previous (Stored ref _) = case load ref of