{-# LANGUAGE LambdaCase #-}

-- | Common option parsers for executables

module PlutusCore.Executable.Parsers where

import PlutusCore.Default (BuiltinSemanticsVariant (..), DefaultFun)
import PlutusCore.Executable.Types

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
"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
"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
Simple
  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

optimiseOpts :: Parser OptimiseOptions
optimiseOpts :: Parser OptimiseOptions
optimiseOpts =
  Input
-> Format
-> Output
-> Format
-> PrintMode
-> Certifier
-> OptimiseOptions
OptimiseOptions
  (Input
 -> Format
 -> Output
 -> Format
 -> PrintMode
 -> Certifier
 -> OptimiseOptions)
-> Parser Input
-> Parser
     (Format
      -> Output -> Format -> PrintMode -> Certifier -> OptimiseOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Input
input Parser
  (Format
   -> Output -> Format -> PrintMode -> Certifier -> OptimiseOptions)
-> Parser Format
-> Parser
     (Output -> Format -> PrintMode -> Certifier -> OptimiseOptions)
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 -> OptimiseOptions)
-> Parser Output
-> Parser (Format -> PrintMode -> Certifier -> OptimiseOptions)
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 -> OptimiseOptions)
-> Parser Format
-> Parser (PrintMode -> Certifier -> OptimiseOptions)
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 -> OptimiseOptions)
-> Parser PrintMode -> Parser (Certifier -> OptimiseOptions)
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 -> OptimiseOptions)
-> Parser Certifier -> Parser OptimiseOptions
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

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
_   -> 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 :: 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
DefaultFunSemanticsVariantC
  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"
    )
  )

-- 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")
  )