-- editorconfig-checker-disable-file
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE StrictData        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}

module PlutusTx.Options where

import PlutusCore.Error as PLC
import PlutusCore.Parser as PLC
import PlutusCore.Quote as PLC
import PlutusCore.Version qualified as PLC
import PlutusIR.Compiler qualified as PIR
import PlutusTx.Compiler.Types
import UntypedPlutusCore qualified as UPLC

import Control.Exception
import Control.Lens
import Data.Bifunctor (first)
import Data.Either.Validation
import Data.Foldable (foldl', toList)
import Data.List qualified as List
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Proxy
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Type.Equality
import GHC.Plugins qualified as GHC
import Prettyprinter

import Text.Read (readMaybe)
import Type.Reflection

data PluginOptions = PluginOptions
  { PluginOptions -> Version
_posPlcTargetVersion               :: PLC.Version
  , PluginOptions -> Bool
_posDoTypecheck                    :: Bool
  , PluginOptions -> Bool
_posDeferErrors                    :: Bool
  , PluginOptions -> Bool
_posConservativeOpts               :: Bool
  , PluginOptions -> Int
_posContextLevel                   :: Int
  , PluginOptions -> Bool
_posDumpPir                        :: Bool
  , PluginOptions -> Bool
_posDumpPlc                        :: Bool
  , PluginOptions -> Bool
_posDumpUPlc                       :: Bool
  , PluginOptions -> Bool
_posOptimize                       :: Bool
  , PluginOptions -> Bool
_posPedantic                       :: Bool
  , PluginOptions -> Verbosity
_posVerbosity                      :: Verbosity
  , PluginOptions -> Int
_posMaxSimplifierIterationsPir     :: Int
  , PluginOptions -> Int
_posMaxSimplifierIterationsUPlc    :: Int
  , PluginOptions -> Int
_posMaxCseIterations               :: Int
  , PluginOptions -> Bool
_posDoSimplifierUnwrapCancel       :: Bool
  , PluginOptions -> Bool
_posDoSimplifierBeta               :: Bool
  , PluginOptions -> Bool
_posDoSimplifierInline             :: Bool
  , PluginOptions -> Bool
_posDoSimplifierEvaluateBuiltins   :: Bool
  , PluginOptions -> Bool
_posDoSimplifierStrictifyBindings  :: Bool
  , PluginOptions -> Bool
_posDoSimplifierRemoveDeadBindings :: Bool
  , PluginOptions -> ProfileOpts
_posProfile                        :: ProfileOpts
  , PluginOptions -> Bool
_posCoverageAll                    :: Bool
  , PluginOptions -> Bool
_posCoverageLocation               :: Bool
  , PluginOptions -> Bool
_posCoverageBoolean                :: Bool
  , PluginOptions -> Bool
_posRelaxedFloatin                 :: Bool
  , PluginOptions -> Bool
_posCaseOfCaseConservative         :: Bool
  , PluginOptions -> Bool
_posInlineConstants                :: Bool
  , PluginOptions -> Bool
_posPreserveLogging                :: Bool
  -- ^ Whether to try and retain the logging behaviour of the program.
  , -- Setting to `True` defines `trace` as `\_ a -> a` instead of the builtin version.
    -- Which effectively ignores the trace text.
    PluginOptions -> Bool
_posRemoveTrace                    :: Bool
  , PluginOptions -> Bool
_posDumpCompilationTrace           :: Bool
  }

makeLenses ''PluginOptions

type OptionKey = Text
type OptionValue = Text

-- | A data type representing option @a@ implying option @b@.
data Implication a = forall b. Implication (a -> Bool) (Lens' PluginOptions b) b

-- | A plugin option definition for a `PluginOptions` field of type @a@.
data PluginOption = forall a.
  (Pretty a) =>
  PluginOption
  { ()
poTypeRep      :: TypeRep a
  -- ^ `TypeRep` used for pretty printing the option.
  , ()
poFun          :: Maybe OptionValue -> Validation ParseError (a -> a)
  -- ^ Consumes an optional value, and either updates the field or reports an error.
  , ()
poLens         :: Lens' PluginOptions a
  -- ^ Lens focusing on the field. This is for modifying the field, as well as
  -- getting the field value from `defaultPluginOptions` for pretty printing.
  , PluginOption -> Text
poDescription  :: Text
  -- ^ A description of the option.
  , ()
poImplications :: [Implication a]
  -- ^ Implications of this option being set to a particular value.
  -- An option should not imply itself.
  }

data ParseError
  = CannotParseValue !OptionKey !OptionValue !SomeTypeRep
  | UnexpectedValue !OptionKey !OptionValue
  | MissingValue !OptionKey
  | UnrecognisedOption !OptionKey ![OptionKey]
  deriving stock (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [ParseError] -> ShowS
Show)

newtype ParseErrors = ParseErrors (NonEmpty ParseError)
  deriving newtype (NonEmpty ParseErrors -> ParseErrors
ParseErrors -> ParseErrors -> ParseErrors
(ParseErrors -> ParseErrors -> ParseErrors)
-> (NonEmpty ParseErrors -> ParseErrors)
-> (forall b. Integral b => b -> ParseErrors -> ParseErrors)
-> Semigroup ParseErrors
forall b. Integral b => b -> ParseErrors -> ParseErrors
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ParseErrors -> ParseErrors -> ParseErrors
<> :: ParseErrors -> ParseErrors -> ParseErrors
$csconcat :: NonEmpty ParseErrors -> ParseErrors
sconcat :: NonEmpty ParseErrors -> ParseErrors
$cstimes :: forall b. Integral b => b -> ParseErrors -> ParseErrors
stimes :: forall b. Integral b => b -> ParseErrors -> ParseErrors
Semigroup)

instance Show ParseErrors where
  show :: ParseErrors -> String
show (ParseErrors NonEmpty ParseError
errs) =
    String
"PlutusTx.Plugin: failed to parse options:\n"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Text -> [Text] -> Text
Text.intercalate Text
"\n" ((ParseError -> Text) -> [ParseError] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseError -> Text
renderParseError (NonEmpty ParseError -> [ParseError]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty ParseError
errs)))

instance Exception ParseErrors

renderParseError :: ParseError -> Text
renderParseError :: ParseError -> Text
renderParseError = \case
  CannotParseValue Text
k Text
v SomeTypeRep
tr ->
    Text
"Cannot parse value "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
v)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for option "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
k)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" into type "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (SomeTypeRep -> String
forall a. Show a => a -> String
show SomeTypeRep
tr)
  UnexpectedValue Text
