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
|
module HBS2.Defaults where
|
||||||
|
|
||||||
|
import Data.String
|
||||||
|
|
||||||
defChunkSize :: Integer
|
defChunkSize :: Integer
|
||||||
defChunkSize = 500
|
defChunkSize = 500
|
||||||
|
|
||||||
defBlockSize :: Integer
|
defBlockSize :: Integer
|
||||||
defBlockSize = 256 * 1024
|
defBlockSize = 256 * 1024
|
||||||
|
|
||||||
|
defStorePath :: IsString a => a
|
||||||
|
defStorePath = "hbs2"
|
||||||
|
|
||||||
|
|
|
@ -1,12 +1,10 @@
|
||||||
module HBS2.Prelude
|
module HBS2.Prelude
|
||||||
( module Data.String
|
( module Data.String
|
||||||
, module HBS2.Defaults
|
|
||||||
-- , module HBS2.Prelude
|
-- , module HBS2.Prelude
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.String (IsString(..))
|
import Data.String (IsString(..))
|
||||||
|
|
||||||
import HBS2.Defaults
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -5,6 +5,11 @@ import Data.Kind
|
||||||
import Data.Hashable hiding (Hashed)
|
import Data.Hashable hiding (Hashed)
|
||||||
|
|
||||||
import HBS2.Hash
|
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 Block block :: Type
|
||||||
type family Key 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 Block (Raw LBS.ByteString) = LBS.ByteString
|
||||||
type instance Key (Raw LBS.ByteString) = Hash HbSync
|
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 }
|
newtype StorageQueueSize = StorageQueueSize { fromQueueSize :: Int }
|
||||||
deriving stock (Data,Show)
|
deriving stock (Data,Show)
|
||||||
|
@ -85,6 +82,8 @@ simpleStorageInit opts = liftIO $ do
|
||||||
|
|
||||||
pdir <- canonicalizePath (fromPrefix prefix)
|
pdir <- canonicalizePath (fromPrefix prefix)
|
||||||
|
|
||||||
|
print (pretty pdir)
|
||||||
|
|
||||||
tbq <- TBMQ.newTBMQueueIO (fromIntegral (fromQueueSize qSize))
|
tbq <- TBMQ.newTBMQueueIO (fromIntegral (fromQueueSize qSize))
|
||||||
|
|
||||||
hcache <- Cache.newCache (Just (toTimeSpec @'Seconds 1)) -- FIXME: real setting
|
hcache <- Cache.newCache (Just (toTimeSpec @'Seconds 1)) -- FIXME: real setting
|
||||||
|
@ -95,8 +94,6 @@ simpleStorageInit opts = liftIO $ do
|
||||||
, _storageChunksCache = hcache
|
, _storageChunksCache = hcache
|
||||||
}
|
}
|
||||||
|
|
||||||
-- print ("STORAGE", stor ^. storageDir, stor ^. storageBlocks )
|
|
||||||
|
|
||||||
createDirectoryIfMissing True (stor ^. storageBlocks)
|
createDirectoryIfMissing True (stor ^. storageBlocks)
|
||||||
|
|
||||||
let alph = getAlphabet
|
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 (ByteString)
|
||||||
import Data.ByteString qualified as B
|
import Data.ByteString qualified as B
|
||||||
import Data.Function
|
import Data.Function
|
||||||
|
import Data.Functor
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
import Prettyprinter
|
import Prettyprinter
|
||||||
|
import System.Directory
|
||||||
|
import System.FilePath.Posix
|
||||||
import System.IO
|
import System.IO
|
||||||
|
|
||||||
import Streaming.Prelude qualified as S
|
import Streaming.Prelude qualified as S
|
||||||
|
@ -18,6 +21,7 @@ import HBS2.Prelude
|
||||||
import HBS2.Prelude.Plated
|
import HBS2.Prelude.Plated
|
||||||
import HBS2.Merkle
|
import HBS2.Merkle
|
||||||
import HBS2.Hash
|
import HBS2.Hash
|
||||||
|
import HBS2.Defaults
|
||||||
|
|
||||||
newtype HashRef = HashRef (Hash HbSync)
|
newtype HashRef = HashRef (Hash HbSync)
|
||||||
deriving newtype (Eq,Ord,IsString,Pretty)
|
deriving newtype (Eq,Ord,IsString,Pretty)
|
||||||
|
@ -43,8 +47,8 @@ readChunked handle size = fuu
|
||||||
S.yield chunk
|
S.yield chunk
|
||||||
next
|
next
|
||||||
|
|
||||||
runStore :: Opts -> IO ()
|
runStore :: Opts -> SimpleStorage HbSync -> IO ()
|
||||||
runStore opts = do
|
runStore opts _ = do
|
||||||
|
|
||||||
let fname = uniLastMay @OptInputFile opts
|
let fname = uniLastMay @OptInputFile opts
|
||||||
|
|
||||||
|
@ -57,7 +61,17 @@ runStore opts = do
|
||||||
|
|
||||||
let pt = toPTree (MaxSize 2048) (MaxNum 2048) hashes
|
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 ()
|
main :: IO ()
|
||||||
|
@ -76,8 +90,8 @@ main = join . customExecParser (prefs showHelpOnError) $
|
||||||
pure ()
|
pure ()
|
||||||
|
|
||||||
pStore = do
|
pStore = do
|
||||||
_ <- common
|
o <- common
|
||||||
file <- optional $ strArgument ( metavar "FILE" )
|
file <- optional $ strArgument ( metavar "FILE" )
|
||||||
pure $ runStore ( Opts file )
|
pure $ withStore o (runStore ( Opts file ))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue