{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-- | Common option parsers for executables
module PlutusCore.Executable.Parsers where

import PlutusCore.AstSize (AstSize (..))
import PlutusCore.Default (BuiltinSemanticsVariant (..), DefaultFun)
import PlutusCore.Executable.Types
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Transform.Cse (CseWhichSubterms (..))

import Control.Lens ((^.))
import Options.Applicative

{-| Parser for an input stream. If none is specified,
default to stdin for ease of use in pipeline. -}
input :: Parser Input
input :: Parser Input
input = Parser Input
fileInput Parser Input -> Parser Input -> Parser Input
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Input
stdInput Parser Input -> Parser Input -> Parser Input
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Input -> Parser Input
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Input
StdInput

fileInput :: Parser Input
fileInput :: Parser Input
fileInput =
  String -> Input
FileInput
    (String -> Input) -> Parser String -> Parser Input
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"input"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'i'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILENAME"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Input file"
      )

stdInput :: Parser Input
stdInput :: Parser Input
stdInput =
  Input -> Mod FlagFields Input -> Parser Input
forall a. a -> Mod FlagFields a -> Parser a
flag'
    Input
StdInput
    ( String -> Mod FlagFields Input
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stdin"
        Mod FlagFields Input
-> Mod FlagFields Input -> Mod FlagFields Input
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Input
forall (f :: * -> *) a. String -> Mod f a
help String
"Read from stdin (default)"
    )

{-| Parser for an output stream. If none is specified,
default to stdout for ease of use in pipeline. -}
output :: Parser Output
output :: Parser Output
output = Parser Output
fileOutput Parser Output -> Parser Output -> Parser Output
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Output
stdOutput Parser Output -> Parser Output -> Parser Output
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Output
noOutput Parser Output -> Parser Output -> Parser Output
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Output -> Parser Output
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Output
StdOutput

fileOutput :: Parser Output
fileOutput :: Parser Output
fileOutput =
  String -> Output
FileOutput
    (String -> Output) -> Parser String -> Parser Output
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILENAME"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Output file"
      )

stdOutput :: Parser Output
stdOutput :: Parser Output
stdOutput =
  Output -> Mod FlagFields Output -> Parser Output
forall a. a -> Mod FlagFields a -> Parser a
flag'
    Output
StdOutput
    ( String -> Mod FlagFields Output
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"stdout"
        Mod FlagFields Output
-> Mod FlagFields Output -> Mod FlagFields Output
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Output
forall (f :: * -> *) a. String -> Mod f a
help String
"Write to stdout (default)"
    )

noOutput :: Parser Output
noOutput :: Parser Output
noOutput =
  Output -> Mod FlagFields Output -> Parser Output
forall a. a -> Mod FlagFields a -> Parser a
flag'
    Output
NoOutput
    ( String -> Mod FlagFields Output
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"silent"
        Mod FlagFields Output
-> Mod FlagFields Output -> Mod FlagFields Output
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Output
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
        Mod FlagFields Output
-> Mod FlagFields Output -> Mod FlagFields Output
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Output
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't output the evaluation result"
    )

formatHelp :: String
formatHelp :: String
formatHelp =
  String
"textual, flat-named (names), flat (de Bruijn indices), "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"serialised (cbor + flat, with de Bruijn indices), "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"hex (hex + cbor + flat), "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"or flat-namedDeBruijn (names and de Bruijn indices)"

formatReader :: String -> Maybe Format
formatReader :: String -> Maybe Format
formatReader =
  \case
    String
"textual" -> Format -> Maybe Format
forall a. a -> Maybe a
Just Format
Textual
    String
"serialised" -> Format -> Maybe Format
forall a. a -> Maybe a
Just Format
Serialised
    String
"hex" -> Format -> Maybe Format
forall a. a -> Maybe a
Just Format
Hex
    String
"flat-named" -> Format -> Maybe Format
forall a. a -> Maybe a
Just (AstNameType -> Format
Flat AstNameType
Named)
    String