k Text
v ->
    Text
"Option "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
k)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a flag and does not take a value, but was given "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
v)
  MissingValue Text
k ->
    Text
"Option " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" needs a value"
  UnrecognisedOption Text
k [Text]
suggs ->
    Text
"Unrecognised option: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Text -> String
forall a. Show a => a -> String
show Text
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case [Text]
suggs of
      [] -> Text
""
      [Text]
_  -> Text
"\nDid you mean one of:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
"\n" [Text]
suggs

-- | Definition of plugin options.
pluginOptions :: Map OptionKey PluginOption
pluginOptions :: Map Text PluginOption
pluginOptions =
  [(Text, PluginOption)] -> Map Text PluginOption
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ let k :: Text
k = Text
"target-version"
          desc :: Text
desc = Text
"The target Plutus Core language version"
       in (Text
k, TypeRep Version
-> (Maybe Text -> Validation ParseError (Version -> Version))
-> Lens' PluginOptions Version
-> Text
-> [Implication Version]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Version
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Parser Version
-> Text -> Maybe Text -> Validation ParseError (Version -> Version)
forall a.
Parser a -> Text -> Maybe Text -> Validation ParseError (a -> a)
plcParserOption Parser Version
PLC.version Text
k) (Version -> f Version) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Version
posPlcTargetVersion Text
desc [])
    , let k :: Text
k = Text
"typecheck"
          desc :: Text
desc = Text
"Perform type checking during compilation."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoTypecheck Text
desc [])
    , let k :: Text
k = Text
"defer-errors"
          desc :: Text
desc =
            Text
"If a compilation error happens and this option is turned on, \
            \the compilation error is suppressed and the original Haskell \
            \expression is replaced with a runtime-error expression."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDeferErrors Text
desc [])
    , let k :: Text
k = Text
"conservative-optimisation"
          desc :: Text
desc =
            Text
"When conservative optimisation is used, only the optimisations that \
            \never make the program worse (in terms of cost or size) are employed. \
            \Implies `no-relaxed-float-in`, `no-inline-constants`, \
            \`no-simplifier-evaluate-builtins`, and `preserve-logging`."
       in ( Text
k
          , TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption
              TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
              (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k)
              (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posConservativeOpts
              Text
desc
              -- conservative-optimisation implies no-relaxed-floatin, and vice versa
              -- similarly, it implies preserving logging
              [ (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posRelaxedFloatin Bool
False
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posPreserveLogging Bool
True
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posCaseOfCaseConservative Bool
True
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posInlineConstants Bool
False
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierEvaluateBuiltins Bool
False
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posRelaxedFloatin Bool
True
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posPreserveLogging Bool
False
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posCaseOfCaseConservative Bool
False
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posInlineConstants Bool
True
              , (Bool -> Bool)
-> Lens' PluginOptions Bool -> Bool -> Implication Bool
forall a b.
(a -> Bool) -> Lens' PluginOptions b -> b -> Implication a
Implication (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierEvaluateBuiltins Bool
True
              ]
          )
    , let k :: Text
k = Text
"context-level"
          desc :: Text
desc = Text
"Set context level for error messages."
       in (Text
k, TypeRep Int
-> (Maybe Text -> Validation ParseError (Int -> Int))
-> Lens' PluginOptions Int
-> Text
-> [Implication Int]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Int -> Int)
forall a.
Read a =>
Text -> Maybe Text -> Validation ParseError (a -> a)
readOption Text
k) (Int -> f Int) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Int
posContextLevel Text
desc [])
    , let k :: Text
k = Text
"dump-pir"
          desc :: Text
desc = Text
"Dump Plutus IR"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDumpPir Text
desc [])
    , let k :: Text
k = Text
"dump-tplc"
          desc :: Text
desc = Text
"Dump Typed Plutus Core"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDumpPlc Text
desc [])
    , let k :: Text
k = Text
"dump-uplc"
          desc :: Text
desc = Text
"Dump Untyped Plutus Core"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDumpUPlc Text
desc [])
    , let k :: Text
k = Text
"inline-constants"
          desc :: Text
desc =
            Text
"Always inline constants. Inlining constants always reduces script \
            \costs slightly, but may increase script sizes if a large constant \
            \is used more than once. Implied by `no-conservative-optimisation`."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posInlineConstants Text
desc [])
    , let k :: Text
k = Text
"optimize"
          desc :: Text
desc = Text
"Run optimization passes such as simplification and floating let-bindings."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posOptimize Text
desc [])
    , let k :: Text
k = Text
"pedantic"
          desc :: Text
desc = Text
"Run type checker after each compilation pass"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posPedantic Text
desc [])
    , let k :: Text
k = Text
"verbosity"
          desc :: Text
desc = Text
"Set logging verbosity level (0=Quiet, 1=Verbose, 2=Debug)"
          toVerbosity :: a -> Verbosity
toVerbosity a
v
            | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 = Verbosity
Quiet
            | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = Verbosity
Verbose
            | Bool
otherwise = Verbosity
Debug
       in ( Text
k
          , TypeRep Verbosity
-> (Maybe Text -> Validation ParseError (Verbosity -> Verbosity))
-> Lens' PluginOptions Verbosity
-> Text
-> [Implication Verbosity]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption
              TypeRep Verbosity
forall {k} (a :: k). Typeable a => TypeRep a
typeRep
              (forall a b.
Read a =>
Text
-> (a -> Validation ParseError b)
-> Maybe Text
-> Validation ParseError (b -> b)
fromReadOption @Int Text
k (Verbosity -> Validation ParseError Verbosity
forall e a. a -> Validation e a
Success (Verbosity -> Validation ParseError Verbosity)
-> (Int -> Verbosity) -> Int -> Validation ParseError Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Verbosity
forall {a}. (Ord a, Num a) => a -> Verbosity
toVerbosity))
              (Verbosity -> f Verbosity) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Verbosity
posVerbosity
              Text
desc
              []
          )
    , let k :: Text
k = Text
"max-simplifier-iterations-pir"
          desc :: Text
desc = Text
"Set the max iterations for the PIR simplifier"
       in (Text
k, TypeRep Int
-> (Maybe Text -> Validation ParseError (Int -> Int))
-> Lens' PluginOptions Int
-> Text
-> [Implication Int]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Int -> Int)
forall a.
Read a =>
Text -> Maybe Text -> Validation ParseError (a -> a)
readOption Text
k) (Int -> f Int) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Int
posMaxSimplifierIterationsPir Text
desc [])
    , let k :: Text
k = Text
"max-simplifier-iterations-uplc"
          desc :: Text
desc = Text
"Set the max iterations for the UPLC simplifier"
       in (Text
k, TypeRep Int
-> (Maybe Text -> Validation ParseError (Int -> Int))
-> Lens' PluginOptions Int
-> Text
-> [Implication Int]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Int -> Int)
forall a.
Read a =>
Text -> Maybe Text -> Validation ParseError (a -> a)
readOption Text
k) (Int -> f Int) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Int
posMaxSimplifierIterationsUPlc Text
desc [])
    , let k :: Text
k = Text
"max-cse-iterations"
          desc :: Text
desc = Text
"Set the max iterations for CSE"
       in (Text
k, TypeRep Int
-> (Maybe Text -> Validation ParseError (Int -> Int))
-> Lens' PluginOptions Int
-> Text
-> [Implication Int]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Int
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Int -> Int)
forall a.
Read a =>
Text -> Maybe Text -> Validation ParseError (a -> a)
readOption Text
k) (Int -> f Int) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Int
posMaxCseIterations Text
desc [])
    , let k :: Text
