Function to load Storable from Stored Object

2 files changed, 10 insertions, 4 deletions

diff --git a/src/Erebos/Object/Internal.hs b/src/Erebos/Object/Internal.hs
index b624d1c..778f80a 100644
--- a/src/Erebos/Object/Internal.hs
+++ b/src/Erebos/Object/Internal.hs
@@ -30,7 +30,7 @@ module Erebos.Object.Internal (
     storeRecItems,
 
     Load, LoadRec,
-    evalLoad,
+    evalLoad, evalLoadWithObject,
     loadCurrentRef, loadCurrentObject,
     loadRecCurrentRef, loadRecItems,
 
@@ -454,8 +454,11 @@ newtype Load a = Load (ReaderT (Ref, Object) (Except ErebosError) a)
     deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadError ErebosError)
 
 evalLoad :: Load a -> Ref -> a
-evalLoad (Load f) ref = either (error {- TODO throw -} . ((BC.unpack (showRef ref) ++ ": ") ++) . showErebosError) id $
-    runExcept $ runReaderT f (ref, lazyLoadObject ref)
+evalLoad act ref = evalLoadWithObject act ref (lazyLoadObject ref)
+
+evalLoadWithObject :: Load a -> Ref -> Object -> a
+evalLoadWithObject (Load f) ref obj = either (error {- TODO throw -} . ((BC.unpack (showRef ref) ++ ": ") ++) . showErebosError) id $
+    runExcept $ runReaderT f ( ref, obj )
 
 loadCurrentRef :: Load Ref
 loadCurrentRef = Load $ asks fst
diff --git a/src/Erebos/Storable/Internal.hs b/src/Erebos/Storable/Internal.hs
index 4ab48a5..70b5fdc 100644
--- a/src/Erebos/Storable/Internal.hs
+++ b/src/Erebos/Storable/Internal.hs
@@ -5,7 +5,7 @@ module Erebos.Storable.Internal (
     Stored(..),
     fromStored, storedRef,
     storedStorage,
-    wrappedStore, wrappedLoad,
+    wrappedStore, wrappedLoad, loadFromObject,
     copyStored,
     unsafeMapStored,
 
@@ -61,6 +61,9 @@ wrappedStore st x = do ref <- liftIO $ store st x
 wrappedLoad :: Storable a => Ref -> Stored a
 wrappedLoad ref = Stored ref (load ref)
 
+loadFromObject :: Storable a => Stored Object -> Stored a
+loadFromObject (Stored ref obj) = Stored ref (evalLoadWithObject load' ref obj)
+
 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'