From afaa0cc6790b55e2db31450d3a2951d524930585 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 2 Aug 2026 11:00:02 +0200 Subject: Function to load Storable from Stored Object --- src/Erebos/Object/Internal.hs | 9 ++++++--- src/Erebos/Storable/Internal.hs | 5 ++++- 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' -- cgit v1.2.3