mirror of https://github.com/voidlizard/hbs2
oops
This commit is contained in:
parent
ce9510efeb
commit
68b6de0d07
|
@ -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"
|
||||
|
||||
|
|
|
@ -1,12 +1,10 @@
|
|||
module HBS2.Prelude
|
||||
( module Data.String
|
||||
, module HBS2.Defaults
|
||||
-- , module HBS2.Prelude
|
||||
) where
|
||||
|
||||
import Data.String (IsString(..))
|
||||
|
||||
import HBS2.Defaults
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
24
hbs2/Main.hs
24
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 ))
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue