Attach device service

1 files changed, 13 insertions, 1 deletions

diff --git a/src/Storage.hs b/src/Storage.hs
index d78d99a..d29056f 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -29,12 +29,14 @@ module Storage (
 
     loadBlob, loadRec, loadZero,
     loadInt, loadNum, loadText, loadBinary, loadDate, loadJson, loadRef,
-    loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef, loadRefs,
+    loadMbInt, loadMbNum, loadMbText, loadMbBinary, loadMbDate, loadMbJson, loadMbRef,
+    loadBinaries, loadRefs,
     loadZRef,
 
     Stored,
     fromStored, storedRef, storedStorage,
     wrappedStore, wrappedLoad,
+    copyStored,
 
     StoreInfo(..), makeStoreInfo,
 
@@ -631,6 +633,12 @@ loadMbBinary name = asks (lookup (BC.pack name) . snd) >>= \case
     Just (RecBinary x) -> return $ Just $ BA.convert x
     Just _ -> throwError $ "Expecting type binary of record item '"++name++"'"
 
+loadBinaries :: BA.ByteArray a => String -> LoadRec [a]
+loadBinaries name = do
+    items <- map snd . filter ((BC.pack name ==) . fst) <$> asks snd
+    forM items $ \case RecBinary x -> return $ BA.convert x
+                       _ -> throwError $ "Expecting type binary of record item '"++name++"'"
+
 loadDate :: StorableDate a => String -> LoadRec a
 loadDate name = maybe (throwError $ "Missing record item '"++name++"'") return =<< loadMbDate name
 
@@ -719,6 +727,10 @@ wrappedStore st x = do ref <- 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'
+
 
 data StoreInfo = StoreInfo
     { infoDate :: ZonedTime