k = Text
"simplifier-unwrap-cancel"
          desc :: Text
desc = Text
"Run a simplification pass that cancels unwrap/wrap pairs"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierUnwrapCancel Text
desc [])
    , let k :: Text
k = Text
"simplifier-beta"
          desc :: Text
desc = Text
"Run a simplification pass that performs beta transformations"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierBeta Text
desc [])
    , let k :: Text
k = Text
"simplifier-evaluate-builtins"
          desc :: Text
desc =
            Text
"Run a simplification pass that evaluates fully saturated builtin applications. \
            \Implied by `no-conservative-optimisation`."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierEvaluateBuiltins Text
desc [])
    , let k :: Text
k = Text
"simplifier-inline"
          desc :: Text
desc = Text
"Run a simplification pass that performs inlining"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierInline Text
desc [])
    , let k :: Text
k = Text
"strictify-bindings"
          desc :: Text
desc = Text
"Run a simplification pass that makes bindings stricter"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierStrictifyBindings Text
desc [])
    , let k :: Text
k = Text
"simplifier-remove-dead-bindings"
          desc :: Text
desc = Text
"Run a simplification pass that removes dead bindings"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDoSimplifierRemoveDeadBindings Text
desc [])
    , let k :: Text
k = Text
"profile-all"
          desc :: Text
desc = Text
"Set profiling options to All, which adds tracing when entering and exiting a term."
       in (Text
k, TypeRep ProfileOpts
-> (Maybe Text
    -> Validation ParseError (ProfileOpts -> ProfileOpts))
-> Lens' PluginOptions ProfileOpts
-> Text
-> [Implication ProfileOpts]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep ProfileOpts
forall {k} (a :: k). Typeable a => TypeRep a
typeRep ((ProfileOpts -> ProfileOpts)
-> Text
-> Maybe Text
-> Validation ParseError (ProfileOpts -> ProfileOpts)
forall a.
(a -> a) -> Text -> Maybe Text -> Validation ParseError (a -> a)
flag (ProfileOpts -> ProfileOpts -> ProfileOpts
forall a b. a -> b -> a
const ProfileOpts
All) Text
k) (ProfileOpts -> f ProfileOpts) -> PluginOptions -> f PluginOptions
Lens' PluginOptions ProfileOpts
posProfile Text
desc [])
    , let k :: Text
k = Text
"coverage-all"
          desc :: Text
desc = Text
"Add all available coverage annotations in the trace output"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posCoverageAll Text
desc [])
    , let k :: Text
k = Text
"coverage-location"
          desc :: Text
desc = Text
"Add location coverage annotations in the trace output"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posCoverageLocation Text
desc [])
    , let k :: Text
k = Text
"coverage-boolean"
          desc :: Text
desc = Text
"Add boolean coverage annotations in the trace output"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posCoverageBoolean Text
desc [])
    , let k :: Text
k = Text
"relaxed-float-in"
          desc :: Text
desc =
            Text
"Use a more aggressive float-in pass, which often leads to reduced costs \
            \but may occasionally lead to slightly increased costs. Implied by \
            \`no-conservative-optimisation`."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posRelaxedFloatin Text
desc [])
    , let k :: Text
k = Text
"preserve-logging"
          desc :: Text
desc =
            Text
"Turn off optimisations that may alter (i.e., add, remove or change the \
            \order of) trace messages. Implied by `conservative-optimisation`."
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posPreserveLogging Text
desc [])
    , let k :: Text
k = Text
"remove-trace"
          desc :: Text
desc = Text
"Eliminate calls to `trace` from Plutus Core"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posRemoveTrace Text
desc [])
    , let k :: Text
k = Text
"dump-compilation-trace"
          desc :: Text
desc = Text
"Dump compilation trace for debugging"
       in (Text
k, TypeRep Bool
-> (Maybe Text -> Validation ParseError (Bool -> Bool))
-> Lens' PluginOptions Bool
-> Text
-> [Implication Bool]
-> PluginOption
forall a.
Pretty a =>
TypeRep a
-> (Maybe Text -> Validation ParseError (a -> a))
-> Lens' PluginOptions a
-> Text
-> [Implication a]
-> PluginOption
PluginOption TypeRep Bool
forall {k} (a :: k). Typeable a => TypeRep a
typeRep (Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue Text
k) (Bool -> f Bool) -> PluginOptions -> f PluginOptions
Lens' PluginOptions Bool
posDumpCompilationTrace Text
desc [])
    ]

