{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE Trustworthy #-}
module ReWire.Config
      ( interpret, Config, getOutFile, eidosFile, synolonFile
      , Language (..), ResetFlag (..), OutFlag (..), Certify (..)
      , verbose, pretty, flatten
      , target, clock, reset
      , resetFlags, outFlags
      , inputSigs, stateSigs, outputSigs
      , vhdlPackages, inputsFile, defaultInputsFile, outFile
      , noWarn, wError
      , start, top, loadPath, cycles, depth, dump, source, rtlOpt, eidos, synolon, certify, noHalt, debugLint
      , testbench
      , stableNames, locators, noLocators
      , pDebug
      ) where

import ReWire.Flags (Flag (..))
import ReWire.Pretty (showt)

import Control.Lens (makeLenses, over, (.~), (^.), Lens', lens)
import Control.Monad (when, foldM)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable)
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack, unpack, splitOn)
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import System.FilePath ((-<.>))
import Text.Read (readMaybe)

import qualified Data.HashSet as Set
import qualified Data.Text.IO as T

data Language = Interpret | VHDL | Verilog | Cryptol | RWCore | Haskell
      deriving (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Language -> Language -> Ordering
compare :: Language -> Language -> Ordering
$c< :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
>= :: Language -> Language -> Bool
$cmax :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
min :: Language -> Language -> Language
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> FilePath
(Int -> Language -> ShowS)
-> (Language -> FilePath) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> FilePath
show :: Language -> FilePath
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show)
data ResetFlag = Inverted | Synchronous
      deriving (ResetFlag -> ResetFlag -> Bool
(ResetFlag -> ResetFlag -> Bool)
-> (ResetFlag -> ResetFlag -> Bool) -> Eq ResetFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResetFlag -> ResetFlag -> Bool
== :: ResetFlag -> ResetFlag -> Bool
$c/= :: ResetFlag -> ResetFlag -> Bool
/= :: ResetFlag -> ResetFlag -> Bool
Eq, Eq ResetFlag
Eq ResetFlag =>
(ResetFlag -> ResetFlag -> Ordering)
-> (ResetFlag -> ResetFlag -> Bool)
-> (ResetFlag -> ResetFlag -> Bool)
-> (ResetFlag -> ResetFlag -> Bool)
-> (ResetFlag -> ResetFlag -> Bool)
-> (ResetFlag -> ResetFlag -> ResetFlag)
-> (ResetFlag -> ResetFlag -> ResetFlag)
-> Ord ResetFlag
ResetFlag -> ResetFlag -> Bool
ResetFlag -> ResetFlag -> Ordering
ResetFlag -> ResetFlag -> ResetFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ResetFlag -> ResetFlag -> Ordering
compare :: ResetFlag -> ResetFlag -> Ordering
$c< :: ResetFlag -> ResetFlag -> Bool
< :: ResetFlag -> ResetFlag -> Bool
$c<= :: ResetFlag -> ResetFlag -> Bool
<= :: ResetFlag -> ResetFlag -> Bool
$c> :: ResetFlag -> ResetFlag -> Bool
> :: ResetFlag -> ResetFlag -> Bool
$c>= :: ResetFlag -> ResetFlag -> Bool
>= :: ResetFlag -> ResetFlag -> Bool
$cmax :: ResetFlag -> ResetFlag -> ResetFlag
max :: ResetFlag -> ResetFlag -> ResetFlag
$cmin :: ResetFlag -> ResetFlag -> ResetFlag
min :: ResetFlag -> ResetFlag -> ResetFlag
Ord, Int -> ResetFlag -> ShowS
[ResetFlag] -> ShowS
ResetFlag -> FilePath
(Int -> ResetFlag -> ShowS)
-> (ResetFlag -> FilePath)
-> ([ResetFlag] -> ShowS)
-> Show ResetFlag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResetFlag -> ShowS
showsPrec :: Int -> ResetFlag -> ShowS
$cshow :: ResetFlag -> FilePath
show :: ResetFlag -> FilePath
$cshowList :: [ResetFlag] -> ShowS
showList :: [ResetFlag] -> ShowS
Show, (forall x. ResetFlag -> Rep ResetFlag x)
-> (forall x. Rep ResetFlag x -> ResetFlag) -> Generic ResetFlag
forall x. Rep ResetFlag x -> ResetFlag
forall x. ResetFlag -> Rep ResetFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResetFlag -> Rep ResetFlag x
from :: forall x. ResetFlag -> Rep ResetFlag x
$cto :: forall x. Rep ResetFlag x -> ResetFlag
to :: forall x. Rep ResetFlag x -> ResetFlag
Generic)
instance Hashable ResetFlag
data OutFlag   = Flatten | Pretty | Verbose
      deriving (OutFlag -> OutFlag -> Bool
(OutFlag -> OutFlag -> Bool)
-> (OutFlag -> OutFlag -> Bool) -> Eq OutFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutFlag -> OutFlag -> Bool
== :: OutFlag -> OutFlag -> Bool
$c/= :: OutFlag -> OutFlag -> Bool
/= :: OutFlag -> OutFlag -> Bool
Eq, Eq OutFlag
Eq OutFlag =>
(OutFlag -> OutFlag -> Ordering)
-> (OutFlag -> OutFlag -> Bool)
-> (OutFlag -> OutFlag -> Bool)
-> (OutFlag -> OutFlag -> Bool)
-> (OutFlag -> OutFlag -> Bool)
-> (OutFlag -> OutFlag -> OutFlag)
-> (OutFlag -> OutFlag -> OutFlag)
-> Ord OutFlag
OutFlag -> OutFlag -> Bool
OutFlag -> OutFlag -> Ordering
OutFlag -> OutFlag -> OutFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: OutFlag -> OutFlag -> Ordering
compare :: OutFlag -> OutFlag -> Ordering
$c< :: OutFlag -> OutFlag -> Bool
< :: OutFlag -> OutFlag -> Bool
$c<= :: OutFlag -> OutFlag -> Bool
<= :: OutFlag -> OutFlag -> Bool
$c> :: OutFlag -> OutFlag -> Bool
> :: OutFlag -> OutFlag -> Bool
$c>= :: OutFlag -> OutFlag -> Bool
>= :: OutFlag -> OutFlag -> Bool
$cmax :: OutFlag -> OutFlag -> OutFlag
max :: OutFlag -> OutFlag -> OutFlag
$cmin :: OutFlag -> OutFlag -> OutFlag
min :: OutFlag -> OutFlag -> OutFlag
Ord, Int -> OutFlag -> ShowS
[OutFlag] -> ShowS
OutFlag -> FilePath
(Int -> OutFlag -> ShowS)
-> (OutFlag -> FilePath) -> ([OutFlag] -> ShowS) -> Show OutFlag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutFlag -> ShowS
showsPrec :: Int -> OutFlag -> ShowS
$cshow :: OutFlag -> FilePath
show :: OutFlag -> FilePath
$cshowList :: [OutFlag] -> ShowS
showList :: [OutFlag] -> ShowS
Show, (forall x. OutFlag -> Rep OutFlag x)
-> (forall x. Rep OutFlag x -> OutFlag) -> Generic OutFlag
forall x. Rep OutFlag x -> OutFlag
forall x. OutFlag -> Rep OutFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutFlag -> Rep OutFlag x
from :: forall x. OutFlag -> Rep OutFlag x
$cto :: forall x. Rep OutFlag x -> OutFlag
to :: forall x. Rep OutFlag x -> OutFlag
Generic)
instance Hashable OutFlag

