{-| Insert necessary or recommended GHC flags and extensions via a driver plugin.
See https://plutus.cardano.intersectmbo.org/docs/using-plinth/extensions-flags-pragmas -}
module PlutusTx.Plugin.Boilerplate where

import GHC.Driver.Flags qualified as GHC
import GHC.LanguageExtensions qualified as GHC
import GHC.Plugins qualified as GHC

{-| Unfortunately, it seems like the `Strict` extension set by the driver plugin cannot be
unset via @LANGUAGE NoStrict@. So we add a plugin flag to allow users to do so. -}
optNoStrict :: GHC.CommandLineOption
optNoStrict :: CommandLineOption
optNoStrict = CommandLineOption
"no-strict"

boilerplateOpts :: [GHC.CommandLineOption]
boilerplateOpts :: [CommandLineOption]
boilerplateOpts = [CommandLineOption
optNoStrict]

removeBoilerplateOpts :: [GHC.CommandLineOption] -> [GHC.CommandLineOption]
removeBoilerplateOpts :: [CommandLineOption] -> [CommandLineOption]
removeBoilerplateOpts = (CommandLineOption -> Bool)
-> [CommandLineOption] -> [CommandLineOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (CommandLineOption -> [CommandLineOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CommandLineOption]
boilerplateOpts)

addFlagsAndExts :: [GHC.CommandLineOption] -> GHC.HscEnv -> IO GHC.HscEnv
addFlagsAndExts :: [CommandLineOption] -> HscEnv -> IO HscEnv
addFlagsAndExts [CommandLineOption]
opts HscEnv
env = HscEnv -> IO HscEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HscEnv
env {GHC.hsc_dflags = dflags}
  where
    dflags :: DynFlags
dflags = DynFlags -> DynFlags
setStrict (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
unsetFlags (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall a b. (a -> b) -> a -> b
$ HscEnv -> DynFlags
GHC.hsc_dflags HscEnv
env

    unsetFlags :: GHC.DynFlags -> GHC.DynFlags
    unsetFlags :: DynFlags -> DynFlags
unsetFlags =
      (DynFlags -> [GeneralFlag] -> DynFlags)
-> [GeneralFlag] -> DynFlags -> DynFlags
forall a b c. (a -> b -> c) -> b -> a -> c
flip
        ((DynFlags -> GeneralFlag -> DynFlags)
-> DynFlags -> [GeneralFlag] -> DynFlags
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl DynFlags -> GeneralFlag -> DynFlags
GHC.gopt_unset)
        [ GeneralFlag
GHC.Opt_IgnoreInterfacePragmas
        , GeneralFlag
GHC.Opt_OmitInterfacePragmas
        , GeneralFlag
GHC.Opt_FullLaziness
        , GeneralFlag
GHC.Opt_SpecConstr
        , GeneralFlag
GHC.Opt_Specialise
        , GeneralFlag
GHC.Opt_Strictness
        , GeneralFlag
GHC.Opt_UnboxStrictFields
        , GeneralFlag
GHC.Opt_UnboxSmallStrictFields
        ]

    setStrict :: GHC.DynFlags -> GHC.DynFlags
    setStrict :: DynFlags -> DynFlags
setStrict =
      if CommandLineOption
optNoStrict CommandLineOption -> [CommandLineOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandLineOption]
opts then DynFlags -> DynFlags
forall a. a -> a
id else (DynFlags -> Extension -> DynFlags
`GHC.xopt_set` Extension
GHC.Strict)