module Verismith.OptParser
  ( OptTool (..),
    Opts (..),
    opts,
  )
where

import Control.Applicative ((<|>))
import Data.Text (Text)
import qualified Data.Text as T
import Options.Applicative
  ( Mod (..),
    OptionFields (..),
    Parser (..),
    ParserInfo (..),
    ReadM (..),
    (<**>),
  )
import qualified Options.Applicative as Opt
import Shelly (FilePath (..), fromText)
import Verismith.Config (SynthDescription (..), versionInfo)
import Prelude hiding (FilePath (..))
import Verismith.Verilog2005 (PrintingOpts (..))

data OptTool
  = TYosys
  | TXST
  | TIcarus

instance Show OptTool where
  show :: OptTool -> String
show OptTool
TYosys = String
"yosys"
  show OptTool
TXST = String
"xst"
  show OptTool
TIcarus = String
"icarus"

data Opts
  = Fuzz
      { Opts -> Text
fuzzOutput :: Text,
        Opts -> Maybe String
fuzzConfigFile :: !(Maybe FilePath),
        Opts -> Bool
fuzzForced :: !Bool,
        Opts -> Bool
fuzzKeepAll :: !Bool,
        Opts -> Int
fuzzNum :: {-# UNPACK #-} !Int,
        Opts -> Bool
fuzzNoSim :: !Bool,
        Opts -> Bool
fuzzNoEquiv :: !Bool,
        Opts -> Bool
fuzzNoReduction :: !Bool,
        Opts -> Maybe String
fuzzExistingFile :: !(Maybe FilePath),
        Opts -> Text
fuzzExistingFileTop :: !Text,
        Opts -> Bool
fuzzCrossCheck :: !Bool,
        Opts -> Maybe Text
fuzzChecker :: !(Maybe Text)
      }
  | EMIOpts
      { Opts -> Text
emiOutput :: Text,
        Opts -> Maybe String
emiConfigFile :: !(Maybe FilePath),
        Opts -> Bool
emiForced :: !Bool,
        Opts -> Bool
emiKeepAll :: !Bool,
        Opts -> Int
emiNum :: {-# UNPACK #-} !Int,
        Opts -> Bool
emiNoSim :: !Bool,
        Opts -> Bool
emiNoEquiv :: !Bool,
        Opts -> Bool
emiNoReduction :: !Bool,
        Opts -> Text
emiTopModule :: Text,
        Opts -> String
emiInputFile :: FilePath
      }
  | Generate
      { Opts -> Maybe String
generateFilename :: !(Maybe FilePath),
        Opts -> Maybe String
generateConfigFile :: !(Maybe FilePath),
        Opts -> Bool
generateValidSyntax :: !Bool,
        Opts -> PrintingOpts
generatePrinting :: !PrintingOpts
      }
  | Parse
      { Opts -> String
parseFilename :: !FilePath,
        Opts -> Maybe String
parseOutput :: !(Maybe FilePath),
        Opts -> Bool
parseStrict :: !Bool,
        Opts -> PrintingOpts
parsePrinting :: !PrintingOpts
      }
  | Reduce
      { Opts -> String
reduceFilename :: !FilePath,
        Opts -> Text
reduceTop :: !Text,
        Opts -> Maybe String
reduceScript :: !(Maybe FilePath),
        Opts -> [SynthDescription]
reduceSynthesiserDesc :: ![SynthDescription],
        Opts -> Bool
reduceRerun :: !Bool
      }
  | ConfigOpt
      { Opts -> Maybe String
configOptWriteConfig :: !(Maybe FilePath),
        Opts -> Maybe String
configOptConfigFile :: !(Maybe FilePath),
        Opts -> Bool
configOptDoRandomise :: !Bool
      }
  | DistanceOpt
      { Opts -> String
distanceOptVerilogA :: !FilePath,
        Opts -> String
distanceOptVerilogB :: !FilePath
      }
  | ShuffleOpt
      { Opts -> String
shuffleOptFilename :: !FilePath,
        Opts -> Text
shuffleOptTop :: !Text,
        Opts -> Maybe String
shuffleOptOutput :: !(Maybe FilePath),
        Opts -> Bool
shuffleOptShuffleLines :: !Bool,
        Opts -> Bool
shuffleOptRenameVars :: !Bool,
        Opts -> Bool
shuffleOptEquiv :: !Bool,
        Opts -> String
shuffleOptEquivFolder :: !FilePath,
        Opts -> Maybe Text
shuffleOptChecker :: !(Maybe Text)
      }
  | Equiv
      { Opts -> String
equivOutput :: !FilePath,
        Opts -> String
equivFilenameA :: !FilePath,
        Opts -> String
equivFilenameB :: !FilePath,
        Opts -> Text
equivFileTop :: !Text,
        Opts -> Maybe Text
equivChecker :: !(Maybe Text)
      }

textOption :: Mod OptionFields String -> Parser Text
textOption :: Mod OptionFields String -> Parser Text
textOption = (String -> Text) -> Parser String -> Parser Text
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Parser String -> Parser Text)
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption

optReader :: (String -> Maybe a) -> ReadM a
optReader :: forall a. (String -> Maybe a) -> ReadM a
optReader String -> Maybe a
f = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
Opt.eitherReader ((String -> Either String a) -> ReadM a)
-> (String -> Either String a) -> ReadM a
forall a b. (a -> b) -> a -> b
$ \String
arg -> case String -> Maybe a
f String
arg of
  Just a
a -> a -> Either String a
forall a b. b -> Either a b
Right a
a
  Maybe a
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Cannot parse option: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
arg

parseSynth :: String -> Maybe OptTool
parseSynth :: String -> Maybe OptTool
parseSynth String
val
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yosys" = OptTool -> Maybe OptTool
forall a. a -> Maybe a
Just OptTool
TYosys
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xst" = OptTool -> Maybe OptTool
forall a. a -> Maybe a
Just OptTool
TXST
  | Bool
otherwise = Maybe OptTool
forall a. Maybe a
Nothing

parseSynthDesc :: String -> Maybe SynthDescription
parseSynthDesc :: String -> Maybe SynthDescription
parseSynthDesc String
val
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"yosys" = SynthDescription -> Maybe SynthDescription
forall a. a -> Maybe a
Just (SynthDescription -> Maybe SynthDescription)
-> SynthDescription -> Maybe SynthDescription
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> SynthDescription
SynthDescription Text
"yosys" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"vivado" = SynthDescription -> Maybe SynthDescription
forall a. a -> Maybe a
Just (SynthDescription -> Maybe SynthDescription)
-> SynthDescription -> Maybe SynthDescription
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> SynthDescription
SynthDescription Text
"vivado" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xst" = SynthDescription -> Maybe SynthDescription
forall a. a -> Maybe a
Just (SynthDescription -> Maybe SynthDescription)
-> SynthDescription -> Maybe SynthDescription
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Text -> Maybe Text -> SynthDescription
SynthDescription Text
"xst" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"quartus" =
    SynthDescription -> Maybe SynthDescription
forall a. a -> Maybe a
Just (SynthDescription -> Maybe SynthDescription)
-> SynthDescription -> Maybe SynthDescription
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe Text -> Maybe Text -> Maybe Text -> SynthDescription
SynthDescription Text
"quartus" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"identity" =
    SynthDescription -> Maybe SynthDescription
forall a. a -> Maybe a
Just (SynthDescription -> Maybe SynthDescription)
-> SynthDescription -> Maybe SynthDescription
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe Text -> Maybe Text -> Maybe Text -> SynthDescription
SynthDescription Text
"identity" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
  | Bool
otherwise = Maybe SynthDescription
forall a. Maybe a
Nothing

parseSim :: String -> Maybe OptTool
parseSim :: String -> Maybe OptTool
parseSim String
val
  | String
val String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"icarus" = OptTool -> Maybe OptTool
forall a. a -> Maybe a
Just OptTool
TIcarus
  | Bool
otherwise = Maybe OptTool
forall a. Maybe a
Nothing

fuzzOpts :: Parser Opts
fuzzOpts :: Parser Opts
fuzzOpts =
  Text
-> Maybe String
-> Bool
-> Bool
-> Int
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Text
-> Bool
-> Maybe Text
-> Opts
Fuzz
    (Text
 -> Maybe String
 -> Bool
 -> Bool
 -> Int
 -> Bool
 -> Bool
 -> Bool
 -> Maybe String
 -> Text
 -> Bool
 -> Maybe Text
 -> Opts)
-> Parser Text
-> Parser
     (Maybe String
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Text
      -> Bool
      -> Maybe Text
      -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser Text
textOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"DIR"
          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
Opt.help String
"Output directory that the fuzz run takes place in."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"output"
      )
    Parser
  (Maybe String
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Text
   -> Bool
   -> Maybe Text
   -> Opts)
-> Parser (Maybe String)
-> Parser
     (Bool
      -> Bool
      -> Int
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Text
      -> Bool
      -> Maybe Text
      -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"config"
              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
Opt.short Char
'c'
              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
Opt.metavar String
"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
Opt.help String
"Config file for the current fuzz run."
        )
    Parser
  (Bool
   -> Bool
   -> Int
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Text
   -> Bool
   -> Maybe Text
   -> Opts)
-> Parser Bool
-> Parser
     (Bool
      -> Int
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Text
      -> Bool
      -> Maybe Text
      -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"force"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'f'
              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
Opt.help
                String
"Overwrite the specified directory."
        )
    Parser
  (Bool
   -> Int
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Text
   -> Bool
   -> Maybe Text
   -> Opts)
-> Parser Bool
-> Parser
     (Int
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Text
      -> Bool
      -> Maybe Text
      -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"keep"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'k'
              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
Opt.help
                String
"Keep all the directories."
        )
    Parser
  (Int
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Text
   -> Bool
   -> Maybe Text
   -> Opts)
-> Parser Int
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Text
      -> Bool
      -> Maybe Text
      -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"num"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'n'
              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
Opt.help String
"The number of fuzz runs that should be performed."
              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
Opt.showDefault
              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
Opt.value Int
1
              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
Opt.metavar String
"INT"
        )
    Parser
  (Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Text
   -> Bool
   -> Maybe Text
   -> Opts)