flag :: (a -> a) -> OptionKey -> Maybe OptionValue -> Validation ParseError (a -> a)
flag :: forall a.
(a -> a) -> Text -> Maybe Text -> Validation ParseError (a -> a)
flag a -> a
f Text
k = Validation ParseError (a -> a)
-> (Text -> Validation ParseError (a -> a))
-> Maybe Text
-> Validation ParseError (a -> a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((a -> a) -> Validation ParseError (a -> a)
forall e a. a -> Validation e a
Success a -> a
f) (ParseError -> Validation ParseError (a -> a)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (a -> a))
-> (Text -> ParseError) -> Text -> Validation ParseError (a -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> ParseError
UnexpectedValue Text
k)

setTrue :: OptionKey -> Maybe OptionValue -> Validation ParseError (Bool -> Bool)
setTrue :: Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
setTrue = (Bool -> Bool)
-> Text -> Maybe Text -> Validation ParseError (Bool -> Bool)
forall a.
(a -> a) -> Text -> Maybe Text -> Validation ParseError (a -> a)
flag (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)

plcParserOption :: PLC.Parser a -> OptionKey -> Maybe OptionValue -> Validation ParseError (a -> a)
plcParserOption :: forall a.
Parser a -> Text -> Maybe Text -> Validation ParseError (a -> a)
plcParserOption Parser a
p Text
k = \case
  Just Text
t -> case QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a
forall (m :: * -> *) a. Monad m => QuoteT m a -> m a
PLC.runQuoteT (QuoteT (Either ParserErrorBundle) a -> Either ParserErrorBundle a)
-> QuoteT (Either ParserErrorBundle) a
-> Either ParserErrorBundle a
forall a b. (a -> b) -> a -> b
$ Parser a -> String -> Text -> QuoteT (Either ParserErrorBundle) a
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> String -> Text -> m a
PLC.parse Parser a
p String
"none" Text
t of
    Right a
v                            -> (a -> a) -> Validation ParseError (a -> a)
forall e a. a -> Validation e a
Success ((a -> a) -> Validation ParseError (a -> a))
-> (a -> a) -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
v
    -- TODO: use the error
    Left (ParserErrorBundle
_e :: PLC.ParserErrorBundle) -> ParseError -> Validation ParseError (a -> a)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (a -> a))
-> ParseError -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SomeTypeRep -> ParseError
CannotParseValue Text
k Text
t (Proxy Int -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Int))
  Maybe Text
Nothing -> ParseError -> Validation ParseError (a -> a)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (a -> a))
-> ParseError -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
MissingValue Text
k

readOption :: (Read a) => OptionKey -> Maybe OptionValue -> Validation ParseError (a -> a)
readOption :: forall a.
Read a =>
Text -> Maybe Text -> Validation ParseError (a -> a)
readOption Text
k = \case
  Just Text
v
    | Just a
i <- String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
v) -> (a -> a) -> Validation ParseError (a -> a)
forall e a. a -> Validation e a
Success ((a -> a) -> Validation ParseError (a -> a))
-> (a -> a) -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
i
    | Bool
otherwise -> ParseError -> Validation ParseError (a -> a)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (a -> a))
-> ParseError -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SomeTypeRep -> ParseError
CannotParseValue Text
k Text
v (Proxy Int -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Int))
  Maybe Text
Nothing -> ParseError -> Validation ParseError (a -> a)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (a -> a))
-> ParseError -> Validation ParseError (a -> a)
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
MissingValue Text
k

-- | Obtain an option value of type @a@ from an `Int`.
fromReadOption ::
  (Read a) =>
  OptionKey ->
  (a -> Validation ParseError b) ->
  Maybe OptionValue ->
  Validation ParseError (b -> b)
fromReadOption :: forall a b.
Read a =>
Text
-> (a -> Validation ParseError b)
-> Maybe Text
-> Validation ParseError (b -> b)
fromReadOption Text
k a -> Validation ParseError b
f = \case
  Just Text
v
    | Just a
i <- String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
Text.unpack Text
v) -> b -> b -> b
forall a b. a -> b -> a
const (b -> b -> b)
-> Validation ParseError b -> Validation ParseError (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Validation ParseError b
f a
i
    | Bool
otherwise -> ParseError -> Validation ParseError (b -> b)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (b -> b))
-> ParseError -> Validation ParseError (b -> b)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SomeTypeRep -> ParseError
CannotParseValue Text
k Text
v (Proxy Int -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
someTypeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Int))
  Maybe Text
Nothing -> ParseError -> Validation ParseError (b -> b)
forall e a. e -> Validation e a
Failure (ParseError -> Validation ParseError (b -> b))
-> ParseError -> Validation ParseError (b -> b)
forall a b. (a -> b) -> a -> b
$ Text -> ParseError
MissingValue Text
k

