From 68b6de0d07f3b05345c0e88d5da4d54c5c457337 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Wed, 11 Jan 2023 14:51:18 +0300
Subject: [PATCH] oops

---
 hbs2-core/lib/HBS2/Defaults.hs                |  4 ++++
 hbs2-core/lib/HBS2/Prelude.hs                 |  2 --
 hbs2-core/lib/HBS2/Storage.hs                 |  5 ++++
 .../lib/HBS2/Storage/Simple.hs                |  7 ++----
 hbs2/Main.hs                                  | 24 +++++++++++++++----
 5 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Defaults.hs b/hbs2-core/lib/HBS2/Defaults.hs
index 731d7565..39609578 100644
--- a/hbs2-core/lib/HBS2/Defaults.hs
+++ b/hbs2-core/lib/HBS2/Defaults.hs
@@ -1,9 +1,13 @@
 module HBS2.Defaults where
 
+import Data.String
+
 defChunkSize :: Integer
 defChunkSize = 500
 
 defBlockSize :: Integer
 defBlockSize = 256 * 1024
 
+defStorePath :: IsString a => a
+defStorePath = "hbs2"
 
diff --git a/hbs2-core/lib/HBS2/Prelude.hs b/hbs2-core/lib/HBS2/Prelude.hs
index 466d421a..b95f59e8 100644
--- a/hbs2-core/lib/HBS2/Prelude.hs
+++ b/hbs2-core/lib/HBS2/Prelude.hs
@@ -1,12 +1,10 @@
 module HBS2.Prelude
   ( module Data.String
-  , module HBS2.Defaults
   -- , module HBS2.Prelude
   ) where
 
 import Data.String (IsString(..))
 
-import HBS2.Defaults
 
 
 
diff --git a/hbs2-core/lib/HBS2/Storage.hs b/hbs2-core/lib/HBS2/Storage.hs
index 0e7c78d7..e2d5f00f 100644
--- a/hbs2-core/lib/HBS2/Storage.hs
+++ b/hbs2-core/lib/HBS2/Storage.hs
@@ -5,6 +5,11 @@ import Data.Kind
 import Data.Hashable hiding (Hashed)
 
 import HBS2.Hash
+import HBS2.Prelude.Plated
+
+newtype StoragePrefix = StoragePrefix  { fromPrefix :: FilePath }
+                        deriving stock (Data,Show)
+                        deriving newtype (IsString)
 
 type family Block block :: Type
 type family Key block   :: Type
diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
index 8004753f..0bf120c0 100644
--- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
+++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs
@@ -54,9 +54,6 @@ newtype Raw a = Raw { fromRaw :: a }
 type instance Block (Raw LBS.ByteString) = LBS.ByteString
 type instance Key (Raw LBS.ByteString) = Hash HbSync
 
-newtype StoragePrefix = StoragePrefix  { fromPrefix :: FilePath }
-                        deriving stock (Data,Show)
-                        deriving newtype (IsString)
 
 newtype StorageQueueSize = StorageQueueSize { fromQueueSize :: Int }
                            deriving stock   (Data,Show)
@@ -85,6 +82,8 @@ simpleStorageInit opts = liftIO $ do
 
   pdir <- canonicalizePath (fromPrefix prefix)
 
+  print (pretty pdir)
+
   tbq <- TBMQ.newTBMQueueIO (fromIntegral (fromQueueSize qSize))
 
   hcache <- Cache.newCache (Just (toTimeSpec @'Seconds 1)) -- FIXME: real setting
@@ -95,8 +94,6 @@ simpleStorageInit opts = liftIO $ do
              , _storageChunksCache = hcache
              }
 
-  -- print ("STORAGE", stor ^. storageDir, stor ^. storageBlocks )
-
   createDirectoryIfMissing True (stor ^. storageBlocks)
 
   let alph = getAlphabet
diff --git a/hbs2/Main.hs b/hbs2/Main.hs
index 1a22ea16..5d354621 100644
--- a/hbs2/Main.hs
+++ b/hbs2/Main.hs
@@ -5,8 +5,11 @@ import Control.Monad.IO.Class
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as B
 import Data.Function
+import Data.Functor
 import Options.Applicative
 import Prettyprinter
+import System.Directory
+import System.FilePath.Posix
 import System.IO
 
 import Streaming.Prelude qualified as S
@@ -18,6 +21,7 @@ import HBS2.Prelude
 import HBS2.Prelude.Plated
 import HBS2.Merkle
 import HBS2.Hash
+import HBS2.Defaults
 
 newtype HashRef = HashRef (Hash HbSync)
                   deriving newtype (Eq,Ord,IsString,Pretty)
@@ -43,8 +47,8 @@ readChunked handle size = fuu
       S.yield chunk
       next
 
-runStore :: Opts -> IO ()
-runStore opts  = do
+runStore :: Opts -> SimpleStorage HbSync -> IO ()
+runStore opts _ = do
 
   let fname = uniLastMay @OptInputFile opts
 
@@ -57,7 +61,17 @@ runStore opts  = do
 
   let pt = toPTree (MaxSize 2048) (MaxNum 2048) hashes
 
-  mapM_ (print . pretty) hashes
+  -- mapM_ (print . pretty) hashes
+
+  pure ()
+
+
+withStore :: Data opts => opts -> ( SimpleStorage HbSync -> IO () ) -> IO ()
+withStore opts f = do
+  xdg <- getXdgDirectory XdgData "hbs2" <&> (</> defStorePath)
+
+  let pref = uniLastDef defStorePath opts :: StoragePrefix
+  simpleStorageInit (Just pref) >>= f
 
 
 main :: IO ()
@@ -76,8 +90,8 @@ main = join . customExecParser (prefs showHelpOnError) $
       pure ()
 
     pStore = do
-      _ <- common
+      o <- common
       file <- optional $ strArgument ( metavar "FILE" )
-      pure $ runStore ( Opts file )
+      pure $ withStore o (runStore ( Opts file ))