"flat" -> Format -> Maybe Format
forall a. a -> Maybe a
Just (AstNameType -> Format
Flat AstNameType
DeBruijn)
    String
"flat-deBruijn" -> Format -> Maybe Format
forall a. a -> Maybe a
Just (AstNameType -> Format
Flat AstNameType
DeBruijn)
    String
"flat-namedDeBruijn" -> Format -> Maybe Format
forall a. a -> Maybe a
Just (AstNameType -> Format
Flat AstNameType
NamedDeBruijn)
    String
_ -> Maybe Format
forall a. Maybe a
Nothing

inputformat :: Parser Format
inputformat :: Parser Format
inputformat =
  ReadM Format -> Mod OptionFields Format -> Parser Format
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe Format) -> ReadM Format
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe Format
formatReader)
    ( String -> Mod OptionFields Format
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"if"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"input-format"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FORMAT"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> Format -> Mod OptionFields Format
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Format
Textual
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Format
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. String -> Mod f a
help (String
"Input format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
formatHelp)
    )

outputformat :: Parser Format
outputformat :: Parser Format
outputformat =
  ReadM Format -> Mod OptionFields Format -> Parser Format
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe Format) -> ReadM Format
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe Format
formatReader)
    ( String -> Mod OptionFields Format
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"of"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-format"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FORMAT"
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> Format -> Mod OptionFields Format
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Format
Textual
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Format
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields Format
-> Mod OptionFields Format -> Mod OptionFields Format
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Format
forall (f :: * -> *) a. String -> Mod f a
help (String
"Output format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
formatHelp)
    )

tracemode :: Parser TraceMode
tracemode :: Parser TraceMode
tracemode =
  ReadM TraceMode -> Mod OptionFields TraceMode -> Parser TraceMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM TraceMode
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields TraceMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"trace-mode"
        Mod OptionFields TraceMode
-> Mod OptionFields TraceMode -> Mod OptionFields TraceMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TraceMode
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MODE"
        Mod OptionFields TraceMode
-> Mod OptionFields TraceMode -> Mod OptionFields TraceMode
forall a. Semigroup a => a -> a -> a
<> TraceMode -> Mod OptionFields TraceMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value TraceMode
None
        Mod OptionFields TraceMode
-> Mod OptionFields TraceMode -> Mod OptionFields TraceMode
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields TraceMode
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields TraceMode
-> Mod OptionFields TraceMode -> Mod OptionFields TraceMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields TraceMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Mode for trace output."
    )

files :: Parser Files
files :: Parser Files
files = Parser String -> Parser Files
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM String
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"[FILES...]"))

applyOpts :: Parser ApplyOptions
applyOpts :: Parser ApplyOptions
applyOpts = Files -> Format -> Output -> Format -> PrintMode -> ApplyOptions
ApplyOptions (Files -> Format -> Output -> Format -> PrintMode -> ApplyOptions)
-> Parser Files
-> Parser (Format -> Output -> Format -> PrintMode -> ApplyOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Files
files Parser (Format -> Output -> Format -> PrintMode -> ApplyOptions)
-> Parser Format
-> Parser (Output -> Format -> PrintMode -> ApplyOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
inputformat Parser (Output -> Format -> PrintMode -> ApplyOptions)
-> Parser Output -> Parser (Format -> PrintMode -> ApplyOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
output Parser (Format -> PrintMode -> ApplyOptions)
-> Parser Format -> Parser (PrintMode -> ApplyOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
outputformat Parser (PrintMode -> ApplyOptions)
-> Parser PrintMode -> Parser ApplyOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintMode
printmode

printmode :: Parser PrintMode
printmode :: Parser PrintMode
printmode =
  ReadM PrintMode -> Mod OptionFields PrintMode -> Parser PrintMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM PrintMode
forall a. Read a => ReadM a
auto
    ( String -> Mod OptionFields PrintMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-mode"
        Mod OptionFields PrintMode
-> Mod OptionFields PrintMode -> Mod OptionFields PrintMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PrintMode
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MODE"
        Mod OptionFields PrintMode
-> Mod OptionFields PrintMode -> Mod OptionFields PrintMode
forall a. Semigroup a => a -> a -> a
<> PrintMode -> Mod OptionFields PrintMode
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PrintMode
Classic
        Mod OptionFields PrintMode
-> Mod OptionFields PrintMode -> Mod OptionFields PrintMode
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields PrintMode
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields PrintMode
-> Mod OptionFields PrintMode -> Mod OptionFields PrintMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PrintMode
forall (f :: * -> *) a. String -> Mod f a
help
          ( String
"Print mode for textual output (ignored elsewhere): Classic -> plcPrettyClassic, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Simple -> plcPrettyClassicSimple, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Readable -> prettyPlcReadable, ReadableSimple -> prettyPlcReadableSimple"
          )
    )

nameformat :: Parser NameFormat
nameformat :: Parser NameFormat
nameformat =
  NameFormat
-> NameFormat -> Mod FlagFields NameFormat -> Parser NameFormat
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
    NameFormat
IdNames
    NameFormat
DeBruijnNames
    ( String -> Mod FlagFields NameFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debruijn"
        Mod FlagFields NameFormat
-> Mod FlagFields NameFormat -> Mod FlagFields NameFormat
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields NameFormat
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
        Mod FlagFields NameFormat
-> Mod FlagFields NameFormat -> Mod FlagFields NameFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields NameFormat
forall (f :: * -> *) a. String -> Mod f a
help String
"Output evaluation result with de Bruijn indices (default: show textual names)"
    )

certifier :: Parser Certifier
certifier :: Parser Certifier
certifier =
  Parser String -> Parser Certifier
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser String -> Parser Certifier)
-> Parser String -> Parser Certifier
forall a b. (a -> b) -> a -> b
$
    Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"certify"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help
            ( String
"[EXPERIMENTAL] Produce a certificate ARG.agda proving that the program"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" transformaton is correct; the certificate is an Agda proof object, which"
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" can be checked using the Agda proof assistant"
            )
      )

printOpts :: Parser PrintOptions
printOpts :: Parser PrintOptions
printOpts = Input -> Output -> PrintMode -> PrintOptions
PrintOptions (Input -> Output -> PrintMode -> PrintOptions)
-> Parser Input -> Parser (Output -> PrintMode -> PrintOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
input Parser (Output -> PrintMode -> PrintOptions)
-> Parser Output -> Parser (PrintMode -> PrintOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
output Parser (PrintMode -> PrintOptions)
-> Parser PrintMode -> Parser PrintOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintMode
printmode

convertOpts :: Parser ConvertOptions
convertOpts :: Parser ConvertOptions
convertOpts = Input -> Format -> Output -> Format -> PrintMode -> ConvertOptions
ConvertOptions (Input
 -> Format -> Output -> Format -> PrintMode -> ConvertOptions)
-> Parser Input
-> Parser
     (Format -> Output -> Format -> PrintMode -> ConvertOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
input Parser (Format -> Output -> Format -> PrintMode -> ConvertOptions)
-> Parser Format
-> Parser (Output -> Format -> PrintMode -> ConvertOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
inputformat Parser (Output -> Format -> PrintMode -> ConvertOptions)
-> Parser Output -> Parser (Format -> PrintMode -> ConvertOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
output Parser (Format -> PrintMode -> ConvertOptions)
-> Parser Format -> Parser (PrintMode -> ConvertOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
outputformat Parser (PrintMode -> ConvertOptions)
-> Parser PrintMode -> Parser ConvertOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintMode
printmode

certifierOutputMode :: Parser CertifierOutputMode
certifierOutputMode :: Parser CertifierOutputMode
certifierOutputMode =
  [Parser CertifierOutputMode] -> Parser CertifierOutputMode
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ CertifierOutputMode
-> Mod FlagFields CertifierOutputMode -> Parser CertifierOutputMode
forall a. a -> Mod FlagFields a -> Parser a
flag'
        CertifierOutputMode
CertBasic
        ( String -> Mod FlagFields CertifierOutputMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"certifier-basic"
            Mod FlagFields CertifierOutputMode
-> Mod FlagFields CertifierOutputMode
-> Mod FlagFields CertifierOutputMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CertifierOutputMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Certifier produces basic output"
        )
    , String -> CertifierOutputMode
CertReport
        (String -> CertifierOutputMode)
-> Parser String -> Parser CertifierOutputMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"certifier-report"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"REPORT_FILE"
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Certifier writes a report to the given file"
          )
    , CertifierOutputMode
-> CertifierOutputMode
-> Mod FlagFields CertifierOutputMode
-> Parser CertifierOutputMode
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
        CertifierOutputMode
CertProject
        CertifierOutputMode
CertProject
        ( String -> Mod FlagFields CertifierOutputMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"certifier-project"
            Mod FlagFields CertifierOutputMode
-> Mod FlagFields CertifierOutputMode
-> Mod FlagFields CertifierOutputMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields CertifierOutputMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Certifier produces an Agda project that can be type checked (default)"
        )
    ]

simplifyOpts :: Parser (UPLC.SimplifyOpts name a)
simplifyOpts :: forall name a. Parser (SimplifyOpts name a)
simplifyOpts = do
  Int
_soMaxSimplifierIterations <-
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Int
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-simplifier-iterations"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (SimplifyOpts Any Any
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts SimplifyOpts Any Any
-> Getting Int (SimplifyOpts Any Any) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (SimplifyOpts Any Any) Int
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxSimplifierIterations)
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of simplifier iterations"
      )
  Int
_soMaxCseIterations <-
    ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Int
forall a. Read a => ReadM a
auto
      ( String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-cse-iterations"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (SimplifyOpts Any Any
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts SimplifyOpts Any Any
-> Getting Int (SimplifyOpts Any Any) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (SimplifyOpts Any Any) Int
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxCseIterations)
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of CSE iterations"
      )
  CseWhichSubterms
_soCseWhichSubterms <-
    ReadM CseWhichSubterms
-> Mod OptionFields CseWhichSubterms -> Parser CseWhichSubterms
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ( (String -> Maybe CseWhichSubterms) -> ReadM CseWhichSubterms
forall a. (String -> Maybe a) -> ReadM a
maybeReader
          ( \case
              String
"all" -> CseWhichSubterms -> Maybe CseWhichSubterms
forall a. a -> Maybe a
Just CseWhichSubterms
AllSubterms
              String
"exclude-work-free" -> CseWhichSubterms -> Maybe CseWhichSubterms
forall a. a -> Maybe a
Just CseWhichSubterms
ExcludeWorkFree
              String
_ -> Maybe CseWhichSubterms
forall a. Maybe a
Nothing
          )
      )
      ( String -> Mod OptionFields CseWhichSubterms
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-cse-which-subterms"
          Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CseWhichSubterms
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MODE"
          Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
forall a. Semigroup a => a -> a -> a
<> CseWhichSubterms -> Mod OptionFields CseWhichSubterms
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value CseWhichSubterms
ExcludeWorkFree
          Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
forall a. Semigroup a => a -> a -> a
<> (CseWhichSubterms -> String) -> Mod OptionFields CseWhichSubterms
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith (\case CseWhichSubterms
AllSubterms -> String
"all"; CseWhichSubterms
ExcludeWorkFree -> String
"exclude-work-free")
          Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
-> Mod OptionFields CseWhichSubterms
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CseWhichSubterms
forall (f :: * -> *) a. String -> Mod f a
help String
"CSE subterm selection: all | exclude-work-free"
      )
  Bool
_soConservativeOpts <-
    Mod FlagFields Bool -> Parser Bool
switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-conservative"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Use conservative optimisation options. May result in less optimized code."
      )
  let _soInlineHints :: InlineHints name a
_soInlineHints = SimplifyOpts name a
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts SimplifyOpts name a
-> Getting
     (InlineHints name a) (SimplifyOpts name a) (InlineHints name a)
-> InlineHints name a
forall s a. s -> Getting a s a -> a
^. Getting
  (InlineHints name a) (SimplifyOpts name a) (InlineHints name a)
forall name1 a1 name2 a2 (f :: * -> *).
Functor f =>
(InlineHints name1 a1 -> f (InlineHints name2 a2))
-> SimplifyOpts name1 a1 -> f (SimplifyOpts name2 a2)
UPLC.soInlineHints
  Bool
_soInlineConstants <-
    Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
      Bool
True
      Bool
False
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-no-inline-constants"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Disable constant inlining"
      )
  AstSize
_soInlineCallsiteGrowth <-
    ReadM AstSize -> Mod OptionFields AstSize -> Parser AstSize
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      (Integer -> AstSize
AstSize (Integer -> AstSize) -> ReadM Integer -> ReadM AstSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Integer
forall a. Read a => ReadM a
auto)
      ( String -> Mod OptionFields AstSize
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-inline-callsite-growth"
          Mod OptionFields AstSize
-> Mod OptionFields AstSize -> Mod OptionFields AstSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AstSize
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"INT"
          Mod OptionFields AstSize
-> Mod OptionFields AstSize -> Mod OptionFields AstSize
forall a. Semigroup a => a -> a -> a
<> AstSize -> Mod OptionFields AstSize
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (SimplifyOpts Any Any
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts SimplifyOpts Any Any
-> Getting AstSize (SimplifyOpts Any Any) AstSize -> AstSize
forall s a. s -> Getting a s a -> a
^. Getting AstSize (SimplifyOpts Any Any) AstSize
forall name a (f :: * -> *).
Functor f =>
(AstSize -> f AstSize)
-> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soInlineCallsiteGrowth)
          Mod OptionFields AstSize
-> Mod OptionFields AstSize -> Mod OptionFields AstSize
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields AstSize
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields AstSize
-> Mod OptionFields AstSize -> Mod OptionFields AstSize
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields AstSize
forall (f :: * -> *) a. String -> Mod f a
help String
"Maximum allowed AST growth at call sites for inlining"
      )
  Bool
_soPreserveLogging <-
    Mod FlagFields Bool -> Parser Bool
switch
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-preserve-logging"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help
            ( String
"Prevent optimizations from removing or reordering log messages."
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" May result in less optimized code."
            )
      )
  Bool