defaultPluginOptions :: PluginOptions
defaultPluginOptions :: PluginOptions
defaultPluginOptions =
  PluginOptions
    { _posPlcTargetVersion :: Version
_posPlcTargetVersion = Version
PLC.plcVersion110
    , _posDoTypecheck :: Bool
_posDoTypecheck = Bool
True
    , _posDeferErrors :: Bool
_posDeferErrors = Bool
False
    , _posConservativeOpts :: Bool
_posConservativeOpts = Bool
False
    , _posContextLevel :: Int
_posContextLevel = Int
1
    , _posDumpPir :: Bool
_posDumpPir = Bool
False
    , _posDumpPlc :: Bool
_posDumpPlc = Bool
False
    , _posDumpUPlc :: Bool
_posDumpUPlc = Bool
False
    , _posOptimize :: Bool
_posOptimize = Bool
True
    , _posPedantic :: Bool
_posPedantic = Bool
False
    , _posVerbosity :: Verbosity
_posVerbosity = Verbosity
Quiet
    , _posMaxSimplifierIterationsPir :: Int
_posMaxSimplifierIterationsPir = Getting Int (CompilationOpts Any) Int -> CompilationOpts Any -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (CompilationOpts Any) Int
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> CompilationOpts a -> f (CompilationOpts a)
PIR.coMaxSimplifierIterations CompilationOpts Any
forall a. CompilationOpts a
PIR.defaultCompilationOpts
    , _posMaxSimplifierIterationsUPlc :: Int
_posMaxSimplifierIterationsUPlc = Getting Int (SimplifyOpts Any Any) Int
-> SimplifyOpts Any Any -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (SimplifyOpts Any Any) Int
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxSimplifierIterations SimplifyOpts Any Any
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts
    , _posMaxCseIterations :: Int
_posMaxCseIterations = Getting Int (SimplifyOpts Any Any) Int
-> SimplifyOpts Any Any -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (SimplifyOpts Any Any) Int
forall name a (f :: * -> *).
Functor f =>
(Int -> f Int) -> SimplifyOpts name a -> f (SimplifyOpts name a)
UPLC.soMaxCseIterations SimplifyOpts Any Any
forall name a. SimplifyOpts name a
UPLC.defaultSimplifyOpts
    , _posDoSimplifierUnwrapCancel :: Bool
_posDoSimplifierUnwrapCancel = Bool
True
    , _posDoSimplifierBeta :: Bool
_posDoSimplifierBeta = Bool
True
    , _posDoSimplifierInline :: Bool
_posDoSimplifierInline = Bool
True
    , _posDoSimplifierEvaluateBuiltins :: Bool
_posDoSimplifierEvaluateBuiltins = Bool
True
    , _posDoSimplifierStrictifyBindings :: Bool
_posDoSimplifierStrictifyBindings = Bool
True
    , _posDoSimplifierRemoveDeadBindings :: Bool
_posDoSimplifierRemoveDeadBindings = Bool
True
    , _posProfile :: ProfileOpts
_posProfile = ProfileOpts
None
    , _posCoverageAll :: Bool
_posCoverageAll = Bool
False
    , _posCoverageLocation :: Bool
_posCoverageLocation = Bool
False
    , _posCoverageBoolean :: Bool
_posCoverageBoolean = Bool
False
    , _posRelaxedFloatin :: Bool
_posRelaxedFloatin = Bool
True
    , _posCaseOfCaseConservative :: Bool
_posCaseOfCaseConservative = Bool
False
    , _posInlineConstants :: Bool
_posInlineConstants = Bool
True
    , _posPreserveLogging :: Bool
_posPreserveLogging = Bool
False
    , _posRemoveTrace :: Bool
_posRemoveTrace = Bool
False
    , _posDumpCompilationTrace :: Bool
_posDumpCompilationTrace = Bool
False
    }

processOne ::
  OptionKey ->
  Maybe OptionValue ->
  Validation ParseError (PluginOptions -> PluginOptions)
processOne :: Text
-> Maybe Text
-> Validation ParseError (PluginOptions -> PluginOptions)
processOne Text
key Maybe Text
val
  | Just (PluginOption TypeRep a
_ Maybe Text -> Validation ParseError (a -> a)
f Lens' PluginOptions a
field Text
_ [Implication a]
impls) <- Text -> Map Text PluginOption -> Maybe PluginOption
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text PluginOption
pluginOptions =
      (PluginOptions -> PluginOptions)
-> (PluginOptions -> PluginOptions)
-> PluginOptions
-> PluginOptions
forall a b. (a -> b) -> (PluginOptions -> a) -> PluginOptions -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' PluginOptions a
-> [Implication a] -> PluginOptions -> PluginOptions
forall a.
Lens' PluginOptions a
-> [Implication a] -> PluginOptions -> PluginOptions
applyImplications (a -> f a) -> PluginOptions -> f PluginOptions
Lens' PluginOptions a
field [Implication a]
impls) ((PluginOptions -> PluginOptions)
 -> PluginOptions -> PluginOptions)