-> Parser Bool
-> Parser
     (Bool
      -> Bool -> Maybe String -> Text -> Bool -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-sim"
              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
Opt.help
                String
"Do not run simulation on the output netlist."
        )
    Parser
  (Bool
   -> Bool -> Maybe String -> Text -> Bool -> Maybe Text -> Opts)
-> Parser Bool
-> Parser
     (Bool -> Maybe String -> Text -> Bool -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-equiv"
              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
Opt.help
                String
"Do not run an equivalence check on the output netlist."
        )
    Parser (Bool -> Maybe String -> Text -> Bool -> Maybe Text -> Opts)
-> Parser Bool
-> Parser (Maybe String -> Text -> Bool -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-reduction"
              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
Opt.help
                String
"Do not run reduction on a failed testcase."
        )
    Parser (Maybe String -> Text -> Bool -> Maybe Text -> Opts)
-> Parser (Maybe String)
-> Parser (Text -> Bool -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"source"
              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
Opt.short Char
's'
              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
Opt.metavar String
"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
Opt.help String
"Name of the top module."
        )
    Parser (Text -> Bool -> Maybe Text -> Opts)
-> Parser Text -> Parser (Bool -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser Text
textOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"source-top"
          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
Opt.short Char
't'
          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
Opt.metavar String
"TOP"
          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
Opt.help String
"Define the top module for the source file."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"top"
      )
    Parser (Bool -> Maybe Text -> Opts)
