-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | This module declares all options/flags that @tasty@ will
-- parse from the command line/environment variables.
--
-- They're used to configure "Test.Cleveland".
module Test.Cleveland.Tasty.Internal.Options
  ( clevelandOptions
  , AliasPrefixOpt(..)
  , MoneybagAliasOpt(..)
  , EndpointOpt(..)
  , PathOpt(..)
  , DataDirOpt(..)
  , VerboseOpt(..)
  , SecretKeyOpt(..)
  , RunModeOpt(..)
  , ContextLinesOpt(..)
  ) where

import Control.Monad.Except (runExcept)
import Data.Tagged (untag)
import Options.Applicative qualified as Opt
import Options.Applicative.Types (Parser, ReadM(..))
import Servant.Client.Core (BaseUrl(..))
import Test.Tasty.Options as Tasty (IsOption(..), OptionDescription(Option), safeRead)

import Morley.Client (Alias, mkAlias)
import Morley.Client.Parser (baseUrlReader)
import Morley.Tezos.Crypto qualified as Crypto
import Morley.Util.CLI (HasCLReader(getMetavar, getReader))

-- $defaultValues
--
-- Tasty will use 'optionCLParser' to attempt to parse options from the command line.
-- If it fails, it will try to parse them from environment variables instead (using 'parseValue').
--
-- For this reason, it's important that 'optionCLParser' is NOT a parser
-- that /always/ succeeds. If it is, tasty will not attempt to read environment variables.
--
-- From the [docs](http://hackage.haskell.org/package/tasty-1.3.1/docs/Test-Tasty-Options.html#v:optionCLParser):
--
-- > Do not supply a default value (e.g., with the value function) here for this parser!
-- > This is because if no value was provided on the command line we may lookup the option e.g.
-- > in the environment. But if the parser always succeeds, we have no way to tell
-- > whether the user really provided the option on the command line.


-- | A list with all the options needed to configure "Test.Cleveland".
clevelandOptions :: [OptionDescription]
clevelandOptions :: [OptionDescription]
clevelandOptions =
  [ Proxy AliasPrefixOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy AliasPrefixOpt
forall k (t :: k). Proxy t
Proxy @AliasPrefixOpt)
  , Proxy EndpointOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy EndpointOpt
forall k (t :: k). Proxy t
Proxy @EndpointOpt)
  , Proxy PathOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy PathOpt
forall k (t :: k). Proxy t
Proxy @PathOpt)
  , Proxy DataDirOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy DataDirOpt
forall k (t :: k). Proxy t
Proxy @DataDirOpt)
  , Proxy VerboseOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy VerboseOpt
forall k (t :: k). Proxy t
Proxy @VerboseOpt)
  , Proxy SecretKeyOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy SecretKeyOpt
forall k (t :: k). Proxy t
Proxy @SecretKeyOpt)
  , Proxy MoneybagAliasOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy MoneybagAliasOpt
forall k (t :: k). Proxy t
Proxy @MoneybagAliasOpt)
  , Proxy RunModeOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy RunModeOpt
forall k (t :: k). Proxy t
Proxy @RunModeOpt)
  , Proxy ContextLinesOpt -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Tasty.Option (Proxy ContextLinesOpt
forall k (t :: k). Proxy t
Proxy @ContextLinesOpt)
  ]

----------------------------------------------------------------------------
-- Morley Client options
----------------------------------------------------------------------------

newtype AliasPrefixOpt = AliasPrefixOpt (Maybe Text)
  deriving stock (Int -> AliasPrefixOpt -> ShowS
[AliasPrefixOpt] -> ShowS
AliasPrefixOpt -> String
(Int -> AliasPrefixOpt -> ShowS)
-> (AliasPrefixOpt -> String)
-> ([AliasPrefixOpt] -> ShowS)
-> Show AliasPrefixOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AliasPrefixOpt] -> ShowS
$cshowList :: [AliasPrefixOpt] -> ShowS
show :: AliasPrefixOpt -> String
$cshow :: AliasPrefixOpt -> String
showsPrec :: Int -> AliasPrefixOpt -> ShowS
$cshowsPrec :: Int -> AliasPrefixOpt -> ShowS
Show, AliasPrefixOpt -> AliasPrefixOpt -> Bool
(AliasPrefixOpt -> AliasPrefixOpt -> Bool)
-> (AliasPrefixOpt -> AliasPrefixOpt -> Bool) -> Eq AliasPrefixOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AliasPrefixOpt -> AliasPrefixOpt -> Bool
$c/= :: AliasPrefixOpt -> AliasPrefixOpt -> Bool
== :: AliasPrefixOpt -> AliasPrefixOpt -> Bool
$c== :: AliasPrefixOpt -> AliasPrefixOpt -> Bool
Eq)

instance IsOption AliasPrefixOpt where
  defaultValue :: AliasPrefixOpt
defaultValue = Maybe Text -> AliasPrefixOpt
AliasPrefixOpt Maybe Text
forall a. Maybe a
Nothing
  optionName :: Tagged AliasPrefixOpt String
optionName = Tagged AliasPrefixOpt String
"cleveland-alias-prefix"
  optionHelp :: Tagged AliasPrefixOpt String
optionHelp = Tagged AliasPrefixOpt String
"[Test.Cleveland] A prefix to prepend to every alias created " Tagged AliasPrefixOpt String
-> Tagged AliasPrefixOpt String -> Tagged AliasPrefixOpt String
forall a. Semigroup a => a -> a -> a
<>
               Tagged AliasPrefixOpt String
"with 'newAddress' or 'newFreshAddress'."
  parseValue :: String -> Maybe AliasPrefixOpt
parseValue = (Text -> AliasPrefixOpt) -> String -> Maybe AliasPrefixOpt
forall v a. HasCLReader a => (a -> v) -> String -> Maybe v
mkParseValue (Maybe Text -> AliasPrefixOpt
AliasPrefixOpt (Maybe Text -> AliasPrefixOpt)
-> (Text -> Maybe Text) -> Text -> AliasPrefixOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just)
  optionCLParser :: Parser AliasPrefixOpt
optionCLParser = (Text -> AliasPrefixOpt) -> Maybe Char -> Parser AliasPrefixOpt
forall v a.
(IsOption v, HasCLReader a) =>
(a -> v) -> Maybe Char -> Parser v
mkOptionParser (Maybe Text -> AliasPrefixOpt
AliasPrefixOpt (Maybe Text -> AliasPrefixOpt)
-> (Text -> Maybe Text) -> Text -> AliasPrefixOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just) Maybe Char
forall a. Maybe a
Nothing

-- | Morley Client option specifying endpoint URL of the Tezos node.
newtype EndpointOpt = EndpointOpt (Maybe BaseUrl)
  deriving stock (Int -> EndpointOpt -> ShowS
[EndpointOpt] -> ShowS
EndpointOpt -> String
(Int -> EndpointOpt -> ShowS)
-> (EndpointOpt -> String)
-> ([EndpointOpt] -> ShowS)
-> Show EndpointOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndpointOpt] -> ShowS
$cshowList :: [EndpointOpt] -> ShowS
show :: EndpointOpt -> String
$cshow :: EndpointOpt -> String
showsPrec :: Int -> EndpointOpt -> ShowS
$cshowsPrec :: Int -> EndpointOpt -> ShowS
Show, EndpointOpt -> EndpointOpt -> Bool
(EndpointOpt -> EndpointOpt -> Bool)
-> (EndpointOpt -> EndpointOpt -> Bool) -> Eq EndpointOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndpointOpt -> EndpointOpt -> Bool
$c/= :: EndpointOpt -> EndpointOpt -> Bool
== :: EndpointOpt -> EndpointOpt -> Bool
$c== :: EndpointOpt -> EndpointOpt -> Bool
Eq)

instance IsOption EndpointOpt where
  defaultValue :: EndpointOpt
defaultValue = Maybe BaseUrl -> EndpointOpt
EndpointOpt Maybe BaseUrl
forall a. Maybe a
Nothing
  optionName :: Tagged EndpointOpt String
optionName = Tagged EndpointOpt String
"cleveland-node-endpoint"
  optionHelp :: Tagged EndpointOpt String
optionHelp = Tagged EndpointOpt String
"[Test.Cleveland] Remote node endpoint URL"
  parseValue :: String -> Maybe EndpointOpt
parseValue = ReadM BaseUrl
-> (BaseUrl -> EndpointOpt) -> String -> Maybe EndpointOpt
forall v a. ReadM a -> (a -> v) -> String -> Maybe v
mkParseValueWithReadM ReadM BaseUrl
baseUrlReader (Maybe BaseUrl -> EndpointOpt
EndpointOpt (Maybe BaseUrl -> EndpointOpt)
-> (BaseUrl -> Maybe BaseUrl) -> BaseUrl -> EndpointOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Maybe BaseUrl
forall a. a -> Maybe a
Just)
  optionCLParser :: Parser EndpointOpt
optionCLParser =
    ReadM BaseUrl
-> String
-> (BaseUrl -> EndpointOpt)
-> Maybe Char
-> Parser EndpointOpt
forall v a.
IsOption v =>
ReadM a -> String -> (a -> v) -> Maybe Char -> Parser v
mkOptionParserWithReadM ReadM BaseUrl
baseUrlReader String
"URL" (Maybe BaseUrl -> EndpointOpt
EndpointOpt (Maybe BaseUrl -> EndpointOpt)
-> (BaseUrl -> Maybe BaseUrl) -> BaseUrl -> EndpointOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseUrl -> Maybe BaseUrl
forall a. a -> Maybe a
Just) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'E')

newtype PathOpt = PathOpt FilePath
  deriving stock (Int -> PathOpt -> ShowS
[PathOpt] -> ShowS
PathOpt -> String
(Int -> PathOpt -> ShowS)
-> (PathOpt -> String) -> ([PathOpt] -> ShowS) -> Show PathOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathOpt] -> ShowS
$cshowList :: [PathOpt] -> ShowS
show :: PathOpt -> String
$cshow :: PathOpt -> String
showsPrec :: Int -> PathOpt -> ShowS
$cshowsPrec :: Int -> PathOpt -> ShowS
Show, PathOpt -> PathOpt -> Bool
(PathOpt -> PathOpt -> Bool)
-> (PathOpt -> PathOpt -> Bool) -> Eq PathOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathOpt -> PathOpt -> Bool
$c/= :: PathOpt -> PathOpt -> Bool
== :: PathOpt -> PathOpt -> Bool
$c== :: PathOpt -> PathOpt -> Bool
Eq)

instance IsOption PathOpt where
  defaultValue :: PathOpt
defaultValue = String -> PathOpt
PathOpt String
"tezos-client"
  optionName :: Tagged PathOpt String
optionName = Tagged PathOpt String
"cleveland-client-path"
  optionHelp :: Tagged PathOpt String
optionHelp = Tagged PathOpt String
"[Test.Cleveland] Path to tezos-client binary"
  parseValue :: String -> Maybe PathOpt
parseValue = (String -> PathOpt) -> String -> Maybe PathOpt
forall v a. HasCLReader a => (a -> v) -> String -> Maybe v
mkParseValue String -> PathOpt
PathOpt
  optionCLParser :: Parser PathOpt
optionCLParser = (String -> PathOpt) -> Maybe Char -> Parser PathOpt
forall v a.
(IsOption v, HasCLReader a) =>
(a -> v) -> Maybe Char -> Parser v
mkOptionParser String -> PathOpt
PathOpt (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'I')

newtype DataDirOpt = DataDirOpt (Maybe FilePath)
  deriving stock (Int -> DataDirOpt -> ShowS
[DataDirOpt] -> ShowS
DataDirOpt -> String
(Int -> DataDirOpt -> ShowS)
-> (DataDirOpt -> String)
-> ([DataDirOpt] -> ShowS)
-> Show DataDirOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataDirOpt] -> ShowS
$cshowList :: [DataDirOpt] -> ShowS
show :: DataDirOpt -> String
$cshow :: DataDirOpt -> String
showsPrec :: Int -> DataDirOpt -> ShowS
$cshowsPrec :: Int -> DataDirOpt -> ShowS
Show, DataDirOpt -> DataDirOpt -> Bool
(DataDirOpt -> DataDirOpt -> Bool)
-> (DataDirOpt -> DataDirOpt -> Bool) -> Eq DataDirOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataDirOpt -> DataDirOpt -> Bool
$c/= :: DataDirOpt -> DataDirOpt -> Bool
== :: DataDirOpt -> DataDirOpt -> Bool
$c== :: DataDirOpt -> DataDirOpt -> Bool
Eq)

instance IsOption DataDirOpt where
  defaultValue :: DataDirOpt
defaultValue = Maybe String -> DataDirOpt
DataDirOpt Maybe String
forall a. Maybe a
Nothing
  optionName :: Tagged DataDirOpt String
optionName = Tagged DataDirOpt String
"cleveland-data-dir"
  optionHelp :: Tagged DataDirOpt String
optionHelp = Tagged DataDirOpt String
"[Test.Cleveland] Path to tezos-client data directory"
  parseValue :: String -> Maybe DataDirOpt
parseValue = (String -> DataDirOpt) -> String -> Maybe DataDirOpt
forall v a. HasCLReader a => (a -> v) -> String -> Maybe v
mkParseValue (Maybe String -> DataDirOpt
DataDirOpt (Maybe String -> DataDirOpt)
-> (String -> Maybe String) -> String -> DataDirOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just)
  optionCLParser :: Parser DataDirOpt
optionCLParser = (String -> DataDirOpt) -> Maybe Char -> Parser DataDirOpt
forall v a.
(IsOption v, HasCLReader a) =>
(a -> v) -> Maybe Char -> Parser v
mkOptionParser (Maybe String -> DataDirOpt
DataDirOpt (Maybe String -> DataDirOpt)
-> (String -> Maybe String) -> String -> DataDirOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just) (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'd')

-- | To increase verbosity, pass @-V@ several times on the command line (e.g. @-VVV@),
-- or set @TASTY_CLEVELAND_VERBOSE=3@ as an environment variable.
newtype VerboseOpt = VerboseOpt Word
  deriving stock (Int -> VerboseOpt -> ShowS
[VerboseOpt] -> ShowS
VerboseOpt -> String
(Int -> VerboseOpt -> ShowS)
-> (VerboseOpt -> String)
-> ([VerboseOpt] -> ShowS)
-> Show VerboseOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerboseOpt] -> ShowS
$cshowList :: [VerboseOpt] -> ShowS
show :: VerboseOpt -> String
$cshow :: VerboseOpt -> String
showsPrec :: Int -> VerboseOpt -> ShowS
$cshowsPrec :: Int -> VerboseOpt -> ShowS
Show, VerboseOpt -> VerboseOpt -> Bool
(VerboseOpt -> VerboseOpt -> Bool)
-> (VerboseOpt -> VerboseOpt -> Bool) -> Eq VerboseOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerboseOpt -> VerboseOpt -> Bool
$c/= :: VerboseOpt -> VerboseOpt -> Bool
== :: VerboseOpt -> VerboseOpt -> Bool
$c== :: VerboseOpt -> VerboseOpt -> Bool
Eq)

instance IsOption VerboseOpt where
  defaultValue :: VerboseOpt
defaultValue = Word -> VerboseOpt
VerboseOpt Word
0
  optionName :: Tagged VerboseOpt String
optionName = Tagged VerboseOpt String
"cleveland-verbose"
  optionHelp :: Tagged VerboseOpt String
optionHelp = Tagged VerboseOpt String
"[Test.Cleveland] Increase verbosity (pass several times to increase further)"
  parseValue :: String -> Maybe VerboseOpt
parseValue = \String
str -> Word -> VerboseOpt
VerboseOpt (Word -> VerboseOpt) -> Maybe Word -> Maybe VerboseOpt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Word
forall a. Read a => String -> Maybe a
safeRead String
str
  optionCLParser :: Parser VerboseOpt
optionCLParser =
    -- See: $defaultValues
    --
    -- Therefore, we use `some` instead of `many` here.
    -- `some` will fail if "-V" is absent, and then tasty will attempt
    -- to parse the "TASTY_CLEVELAND_VERBOSE" env variable instead.
    Word -> VerboseOpt
VerboseOpt (Word -> VerboseOpt) -> ([()] -> Word) -> [()] -> VerboseOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [()] -> Word
forall i a. Num i => [a] -> i
genericLength ([()] -> VerboseOpt) -> Parser [()] -> Parser VerboseOpt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () -> Parser [()]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser ()
flag
    where
      flag :: Parser ()
flag =
        () -> Mod FlagFields () -> Parser ()
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' () (Mod FlagFields () -> Parser ())
-> ([Mod FlagFields ()] -> Mod FlagFields ())
-> [Mod FlagFields ()]
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Mod FlagFields ()] -> Mod FlagFields ()
forall a. Monoid a => [a] -> a
mconcat ([Mod FlagFields ()] -> Parser ())
-> [Mod FlagFields ()] -> Parser ()
forall a b. (a -> b) -> a -> b
$
          [ Char -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'V'
          , String -> Mod FlagFields ()
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (Tagged VerboseOpt String -> String
forall k (s :: k) b. Tagged s b -> b
untag (IsOption VerboseOpt => Tagged VerboseOpt String
forall v. IsOption v => Tagged v String
optionName @VerboseOpt))
          , String -> Mod FlagFields ()
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Tagged VerboseOpt String -> String
forall k (s :: k) b. Tagged s b -> b
untag (IsOption VerboseOpt => Tagged VerboseOpt String
forall v. IsOption v => Tagged v String
optionHelp @VerboseOpt))
          ]

----------------------------------------------------------------------------
-- cleveland options
----------------------------------------------------------------------------

newtype SecretKeyOpt = SecretKeyOpt (Maybe Crypto.SecretKey)
  deriving stock (Int -> SecretKeyOpt -> ShowS
[SecretKeyOpt] -> ShowS
SecretKeyOpt -> String
(Int -> SecretKeyOpt -> ShowS)
-> (SecretKeyOpt -> String)
-> ([SecretKeyOpt] -> ShowS)
-> Show SecretKeyOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SecretKeyOpt] -> ShowS
$cshowList :: [SecretKeyOpt] -> ShowS
show :: SecretKeyOpt -> String
$cshow :: SecretKeyOpt -> String
showsPrec :: Int -> SecretKeyOpt -> ShowS
$cshowsPrec :: Int -> SecretKeyOpt -> ShowS
Show, SecretKeyOpt -> SecretKeyOpt -> Bool
(SecretKeyOpt -> SecretKeyOpt -> Bool)
-> (SecretKeyOpt -> SecretKeyOpt -> Bool) -> Eq SecretKeyOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SecretKeyOpt -> SecretKeyOpt -> Bool
$c/= :: SecretKeyOpt -> SecretKeyOpt -> Bool
== :: SecretKeyOpt -> SecretKeyOpt -> Bool
$c== :: SecretKeyOpt -> SecretKeyOpt -> Bool
Eq)

instance IsOption SecretKeyOpt where
  defaultValue :: SecretKeyOpt
defaultValue = Maybe SecretKey -> SecretKeyOpt
SecretKeyOpt Maybe SecretKey
forall a. Maybe a
Nothing
  optionName :: Tagged SecretKeyOpt String
optionName = Tagged SecretKeyOpt String
"cleveland-moneybag-secret-key"
  optionHelp :: Tagged SecretKeyOpt String
optionHelp = Tagged SecretKeyOpt String
"[Test.Cleveland] Secret key of the account to be used to execute all transfers/originations " Tagged SecretKeyOpt String
-> Tagged SecretKeyOpt String -> Tagged SecretKeyOpt String
forall a. Semigroup a => a -> a -> a
<>
               Tagged SecretKeyOpt String
"(unless overriden with `withSender`) and fund new accounts (unless overriden with `withMoneybag`)."
  parseValue :: String -> Maybe SecretKeyOpt
parseValue = (SecretKey -> SecretKeyOpt) -> String -> Maybe SecretKeyOpt
forall v a. HasCLReader a => (a -> v) -> String -> Maybe v
mkParseValue (Maybe SecretKey -> SecretKeyOpt
SecretKeyOpt (Maybe SecretKey -> SecretKeyOpt)
-> (SecretKey -> Maybe SecretKey) -> SecretKey -> SecretKeyOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just)
  optionCLParser :: Parser SecretKeyOpt
optionCLParser = (SecretKey -> SecretKeyOpt) -> Maybe Char -> Parser SecretKeyOpt
forall v a.
(IsOption v, HasCLReader a) =>
(a -> v) -> Maybe Char -> Parser v
mkOptionParser (Maybe SecretKey -> SecretKeyOpt
SecretKeyOpt (Maybe SecretKey -> SecretKeyOpt)
-> (SecretKey -> Maybe SecretKey) -> SecretKey -> SecretKeyOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Maybe SecretKey
forall a. a -> Maybe a
Just) Maybe Char
forall a. Maybe a
Nothing

newtype MoneybagAliasOpt = MoneybagAliasOpt Alias
  deriving stock (Int -> MoneybagAliasOpt -> ShowS
[MoneybagAliasOpt] -> ShowS
MoneybagAliasOpt -> String
(Int -> MoneybagAliasOpt -> ShowS)
-> (MoneybagAliasOpt -> String)
-> ([MoneybagAliasOpt] -> ShowS)
-> Show MoneybagAliasOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MoneybagAliasOpt] -> ShowS
$cshowList :: [MoneybagAliasOpt] -> ShowS
show :: MoneybagAliasOpt -> String
$cshow :: MoneybagAliasOpt -> String
showsPrec :: Int -> MoneybagAliasOpt -> ShowS
$cshowsPrec :: Int -> MoneybagAliasOpt -> ShowS
Show, MoneybagAliasOpt -> MoneybagAliasOpt -> Bool
(MoneybagAliasOpt -> MoneybagAliasOpt -> Bool)
-> (MoneybagAliasOpt -> MoneybagAliasOpt -> Bool)
-> Eq MoneybagAliasOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MoneybagAliasOpt -> MoneybagAliasOpt -> Bool
$c/= :: MoneybagAliasOpt -> MoneybagAliasOpt -> Bool
== :: MoneybagAliasOpt -> MoneybagAliasOpt -> Bool
$c== :: MoneybagAliasOpt -> MoneybagAliasOpt -> Bool
Eq)


instance IsOption MoneybagAliasOpt where
  defaultValue :: MoneybagAliasOpt
defaultValue = Alias -> MoneybagAliasOpt
MoneybagAliasOpt (Alias -> MoneybagAliasOpt) -> Alias -> MoneybagAliasOpt
forall a b. (a -> b) -> a -> b
$ Text -> Alias
mkAlias Text
"moneybag"
  optionName :: Tagged MoneybagAliasOpt String
optionName = Tagged MoneybagAliasOpt String
"cleveland-moneybag-alias"
  optionHelp :: Tagged MoneybagAliasOpt String
optionHelp = Tagged MoneybagAliasOpt String
"[Test.Cleveland] Alias of the account to be used to execute all transfers/originations " Tagged MoneybagAliasOpt String
-> Tagged MoneybagAliasOpt String -> Tagged MoneybagAliasOpt String
forall a. Semigroup a => a -> a -> a
<>
               Tagged MoneybagAliasOpt String
"(unless overriden with `withSender`) and fund new accounts (unless overriden with `withMoneybag`)."
  parseValue :: String -> Maybe MoneybagAliasOpt
parseValue = MoneybagAliasOpt -> Maybe MoneybagAliasOpt
forall a. a -> Maybe a
Just (MoneybagAliasOpt -> Maybe MoneybagAliasOpt)
-> (String -> MoneybagAliasOpt) -> String -> Maybe MoneybagAliasOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alias -> MoneybagAliasOpt
MoneybagAliasOpt (Alias -> MoneybagAliasOpt)
-> (String -> Alias) -> String -> MoneybagAliasOpt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Alias
mkAlias (Text -> Alias) -> (String -> Text) -> String -> Alias
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

data RunModeOpt
  = RunAllMode
  | OnlyNetworkMode
  | DisableNetworkMode
  | DefaultMode

instance IsOption RunModeOpt where
  defaultValue :: RunModeOpt
defaultValue = RunModeOpt
DefaultMode
  optionName :: Tagged RunModeOpt String
optionName = Tagged RunModeOpt String
"cleveland-mode"
  optionHelp :: Tagged RunModeOpt String
optionHelp =
    Tagged RunModeOpt String
"[Test.Cleveland] Determines whether tests on a Tezos network\
    \and Morley.Michelson emulator should run. \
    \The following modes are supported:\
    \ 1) 'all' — run both network and emulator tests. Also, all non-cleveland \
    \    tests are run as well.\
    \ 2) 'only-network' — run only network tests, this mod is a short version of\
    \   '--pattern \"$1 == \"On network\" || $NF == \"On network\" || $0 ~ /.On network./\"'.\
    \   Non-cleveland tests will be disabled as well.\
    \ 3) 'disable-network' — disable network tests and run only emulator\
    \    and non-cleveland tests.\
    \\
    \In case no mode is provided, the behaviour of this option depends on whether\
    \the 'CI' environment variable is set: \
    \ * In case 'CI' is set, the default behaviour is 'all'\
    \ * In case 'CI' is unset, the default behaviour is 'disable-network'"
  parseValue :: String -> Maybe RunModeOpt
parseValue String
str = case String
str of
    String
"all" -> RunModeOpt -> Maybe RunModeOpt
forall a. a -> Maybe a
Just RunModeOpt
RunAllMode
    String
"only-network" -> RunModeOpt -> Maybe RunModeOpt
forall a. a -> Maybe a
Just RunModeOpt
OnlyNetworkMode
    String
"disable-network" -> RunModeOpt -> Maybe RunModeOpt
forall a. a -> Maybe a
Just RunModeOpt
DisableNetworkMode
    String
_ -> Maybe RunModeOpt
forall a. Maybe a
Nothing

newtype ContextLinesOpt = ContextLinesOpt Natural
  deriving stock (Int -> ContextLinesOpt -> ShowS
[ContextLinesOpt] -> ShowS
ContextLinesOpt -> String
(Int -> ContextLinesOpt -> ShowS)
-> (ContextLinesOpt -> String)
-> ([ContextLinesOpt] -> ShowS)
-> Show ContextLinesOpt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextLinesOpt] -> ShowS
$cshowList :: [ContextLinesOpt] -> ShowS
show :: ContextLinesOpt -> String
$cshow :: ContextLinesOpt -> String
showsPrec :: Int -> ContextLinesOpt -> ShowS
$cshowsPrec :: Int -> ContextLinesOpt -> ShowS
Show, ContextLinesOpt -> ContextLinesOpt -> Bool
(ContextLinesOpt -> ContextLinesOpt -> Bool)
-> (ContextLinesOpt -> ContextLinesOpt -> Bool)
-> Eq ContextLinesOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextLinesOpt -> ContextLinesOpt -> Bool
$c/= :: ContextLinesOpt -> ContextLinesOpt -> Bool
== :: ContextLinesOpt -> ContextLinesOpt -> Bool
$c== :: ContextLinesOpt -> ContextLinesOpt -> Bool
Eq)

instance IsOption ContextLinesOpt where
  defaultValue :: ContextLinesOpt
defaultValue = Natural -> ContextLinesOpt
ContextLinesOpt Natural
5
  optionName :: Tagged ContextLinesOpt String
optionName = Tagged ContextLinesOpt String
"cleveland-context-lines"
  optionHelp :: Tagged ContextLinesOpt String
optionHelp = Tagged ContextLinesOpt String
"[Test.Cleveland] Number of source code lines to show around an error when a test fails"
  parseValue :: String -> Maybe ContextLinesOpt
parseValue = (Natural -> ContextLinesOpt) -> String -> Maybe ContextLinesOpt
forall v a. HasCLReader a => (a -> v) -> String -> Maybe v
mkParseValue Natural -> ContextLinesOpt
ContextLinesOpt
  optionCLParser :: Parser ContextLinesOpt
optionCLParser = (Natural -> ContextLinesOpt)
-> Maybe Char -> Parser ContextLinesOpt
forall v a.
(IsOption v, HasCLReader a) =>
(a -> v) -> Maybe Char -> Parser v
mkOptionParser Natural -> ContextLinesOpt
ContextLinesOpt Maybe Char
forall a. Maybe a
Nothing

----------------------------------------------------------------------------
-- Helpers
----------------------------------------------------------------------------

-- Create an environment variable parser for types that don't have a
-- 'HasCLReader' instance to avoid adding an unnecessary dependency.
mkParseValueWithReadM :: forall v a. ReadM a -> (a -> v) -> String -> Maybe v
mkParseValueWithReadM :: ReadM a -> (a -> v) -> String -> Maybe v
mkParseValueWithReadM ReadM a
readm a -> v
wrap =
  (a -> v) -> Maybe a -> Maybe v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> v
wrap (Maybe a -> Maybe v) -> (String -> Maybe a) -> String -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError a -> Maybe a
forall l r. Either l r -> Maybe r
rightToMaybe (Either ParseError a -> Maybe a)
-> (String -> Either ParseError a) -> String -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except ParseError a -> Either ParseError a
forall e a. Except e a -> Either e a
runExcept (Except ParseError a -> Either ParseError a)
-> (String -> Except ParseError a) -> String -> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT String (Except ParseError) a
-> String -> Except ParseError a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReadM a -> ReaderT String (Except ParseError) a
forall a. ReadM a -> ReaderT String (Except ParseError) a
unReadM ReadM a
readm)

-- | Create an environment variable parser by reusing an instance of `HasCLReader`.
mkParseValue
  :: forall v a
  .  HasCLReader a
  => (a -> v)
  -> String
  -> Maybe v
mkParseValue :: (a -> v) -> String -> Maybe v
mkParseValue = ReadM a -> (a -> v) -> String -> Maybe v
forall v a. ReadM a -> (a -> v) -> String -> Maybe v
mkParseValueWithReadM (HasCLReader a => ReadM a
forall a. HasCLReader a => ReadM a
getReader @a)

-- | Build a command line option parser by reusing an instance of `IsOption`,
-- for types that don't have an instance of 'HasCLReader'.
mkOptionParserWithReadM
  :: forall v a
  .  IsOption v
  => ReadM a
  -> String -- ^ metavar
  -> (a -> v)
  -> Maybe Char
  -> Parser v
mkOptionParserWithReadM :: ReadM a -> String -> (a -> v) -> Maybe Char -> Parser v
mkOptionParserWithReadM ReadM a
readm String
metav a -> v
wrap Maybe Char
shortMb =
  a -> v
wrap (a -> v) -> Parser a -> Parser v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM a -> Mod OptionFields a -> Parser a
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM a
readm Mod OptionFields a
mods
  where
    -- See: $defaultValues
    --
    -- Therefore, we never specify a default value here.
    mods :: Mod OptionFields a
mods = [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat
      [ String -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
metav
      , Mod OptionFields a
-> (Char -> Mod OptionFields a) -> Maybe Char -> Mod OptionFields a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod OptionFields a
forall a. Monoid a => a
mempty Char -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Maybe Char
shortMb
      , String -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long (Tagged v String -> String
forall k (s :: k) b. Tagged s b -> b
untag (IsOption v => Tagged v String
forall v. IsOption v => Tagged v String
optionName @v))
      , String -> Mod OptionFields a
forall (f :: * -> *) a. String -> Mod f a
Opt.help (Tagged v String -> String
forall k (s :: k) b. Tagged s b -> b
untag (IsOption v => Tagged v String
forall v. IsOption v => Tagged v String
optionHelp @v))
      ]

-- | Build a command line option parser by reusing instances of `HasCLReader` and `IsOption`
mkOptionParser
  :: forall v a
  .  (IsOption v, HasCLReader a)
  => (a -> v)
  -> Maybe Char
  -> Parser v
mkOptionParser :: (a -> v) -> Maybe Char -> Parser v
mkOptionParser = ReadM a -> String -> (a -> v) -> Maybe Char -> Parser v
forall v a.
IsOption v =>
ReadM a -> String -> (a -> v) -> Maybe Char -> Parser v
mkOptionParserWithReadM (HasCLReader a => ReadM a
forall a. HasCLReader a => ReadM a
getReader @a) (HasCLReader a => String
forall a. HasCLReader a => String
getMetavar @a)