module HashAddressed.App.Command.Examples.Initialize
  (
    initializeCommand,
  )
  where

import Essentials
import HashAddressed.App.Command.Type
import HashAddressed.App.HashFunction.Options
import HashAddressed.App.Meta.Initialization
import HashAddressed.App.Verbosity.Options

import qualified Options.Applicative as Options

initializeCommand :: Command
initializeCommand :: Command
initializeCommand =  forall a. Parser a -> InfoMod a -> ParserInfo a
Options.info (Parser (CommandAction ())
parser forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
Options.helper) forall a b. (a -> b) -> a -> b
$
    forall a. FilePath -> InfoMod a
Options.progDesc FilePath
"Initialize a hash-addressed store"
  where
    parser :: Options.Parser (CommandAction ())
    parser :: Parser (CommandAction ())
parser = do
        FilePath
optStoreDirectory <- forall s. IsString s => Mod OptionFields s -> Parser s
Options.strOption forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"directory" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
"Where the hash-addressed files are located"

        HashFunctionName
optHashFunction <- forall a. ReadM a -> Mod OptionFields a -> Parser a
Options.option ReadM HashFunctionName
hashFunctionRead forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.long FilePath
"hash-function" forall a. Semigroup a => a -> a -> a
<>
            forall (f :: * -> *) a. FilePath -> Mod f a
Options.help FilePath
hashFunctionInstructions

        Verbosity
optVerbosity <- Parser Verbosity
verbosityOption

        pure $ InitializationType
-> Verbosity -> HashFunctionName -> FilePath -> CommandAction ()
tryInitializeStore InitializationType
CreateNew Verbosity
optVerbosity HashFunctionName
optHashFunction
            FilePath
optStoreDirectory