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

{-# OPTIONS_GHC -Wno-orphans #-}

-- | Utilities for parsing Morley types using @optparse-applicative@.

module Morley.CLI
  ( -- * Full parsers
    parserInfo
    -- * Options
  , contractFileOption
  , nowOption
  , levelOption
  , minBlockTimeOption
  , maxStepsOption
  , dbPathOption
  , txDataOption
  , keyHashOption
  , secretKeyOption
  , valueOption
  , mutezOption
  , addressOption
  , aliasOption
  , addressOrAliasOption
  , someAddressOrAliasOption
  , onelineOption
  , entrypointOption
  , mTextOption
  , payloadOption
  , timeOption
  ) where

import Data.Singletons (SingI)
import Fmt (pretty)
import Options.Applicative
  (footerDoc, fullDesc, header, help, helper, info, long, metavar, option, progDesc, strOption,
  switch)
import Options.Applicative qualified as Opt
import Options.Applicative.Help qualified as Pretty
import Options.Applicative.Help.Pretty (Doc)
import Text.Read (read)

import Morley.Michelson.Parser (MichelsonSource(..))
import Morley.Michelson.Parser qualified as P
import Morley.Michelson.Runtime (TxData(..), TxParam(..))
import Morley.Michelson.Runtime.GState (genesisAddress)
import Morley.Michelson.Text (MText)
import Morley.Michelson.Untyped (EpName)
import Morley.Michelson.Untyped qualified as U
import Morley.Tezos.Address
import Morley.Tezos.Address.Alias
import Morley.Tezos.Core (Mutez, Timestamp, parseTimestamp, timestampFromSeconds)
import Morley.Tezos.Crypto
import Morley.Util.CLI
import Morley.Util.Interpolate (itu)
import Morley.Util.Named

----------------------------------------------------------------------------
-- These options are mostly specifications of 'mkCLOptionParser'
-- for concrete types (with more specific names).
----------------------------------------------------------------------------

-- | Full parser for a client.
parserInfo
  :: "usage" :! Doc
  -> "description" :! String
  -> "header" :! String
  -> "parser" :! Opt.Parser s
  -> Opt.ParserInfo s
parserInfo
  (arg #usage -> usage)
  (arg #description -> description)
  (arg #header -> clientHeader)
  (arg #parser -> parser) =
  info (helper <*> parser) $
  mconcat
    [ fullDesc
    , progDesc description
    , header clientHeader
    , footerDoc $ pure usage
    ]

-- | Parser for path to a contract code.
contractFileOption :: Opt.Parser FilePath
contractFileOption = strOption $
  long "contract" <>
  metavar "FILEPATH" <>
  help "Path to contract file"

-- | Parser for timelocked chest payload.
payloadOption :: Opt.Parser ByteString
payloadOption = strOption $
  long "payload" <>
  metavar "PAYLOAD" <>
  help "Chest payload"

-- | Parser for timelocked chest time.
timeOption :: Opt.Parser TLTime
timeOption = mkCLOptionParser
  Nothing
  (#name :! "time")
  (#help :! "Time constant for timelocked chest")

-- | Parser for the time returned by @NOW@ instruction.
nowOption :: Opt.Parser (Maybe Timestamp)
nowOption = optional $ option parser $
  long "now" <>
  metavar "TIMESTAMP" <>
  help "Timestamp that you want the runtime interpreter to use (default is now)"
  where
    parser =
      (timestampFromSeconds <$> Opt.auto) <|>
      Opt.maybeReader (parseTimestamp . toText)


levelOption :: Opt.Parser (Maybe Natural)
levelOption = optional $ option parser $
  long "level" <>
  metavar "NATURAL" <>
  help "Level of the block in transaction chain"
  where
    parser = Opt.maybeReader (Just . read)

minBlockTimeOption :: Opt.Parser (Maybe Natural)
minBlockTimeOption = optional $ option parser $
  long "min-block-time" <>
  metavar "NATURAL" <>
  help "Minimum time between blocks"
  where
    parser = Opt.maybeReader (Just . read)

-- | Parser for gas limit on contract execution.
maxStepsOption :: Opt.Parser Word64
maxStepsOption = mkCLOptionParser
  (Just 100500)
  (#name :! "max-steps")
  (#help :! "Max steps that you want the runtime interpreter to use")

-- | Parser for path to database with Morley state.
dbPathOption :: Opt.Parser FilePath
dbPathOption = Opt.strOption $
  long "db" <>
  metavar "FILEPATH" <>
  Opt.value "db.json" <>
  help "Path to DB with data which is used instead of real blockchain data" <>
  Opt.showDefault

aliasOption :: (SingI kind, L1AddressKind kind) => String -> Opt.Parser (Alias kind)
aliasOption key = fmap mkAlias . Opt.strOption $
  long key <>
  metavar "ALIAS" <>
  help "An alias to be associated with the originated contract's address, e.g: 'alice', 'bob'"

-- | Generic parser to read an option of 'AddressOrAlias' type.
addressOrAliasOption
  :: (SingI kind, L1AddressKind kind)
  => Maybe (AddressOrAlias kind)
  -> "name" :! String
  -> "help" :! String
  -> Opt.Parser (AddressOrAlias kind)
addressOrAliasOption = mkCLOptionParser

-- | Generic parser to read an option of 'SomeAddressOrAlias' type.
someAddressOrAliasOption
  :: Maybe SomeAddressOrAlias
  -> "name" :! String
  -> "help" :! String
  -> Opt.Parser SomeAddressOrAlias
someAddressOrAliasOption defValue (arg #name -> name) (arg #help -> hInfo) =
  Opt.option (getReader @SomeAddressOrAlias) $ mconcat
    [ Opt.metavar (getMetavar @SomeAddressOrAlias)
    , Opt.long name
    -- Note: `Opt.help` ignores newlines, so we use `Opt.helpDoc` + `vsep` instead.
    -- We use `paragraph` to word-wrap the help text.
    , Opt.helpDoc $ Just $ Pretty.vsep $ (Pretty.extractChunk . Pretty.paragraph) <$>
      [ hInfo
      , [itu|
        When using an alias that is assigned to both a contract and an implicit account,
        use the prefix '#{contractPrefix}:' or '#{implicitPrefix}:' to disambiguate.
        |]
      ]
    , maybeAddDefault pretty defValue
    ]

-- | Parser for transaction parameters.
txDataOption :: Opt.Parser TxData
txDataOption =
  mkTxData
    <$> addressOption (Just genesisAddress)
      (#name :! "sender") (#help :! "Sender address")
    <*> valueOption Nothing
      (#name :! "parameter") (#help :! "Parameter of passed contract")
    <*> mutezOption (Just minBound)
      (#name :! "amount") (#help :! "Amount sent by a transaction")
    <*> entrypointOption (#name :! "entrypoint") (#help :! "Entrypoint to call")
  where
    mkTxData :: ImplicitAddress -> U.Value -> Mutez -> EpName -> TxData
    mkTxData addr param amount epName =
      TxData
        { tdSenderAddress = Constrained addr
        , tdParameter = TxUntypedParam param
        , tdEntrypoint = epName
        , tdAmount = amount
        }

-- | Generic parser to read an option of t'KeyHash' type.
keyHashOption ::
  Maybe KeyHash -> "name" :! String -> "help" :! String -> Opt.Parser KeyHash
keyHashOption = mkCLOptionParser

-- | Generic parser to read an option of 'SecretKey' type.
secretKeyOption ::
  Maybe SecretKey -> "name" :! String -> "help" :! String -> Opt.Parser SecretKey
secretKeyOption = mkCLOptionParser

-- | Generic parser to read an option of 'U.Value' type.
valueOption ::
  Maybe U.Value -> "name" :! String -> "help" :! String -> Opt.Parser U.Value
valueOption = mkCLOptionParser

-- | Generic parser to read an option of 'Mutez' type.
mutezOption ::
  Maybe Mutez -> "name" :! String -> "help" :! String -> Opt.Parser Mutez
mutezOption = mkCLOptionParser

-- | Generic parser to read an option of 'KindedAddress' type.
addressOption :: SingI kind =>
  Maybe (KindedAddress kind) -> "name" :! String -> "help" :! String -> Opt.Parser (KindedAddress kind)
addressOption = mkCLOptionParser

-- | @--oneline@ flag.
onelineOption :: Opt.Parser Bool
onelineOption = switch (
  long "oneline" <>
  help "Force single line output")

-- | Generic parser to read an option of 'EpName' type.
entrypointOption :: "name" :! String -> "help" :! String -> Opt.Parser EpName
entrypointOption = mkCLOptionParser (Just U.DefEpName)

-- | Generic parser to read an option of 'MText' type.
mTextOption ::
  Maybe MText -> "name" :! String -> "help" :! String -> Opt.Parser MText
mTextOption = mkCLOptionParser

----------------------------------------------------------------------------
-- 'HasCLReader' orphan instances (better to avoid)
----------------------------------------------------------------------------

-- This instance uses parser which is not in the place where 'U.Value'
-- is defined, hence it is orphan.
instance HasCLReader U.Value where
  getReader = eitherReader parseValue
    where
      parseValue :: String -> Either String U.Value
      parseValue =
        first (mappend "Failed to parse value: " . displayException) .
        P.parseExpandValue MSCli .
        toText
  getMetavar = "MICHELSON VALUE"

-- This instance uses parser which is not in the place where 'U.Ty'
-- is defined, hence it is orphan.
instance HasCLReader U.Ty where
  getReader = eitherReader
    $ first (mappend "Failed to parse type: " . displayException)
    . P.parseType MSCli
    . toText
  getMetavar = "MICHELSON TYPE"