_soApplyToCase <-
    Bool -> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> a -> Mod FlagFields a -> Parser a
flag
      Bool
True
      Bool
False
      ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"opt-no-apply-to-case"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Disable apply-to-case optimization"
      )
  pure UPLC.SimplifyOpts {Bool
Int
InlineHints name a
AstSize
CseWhichSubterms
_soMaxSimplifierIterations :: Int
_soMaxCseIterations :: Int
_soCseWhichSubterms :: CseWhichSubterms
_soConservativeOpts :: Bool
_soInlineHints :: InlineHints name a
_soInlineConstants :: Bool
_soInlineCallsiteGrowth :: AstSize
_soPreserveLogging :: Bool
_soApplyToCase :: Bool
_soMaxSimplifierIterations :: Int
_soMaxCseIterations :: Int
_soCseWhichSubterms :: CseWhichSubterms
_soConservativeOpts :: Bool
_soInlineHints :: InlineHints name a
_soInlineConstants :: Bool
_soInlineCallsiteGrowth :: AstSize
_soPreserveLogging :: Bool
_soApplyToCase :: Bool
..}

optimiseOpts :: Parser (OptimiseOptions name a)
optimiseOpts :: forall name a. Parser (OptimiseOptions name a)
optimiseOpts =
  Input
-> Format
-> Output
-> Format
-> PrintMode
-> Certifier
-> CertifierOutputMode
-> SimplifyOpts name a
-> OptimiseOptions name a
forall name a.
Input
-> Format
-> Output
-> Format
-> PrintMode
-> Certifier
-> CertifierOutputMode
-> SimplifyOpts name a
-> OptimiseOptions name a
OptimiseOptions
    (Input
 -> Format
 -> Output
 -> Format
 -> PrintMode
 -> Certifier
 -> CertifierOutputMode
 -> SimplifyOpts name a
 -> OptimiseOptions name a)
