make storage to use configurable on command line

1 files changed, 15 insertions, 0 deletions

diff --git a/Storage.hs b/Storage.hs
index d13cbfe..d1a3ad8 100644
--- a/Storage.hs
+++ b/Storage.hs
@@ -6,6 +6,7 @@
 module Storage where
 
 import Types
+import Shard
 
 data Storage = Storage
 	{ storeShard :: StorableObjectIdent -> Shard -> IO StoreResult
@@ -26,3 +27,17 @@ data ObscureResult = ObscureSuccess | ObscureFailure String
 
 data CountResult = CountResult Integer | CountFailure String
 	deriving (Show)
+
+storeShards :: Storage -> ShardIdents -> [(IO (), Shard)] -> IO StoreResult
+storeShards storage sis shards = do
+	r <- go (zip (getIdents sis) shards)
+	_ <- obscureShards storage
+	return r
+  where
+	go [] = return StoreSuccess
+	go ((i,(showprogress, s)):rest) = do
+		r <- storeShard storage i s
+		_ <- showprogress
+		case r of
+			StoreSuccess -> go rest
+			_ -> return r