-> ((a -> a) -> PluginOptions -> PluginOptions)
-> (a -> a)
-> PluginOptions
-> PluginOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter PluginOptions PluginOptions a a
-> (a -> a) -> PluginOptions -> PluginOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter PluginOptions PluginOptions a a
Lens' PluginOptions a
field ((a -> a) -> PluginOptions -> PluginOptions)
-> Validation ParseError (a -> a)
-> Validation ParseError (PluginOptions -> PluginOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Validation ParseError (a -> a)
f Maybe Text
val
  -- For each boolean option there is a "no-" version for disabling it.
  | Just Text
key' <- Text -> Text -> Maybe Text
Text.stripPrefix Text
"no-" Text
key
  , Just (PluginOption TypeRep a
tr Maybe Text -> Validation ParseError (a -> a)
f Lens' PluginOptions a
field Text
_ [Implication a]
impls) <- Text -> Map Text PluginOption -> Maybe PluginOption
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key' Map Text PluginOption
pluginOptions
  , Just a :~: Bool
Refl <- TypeRep a -> TypeRep Bool -> Maybe (a :~: Bool)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality TypeRep a
tr (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Bool) =
      (PluginOptions -> PluginOptions)
-> (PluginOptions -> PluginOptions)
-> PluginOptions
-> PluginOptions
forall a b. (a -> b) -> (PluginOptions -> a) -> PluginOptions -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lens' PluginOptions a
-> [Implication a] -> PluginOptions -> PluginOptions
forall a.
Lens' PluginOptions a
-> [Implication a] -> PluginOptions -> PluginOptions
applyImplications (a -> f a) -> PluginOptions -> f PluginOptions
Lens' PluginOptions a
field [Implication a]
impls) ((PluginOptions -> PluginOptions)
 -> PluginOptions -> PluginOptions)
-> ((a -> Bool) -> PluginOptions -> PluginOptions)
-> (a -> Bool)
-> PluginOptions
-> PluginOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter PluginOptions PluginOptions a a
-> (a -> a) -> PluginOptions -> PluginOptions
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter PluginOptions PluginOptions a a
Lens' PluginOptions a
field ((a -> a) -> PluginOptions -> PluginOptions)
-> ((a -> Bool) -> a -> a)
-> (a -> Bool)
-> PluginOptions
-> PluginOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> a
Bool -> Bool
not (Bool -> a) -> (a -> Bool) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Bool) -> PluginOptions -> PluginOptions)
-> Validation ParseError (a -> Bool)
-> Validation ParseError (PluginOptions -> PluginOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Validation ParseError (a -> a)
f Maybe Text
val
  | Bool
otherwise =
      let suggs :: [Text]
suggs =
            String -> Text
Text.pack
              (String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> [String]
GHC.fuzzyMatch (Text -> String
Text.unpack Text
key) (Text -> String
Text.unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text PluginOption -> [Text]
forall k a. Map k a -> [k]
Map.keys Map Text PluginOption
pluginOptions)
       in ParseError
-> Validation ParseError (PluginOptions -> PluginOptions)
forall e a. e -> Validation e a
Failure (Text -> [Text] -> ParseError
UnrecognisedOption Text
key [Text]
suggs)

applyImplications :: Lens' PluginOptions a -> [Implication a] -> PluginOptions -> PluginOptions
applyImplications :: forall a.
Lens' PluginOptions a
-> [Implication a] -> PluginOptions -> PluginOptions
applyImplications Lens' PluginOptions a
field =
  (Implication a
 -> (PluginOptions -> PluginOptions)
 -> PluginOptions
 -> PluginOptions)
-> (PluginOptions -> PluginOptions)
-> [Implication a]
-> PluginOptions
-> PluginOptions
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    -- The value of `field` implies the value of `field'`.
    ( \(Implication a -> Bool
f Lens' PluginOptions b
field' b
val) PluginOptions -> PluginOptions
acc ->
        PluginOptions -> PluginOptions
acc (PluginOptions -> PluginOptions)
-> (PluginOptions -> PluginOptions)
-> PluginOptions
-> PluginOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\PluginOptions
opts -> if a -> Bool
f (PluginOptions
opts PluginOptions -> Getting a PluginOptions a -> a
forall s a. s -> Getting a s a -> a
^. Getting a PluginOptions a
Lens' PluginOptions a
field) then PluginOptions
opts PluginOptions -> (PluginOptions -> PluginOptions) -> PluginOptions
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> PluginOptions -> Identity PluginOptions
Lens' PluginOptions b
field' ((b -> Identity b) -> PluginOptions -> Identity PluginOptions)
-> b -> PluginOptions -> PluginOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
val else PluginOptions
opts)
    )
    PluginOptions -> PluginOptions
forall a. a -> a
id

processAll ::
  [(OptionKey, Maybe OptionValue)] ->
  Validation ParseErrors [PluginOptions -> PluginOptions]
processAll :: [(Text, Maybe Text)]
-> Validation ParseErrors [PluginOptions -> PluginOptions]
processAll = ((Text, Maybe Text)
 -> Validation ParseErrors (PluginOptions -> PluginOptions))
-> [(Text, Maybe Text)]
-> Validation ParseErrors [PluginOptions -> PluginOptions]
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, Maybe Text)
  -> Validation ParseErrors (PluginOptions -> PluginOptions))
 -> [(Text, Maybe Text)]
 -> Validation ParseErrors [PluginOptions -> PluginOptions])
