This commit is contained in:
Dmitry Zuikov 2023-01-11 14:51:18 +03:00
parent ce9510efeb
commit 68b6de0d07
5 changed files with 30 additions and 12 deletions

View File

@ -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"

View File

@ -1,12 +1,10 @@
module HBS2.Prelude
( module Data.String
, module HBS2.Defaults
-- , module HBS2.Prelude
) where
import Data.String (IsString(..))
import HBS2.Defaults

View File

@ -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

View File

@ -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

View File

@ -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 ))