-- | @--certify@: off, best-effort with an unsuppressible status report
--   (--certify=warn), or required (plain --certify: compilation fails
--   unless the validator returns VALIDATED).
data Certify   = CertifyOff | CertifyWarn | CertifyRequired
      deriving (Certify -> Certify -> Bool
(Certify -> Certify -> Bool)
-> (Certify -> Certify -> Bool) -> Eq Certify
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Certify -> Certify -> Bool
== :: Certify -> Certify -> Bool
$c/= :: Certify -> Certify -> Bool
/= :: Certify -> Certify -> Bool
Eq, Eq Certify
Eq Certify =>
(Certify -> Certify -> Ordering)
-> (Certify -> Certify -> Bool)
-> (Certify -> Certify -> Bool)
-> (Certify -> Certify -> Bool)
-> (Certify -> Certify -> Bool)
-> (Certify -> Certify -> Certify)
-> (Certify -> Certify -> Certify)
-> Ord Certify
Certify -> Certify -> Bool
Certify -> Certify -> Ordering
Certify -> Certify -> Certify
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Certify -> Certify -> Ordering
compare :: Certify -> Certify -> Ordering
$c< :: Certify -> Certify -> Bool
< :: Certify -> Certify -> Bool
$c<= :: Certify -> Certify -> Bool
<= :: Certify -> Certify -> Bool
$c> :: Certify -> Certify -> Bool
> :: Certify -> Certify -> Bool
$c>= :: Certify -> Certify -> Bool
>= :: Certify -> Certify -> Bool
$cmax :: Certify -> Certify -> Certify
max :: Certify -> Certify -> Certify
$cmin :: Certify -> Certify -> Certify
min :: Certify -> Certify -> Certify
Ord, Int -> Certify -> ShowS
[Certify] -> ShowS
Certify -> FilePath
(Int -> Certify -> ShowS)
-> (Certify -> FilePath) -> ([Certify] -> ShowS) -> Show Certify
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Certify -> ShowS
showsPrec :: Int -> Certify -> ShowS
$cshow :: Certify -> FilePath
show :: Certify -> FilePath
$cshowList :: [Certify] -> ShowS
showList :: [Certify] -> ShowS
Show)

data Config = Config
      { Config -> Language
_source       :: Language
      , Config -> Language
_target       :: Language
      , Config -> Text
_clock        :: Text -- ^ No clock if null.
      , Config -> Text
_reset        :: Text -- ^ No reset if null.
      , Config -> HashSet ResetFlag
_resetFlags   :: HashSet ResetFlag
      , Config -> HashSet OutFlag
_outFlags     :: HashSet OutFlag
      , Config -> [Text]
_inputSigs    :: [Text]
      , Config -> [Text]
_stateSigs    :: [Text]
      , Config -> [Text]
_outputSigs   :: [Text]
      , Config -> [Text]
_vhdlPackages :: [Text]
      , Config -> FilePath
_inputsFile   :: FilePath
      , Config -> Maybe FilePath
_outFile      :: Maybe FilePath
      , Config -> Text
_start        :: Text
      , Config -> Text
_top          :: Text
      , Config -> [FilePath]
_loadPath     :: [FilePath]
      , Config -> Maybe Natural
_cycles       :: Maybe Natural -- ^ @--cycles@: Nothing means derive a default from the inputs (see effectiveCycles).
      , Config -> Natural
_depth        :: Natural
      , Config -> Natural -> Bool
_dump         :: Natural -> Bool
      , Config -> Bool
_eidos        :: Bool -- ^ @--eidos@: dump the Eidos IR after its last pass (\<out\>.eir).
      , Config -> Bool
_synolon      :: Bool -- ^ @--synolon@: dump the Synolon IR after its last pass (\<out\>.syn).
      , Config -> Certify
_certify      :: Certify -- ^ @--certify@: validate the compiled device against the Synolon IR with the verified validator.
      , Config -> Bool
_noHalt       :: Bool
      , Config -> Bool
_debugLint    :: Bool
      , Config -> Natural
_rtlOpt       :: Natural
      , Config -> Bool
_testbench    :: Bool
      , Config -> Bool
_noWarn       :: Bool -- ^ @-w@: suppress warnings.
      , Config -> Bool
_wError       :: Bool -- ^ @-Werror@: warnings are fatal.
      , Config -> Bool
_stableNames  :: Bool -- ^ @--stable-names@: fully-uniquified (less readable, edit-stable) generated names.
      , Config -> Bool
_locators     :: Bool -- ^ @--locators@: source-locator comments in .rwc output (--no-locators wins).
      , Config -> Bool
_noLocators   :: Bool -- ^ @--no-locators@: no source-locator or provenance comments in output.
      }

makeLenses ''Config

defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
      { _source :: Language
_source       = Language
Haskell
      , _target :: Language
_target       = Language
Verilog
      , _clock :: Text
_clock        = Text
"clk"
      , _reset :: Text
_reset        = Text
"rst"
      , _resetFlags :: HashSet ResetFlag
_resetFlags   = HashSet ResetFlag
forall a. Monoid a => a
mempty
      , _outFlags :: HashSet OutFlag
_outFlags     = HashSet OutFlag
forall a. Monoid a => a
mempty
      , _inputSigs :: [Text]
_inputSigs    = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"__in" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. TextShow a => a -> Text
showt) [Int
0::Int ..]
      , _stateSigs :: [Text]
_stateSigs    = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"__st" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. TextShow a => a -> Text
showt) [Int
0::Int ..]
      , _outputSigs :: [Text]
_outputSigs   = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"__out" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. TextShow a => a -> Text
showt) [Int
0::Int ..]
      , _vhdlPackages :: [Text]
_vhdlPackages = [Text
"ieee.std_logic_1164.all"]
      , _inputsFile :: FilePath
_inputsFile   = FilePath
defaultInputsFile
      , _outFile :: Maybe FilePath
_outFile      = Maybe FilePath
forall a. Maybe a
Nothing
      , _start :: Text
_start        = Text
"Main.start"
      , _top :: Text
_top          = Text
"top_level"
      , _loadPath :: [FilePath]
_loadPath     = []
      , _cycles :: Maybe Natural
_cycles       = Maybe Natural
forall a. Maybe a
Nothing
      , _depth :: Natural
_depth        = Natural
8
      , _dump :: Natural -> Bool
_dump         = Bool -> Natural -> Bool
forall a b. a -> b -> a
const Bool
False
      , _eidos :: Bool
_eidos        = Bool
False
      , _synolon :: Bool
_synolon      = Bool
False
      , _certify :: Certify
_certify      = Certify
CertifyOff
      , _noHalt :: Bool
_noHalt       = Bool
False
      , _debugLint :: Bool
_debugLint    = Bool
False
      , _rtlOpt :: Natural
_rtlOpt       = Natural
8
      , _testbench :: Bool
_testbench    = Bool
False
      , _noWarn :: Bool
_noWarn       = Bool
False
      , _wError :: Bool
_wError       = Bool
False
      , _stableNames :: Bool
_stableNames  = Bool
False
      , _locators :: Bool
_locators     = Bool
False
      , _noLocators :: Bool
_noLocators   = Bool
False
      }

-- | The default value of the inputsFile field: when the user hasn't named an
--   inputs file explicitly, its absence is not warning-worthy.
defaultInputsFile :: FilePath
defaultInputsFile :: FilePath
defaultInputsFile = FilePath
"inputs.yaml"

verbose :: Lens' Config Bool
verbose :: Lens' Config Bool
verbose = (Config -> Bool) -> (Config -> Bool -> Config) -> Lens' Config Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (OutFlag -> Config -> Bool
getOutFlag OutFlag
Verbose) (OutFlag -> Config -> Bool -> Config
setOutFlag OutFlag
Verbose)

pretty :: Lens' Config Bool
pretty :: Lens' Config Bool
pretty = (Config -> Bool) -> (Config -> Bool -> Config) -> Lens' Config Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (OutFlag -> Config -> Bool
getOutFlag OutFlag
Pretty) (OutFlag -> Config -> Bool -> Config
setOutFlag OutFlag
Pretty)