-> ((Text, Maybe Text)
    -> Validation ParseErrors (PluginOptions -> PluginOptions))
-> [(Text, Maybe Text)]
-> Validation ParseErrors [PluginOptions -> PluginOptions]
forall a b. (a -> b) -> a -> b
$ (ParseError -> ParseErrors)
-> Validation ParseError (PluginOptions -> PluginOptions)
-> Validation ParseErrors (PluginOptions -> PluginOptions)
forall a b c. (a -> b) -> Validation a c -> Validation b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (NonEmpty ParseError -> ParseErrors
ParseErrors (NonEmpty ParseError -> ParseErrors)
-> (ParseError -> NonEmpty ParseError) -> ParseError -> ParseErrors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> NonEmpty ParseError
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Validation ParseError (PluginOptions -> PluginOptions)
 -> Validation ParseErrors (PluginOptions -> PluginOptions))
-> ((Text, Maybe Text)
    -> Validation ParseError (PluginOptions -> PluginOptions))
-> (Text, Maybe Text)
-> Validation ParseErrors (PluginOptions -> PluginOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
 -> Maybe Text
 -> Validation ParseError (PluginOptions -> PluginOptions))
-> (Text, Maybe Text)
-> Validation ParseError (PluginOptions -> PluginOptions)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text
-> Maybe Text
-> Validation ParseError (PluginOptions -> PluginOptions)
processOne

toKeyValue :: GHC.CommandLineOption -> (OptionKey, Maybe OptionValue)
toKeyValue :: String -> (Text, Maybe Text)
toKeyValue String
opt = case Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Char
'=' String
opt of
  Maybe Int
Nothing -> (String -> Text
Text.pack String
opt, Maybe Text
forall a. Maybe a
Nothing)
  Just Int
idx ->
    let (String
lhs, String
rhs) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
idx String
opt
     in (String -> Text
Text.pack String
lhs, Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
Text.pack (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
rhs)))

{- | Parses the arguments that were given to ghc at commandline as
 "-fplugin-opt PlutusTx.Plugin:opt" or "-fplugin-opt PlutusTx.Plugin:opt=val"
-}
parsePluginOptions :: [GHC.CommandLineOption] -> Validation ParseErrors PluginOptions
parsePluginOptions :: [String] -> Validation ParseErrors PluginOptions
parsePluginOptions = ([PluginOptions -> PluginOptions] -> PluginOptions)
-> Validation ParseErrors [PluginOptions -> PluginOptions]
-> Validation ParseErrors PluginOptions
forall a b.
(a -> b) -> Validation ParseErrors a -> Validation ParseErrors b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PluginOptions
 -> (PluginOptions -> PluginOptions) -> PluginOptions)
-> PluginOptions
-> [PluginOptions -> PluginOptions]
-> PluginOptions
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((PluginOptions -> PluginOptions)
 -> PluginOptions -> PluginOptions)
-> PluginOptions
-> (PluginOptions -> PluginOptions)
-> PluginOptions
forall a b c. (a -> b -> c) -> b -> a -> c
flip (PluginOptions -> PluginOptions) -> PluginOptions -> PluginOptions
forall a b. (a -> b) -> a -> b
($)) PluginOptions
defaultPluginOptions) (Validation ParseErrors [PluginOptions -> PluginOptions]
 -> Validation ParseErrors PluginOptions)
-> ([String]
    -> Validation ParseErrors [PluginOptions -> PluginOptions])
-> [String]
-> Validation ParseErrors PluginOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Maybe Text)]
-> Validation ParseErrors [PluginOptions -> PluginOptions]
processAll ([(Text, Maybe Text)]
 -> Validation ParseErrors [PluginOptions -> PluginOptions])
-> ([String] -> [(Text, Maybe Text)])
-> [String]
-> Validation ParseErrors [PluginOptions -> PluginOptions]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Text, Maybe Text)) -> [String] -> [(Text, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> (Text, Maybe Text)
toKeyValue