-> Parser Input
-> Parser
     (Format
      -> Output
      -> Format
      -> PrintMode
      -> Certifier
      -> CertifierOutputMode
      -> SimplifyOpts name a
      -> OptimiseOptions name a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
input
    Parser
  (Format
   -> Output
   -> Format
   -> PrintMode
   -> Certifier
   -> CertifierOutputMode
   -> SimplifyOpts name a
   -> OptimiseOptions name a)
-> Parser Format
-> Parser
     (Output
      -> Format
      -> PrintMode
      -> Certifier
      -> CertifierOutputMode
      -> SimplifyOpts name a
      -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
inputformat
    Parser
  (Output
   -> Format
   -> PrintMode
   -> Certifier
   -> CertifierOutputMode
   -> SimplifyOpts name a
   -> OptimiseOptions name a)
-> Parser Output
-> Parser
     (Format
      -> PrintMode
      -> Certifier
      -> CertifierOutputMode
      -> SimplifyOpts name a
      -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Output
output
    Parser
  (Format
   -> PrintMode
   -> Certifier
   -> CertifierOutputMode
   -> SimplifyOpts name a
   -> OptimiseOptions name a)
-> Parser Format
-> Parser
     (PrintMode
      -> Certifier
      -> CertifierOutputMode
      -> SimplifyOpts name a
      -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Format
outputformat
    Parser
  (PrintMode
   -> Certifier
   -> CertifierOutputMode
   -> SimplifyOpts name a
   -> OptimiseOptions name a)
-> Parser PrintMode
-> Parser
     (Certifier
      -> CertifierOutputMode
      -> SimplifyOpts name a
      -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintMode
printmode
    Parser
  (Certifier
   -> CertifierOutputMode
   -> SimplifyOpts name a
   -> OptimiseOptions name a)
-> Parser Certifier
-> Parser
     (CertifierOutputMode
      -> SimplifyOpts name a -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Certifier
certifier
    Parser
  (CertifierOutputMode
   -> SimplifyOpts name a -> OptimiseOptions name a)
-> Parser CertifierOutputMode
-> Parser (SimplifyOpts name a -> OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CertifierOutputMode
certifierOutputMode
    Parser (SimplifyOpts name a -> OptimiseOptions name a)
-> Parser (SimplifyOpts name a) -> Parser (OptimiseOptions name a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SimplifyOpts name a)
forall name a. Parser (SimplifyOpts name a)
simplifyOpts

exampleMode :: Parser ExampleMode
exampleMode :: Parser ExampleMode
exampleMode = Parser ExampleMode
exampleAvailable Parser ExampleMode -> Parser ExampleMode -> Parser ExampleMode
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ExampleMode
exampleSingle

exampleAvailable :: Parser ExampleMode
exampleAvailable :: Parser ExampleMode
exampleAvailable =
  ExampleMode -> Mod FlagFields ExampleMode -> Parser ExampleMode
forall a. a -> Mod FlagFields a -> Parser a
flag'
    ExampleMode
ExampleAvailable
    ( String -> Mod FlagFields ExampleMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"available"
        Mod FlagFields ExampleMode
-> Mod FlagFields ExampleMode -> Mod FlagFields ExampleMode
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields ExampleMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
        Mod FlagFields ExampleMode
-> Mod FlagFields ExampleMode -> Mod FlagFields ExampleMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ExampleMode
forall (f :: * -> *) a. String -> Mod f a
help String
"Show available examples"
    )

exampleName :: Parser ExampleName
exampleName :: Parser ExampleName
exampleName =
  Mod OptionFields ExampleName -> Parser ExampleName
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( String -> Mod OptionFields ExampleName
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"single"
        Mod OptionFields ExampleName
-> Mod OptionFields ExampleName -> Mod OptionFields ExampleName
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ExampleName
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
        Mod OptionFields ExampleName
-> Mod OptionFields ExampleName -> Mod OptionFields ExampleName
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields ExampleName
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
        Mod OptionFields ExampleName
-> Mod OptionFields ExampleName -> Mod OptionFields ExampleName
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ExampleName
forall (f :: * -> *) a. String -> Mod f a
help String
"Show a single example"
    )

exampleSingle :: Parser ExampleMode
exampleSingle :: Parser ExampleMode
exampleSingle = ExampleName -> ExampleMode
ExampleSingle (ExampleName -> ExampleMode)
-> Parser ExampleName -> Parser ExampleMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExampleName
exampleName

exampleOpts :: Parser ExampleOptions
exampleOpts :: Parser ExampleOptions
exampleOpts = ExampleMode -> ExampleOptions
ExampleOptions (ExampleMode -> ExampleOptions)
-> Parser ExampleMode -> Parser ExampleOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ExampleMode
exampleMode

builtinSemanticsVariantReader :: String -> Maybe (BuiltinSemanticsVariant DefaultFun)
builtinSemanticsVariantReader :: String -> Maybe (BuiltinSemanticsVariant DefaultFun)
builtinSemanticsVariantReader =
  \case
    String
"A" -> BuiltinSemanticsVariant DefaultFun
-> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. a -> Maybe a
Just BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantA
    String
"B" -> BuiltinSemanticsVariant DefaultFun
-> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. a -> Maybe a
Just BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantB
    String
"C" -> BuiltinSemanticsVariant DefaultFun
-> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. a -> Maybe a
Just BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantC
    String
"D" -> BuiltinSemanticsVariant DefaultFun
-> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. a -> Maybe a
Just BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantD
    String
"E" -> BuiltinSemanticsVariant DefaultFun
-> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. a -> Maybe a
Just BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantE
    String
_ -> Maybe (BuiltinSemanticsVariant DefaultFun)
forall a. Maybe a
Nothing

-- This is used to make the help message show you what you actually need to type.
showBuiltinSemanticsVariant :: BuiltinSemanticsVariant DefaultFun -> String
showBuiltinSemanticsVariant :: BuiltinSemanticsVariant DefaultFun -> String
showBuiltinSemanticsVariant =
  \case
    BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantA -> String
"A"
    BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantB -> String
"B"
    BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantC -> String
"C"
    BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantD -> String
"D"
    BuiltinSemanticsVariant DefaultFun
R:BuiltinSemanticsVariantDefaultFun
DefaultFunSemanticsVariantE -> String
"E"

builtinSemanticsVariant :: Parser (BuiltinSemanticsVariant DefaultFun)
builtinSemanticsVariant :: Parser (BuiltinSemanticsVariant DefaultFun)
builtinSemanticsVariant =
  ReadM (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Parser (BuiltinSemanticsVariant DefaultFun)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe (BuiltinSemanticsVariant DefaultFun))
-> ReadM (BuiltinSemanticsVariant DefaultFun)
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe (BuiltinSemanticsVariant DefaultFun)
builtinSemanticsVariantReader)
    ( String -> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"builtin-semantics-variant"
        Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'S'
        Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VARIANT"
        Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a. Semigroup a => a -> a -> a
<> BuiltinSemanticsVariant DefaultFun
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value BuiltinSemanticsVariant DefaultFun
DefaultFunSemanticsVariantE
        Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a. Semigroup a => a -> a -> a
<> (BuiltinSemanticsVariant DefaultFun -> String)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith BuiltinSemanticsVariant DefaultFun -> String
showBuiltinSemanticsVariant
        Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
-> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (BuiltinSemanticsVariant DefaultFun)
forall (f :: * -> *) a. String -> Mod f a
help
          ( String
"Builtin semantics variant: A -> DefaultFunSemanticsVariantA, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"B -> DefaultFunSemanticsVariantB, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"C -> DefaultFunSemanticsVariantC, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"D -> DefaultFunSemanticsVariantD, "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"E -> DefaultFunSemanticsVariantE"
          )
    )

-- Specialised parsers for PIR, which only supports ASTs over the Textual and
-- Named types.

pirFormatHelp :: String
pirFormatHelp :: String
pirFormatHelp =
  String
"textual or flat-named (names)"

pirFormatReader :: String -> Maybe PirFormat
pirFormatReader :: String -> Maybe PirFormat
pirFormatReader =
  \case
    String
"textual" -> PirFormat -> Maybe PirFormat
forall a. a -> Maybe a
Just PirFormat
TextualPir
    String
"flat-named" -> PirFormat -> Maybe PirFormat
forall a. a -> Maybe a
Just PirFormat
FlatNamed
    String
_ -> Maybe PirFormat
forall a. Maybe a
Nothing

pPirInputFormat :: Parser PirFormat
pPirInputFormat :: Parser PirFormat
pPirInputFormat =
  ReadM PirFormat -> Mod OptionFields PirFormat -> Parser PirFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe PirFormat) -> ReadM PirFormat
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe PirFormat
pirFormatReader)
    ( String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"if"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"input-format"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PIR-FORMAT"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> PirFormat -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PirFormat
TextualPir
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields PirFormat
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. String -> Mod f a
help (String
"Input format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pirFormatHelp)
    )

pPirOutputFormat :: Parser PirFormat
pPirOutputFormat :: Parser PirFormat
pPirOutputFormat =
  ReadM PirFormat -> Mod OptionFields PirFormat -> Parser PirFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe PirFormat) -> ReadM PirFormat
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe PirFormat
pirFormatReader)
    ( String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"of"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output-format"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PIR-FORMAT"
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> PirFormat -> Mod OptionFields PirFormat
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value PirFormat
TextualPir
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields PirFormat
forall a (f :: * -> *). Show a => Mod f a
showDefault
        Mod OptionFields PirFormat
-> Mod OptionFields PirFormat -> Mod OptionFields PirFormat
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields PirFormat
forall (f :: * -> *) a. String -> Mod f a
help (String
"Output format: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pirFormatHelp)
    )

-- Which language: PLC or UPLC?

languageReader :: String -> Maybe Language
languageReader :: String -> Maybe Language
languageReader =
  \case
    String
"plc" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
PLC
    String
"uplc" -> Language -> Maybe Language
forall a. a -> Maybe a
Just Language
UPLC
    String
_ -> Maybe Language
forall a. Maybe a
Nothing

pLanguage :: Parser Language
pLanguage :: Parser Language
pLanguage =
  ReadM Language -> Mod OptionFields Language -> Parser Language
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ((String -> Maybe Language) -> ReadM Language
forall a. (String -> Maybe a) -> ReadM a
maybeReader String -> Maybe Language
languageReader)
    ( String -> Mod OptionFields Language
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"language"
        Mod OptionFields Language
-> Mod OptionFields Language -> Mod OptionFields Language
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Language
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
        Mod OptionFields Language
-> Mod OptionFields Language -> Mod OptionFields Language
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Language
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"LANGUAGE"
        Mod OptionFields Language
-> Mod OptionFields Language -> Mod OptionFields Language
forall a. Semigroup a => a -> a -> a
<> Language -> Mod OptionFields Language
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Language
UPLC
        Mod OptionFields Language
-> Mod OptionFields Language -> Mod OptionFields Language
forall a. Semigroup a => a -> a -> a
<> (Language -> String) -> Mod OptionFields Language
forall a (f :: * -> *). (a -> String) -> Mod f a
showDefaultWith (\case Language
PLC -> String
"plc"; Language
UPLC -> String
"uplc")
        Mod OptionFields Language
-> Mod OptionFields Language -> Mod OptionFields Language
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Language
forall (f :: * -> *) a. String -> Mod f a
help (String
"Target language: plc or uplc")
    )