-> Parser Bool -> Parser (Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"crosscheck"
              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
Opt.help
                String
"Do not only compare against the original design, but also against other netlists."
        )
    Parser (Maybe Text -> Opts) -> Parser (Maybe Text) -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields String -> Parser Text)
-> Mod OptionFields String
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser Text
textOption (Mod OptionFields String -> Parser (Maybe Text))
-> Mod OptionFields String -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"checker"
              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
Opt.metavar String
"CHECKER"
              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
Opt.help String
"Define the checker to use."
        )

emiOpts :: Parser Opts
emiOpts :: Parser Opts
emiOpts =
  Text
-> Maybe String
-> Bool
-> Bool
-> Int
-> Bool
-> Bool
-> Bool
-> Text
-> String
-> Opts
EMIOpts
    (Text
 -> Maybe String
 -> Bool
 -> Bool
 -> Int
 -> Bool
 -> Bool
 -> Bool
 -> Text
 -> String
 -> Opts)
-> Parser Text
-> Parser
     (Maybe String
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> String
      -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser Text
textOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"DIR"
          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
Opt.help String
"Output directory that the fuzz run takes place in."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"output"
      )
    Parser
  (Maybe String
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> String
   -> Opts)
-> Parser (Maybe String)
-> Parser
     (Bool
      -> Bool -> Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"config"
              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
Opt.short Char
'c'
              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
Opt.metavar String
"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
Opt.help String
"Config file for the current fuzz run."
        )
    Parser
  (Bool
   -> Bool -> Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
-> Parser Bool
-> Parser
     (Bool -> Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"force"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'f'
              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
Opt.help
                String
"Overwrite the specified directory."
        )
    Parser
  (Bool -> Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
-> Parser Bool
-> Parser (Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"keep"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'k'
              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
Opt.help
                String
"Keep all the directories."
        )
    Parser (Int -> Bool -> Bool -> Bool -> Text -> String -> Opts)
-> Parser Int
-> Parser (Bool -> Bool -> Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ReadM Int
forall a. Read a => ReadM a
Opt.auto (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"num"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'n'
              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
Opt.help String
"The number of fuzz runs that should be performed."
              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
Opt.showDefault
              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
Opt.value Int
1
              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
Opt.metavar String
"INT"
        )
    Parser (Bool -> Bool -> Bool -> Text -> String -> Opts)
-> Parser Bool -> Parser (Bool -> Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-sim"
              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
Opt.help
                String
"Do not run simulation on the output netlist."
        )
    Parser (Bool -> Bool -> Text -> String -> Opts)
-> Parser Bool -> Parser (Bool -> Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-equiv"
              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
Opt.help
                String
"Do not run an equivalence check on the output netlist."
        )
    Parser (Bool -> Text -> String -> Opts)
-> Parser Bool -> Parser (Text -> String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-reduction"
              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
Opt.help
                String
"Do not run reduction on a failed testcase."
        )
    Parser (Text -> String -> Opts)
-> Parser Text -> Parser (String -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser Text
textOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"top"
          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
Opt.short Char
't'
          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
Opt.metavar String
"MODULE"
          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
Opt.help String
"Top module for the Verilog module."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"top"
      )
    Parser (String -> Opts) -> Parser String -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Verilog input file to pass to EMI.")

printOpts :: Parser PrintingOpts
printOpts :: Parser PrintingOpts
printOpts =
  Bool -> Bool -> Bool -> PrintingOpts
PrintingOpts
    (Bool -> Bool -> Bool -> PrintingOpts)
-> Parser Bool -> Parser (Bool -> Bool -> PrintingOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"space-after-escaped"
              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
Opt.help String
"Always print a space after an escaped identifier."
        )
    Parser (Bool -> Bool -> PrintingOpts)
-> Parser Bool -> Parser (Bool -> PrintingOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"spaces-in-primitive"
              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
Opt.help String
"Always print spaces in primitives table between levels."
        )
    Parser (Bool -> PrintingOpts) -> Parser Bool -> Parser PrintingOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"edge-control-z"
              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
Opt.help String
"Use z instead of x in edge-control specifiers."
        )

genOpts :: Parser Opts
genOpts :: Parser Opts
genOpts =
  Maybe String -> Maybe String -> Bool -> PrintingOpts -> Opts
Generate
    (Maybe String -> Maybe String -> Bool -> PrintingOpts -> Opts)
-> Parser (Maybe String)
-> Parser (Maybe String -> Bool -> PrintingOpts -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"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
Opt.help String
"Output to a verilog file instead."
        )
    Parser (Maybe String -> Bool -> PrintingOpts -> Opts)
-> Parser (Maybe String) -> Parser (Bool -> PrintingOpts -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"config"
              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
Opt.short Char
'c'
              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
Opt.metavar String
"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
Opt.help String
"Config file for the generation run."
        )
    Parser (Bool -> PrintingOpts -> Opts)
-> Parser Bool -> Parser (PrintingOpts -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"invalid"
              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
Opt.help
                String
"Generate invalid Verilog that is only syntactically allowed."
        )
    Parser (PrintingOpts -> Opts) -> Parser PrintingOpts -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintingOpts
printOpts

parseOpts :: Parser Opts
parseOpts :: Parser Opts
parseOpts =
  String -> Maybe String -> Bool -> PrintingOpts -> Opts
Parse
    (String -> Maybe String -> Bool -> PrintingOpts -> Opts)
-> Parser String
-> Parser (Maybe String -> Bool -> PrintingOpts -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Verilog input file.")
        )
    Parser (Maybe String -> Bool -> PrintingOpts -> Opts)
-> Parser (Maybe String) -> Parser (Bool -> PrintingOpts -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"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
Opt.help String
"Output file to write the parsed file to."
        )
    Parser (Bool -> PrintingOpts -> Opts)
-> Parser Bool -> Parser (PrintingOpts -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"strict"
              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
Opt.help
                String
"Makes the parser comply strictly to the Verilog 2005 standard."
        )
    Parser (PrintingOpts -> Opts) -> Parser PrintingOpts -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PrintingOpts
printOpts

shuffleOpts :: Parser Opts
shuffleOpts :: Parser Opts
shuffleOpts =
  String
-> Text
-> Maybe String
-> Bool
-> Bool
-> Bool
-> String
-> Maybe Text
-> Opts
ShuffleOpt
    (String
 -> Text
 -> Maybe String
 -> Bool
 -> Bool
 -> Bool
 -> String
 -> Maybe Text
 -> Opts)
-> Parser String
-> Parser
     (Text
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> String
      -> Maybe Text
      -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Verilog input file.")
        )
    Parser
  (Text
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> String
   -> Maybe Text
   -> Opts)
-> Parser Text
-> Parser
     (Maybe String
      -> Bool -> Bool -> Bool -> String -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser Text
textOption
      ( Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
't'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"top"
          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
Opt.metavar String
"TOP"
          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
Opt.help String
"Name of top level module."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"top"
      )
    Parser
  (Maybe String
   -> Bool -> Bool -> Bool -> String -> Maybe Text -> Opts)
-> Parser (Maybe String)
-> Parser (Bool -> Bool -> Bool -> String -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"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
Opt.help String
"Output file to write the parsed file to."
        )
    Parser (Bool -> Bool -> Bool -> String -> Maybe Text -> Opts)
-> Parser Bool
-> Parser (Bool -> Bool -> String -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-shuffle-lines"
              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
Opt.help
                String
"Shuffle the lines in a Verilog file."
        )
    Parser (Bool -> Bool -> String -> Maybe Text -> Opts)
-> Parser Bool -> Parser (Bool -> String -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"no-rename-vars"
              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
Opt.help
                String
"Rename the variables in a Verilog file."
        )
    Parser (Bool -> String -> Maybe Text -> Opts)
-> Parser Bool -> Parser (String -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"noequiv"
              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
Opt.help
                String
"Do not check equivalence between input and output (currently only verismith generated Verilog is likely to pass this equivalence check)."
        )
    Parser (String -> Maybe Text -> Opts)
-> Parser String -> Parser (Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"equiv-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
Opt.short Char
'e'
              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
Opt.metavar String
"FOLDER"
              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
Opt.help String
"Output folder to write the equivalence checking files in."
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
              Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"equiv"
        )
    Parser (Maybe Text -> Opts) -> Parser (Maybe Text) -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields String -> Parser Text)
-> Mod OptionFields String
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser Text
textOption (Mod OptionFields String -> Parser (Maybe Text))
-> Mod OptionFields String -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"checker"
              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
Opt.metavar String
"CHECKER"
              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
Opt.help String
"Define the checker to use."
        )

reduceOpts :: Parser Opts
reduceOpts :: Parser Opts
reduceOpts =
  String
-> Text -> Maybe String -> [SynthDescription] -> Bool -> Opts
Reduce
    (String
 -> Text -> Maybe String -> [SynthDescription] -> Bool -> Opts)
-> ShowS
-> String
-> Text
-> Maybe String
-> [SynthDescription]
-> Bool
-> Opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
fromText
    (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String
 -> Text -> Maybe String -> [SynthDescription] -> Bool -> Opts)
-> Parser String
-> Parser
     (Text -> Maybe String -> [SynthDescription] -> Bool -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Verilog input file.")
    Parser (Text -> Maybe String -> [SynthDescription] -> Bool -> Opts)
-> Parser Text
-> Parser (Maybe String -> [SynthDescription] -> Bool -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser Text
textOption
      ( Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
't'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"top"
          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
Opt.metavar String
"TOP"
          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
Opt.help String
"Name of top level module."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"top"
      )
    Parser (Maybe String -> [SynthDescription] -> Bool -> Opts)
-> Parser (Maybe String)
-> Parser ([SynthDescription] -> Bool -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"script"
              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
Opt.metavar String
"SCRIPT"
              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
Opt.help
                String
"Script that determines if the current file is interesting, which is determined by the script returning 0."
        )
    Parser ([SynthDescription] -> Bool -> Opts)
-> Parser [SynthDescription] -> Parser (Bool -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser SynthDescription -> Parser [SynthDescription]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Opt.many
            (Parser SynthDescription -> Parser [SynthDescription])
-> (Mod OptionFields SynthDescription -> Parser SynthDescription)
-> Mod OptionFields SynthDescription
-> Parser [SynthDescription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadM SynthDescription
-> Mod OptionFields SynthDescription -> Parser SynthDescription
forall a. ReadM a -> Mod OptionFields a -> Parser a
Opt.option ((String -> Maybe SynthDescription) -> ReadM SynthDescription
forall a. (String -> Maybe a) -> ReadM a
optReader String -> Maybe SynthDescription
parseSynthDesc)
            (Mod OptionFields SynthDescription -> Parser [SynthDescription])
-> Mod OptionFields SynthDescription -> Parser [SynthDescription]
forall a b. (a -> b) -> a -> b
$ Char -> Mod OptionFields SynthDescription
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
's'
              Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SynthDescription
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"synth"
              Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SynthDescription
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"SYNTH"
              Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
-> Mod OptionFields SynthDescription
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SynthDescription
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Specify synthesiser to use."
        )
    Parser (Bool -> Opts) -> Parser Bool -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'r'
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"rerun"
              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
Opt.help
                String
"Only rerun the current synthesis file with all the synthesisers."
        )

configOpts :: Parser Opts
configOpts :: Parser Opts
configOpts =
  Maybe String -> Maybe String -> Bool -> Opts
ConfigOpt
    (Maybe String -> Maybe String -> Bool -> Opts)
-> Parser (Maybe String) -> Parser (Maybe String -> Bool -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"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
Opt.help String
"Output to a TOML Config file."
        )
    Parser (Maybe String -> Bool -> Opts)
-> Parser (Maybe String) -> Parser (Bool -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional
            (Parser String -> Parser (Maybe String))
-> (Mod OptionFields String -> Parser String)
-> Mod OptionFields String
-> Parser (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
Opt.strOption
            (Mod OptionFields String -> Parser (Maybe String))
-> Mod OptionFields String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"config"
              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
Opt.short Char
'c'
              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
Opt.metavar String
"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
Opt.help String
"Config file for the current fuzz run."
        )
    Parser (Bool -> Opts) -> Parser Bool -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Mod FlagFields Bool -> Parser Bool
Opt.switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
            String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"randomise"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'r'
              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
Opt.help
                String
"Randomise the given default config, or the default config by randomly switchin on and off options."
        )

distanceOpts :: Parser Opts
distanceOpts :: Parser Opts
distanceOpts =
  String -> String -> Opts
DistanceOpt
    (String -> String -> Opts)
-> Parser String -> Parser (String -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"First verilog file.")
        )
    Parser (String -> Opts) -> Parser String -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILE" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Second verilog file.")
        )

equivOpts :: Parser Opts
equivOpts :: Parser Opts
equivOpts =
  String -> String -> String -> Text -> Maybe Text -> Opts
Equiv
    (String -> String -> String -> Text -> Maybe Text -> Opts)
-> Parser String
-> Parser (String -> String -> Text -> Maybe Text -> Opts)
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
Opt.strOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.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
Opt.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
Opt.metavar String
"DIR"
          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
Opt.help String
"Output directory that the equivalence run takes place in."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"output"
      )
    Parser (String -> String -> Text -> Maybe Text -> Opts)
-> Parser String -> Parser (String -> Text -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILEA" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"First verilog file.")
        )
    Parser (String -> Text -> Maybe Text -> Opts)
-> Parser String -> Parser (Text -> Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Text -> String
fromText (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
            ShowS -> Parser String -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
Opt.strArgument
              (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"FILEB" Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Second verilog file.")
        )
    Parser (Text -> Maybe Text -> Opts)
-> Parser Text -> Parser (Maybe Text -> Opts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser Text
textOption
      ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"source-top"
          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
Opt.short Char
't'
          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
Opt.metavar String
"TOP"
          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
Opt.help String
"Define the top module to compare between the source files."
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
Opt.showDefault
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
Opt.value String
"top"
      )
    Parser (Maybe Text -> Opts) -> Parser (Maybe Text) -> Parser Opts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
Opt.optional (Parser Text -> Parser (Maybe Text))
-> (Mod OptionFields String -> Parser Text)
-> Mod OptionFields String
-> Parser (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mod OptionFields String -> Parser Text
textOption (Mod OptionFields String -> Parser (Maybe Text))
-> Mod OptionFields String -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$
            String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"checker"
              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
Opt.metavar String
"CHECKER"
              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
Opt.help String
"Define the checker to use."
        )

argparse :: Parser Opts
argparse :: Parser Opts
argparse =
  Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
    ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
        String
"fuzz"
        ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
            Parser Opts
fuzzOpts
            ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                String
"Run fuzzing on the specified simulators and synthesisers."
            )
        )
        Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"fuzz"
    )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"emi"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
emiOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"EMI testing using generated inputs, or existing Verilog designs."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"emi"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"generate"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
genOpts
              (String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc String
"Generate a random Verilog program.")
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"generate"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"parse"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
parseOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Parse a verilog file and output a pretty printed version."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"parse"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"reduce"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
reduceOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Reduce a Verilog file by rerunning the fuzzer on the file."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"reduce"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"shuffle"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
shuffleOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Shuffle a Verilog file."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"shuffle"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"config"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
configOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Print the current configuration of the fuzzer."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"config"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"distance"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
distanceOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Calculate the distance between two different pieces of Verilog."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"distance"
      )
    Parser Opts -> Parser Opts -> Parser Opts
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Opts -> Parser Opts
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
      ( String -> ParserInfo Opts -> Mod CommandFields Opts
forall a. String -> ParserInfo a -> Mod CommandFields a
Opt.command
          String
"equiv"
          ( Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
              Parser Opts
equivOpts
              ( String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc
                  String
"Check two different pieces of Verilog are equivalent."
              )
          )
          Mod CommandFields Opts
-> Mod CommandFields Opts -> Mod CommandFields Opts
forall a. Semigroup a => a -> a -> a
<> String -> Mod CommandFields Opts
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"equiv"
      )

version :: Parser (a -> a)
version :: forall a. Parser (a -> a)
version =
  String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
Opt.infoOption String
versionInfo (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
    [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
      [String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"version", Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
Opt.short Char
'v', String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Show version information.", Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
Opt.hidden]

opts :: ParserInfo Opts
opts :: ParserInfo Opts
opts =
  Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
    (Parser Opts
argparse Parser Opts -> Parser (Opts -> Opts) -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Opts -> Opts)
forall a. Parser (a -> a)
Opt.helper Parser Opts -> Parser (Opts -> Opts) -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Opts -> Opts)
forall a. Parser (a -> a)
version)
    ( InfoMod Opts
forall a. InfoMod a
Opt.fullDesc
        InfoMod Opts -> InfoMod Opts -> InfoMod Opts
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.progDesc String
"Fuzz different simulators and synthesisers."
        InfoMod Opts -> InfoMod Opts -> InfoMod Opts
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Opts
forall a. String -> InfoMod a
Opt.header
          String
"Verismith - A hardware simulator and synthesiser Verilog fuzzer."
    )