flatten :: Lens' Config Bool
flatten :: Lens' Config Bool
flatten = (Config -> Bool) -> (Config -> Bool -> Config) -> Lens' Config Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (OutFlag -> Config -> Bool
getOutFlag OutFlag
Flatten) (OutFlag -> Config -> Bool -> Config
setOutFlag OutFlag
Flatten)

getOutFlag :: OutFlag -> Config -> Bool
getOutFlag :: OutFlag -> Config -> Bool
getOutFlag OutFlag
f Config
conf = OutFlag
f OutFlag -> HashSet OutFlag -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`Set.member` (Config
confConfig
-> Getting (HashSet OutFlag) Config (HashSet OutFlag)
-> HashSet OutFlag
forall s a. s -> Getting a s a -> a
^.Getting (HashSet OutFlag) Config (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags)

setOutFlag :: OutFlag -> Config -> Bool -> Config
setOutFlag :: OutFlag -> Config -> Bool -> Config
setOutFlag OutFlag
f Config
conf Bool
ins | Bool
ins       = ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
-> (HashSet OutFlag -> HashSet OutFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags (OutFlag -> HashSet OutFlag -> HashSet OutFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert OutFlag
f) Config
conf
                      | Bool
otherwise = ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
-> (HashSet OutFlag -> HashSet OutFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags (OutFlag -> HashSet OutFlag -> HashSet OutFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.delete OutFlag
f) Config
conf

type ErrorMsg = Text

-- | The Eidos IR dump beside the output (the @--eidos@ dump): @\<out\>.eir@.
eidosFile :: Config -> FilePath -> FilePath
eidosFile :: Config -> ShowS
eidosFile Config
c FilePath
filename = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
filename (Config
cConfig
-> Getting (Maybe FilePath) Config (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) Config (Maybe FilePath)
Lens' Config (Maybe FilePath)
outFile) FilePath -> ShowS
-<.> FilePath
"eir"

-- | The Synolon IR dump beside the output — the @--synolon@ dump, and the
--   @--certify@ source artifact (both the writer and the validator
--   invocation compute the path here): @\<out\>.syn@.
synolonFile :: Config -> FilePath -> FilePath
synolonFile :: Config -> ShowS
synolonFile Config
c FilePath
filename = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
filename (Config
cConfig
-> Getting (Maybe FilePath) Config (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) Config (Maybe FilePath)
Lens' Config (Maybe FilePath)
outFile) FilePath -> ShowS
-<.> FilePath
"syn"

getOutFile :: Config -> FilePath -> FilePath
getOutFile :: Config -> ShowS
getOutFile Config
c FilePath
filename = (FilePath -> Maybe FilePath -> FilePath) -> Maybe FilePath -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (Config
cConfig
-> Getting (Maybe FilePath) Config (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) Config (Maybe FilePath)
Lens' Config (Maybe FilePath)
outFile) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case Config
cConfig -> Getting Language Config Language -> Language
forall s a. s -> Getting a s a -> a
^.Getting Language Config Language
Lens' Config Language
target of
      Language
Verilog   -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"sv"
      Language
VHDL      -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"vhdl"
      Language
Cryptol   -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"cry"
      Language
Interpret -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"yaml"
      Language
RWCore    -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"rwc"
      Language
Haskell   -> FilePath
filename FilePath -> ShowS
-<.> FilePath
"hs"

-- TODO(chathhorn): separate validation pass.
interpret :: [Flag] -> Either ErrorMsg Config
interpret :: [Flag] -> Either Text Config
interpret = (Config -> Flag -> Either Text Config)
-> Config -> [Flag] -> Either Text Config
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Config -> Flag -> Either Text Config
interp Config
defaultConfig
      where interp :: Config -> Flag -> Either ErrorMsg Config
            interp :: Config -> Flag -> Either Text Config
interp Config
c = \ case
                  Flag
FlagHelp                        -> Text -> Either Text Config
forall a b. a -> Either a b
Left Text
""
                  FlagLoadPath (FilePath -> Text
pack -> Text
p)        -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [FilePath] [FilePath]
-> ([FilePath] -> [FilePath]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [FilePath] [FilePath]
Lens' Config [FilePath]
loadPath ([FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack (Text -> Text -> [Text]
splitOn' Text
"," Text
p)) Config
c
                  FlagO FilePath
p | Maybe FilePath
Nothing <- Config
cConfig
-> Getting (Maybe FilePath) Config (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^.Getting (Maybe FilePath) Config (Maybe FilePath)
Lens' Config (Maybe FilePath)
outFile -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Maybe FilePath -> Identity (Maybe FilePath))
-> Config -> Identity Config
Lens' Config (Maybe FilePath)
outFile ((Maybe FilePath -> Identity (Maybe FilePath))
 -> Config -> Identity Config)
-> Maybe FilePath -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath -> Maybe FilePath
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
p   (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                          | Bool
otherwise             -> Text -> Either Text Config
forall a b. a -> Either a b
Left Text
"Multiple output files specified on the command line."
                  Flag
FlagVerilog                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
Verilog   (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagVhdl                        -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
VHDL      (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagCryptol                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
Cryptol   (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagInterpret Maybe FilePath
Nothing           -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
Interpret (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagInterpret (Just FilePath
ip)         -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
Interpret (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ (FilePath -> Identity FilePath) -> Config -> Identity Config
Lens' Config FilePath
inputsFile ((FilePath -> Identity FilePath) -> Config -> Identity Config)
-> FilePath -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
ip (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagTestbench Maybe FilePath
Nothing           -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
testbench ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True   (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagTestbench (Just FilePath
ip)         -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
testbench ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True   (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ (FilePath -> Identity FilePath) -> Config -> Identity Config
Lens' Config FilePath
inputsFile ((FilePath -> Identity FilePath) -> Config -> Identity Config)
-> FilePath -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
ip (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagCore                        -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
target ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
RWCore    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagFromCore                    -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Language -> Identity Language) -> Config -> Identity Config
Lens' Config Language
source ((Language -> Identity Language) -> Config -> Identity Config)
-> Language -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Language
RWCore    (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagClockName (FilePath -> Text
pack -> Text
n)       -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
clock  ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
n         (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagNoClock                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
clock  ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
""        (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
reset ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
""      (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagResetName (FilePath -> Text
pack -> Text
n)       -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
reset  ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
n         (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagNoReset                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
reset  ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
""        (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagInvertReset                 -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (HashSet ResetFlag) (HashSet ResetFlag)
-> (HashSet ResetFlag -> HashSet ResetFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet ResetFlag) (HashSet ResetFlag)
Lens' Config (HashSet ResetFlag)
resetFlags (ResetFlag -> HashSet ResetFlag -> HashSet ResetFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert ResetFlag
Inverted) Config
c
                  Flag
FlagSyncReset                   -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (HashSet ResetFlag) (HashSet ResetFlag)
-> (HashSet ResetFlag -> HashSet ResetFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet ResetFlag) (HashSet ResetFlag)
Lens' Config (HashSet ResetFlag)
resetFlags (ResetFlag -> HashSet ResetFlag -> HashSet ResetFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert ResetFlag
Synchronous) Config
c
                  Flag
FlagFlatten                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
-> (HashSet OutFlag -> HashSet OutFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags (OutFlag -> HashSet OutFlag -> HashSet OutFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert OutFlag
Flatten) Config
c
                  Flag
FlagPretty                      -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
-> (HashSet OutFlag -> HashSet OutFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags (OutFlag -> HashSet OutFlag -> HashSet OutFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert OutFlag
Pretty) Config
c
                  Flag
FlagVerbose                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
-> (HashSet OutFlag -> HashSet OutFlag) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config (HashSet OutFlag) (HashSet OutFlag)
Lens' Config (HashSet OutFlag)
outFlags (OutFlag -> HashSet OutFlag -> HashSet OutFlag
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
Set.insert OutFlag
Verbose) Config
c
                  FlagDump (FilePath -> Text
pack -> Text
d)            -> do
                        ns <- (FilePath -> Either Text Natural)
-> [FilePath] -> Either Text [Natural]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Text -> FilePath -> Either Text Natural
readNat Text
"-d/--dump") ([FilePath] -> Either Text [Natural])
-> [FilePath] -> Either Text [Natural]
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
unpack ([Text] -> [FilePath]) -> [Text] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
splitOn' Text
"," Text
d
                        pure $ over dump (augment ns) c
                  Flag
FlagDumpAll                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config (Natural -> Bool) (Natural -> Bool)
Lens' Config (Natural -> Bool)
dump ASetter Config Config (Natural -> Bool) (Natural -> Bool)
-> (Natural -> Bool) -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool -> Natural -> Bool
forall a b. a -> b -> a
const Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagVhdlPkgs (FilePath -> Text
pack -> Text
p)        -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Text] [Text]
-> ([Text] -> [Text]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Text] [Text]
Lens' Config [Text]
vhdlPackages ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> [Text]
splitOn' Text
"," Text
p) Config
c
                  FlagInputNames (FilePath -> Text
pack -> Text
n)      -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Text] [Text]
-> ([Text] -> [Text]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Text] [Text]
Lens' Config [Text]
inputSigs  (Text -> Text -> [Text]
splitOn' Text
"," Text
n [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) Config
c
                  FlagStateNames (FilePath -> Text
pack -> Text
n)      -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Text] [Text]
-> ([Text] -> [Text]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Text] [Text]
Lens' Config [Text]
stateSigs  (Text -> Text -> [Text]
splitOn' Text
"," Text
n [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) Config
c
                  FlagOutputNames (FilePath -> Text
pack -> Text
n)     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ ASetter Config Config [Text] [Text]
-> ([Text] -> [Text]) -> Config -> Config
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter Config Config [Text] [Text]
Lens' Config [Text]
outputSigs (Text -> Text -> [Text]
splitOn' Text
"," Text
n [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) Config
c
                  FlagStart (FilePath -> Text
pack -> Text
n)           -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
start ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
n (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagTop (FilePath -> Text
pack -> Text
n)             -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Text -> Identity Text) -> Config -> Identity Config
Lens' Config Text
top ((Text -> Identity Text) -> Config -> Identity Config)
-> Text -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
n (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagCycles FilePath
n                    -> Text -> FilePath -> Either Text Natural
readNat Text
"--cycles" FilePath
n  Either Text Natural
-> (Natural -> Either Text Config) -> Either Text Config
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Natural
v -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Maybe Natural -> Identity (Maybe Natural))
-> Config -> Identity Config
Lens' Config (Maybe Natural)
cycles ((Maybe Natural -> Identity (Maybe Natural))
 -> Config -> Identity Config)
-> Maybe Natural -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> Maybe Natural
forall a. a -> Maybe a
Just Natural
v (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagEvalDepth FilePath
n                 -> Text -> FilePath -> Either Text Natural
readNat Text
"--depth" FilePath
n   Either Text Natural
-> (Natural -> Either Text Config) -> Either Text Config
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Natural
v -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Natural -> Identity Natural) -> Config -> Identity Config
Lens' Config Natural
depth ((Natural -> Identity Natural) -> Config -> Identity Config)
-> Natural -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
v (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagEidos                       -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
eidos ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagSynolon                     -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
synolon ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagCertify Maybe FilePath
Nothing             -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Certify -> Identity Certify) -> Config -> Identity Config
Lens' Config Certify
certify ((Certify -> Identity Certify) -> Config -> Identity Config)
-> Certify -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Certify
CertifyRequired (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagCertify (Just FilePath
"required")   -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Certify -> Identity Certify) -> Config -> Identity Config
Lens' Config Certify
certify ((Certify -> Identity Certify) -> Config -> Identity Config)
-> Certify -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Certify
CertifyRequired (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagCertify (Just FilePath
"warn")       -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Certify -> Identity Certify) -> Config -> Identity Config
Lens' Config Certify
certify ((Certify -> Identity Certify) -> Config -> Identity Config)
-> Certify -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Certify
CertifyWarn (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagCertify (Just FilePath
m)            -> Text -> Either Text Config
forall a b. a -> Either a b
Left (Text -> Either Text Config) -> Text -> Either Text Config
forall a b. (a -> b) -> a -> b
$ Text
"Invalid value for --certify: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack FilePath
m Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' (expected 'required' or 'warn')."
                  Flag
FlagNoHalt                      -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
noHalt ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagDebugLint                   -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
debugLint ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagRtlOpt FilePath
n                    -> Text -> FilePath -> Either Text Natural
readNat Text
"--rtl-opt" FilePath
n Either Text Natural
-> (Natural -> Either Text Config) -> Either Text Config
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Natural
v -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Natural -> Identity Natural) -> Config -> Identity Config
Lens' Config Natural
rtlOpt ((Natural -> Identity Natural) -> Config -> Identity Config)
-> Natural -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
v (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagStableNames                 -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
stableNames ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagLocators                    -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
locators ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagNoLocators                  -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
noLocators ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  Flag
FlagNoWarn                      -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
noWarn ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagW FilePath
"error"                   -> Config -> Either Text Config
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> Either Text Config) -> Config -> Either Text Config
forall a b. (a -> b) -> a -> b
$ (Bool -> Identity Bool) -> Config -> Identity Config
Lens' Config Bool
wError ((Bool -> Identity Bool) -> Config -> Identity Config)
-> Bool -> Config -> Config
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True (Config -> Config) -> Config -> Config
forall a b. (a -> b) -> a -> b
$ Config
c
                  FlagW FilePath
w                         -> Text -> Either Text Config
forall a b. a -> Either a b
Left (Text -> Either Text Config) -> Text -> Either Text Config
forall a b. (a -> b) -> a -> b
$ Text
"Unknown warning option: -W" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack FilePath
w

            -- | Parse a non-negative integer flag argument, reporting a clean
            --   usage error instead of a partial 'read' crash.
            readNat :: Text -> String -> Either ErrorMsg Natural
            readNat :: Text -> FilePath -> Either Text Natural
readNat Text
what FilePath
s = Either Text Natural
-> (Natural -> Either Text Natural)
-> Maybe Natural
-> Either Text Natural
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Natural
forall a b. a -> Either a b
Left Text
err) Natural -> Either Text Natural
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Natural -> Either Text Natural)
-> Maybe Natural -> Either Text Natural
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Natural
forall a. Read a => FilePath -> Maybe a
readMaybe FilePath
s
                  where err :: Text
err = Text
"Invalid value for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
what Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack FilePath
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' (expected a non-negative integer)."

            augment :: [Natural] -> (Natural -> Bool) -> Natural -> Bool
            augment :: [Natural] -> (Natural -> Bool) -> Natural -> Bool
augment [Natural]
ns Natural -> Bool
f Natural
n | Natural
n Natural -> [Natural] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Natural]
ns = Bool
True
                           | Bool
otherwise   = Natural -> Bool
f Natural
n

            -- | Version of splitOn that returns '[]' instead of '[""]' when the second argument is empty.
            splitOn' :: Text -> Text -> [Text]
            splitOn' :: Text -> Text -> [Text]
splitOn' Text
sep = \ case
                  Text
"" -> []
                  Text
s  -> HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
splitOn Text
sep Text
s

pDebug :: MonadIO m => Config -> Text -> m ()
pDebug :: forall (m :: * -> *). MonadIO m => Config -> Text -> m ()
pDebug Config
conf Text
s = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config
confConfig -> Getting Bool Config Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Config Bool
Lens' Config Bool
verbose) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Debug: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s