{-# LANGUAGE CPP                 #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Overloaded plugin, which makes magic possible.
module Overloaded.Plugin (plugin) where

import Control.Exception      (throwIO)
import Control.Monad          (foldM, when)
import Control.Monad.IO.Class (MonadIO (..))
import Data.List              (intercalate)
import Data.List.Split        (splitOn)
import Data.Maybe             (catMaybes)

import qualified Data.Generics as SYB

-- GHC stuff
import qualified GHC.Compat.All  as GHC
import           GHC.Compat.Expr

#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Plugins as Plugins
#else
import qualified GhcPlugins as Plugins
#endif

import Overloaded.Plugin.Categories
import Overloaded.Plugin.Diagnostics
import Overloaded.Plugin.IdiomBrackets
import Overloaded.Plugin.LocalDo
import Overloaded.Plugin.Names
import Overloaded.Plugin.Rewrite
import Overloaded.Plugin.TcPlugin
import Overloaded.Plugin.V

-------------------------------------------------------------------------------
-- Plugin
-------------------------------------------------------------------------------

-- | @Overloaded@ plugin.
--
-- To enable plugin put the following at top of the module:
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Symbols #-}
-- @
--
-- At least one option is required, multiple can given
-- either using multiple @-fplugin-opt@ options, or by separating options
-- with colon:
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Symbols:Numerals #-}
-- @
--
-- Options also take optional desugaring names, for example
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Labels=Data.Generics.ProductFields.field #-}
-- @
--
-- to desugar @OverloadedLabels@ directly into 'field' from @generics-lens@ (no need to import orphan instance!)
--
-- == Supported options
--
-- * @Symbols@ desugars literal strings to @'Overloaded.Symbols.fromSymbol' \@sym@
-- * @Strings@ works like built-in @OverloadedStrings@ (but you can use different method than 'Data.String.fromString')
-- * @Numerals@ desugars literal numbers to @'Overloaded.Numerals.fromNumeral' \@nat@
-- * @Naturals@ desugars literal numbers to @'Overloaded.Naturals.fromNatural' nat@ (i.e. like 'Data.String.fromString')
-- * @Chars@ desugars literal characters to @'Overloaded.Chars.fromChars' c@. /Note:/ there isn't type-level alternative: we cannot promote 'Char's
-- * @Lists@ __is not__ like built-in @OverloadedLists@, but desugars explicit lists to 'Overloaded.Lists.cons' and 'Overloaded.Lists.nil'
-- * @If@ desugars @if@-expressions to @'Overloaded.If.ifte' b t e@
-- * @Unit@ desugars @()@-expressions to @'Overloaded.Lists.nil'@ (but you can use different method, e.g. @boring@ from <https://hackage.haskell.org/package/boring-0.1.3/docs/Data-Boring.html Data.Boring>)
-- * @Labels@ works like built-in @OverloadedLabels@ (you should enable @OverloadedLabels@ so parser recognises the syntax)
-- * @TypeNats@ and @TypeSymbols@ desugar type-level literals into @'Overloaded.TypeNats.FromNat'@ and @'Overloaded.TypeSymbols.FromTypeSymbol'@ respectively
-- * @Do@ desugar in /Local Do/ fashion. See examples.
-- * @Categories@ change @Arrows@ desugaring to use /"correct"/ category classes.
-- * @CodeLabels@ desugars @OverloadedLabels@ into Typed Template Haskell splices
-- * @CodeStrings@ desugars string literals into Typed Template Haskell splices
-- * @RebindableApplication@ changes how juxtaposition is interpreted
-- * @OverloadedConstructors@ allows you to use overloaded constructor names!
--
-- == Known limitations
--
-- * Doesn't desugar inside patterns
--
-- == RecordFields
--
-- __WARNING__ the type-checker plugin is experimental, it's adviced to use
--
-- @
-- {-\# OPTIONS_GHC -ddump-simpl #-}
-- @
--
-- to avoid surprising segfaults.
--
-- === Usage
--
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:RecordFields #-}
--
-- === Implementation bits
--
-- See Note [HasField instances] in "ClsInst", the behavior of this plugin is similar.
--
-- The 'GHC.Records.Compat.HasField' class is defined in "GHC.Records.Compat" module of @record-hasfield@ package:
--
-- @
-- class 'GHC.Records.Compat.HasField' {k} x r a | x r -> a where
--     'GHC.Records.Compat.hasField' :: r -> (a -> r, a)
-- @
-- Suppose we have
--
-- @
-- data R y = MkR { foo :: [y] }
-- @
--
-- and @foo@ in scope. We will solve constraints like
--
-- @
-- HasField "foo" (R Int) a
-- @
--
-- by emitting a new wanted constraint
--
-- @
-- [Int] ~# a
-- @
--
-- and building a @HasField@ dictionary out of selector @foo@ appropriately cast.
--
-- == Idiom brackets from TemplateHaskellQuotes
--
-- @
-- {-\# LANGUAGE TemplateHaskellQuotes #-}
-- {-\# OPTIONS_GHC -fplugin=Overloaded -fplugin-opt=Overloaded:IdiomBrackets #-}
--
-- data Tree a
--     = Leaf a
--     | Branch (Tree a) (Tree a)
--   deriving (Show)
--
-- instance Functor Tree where
--     'fmap' f (Leaf x)     = Leaf (f x)
--     'fmap' f (Branch l r) = Branch ('fmap' f l) ('fmap' f r)
--
-- instance Traversable Tree where
--     'traverse' f (Leaf x)     = [| Leaf (f x) |]
--     'traverse' f (Branch l r) = [| Branch ('traverse' f l) ('traverse' f r) |]
-- @
--
-- == RebindableApplication
--
-- Converts all @f x@ applications into @(f $ x)@ with whatever @$@
-- is in scope.
--
-- @
-- {-\# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:RebindableApplication #-}
--
-- let f = pure ((+) :: Int -> Int -> Int)
--     x = Just 1
--     y = Just 2
--
--     z = let ($) = ('<*>') in f x y
-- in z
-- @
--
plugin :: Plugins.Plugin
plugin :: Plugin
plugin = Plugin
Plugins.defaultPlugin
    { renamedResultAction :: [CommandLineOption]
-> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
Plugins.renamedResultAction = [CommandLineOption]
-> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction
    , parsedResultAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
Plugins.parsedResultAction  = [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedAction
    , tcPlugin :: TcPlugin
Plugins.tcPlugin            = TcPlugin -> TcPlugin
forall (t :: * -> *) a.
Foldable t =>
a -> t CommandLineOption -> Maybe a
enabled TcPlugin
tcPlugin
    , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
Plugins.pluginRecompile     = [CommandLineOption] -> IO PluginRecompile
Plugins.purePlugin
    }
  where
    enabled :: a -> t CommandLineOption -> Maybe a
enabled a
p t CommandLineOption
args'
        | CommandLineOption
"RecordFields" CommandLineOption -> [CommandLineOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandLineOption]
args = a -> Maybe a
forall a. a -> Maybe a
Just a
p
        | CommandLineOption
"Constructors" CommandLineOption -> [CommandLineOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CommandLineOption]
args = a -> Maybe a
forall a. a -> Maybe a
Just a
p
        | Bool
otherwise                  = Maybe a
forall a. Maybe a
Nothing
      where
        args :: [CommandLineOption]
args = (CommandLineOption -> CommandLineOption)
-> [CommandLineOption] -> [CommandLineOption]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> CommandLineOption -> CommandLineOption
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')) ([CommandLineOption] -> [CommandLineOption])
-> [CommandLineOption] -> [CommandLineOption]
forall a b. (a -> b) -> a -> b
$ (CommandLineOption -> [CommandLineOption])
-> t CommandLineOption -> [CommandLineOption]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CommandLineOption -> CommandLineOption -> [CommandLineOption]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn CommandLineOption
":") t CommandLineOption
args'

-------------------------------------------------------------------------------
-- Renamer
-------------------------------------------------------------------------------

renamedAction
    :: [Plugins.CommandLineOption]
    -> GHC.TcGblEnv
    -> HsGroup GhcRn
    -> GHC.TcM (GHC.TcGblEnv, HsGroup GhcRn)
renamedAction :: [CommandLineOption]
-> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedAction [CommandLineOption]
args' TcGblEnv
env HsGroup GhcRn
gr = do
    DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags
    HscEnv
topEnv <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
GHC.getTopEnv

    CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => CommandLineOption -> m ()
debug (CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ [CommandLineOption] -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show [CommandLineOption]
args
    CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => CommandLineOption -> m ()
debug (CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> HsGroup GhcRn -> CommandLineOption
forall a. Outputable a => DynFlags -> a -> CommandLineOption
GHC.showPpr DynFlags
dflags HsGroup GhcRn
gr

    Names
names <- DynFlags -> HscEnv -> TcM Names
getNames DynFlags
dflags HscEnv
topEnv
    opts :: Options
opts@Options {Bool
OnOff CommandLineOption
OnOff VarName
OnOff (V2 VarName)
LabelOpt
NumNat
StrSym
optConstructors :: Options -> OnOff VarName
optRebindApp :: Options -> OnOff VarName
optCategories :: Options -> OnOff CommandLineOption
optDo :: Options -> Bool
optIdiomBrackets :: Options -> Bool
optRecordFields :: Options -> Bool
optTypeSymbols :: Options -> OnOff VarName
optTypeNats :: Options -> OnOff VarName
optUnit :: Options -> OnOff VarName
optLabels :: Options -> LabelOpt
optIf :: Options -> OnOff VarName
optLists :: Options -> OnOff (V2 VarName)
optChars :: Options -> OnOff VarName
optNumerals :: Options -> NumNat
optStrings :: Options -> StrSym
optConstructors :: OnOff VarName
optRebindApp :: OnOff VarName
optCategories :: OnOff CommandLineOption
optDo :: Bool
optIdiomBrackets :: Bool
optRecordFields :: Bool
optTypeSymbols :: OnOff VarName
optTypeNats :: OnOff VarName
optUnit :: OnOff VarName
optLabels :: LabelOpt
optIf :: OnOff VarName
optLists :: OnOff (V2 VarName)
optChars :: OnOff VarName
optNumerals :: NumNat
optStrings :: StrSym
..} <- DynFlags
-> [CommandLineOption] -> IOEnv (Env TcGblEnv TcLclEnv) Options
forall (m :: * -> *).
MonadIO m =>
DynFlags -> [CommandLineOption] -> m Options
parseArgs DynFlags
dflags [CommandLineOption]
args
    Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Options
opts Options -> Options -> Bool
forall a. Eq a => a -> a -> Bool
== Options
defaultOptions) (IOEnv (Env TcGblEnv TcLclEnv) ()
 -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
        DynFlags -> SrcSpan -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> SDoc
GHC.text CommandLineOption
"No Overloaded features enabled"

    let transformNoOp :: a -> Rewrite a
        transformNoOp :: a -> Rewrite a
transformNoOp a
_ = Rewrite a
forall a. Rewrite a
NoRewrite

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trStr <- case StrSym
optStrings of
        StrSym
NoStr             -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        Str Maybe VarName
Nothing       -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformStrings Names
names
        Sym Maybe VarName
Nothing       -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformSymbols Names
names
        CodeStr Maybe VarName
Nothing   -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeStrings Names
names
        Str (Just VarName
vn)     -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformStrings (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromStringName :: Name
fromStringName = Name
n }
        Sym (Just VarName
vn)     -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformSymbols (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromSymbolName :: Name
fromSymbolName = Name
n }
        CodeStr (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformSymbols (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { codeFromStringName :: Name
codeFromStringName = Name
n }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trNum <- case NumNat
optNumerals of
        NumNat
NoNum           -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        IsNum Maybe VarName
Nothing   -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNumerals Names
names
        IsNat Maybe VarName
Nothing   -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNaturals Names
names
        IsNum (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNumerals (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromNumeralName :: Name
fromNumeralName = Name
n }
        IsNat (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNaturals (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromNaturalName :: Name
fromNaturalName = Name
n }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trChr <- case OnOff VarName
optChars of
        OnOff VarName
Off        -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformChars Names
names
        On (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformChars (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromCharName :: Name
fromCharName = Name
n }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trLists <- case OnOff (V2 VarName)
optLists of
        OnOff (V2 VarName)
Off        -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe (V2 VarName)
Nothing -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLists Names
names
        On (Just (V2 VarName
xn VarName
yn)) -> do
            Name
x <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
xn
            Name
y <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
yn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLists (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { nilName :: Name
nilName = Name
x, consName :: Name
consName = Name
y }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trIf <- case OnOff VarName
optIf of
        OnOff VarName
Off        -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformIf Names
names
        On (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformIf (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { ifteName :: Name
ifteName = Name
n }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trLabel <- case LabelOpt
optLabels of
        LabelOpt
NoLabel                 -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        Label Maybe VarName
Nothing       -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLabels Names
names
        CodeLabel Maybe VarName
Nothing   -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeLabels Names
names
        Label (Just VarName
vn)     -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLabels (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromLabelName :: Name
fromLabelName = Name
n }
        CodeLabel (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeLabels (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { codeFromLabelName :: Name
codeFromLabelName = Name
n }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trBrackets <- case Bool
optIdiomBrackets of
        Bool
False -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        Bool
True  -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformIdiomBrackets Names
names

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trDo <- case Bool
optDo of
        Bool
False -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        Bool
True  -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformDo Names
names

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trCategories <- case OnOff CommandLineOption
optCategories of
        OnOff CommandLineOption
Off          -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe CommandLineOption
Nothing   -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCategories Names
names
        On (Just CommandLineOption
mn) -> do
            CatNames
catNames' <- DynFlags -> HscEnv -> ModuleName -> TcM CatNames
getCatNames DynFlags
dflags HscEnv
topEnv (CommandLineOption -> ModuleName
GHC.mkModuleName CommandLineOption
mn)
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCategories (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { catNames :: CatNames
catNames = CatNames
catNames' }

    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trUnit <- case OnOff VarName
optUnit of
        OnOff VarName
Off        -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformUnit Names
names
        On (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupVarName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)))
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformUnit (Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { unitName :: Name
unitName = Name
n }

    LHsType GhcRn -> Rewrite (LHsType GhcRn)
trTypeNats <- case OnOff VarName
optTypeNats of
        OnOff VarName
Off          -> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing   -> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsType GhcRn -> Rewrite (LHsType GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn)))
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeNats Names
names
        On (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupTypeName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsType GhcRn -> Rewrite (LHsType GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn)))
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeNats (Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromTypeNatName :: Name
fromTypeNatName = Name
n }

    LHsType GhcRn -> Rewrite (LHsType GhcRn)
trTypeSymbols <- case OnOff VarName
optTypeSymbols of
        OnOff VarName
Off          -> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing   -> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsType GhcRn -> Rewrite (LHsType GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn)))
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeSymbols Names
names
        On (Just VarName
vn) -> do
            Name
n <- DynFlags -> HscEnv -> VarName -> TcM Name
lookupTypeName DynFlags
dflags HscEnv
topEnv VarName
vn
            (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsType GhcRn -> Rewrite (LHsType GhcRn))
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn)))
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> IOEnv
     (Env TcGblEnv TcLclEnv) (LHsType GhcRn -> Rewrite (LHsType GhcRn))
forall a b. (a -> b) -> a -> b
$ Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeSymbols (Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a b. (a -> b) -> a -> b
$ Names
names { fromTypeSymbolName :: Name
fromTypeSymbolName = Name
n }

    let tr :: LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
tr  = [LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)]
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. Monoid a => [a] -> a
mconcat
            [ LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trStr
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trNum
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trChr
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trLists
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trIf
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trLabel
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trBrackets
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trDo
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trCategories
            , LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
trUnit
            ]
    let trT :: LHsType GhcRn -> Rewrite (LHsType GhcRn)
trT = LHsType GhcRn -> Rewrite (LHsType GhcRn)
trTypeNats (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> LHsType GhcRn
-> Rewrite (LHsType GhcRn)
forall a. Semigroup a => a -> a -> a
<> LHsType GhcRn -> Rewrite (LHsType GhcRn)
trTypeSymbols

    HsGroup GhcRn
gr' <- DynFlags
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> HsGroup GhcRn
-> TcM (HsGroup GhcRn)
transformType DynFlags
dflags LHsType GhcRn -> Rewrite (LHsType GhcRn)
trT HsGroup GhcRn
gr
    HsGroup GhcRn
gr'' <- DynFlags
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> HsGroup GhcRn
-> TcM (HsGroup GhcRn)
transformRn DynFlags
dflags LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
tr HsGroup GhcRn
gr'

    (TcGblEnv, HsGroup GhcRn) -> TcM (TcGblEnv, HsGroup GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return (TcGblEnv
env, HsGroup GhcRn
gr'')
  where
    args :: [CommandLineOption]
args = (CommandLineOption -> [CommandLineOption])
-> [CommandLineOption] -> [CommandLineOption]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CommandLineOption -> CommandLineOption -> [CommandLineOption]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn CommandLineOption
":") [CommandLineOption]
args'

-------------------------------------------------------------------------------
-- Parsed Action
-------------------------------------------------------------------------------

parsedAction
    :: [Plugins.CommandLineOption]
    -> Plugins.ModSummary
    -> Plugins.HsParsedModule
    -> Plugins.Hsc Plugins.HsParsedModule
parsedAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedAction [CommandLineOption]
args ModSummary
_modSum HsParsedModule
pm = do
    let hsmodule :: Located (HsModule GhcPs)
hsmodule = HsParsedModule -> Located (HsModule GhcPs)
Plugins.hpm_module HsParsedModule
pm
    HscEnv
topEnv <- (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
-> Hsc HscEnv
forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
GHC.Hsc ((HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
 -> Hsc HscEnv)
-> (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
-> Hsc HscEnv
forall a b. (a -> b) -> a -> b
$ \HscEnv
env WarningMessages
warnMsgs -> (HscEnv, WarningMessages) -> IO (HscEnv, WarningMessages)
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv
env, WarningMessages
warnMsgs)

    DynFlags
dflags <- Hsc DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
GHC.getDynFlags

    CommandLineOption -> Hsc ()
forall (m :: * -> *). MonadIO m => CommandLineOption -> m ()
debug (CommandLineOption -> Hsc ()) -> CommandLineOption -> Hsc ()
forall a b. (a -> b) -> a -> b
$ [CommandLineOption] -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show [CommandLineOption]
args
    CommandLineOption -> Hsc ()
forall (m :: * -> *). MonadIO m => CommandLineOption -> m ()
debug (CommandLineOption -> Hsc ()) -> CommandLineOption -> Hsc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Located (HsModule GhcPs) -> CommandLineOption
forall a. Outputable a => DynFlags -> a -> CommandLineOption
GHC.showPpr DynFlags
dflags Located (HsModule GhcPs)
hsmodule

    RdrNames
names <- DynFlags -> HscEnv -> Hsc RdrNames
getRdrNames DynFlags
dflags HscEnv
topEnv
    _opts :: Options
_opts@Options {Bool
OnOff CommandLineOption
OnOff VarName
OnOff (V2 VarName)
LabelOpt
NumNat
StrSym
optConstructors :: OnOff VarName
optRebindApp :: OnOff VarName
optCategories :: OnOff CommandLineOption
optDo :: Bool
optIdiomBrackets :: Bool
optRecordFields :: Bool
optTypeSymbols :: OnOff VarName
optTypeNats :: OnOff VarName
optUnit :: OnOff VarName
optLabels :: LabelOpt
optIf :: OnOff VarName
optLists :: OnOff (V2 VarName)
optChars :: OnOff VarName
optNumerals :: NumNat
optStrings :: StrSym
optConstructors :: Options -> OnOff VarName
optRebindApp :: Options -> OnOff VarName
optCategories :: Options -> OnOff CommandLineOption
optDo :: Options -> Bool
optIdiomBrackets :: Options -> Bool
optRecordFields :: Options -> Bool
optTypeSymbols :: Options -> OnOff VarName
optTypeNats :: Options -> OnOff VarName
optUnit :: Options -> OnOff VarName
optLabels :: Options -> LabelOpt
optIf :: Options -> OnOff VarName
optLists :: Options -> OnOff (V2 VarName)
optChars :: Options -> OnOff VarName
optNumerals :: Options -> NumNat
optStrings :: Options -> StrSym
..} <- DynFlags -> [CommandLineOption] -> Hsc Options
forall (m :: * -> *).
MonadIO m =>
DynFlags -> [CommandLineOption] -> m Options
parseArgs DynFlags
dflags [CommandLineOption]
args

    let transformNoOp :: a -> Rewrite a
        transformNoOp :: a -> Rewrite a
transformNoOp a
_ = Rewrite a
forall a. Rewrite a
NoRewrite

    LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
trRebindApp <- case OnOff VarName
optRebindApp of
        OnOff VarName
Off -> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing  -> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
 -> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformRebindableApplication RdrNames
names
        On (Just VarName
rn) -> do
            let n :: RdrName
n = VarName -> RdrName
mkRdrName VarName
rn
            (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
 -> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformRebindableApplication (RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ RdrNames
names { dollarName :: RdrName
dollarName = RdrName
n }

    LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
trConstructors <- case OnOff VarName
optConstructors of
        OnOff VarName
Off -> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a. a -> Rewrite a
transformNoOp
        On Maybe VarName
Nothing -> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
 -> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformConstructors RdrNames
names
        On (Just VarName
rn) -> do
            let n :: RdrName
n = VarName -> RdrName
mkRdrName VarName
rn
            (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall (m :: * -> *) a. Monad m => a -> m a
return ((LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
 -> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)))
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Hsc (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
forall a b. (a -> b) -> a -> b
$ RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformConstructors (RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ RdrNames
names { buildName :: RdrName
buildName = RdrName
n }

    let tr :: LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
tr  = [LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)]
-> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a. Monoid a => [a] -> a
mconcat
            [ LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
trRebindApp
            , LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
trConstructors
            ]

    Located (HsModule GhcPs)
hsmodule' <- DynFlags
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Located (HsModule GhcPs)
-> Hsc (Located (HsModule GhcPs))
transformPs DynFlags
dflags LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
tr Located (HsModule GhcPs)
hsmodule
    let pm' :: HsParsedModule
pm' = HsParsedModule
pm { hpm_module :: Located (HsModule GhcPs)
Plugins.hpm_module = Located (HsModule GhcPs)
hsmodule' }

    HsParsedModule -> Hsc HsParsedModule
forall (m :: * -> *) a. Monad m => a -> m a
return HsParsedModule
pm'

-------------------------------------------------------------------------------
-- Args parsing
-------------------------------------------------------------------------------

parseArgs :: forall m. MonadIO m => GHC.DynFlags -> [String] -> m Options
parseArgs :: DynFlags -> [CommandLineOption] -> m Options
parseArgs DynFlags
dflags = (Options -> CommandLineOption -> m Options)
-> Options -> [CommandLineOption] -> m Options
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Options -> CommandLineOption -> m Options
go0 Options
defaultOptions where
    ambWarn :: String -> String -> m ()
    ambWarn :: CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
x CommandLineOption
y = DynFlags -> SrcSpan -> SDoc -> m ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$
        CommandLineOption -> SDoc
GHC.text (CommandLineOption
"Overloaded:" CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
x CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
" and Overloaded:" CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
y CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
" enabled")
        SDoc -> SDoc -> SDoc
GHC.$$
        CommandLineOption -> SDoc
GHC.text (CommandLineOption
"picking Overloaded:" CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
y)

    go0 :: Options -> CommandLineOption -> m Options
go0 Options
opts CommandLineOption
arg = do
        (CommandLineOption
arg', [VarName]
vns) <- CommandLineOption -> m (CommandLineOption, [VarName])
elaborateArg CommandLineOption
arg
        Options -> CommandLineOption -> [VarName] -> m Options
go Options
opts CommandLineOption
arg' [VarName]
vns

    go :: Options -> CommandLineOption -> [VarName] -> m Options
go Options
opts CommandLineOption
"Strings" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isSym (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts)     (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Symbols" CommandLineOption
"Strings"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isCodeStr (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"CodeStrings" CommandLineOption
"Strings"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Strings" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optStrings :: StrSym
optStrings = Maybe VarName -> StrSym
Str Maybe VarName
mvn }

    go Options
opts CommandLineOption
"Symbols" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isStr (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts)     (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Strings" CommandLineOption
"Symbols"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isCodeStr (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"CodeStrings" CommandLineOption
"Symbols"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Symbols" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optStrings :: StrSym
optStrings = Maybe VarName -> StrSym
Sym Maybe VarName
mvn }

    go Options
opts CommandLineOption
"CodeStrings" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isStr (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Strings" CommandLineOption
"CodeStrings"
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrSym -> Bool
isSym (StrSym -> Bool) -> StrSym -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> StrSym
optStrings Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Symbols" CommandLineOption
"CodeStrings"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"CodeStrings" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optStrings :: StrSym
optStrings = Maybe VarName -> StrSym
CodeStr Maybe VarName
mvn }

    go Options
opts CommandLineOption
"Numerals" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NumNat -> Bool
isNat (NumNat -> Bool) -> NumNat -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> NumNat
optNumerals Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Naturals" CommandLineOption
"Numerals"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Numerals" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optNumerals :: NumNat
optNumerals = Maybe VarName -> NumNat
IsNum Maybe VarName
mvn }

    go Options
opts CommandLineOption
"Naturals" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NumNat -> Bool
isNum (NumNat -> Bool) -> NumNat -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> NumNat
optNumerals Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Numerals" CommandLineOption
"Naturals"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Naturals" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optNumerals :: NumNat
optNumerals = Maybe VarName -> NumNat
IsNat Maybe VarName
mvn }

    go Options
opts CommandLineOption
"Chars"    [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Chars" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optChars :: OnOff VarName
optChars = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mvn }
    go Options
opts CommandLineOption
"Lists"    [VarName]
vns = do
        Maybe (V2 VarName)
mvn <- CommandLineOption -> [VarName] -> m (Maybe (V2 VarName))
forall (m :: * -> *) a.
MonadIO m =>
CommandLineOption -> [a] -> m (Maybe (V2 a))
twoNames CommandLineOption
"Lists" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optLists :: OnOff (V2 VarName)
optLists = Maybe (V2 VarName) -> OnOff (V2 VarName)
forall a. Maybe a -> OnOff a
On Maybe (V2 VarName)
mvn }
    go Options
opts CommandLineOption
"If"       [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"If" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optIf :: OnOff VarName
optIf = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mvn }
    go Options
opts CommandLineOption
"Unit"       [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Unit" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optUnit :: OnOff VarName
optUnit = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mvn }
    go Options
opts CommandLineOption
"Labels"   [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LabelOpt -> Bool
isCodeLabel (LabelOpt -> Bool) -> LabelOpt -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> LabelOpt
optLabels Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"CodeLabels" CommandLineOption
"Labels"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Labels" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optLabels :: LabelOpt
optLabels = Maybe VarName -> LabelOpt
Label Maybe VarName
mvn }
    go Options
opts CommandLineOption
"CodeLabels" [VarName]
vns = do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LabelOpt -> Bool
isLabel (LabelOpt -> Bool) -> LabelOpt -> Bool
forall a b. (a -> b) -> a -> b
$ Options -> LabelOpt
optLabels Options
opts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> m ()
ambWarn CommandLineOption
"Labels" CommandLineOption
"CodeLabels"

        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"CodeLabels" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optLabels :: LabelOpt
optLabels = Maybe VarName -> LabelOpt
CodeLabel Maybe VarName
mvn }
    go Options
opts CommandLineOption
"TypeNats" [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"TypeNats" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optTypeNats :: OnOff VarName
optTypeNats = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mvn }
    go Options
opts CommandLineOption
"TypeSymbols" [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"TypeSymbols" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optTypeSymbols :: OnOff VarName
optTypeSymbols = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mvn }
    go Options
opts CommandLineOption
"RecordFields" [VarName]
_ =
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optRecordFields :: Bool
optRecordFields = Bool
True }
    go Options
opts CommandLineOption
"IdiomBrackets" [VarName]
_ =
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optIdiomBrackets :: Bool
optIdiomBrackets = Bool
True }
    go Options
opts CommandLineOption
"Do" [VarName]
_ =
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optDo :: Bool
optDo = Bool
True }
    go Options
opts CommandLineOption
"Categories" [VarName]
vns = do
        Maybe VarName
mvn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Categories" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optCategories :: OnOff CommandLineOption
optCategories = Maybe CommandLineOption -> OnOff CommandLineOption
forall a. Maybe a -> OnOff a
On (Maybe CommandLineOption -> OnOff CommandLineOption)
-> Maybe CommandLineOption -> OnOff CommandLineOption
forall a b. (a -> b) -> a -> b
$ (VarName -> CommandLineOption)
-> Maybe VarName -> Maybe CommandLineOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(VN CommandLineOption
x CommandLineOption
_) -> CommandLineOption
x) Maybe VarName
mvn }
    go Options
opts CommandLineOption
"RebindableApplication" [VarName]
vns = do
        Maybe VarName
mrn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"RebindableApplication" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optRebindApp :: OnOff VarName
optRebindApp = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mrn }
    go Options
opts CommandLineOption
"Constructors" [VarName]
vns = do
        Maybe VarName
mrn <- CommandLineOption -> [VarName] -> m (Maybe VarName)
forall a. CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
"Constructors" [VarName]
vns
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return (Options -> m Options) -> Options -> m Options
forall a b. (a -> b) -> a -> b
$ Options
opts { optConstructors :: OnOff VarName
optConstructors = Maybe VarName -> OnOff VarName
forall a. Maybe a -> OnOff a
On Maybe VarName
mrn }

    go Options
opts CommandLineOption
s [VarName]
_ = do
        DynFlags -> SrcSpan -> SDoc -> m ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> SDoc
GHC.text (CommandLineOption -> SDoc) -> CommandLineOption -> SDoc
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"Unknown Overloaded option " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++  CommandLineOption -> CommandLineOption
forall a. Show a => a -> CommandLineOption
show CommandLineOption
s
        Options -> m Options
forall (m :: * -> *) a. Monad m => a -> m a
return Options
opts

    oneName :: [Char] -> [a] -> m (Maybe a)
    oneName :: CommandLineOption -> [a] -> m (Maybe a)
oneName CommandLineOption
arg [a]
vns = case [a]
vns of
        []     -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        [a
vn]   -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
vn)
        (a
vn:[a]
_) -> do
            DynFlags -> SrcSpan -> SDoc -> m ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> SDoc
GHC.text (CommandLineOption -> SDoc) -> CommandLineOption -> SDoc
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"Multiple desugaring names specified for " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
arg
            Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
vn)

    twoNames :: CommandLineOption -> [a] -> m (Maybe (V2 a))
twoNames CommandLineOption
arg [a]
vns = case [a]
vns of
        []  -> Maybe (V2 a) -> m (Maybe (V2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (V2 a)
forall a. Maybe a
Nothing
        [a
_] -> do
            DynFlags -> SrcSpan -> SDoc -> m ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> SDoc
GHC.text (CommandLineOption -> SDoc) -> CommandLineOption -> SDoc
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"Only single desugaring name specified for " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
arg
            Maybe (V2 a) -> m (Maybe (V2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (V2 a)
forall a. Maybe a
Nothing
        [a
x,a
y]   -> Maybe (V2 a) -> m (Maybe (V2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (V2 a -> Maybe (V2 a)
forall a. a -> Maybe a
Just (a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y))
        (a
x:a
y:[a]
_) -> do
            DynFlags -> SrcSpan -> SDoc -> m ()
forall (m :: * -> *).
MonadIO m =>
DynFlags -> SrcSpan -> SDoc -> m ()
warn DynFlags
dflags SrcSpan
noSrcSpan (SDoc -> m ()) -> SDoc -> m ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> SDoc
GHC.text (CommandLineOption -> SDoc) -> CommandLineOption -> SDoc
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"Over two names specified for " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
arg
            Maybe (V2 a) -> m (Maybe (V2 a))
forall (m :: * -> *) a. Monad m => a -> m a
return (V2 a -> Maybe (V2 a)
forall a. a -> Maybe a
Just (a -> a -> V2 a
forall a. a -> a -> V2 a
V2 a
x a
y))

    elaborateArg :: String -> m (String, [VarName])
    elaborateArg :: CommandLineOption -> m (CommandLineOption, [VarName])
elaborateArg CommandLineOption
s = case CommandLineOption -> CommandLineOption -> [CommandLineOption]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn CommandLineOption
"=" CommandLineOption
s of
        []       -> (CommandLineOption, [VarName]) -> m (CommandLineOption, [VarName])
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandLineOption
"", [])
        (CommandLineOption
pfx:[CommandLineOption]
xs) -> do
            [Maybe VarName]
vns <- (CommandLineOption -> m (Maybe VarName))
-> [CommandLineOption] -> m [Maybe VarName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CommandLineOption -> m (Maybe VarName)
parseVarName [CommandLineOption]
xs
            (CommandLineOption, [VarName]) -> m (CommandLineOption, [VarName])
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandLineOption
pfx, [Maybe VarName] -> [VarName]
forall a. [Maybe a] -> [a]
catMaybes [Maybe VarName]
vns)

    parseVarName :: String -> m (Maybe VarName)
    parseVarName :: CommandLineOption -> m (Maybe VarName)
parseVarName CommandLineOption
"" = Maybe VarName -> m (Maybe VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VarName
forall a. Maybe a
Nothing
    parseVarName CommandLineOption
xs = do
        let ps :: [CommandLineOption]
ps = CommandLineOption -> CommandLineOption -> [CommandLineOption]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn CommandLineOption
"." CommandLineOption
xs
        Maybe VarName -> m (Maybe VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> Maybe VarName
forall a. a -> Maybe a
Just (CommandLineOption -> CommandLineOption -> VarName
VN (CommandLineOption -> [CommandLineOption] -> CommandLineOption
forall a. [a] -> [[a]] -> [a]
intercalate CommandLineOption
"." ([CommandLineOption] -> CommandLineOption)
-> [CommandLineOption] -> CommandLineOption
forall a b. (a -> b) -> a -> b
$ [CommandLineOption] -> [CommandLineOption]
forall a. [a] -> [a]
init [CommandLineOption]
ps) ([CommandLineOption] -> CommandLineOption
forall a. [a] -> a
last [CommandLineOption]
ps)))

data Options = Options
    { Options -> StrSym
optStrings       :: StrSym
    , Options -> NumNat
optNumerals      :: NumNat
    , Options -> OnOff VarName
optChars         :: OnOff VarName
    , Options -> OnOff (V2 VarName)
optLists         :: OnOff (V2 VarName)
    , Options -> OnOff VarName
optIf            :: OnOff VarName
    , Options -> LabelOpt
optLabels        :: LabelOpt
    , Options -> OnOff VarName
optUnit          :: OnOff VarName
    , Options -> OnOff VarName
optTypeNats      :: OnOff VarName
    , Options -> OnOff VarName
optTypeSymbols   :: OnOff VarName
    , Options -> Bool
optRecordFields  :: Bool
    , Options -> Bool
optIdiomBrackets :: Bool
    , Options -> Bool
optDo            :: Bool
    , Options -> OnOff CommandLineOption
optCategories    :: OnOff String -- module name
    , Options -> OnOff VarName
optRebindApp     :: OnOff VarName
    , Options -> OnOff VarName
optConstructors  :: OnOff VarName
    }
  deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> CommandLineOption -> CommandLineOption
[Options] -> CommandLineOption -> CommandLineOption
Options -> CommandLineOption
(Int -> Options -> CommandLineOption -> CommandLineOption)
-> (Options -> CommandLineOption)
-> ([Options] -> CommandLineOption -> CommandLineOption)
-> Show Options
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [Options] -> CommandLineOption -> CommandLineOption
$cshowList :: [Options] -> CommandLineOption -> CommandLineOption
show :: Options -> CommandLineOption
$cshow :: Options -> CommandLineOption
showsPrec :: Int -> Options -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> Options -> CommandLineOption -> CommandLineOption
Show)

defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: StrSym
-> NumNat
-> OnOff VarName
-> OnOff (V2 VarName)
-> OnOff VarName
-> LabelOpt
-> OnOff VarName
-> OnOff VarName
-> OnOff VarName
-> Bool
-> Bool
-> Bool
-> OnOff CommandLineOption
-> OnOff VarName
-> OnOff VarName
-> Options
Options
    { optStrings :: StrSym
optStrings       = StrSym
NoStr
    , optNumerals :: NumNat
optNumerals      = NumNat
NoNum
    , optChars :: OnOff VarName
optChars         = OnOff VarName
forall a. OnOff a
Off
    , optLists :: OnOff (V2 VarName)
optLists         = OnOff (V2 VarName)
forall a. OnOff a
Off
    , optIf :: OnOff VarName
optIf            = OnOff VarName
forall a. OnOff a
Off
    , optLabels :: LabelOpt
optLabels        = LabelOpt
NoLabel
    , optTypeNats :: OnOff VarName
optTypeNats      = OnOff VarName
forall a. OnOff a
Off
    , optTypeSymbols :: OnOff VarName
optTypeSymbols   = OnOff VarName
forall a. OnOff a
Off
    , optUnit :: OnOff VarName
optUnit          = OnOff VarName
forall a. OnOff a
Off
    , optRecordFields :: Bool
optRecordFields  = Bool
False
    , optIdiomBrackets :: Bool
optIdiomBrackets = Bool
False
    , optDo :: Bool
optDo            = Bool
False
    , optCategories :: OnOff CommandLineOption
optCategories    = OnOff CommandLineOption
forall a. OnOff a
Off
    , optRebindApp :: OnOff VarName
optRebindApp     = OnOff VarName
forall a. OnOff a
Off
    , optConstructors :: OnOff VarName
optConstructors  = OnOff VarName
forall a. OnOff a
Off
    }

data StrSym
    = NoStr
    | Str (Maybe VarName)
    | Sym (Maybe VarName)
    | CodeStr (Maybe VarName)
  deriving (StrSym -> StrSym -> Bool
(StrSym -> StrSym -> Bool)
-> (StrSym -> StrSym -> Bool) -> Eq StrSym
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StrSym -> StrSym -> Bool
$c/= :: StrSym -> StrSym -> Bool
== :: StrSym -> StrSym -> Bool
$c== :: StrSym -> StrSym -> Bool
Eq, Int -> StrSym -> CommandLineOption -> CommandLineOption
[StrSym] -> CommandLineOption -> CommandLineOption
StrSym -> CommandLineOption
(Int -> StrSym -> CommandLineOption -> CommandLineOption)
-> (StrSym -> CommandLineOption)
-> ([StrSym] -> CommandLineOption -> CommandLineOption)
-> Show StrSym
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [StrSym] -> CommandLineOption -> CommandLineOption
$cshowList :: [StrSym] -> CommandLineOption -> CommandLineOption
show :: StrSym -> CommandLineOption
$cshow :: StrSym -> CommandLineOption
showsPrec :: Int -> StrSym -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> StrSym -> CommandLineOption -> CommandLineOption
Show)

isSym :: StrSym -> Bool
isSym :: StrSym -> Bool
isSym (Sym Maybe VarName
_) = Bool
True
isSym StrSym
_       = Bool
False

isStr :: StrSym -> Bool
isStr :: StrSym -> Bool
isStr (Str Maybe VarName
_) = Bool
True
isStr StrSym
_       = Bool
False

isCodeStr :: StrSym -> Bool
isCodeStr :: StrSym -> Bool
isCodeStr (CodeStr Maybe VarName
_) = Bool
True
isCodeStr StrSym
_           = Bool
False

data NumNat
    = NoNum
    | IsNum (Maybe VarName)
    | IsNat (Maybe VarName)
  deriving (NumNat -> NumNat -> Bool
(NumNat -> NumNat -> Bool)
-> (NumNat -> NumNat -> Bool) -> Eq NumNat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumNat -> NumNat -> Bool
$c/= :: NumNat -> NumNat -> Bool
== :: NumNat -> NumNat -> Bool
$c== :: NumNat -> NumNat -> Bool
Eq, Int -> NumNat -> CommandLineOption -> CommandLineOption
[NumNat] -> CommandLineOption -> CommandLineOption
NumNat -> CommandLineOption
(Int -> NumNat -> CommandLineOption -> CommandLineOption)
-> (NumNat -> CommandLineOption)
-> ([NumNat] -> CommandLineOption -> CommandLineOption)
-> Show NumNat
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [NumNat] -> CommandLineOption -> CommandLineOption
$cshowList :: [NumNat] -> CommandLineOption -> CommandLineOption
show :: NumNat -> CommandLineOption
$cshow :: NumNat -> CommandLineOption
showsPrec :: Int -> NumNat -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> NumNat -> CommandLineOption -> CommandLineOption
Show)

isNum :: NumNat -> Bool
isNum :: NumNat -> Bool
isNum (IsNum Maybe VarName
_) = Bool
True
isNum NumNat
_         = Bool
False

isNat :: NumNat -> Bool
isNat :: NumNat -> Bool
isNat (IsNat Maybe VarName
_) = Bool
True
isNat NumNat
_         = Bool
False

data LabelOpt
    = NoLabel
    | Label (Maybe VarName)
    | CodeLabel (Maybe VarName)
  deriving (LabelOpt -> LabelOpt -> Bool
(LabelOpt -> LabelOpt -> Bool)
-> (LabelOpt -> LabelOpt -> Bool) -> Eq LabelOpt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LabelOpt -> LabelOpt -> Bool
$c/= :: LabelOpt -> LabelOpt -> Bool
== :: LabelOpt -> LabelOpt -> Bool
$c== :: LabelOpt -> LabelOpt -> Bool
Eq, Int -> LabelOpt -> CommandLineOption -> CommandLineOption
[LabelOpt] -> CommandLineOption -> CommandLineOption
LabelOpt -> CommandLineOption
(Int -> LabelOpt -> CommandLineOption -> CommandLineOption)
-> (LabelOpt -> CommandLineOption)
-> ([LabelOpt] -> CommandLineOption -> CommandLineOption)
-> Show LabelOpt
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [LabelOpt] -> CommandLineOption -> CommandLineOption
$cshowList :: [LabelOpt] -> CommandLineOption -> CommandLineOption
show :: LabelOpt -> CommandLineOption
$cshow :: LabelOpt -> CommandLineOption
showsPrec :: Int -> LabelOpt -> CommandLineOption -> CommandLineOption
$cshowsPrec :: Int -> LabelOpt -> CommandLineOption -> CommandLineOption
Show)

isLabel :: LabelOpt -> Bool
isLabel :: LabelOpt -> Bool
isLabel (Label Maybe VarName
_) = Bool
True
isLabel LabelOpt
_         = Bool
False

isCodeLabel :: LabelOpt -> Bool
isCodeLabel :: LabelOpt -> Bool
isCodeLabel (CodeLabel Maybe VarName
_) = Bool
True
isCodeLabel LabelOpt
_             = Bool
False

data OnOff a
    = Off
    | On (Maybe a)
  deriving (OnOff a -> OnOff a -> Bool
(OnOff a -> OnOff a -> Bool)
-> (OnOff a -> OnOff a -> Bool) -> Eq (OnOff a)
forall a. Eq a => OnOff a -> OnOff a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnOff a -> OnOff a -> Bool
$c/= :: forall a. Eq a => OnOff a -> OnOff a -> Bool
== :: OnOff a -> OnOff a -> Bool
$c== :: forall a. Eq a => OnOff a -> OnOff a -> Bool
Eq, Int -> OnOff a -> CommandLineOption -> CommandLineOption
[OnOff a] -> CommandLineOption -> CommandLineOption
OnOff a -> CommandLineOption
(Int -> OnOff a -> CommandLineOption -> CommandLineOption)
-> (OnOff a -> CommandLineOption)
-> ([OnOff a] -> CommandLineOption -> CommandLineOption)
-> Show (OnOff a)
forall a.
Show a =>
Int -> OnOff a -> CommandLineOption -> CommandLineOption
forall a.
Show a =>
[OnOff a] -> CommandLineOption -> CommandLineOption
forall a. Show a => OnOff a -> CommandLineOption
forall a.
(Int -> a -> CommandLineOption -> CommandLineOption)
-> (a -> CommandLineOption)
-> ([a] -> CommandLineOption -> CommandLineOption)
-> Show a
showList :: [OnOff a] -> CommandLineOption -> CommandLineOption
$cshowList :: forall a.
Show a =>
[OnOff a] -> CommandLineOption -> CommandLineOption
show :: OnOff a -> CommandLineOption
$cshow :: forall a. Show a => OnOff a -> CommandLineOption
showsPrec :: Int -> OnOff a -> CommandLineOption -> CommandLineOption
$cshowsPrec :: forall a.
Show a =>
Int -> OnOff a -> CommandLineOption -> CommandLineOption
Show)

-------------------------------------------------------------------------------
-- OverloadedStrings
-------------------------------------------------------------------------------

transformStrings :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformStrings :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformStrings Names {Name
CatNames
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsExpr GhcRn
e@(L SrcSpan
l (HsLit XLitE GhcRn
_ (HsString XHsString GhcRn
_ FastString
_fs))) =
    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromStringName) [LHsExpr GhcRn
e]

transformStrings Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedSymbols
-------------------------------------------------------------------------------

transformSymbols :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformSymbols :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformSymbols Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsLit XLitE GhcRn
_ (HsString XHsString GhcRn
_ FastString
fs))) = do
    let name' :: LHsExpr GhcRn
name' = SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromSymbolName
    let inner :: LHsExpr GhcRn
inner = SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
hsTyApp SrcSpan
l LHsExpr GhcRn
name' (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit NoExtField
XTyLit GhcRn
noExtField (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
GHC.NoSourceText FastString
fs))
    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite LHsExpr GhcRn
inner

transformSymbols Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedCodeStrings
-------------------------------------------------------------------------------

transformCodeStrings :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeStrings :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeStrings Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsExpr GhcRn
e@(L SrcSpan
l (HsLit XLitE GhcRn
_ (HsString XHsString GhcRn
_ FastString
_fs))) = do
    let inner :: LHsExpr GhcRn
inner = SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
codeFromStringName) [LHsExpr GhcRn
e]
    (Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn)
forall a. (Name -> Rewrite a) -> Rewrite a
WithName ((Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn))
-> (Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ \Name
n -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XSpliceE GhcRn -> HsSplice GhcRn -> HsExpr GhcRn
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE NoExtField
XSpliceE GhcRn
noExtField (HsSplice GhcRn -> HsExpr GhcRn) -> HsSplice GhcRn -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XTypedSplice GhcRn
-> SpliceDecoration -> IdP GhcRn -> LHsExpr GhcRn -> HsSplice GhcRn
forall id.
XTypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsTypedSplice NoExtField
XTypedSplice GhcRn
noExtField SpliceDecoration
hasParens IdP GhcRn
Name
n LHsExpr GhcRn
inner

transformCodeStrings Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedNumerals
-------------------------------------------------------------------------------

transformNumerals :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNumerals :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNumerals Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsOverLit XOverLitE GhcRn
_ (OverLit XOverLit GhcRn
_ (HsIntegral (GHC.IL SourceText
_ Bool
n Integer
i)) HsExpr GhcRn
_)))
    | Bool -> Bool
not Bool
n, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = do
        let name' :: LHsExpr GhcRn
name' = SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromNumeralName
        let inner :: LHsExpr GhcRn
inner = SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
hsTyApp SrcSpan
l LHsExpr GhcRn
name' (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit NoExtField
XTyLit GhcRn
noExtField (SourceText -> Integer -> HsTyLit
HsNumTy SourceText
GHC.NoSourceText Integer
i))
        LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite LHsExpr GhcRn
inner

transformNumerals Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedNaturals
-------------------------------------------------------------------------------

transformNaturals :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNaturals :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformNaturals Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsExpr GhcRn
e@(L SrcSpan
l (HsOverLit XOverLitE GhcRn
_ (OverLit XOverLit GhcRn
_ (HsIntegral (GHC.IL SourceText
_ Bool
n Integer
i)) HsExpr GhcRn
_)))
    | Bool -> Bool
not Bool
n
    , Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0
    = LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromNaturalName) [LHsExpr GhcRn
e]

transformNaturals Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedChars
-------------------------------------------------------------------------------

transformChars :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformChars :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformChars Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsExpr GhcRn
e@(L SrcSpan
l (HsLit XLitE GhcRn
_ (HsChar XHsChar GhcRn
_ Char
_))) =
    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromCharName) [LHsExpr GhcRn
e]

transformChars Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedLists
-------------------------------------------------------------------------------

transformLists :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLists :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLists Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (ExplicitList XExplicitList GhcRn
_ Maybe (SyntaxExpr GhcRn)
Nothing [LHsExpr GhcRn]
xs)) =
    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn)
-> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
cons' LHsExpr GhcRn
nil' [LHsExpr GhcRn]
xs
  where
    cons' :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
    cons' :: LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
cons' LHsExpr GhcRn
y LHsExpr GhcRn
ys = SrcSpan -> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
hsApps SrcSpan
l (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
consName) [LHsExpr GhcRn
y, LHsExpr GhcRn
ys]

    nil' :: LHsExpr GhcRn
    nil' :: LHsExpr GhcRn
nil' = SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
nilName

    -- otherwise: leave intact
transformLists Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedIf
-------------------------------------------------------------------------------

transformIf :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
#if MIN_VERSION_ghc(9,0,0)
transformIf Names {..} (L l (HsIf _ co th el)) = Rewrite val4 where
#else
transformIf :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformIf Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsIf XIf GhcRn
_ Maybe (SyntaxExpr GhcRn)
_ LHsExpr GhcRn
co LHsExpr GhcRn
th LHsExpr GhcRn
el)) = LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite LHsExpr GhcRn
val4 where
#endif
    val4 :: LHsExpr GhcRn
val4 = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcRn
noExtField LHsExpr GhcRn
val3 LHsExpr GhcRn
el
    val3 :: LHsExpr GhcRn
val3 = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcRn
noExtField LHsExpr GhcRn
val2 LHsExpr GhcRn
th
    val2 :: LHsExpr GhcRn
val2 = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcRn
noExtField LHsExpr GhcRn
val1 LHsExpr GhcRn
co
    val1 :: LHsExpr GhcRn
val1 = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Located (IdP GhcRn) -> HsExpr GhcRn)
-> Located (IdP GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
ifteName
transformIf Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedLabels
-------------------------------------------------------------------------------

transformLabels :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLabels :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformLabels Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsOverLabel XOverLabel GhcRn
_ Maybe (IdP GhcRn)
Nothing FastString
fs)) = do
    let name' :: LHsExpr GhcRn
name' = SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
fromLabelName
    let inner :: LHsExpr GhcRn
inner = SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
hsTyApp SrcSpan
l LHsExpr GhcRn
name' (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit NoExtField
XTyLit GhcRn
noExtField (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
GHC.NoSourceText FastString
fs))
    LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite LHsExpr GhcRn
inner

transformLabels Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedCodeLabels
-------------------------------------------------------------------------------

hasParens :: SpliceDecoration
#if MIN_VERSION_ghc(9,0,0)
hasParens = DollarSplice
#else
hasParens :: SpliceDecoration
hasParens = SpliceDecoration
HasParens
#endif

transformCodeLabels :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeLabels :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformCodeLabels Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsOverLabel XOverLabel GhcRn
_ Maybe (IdP GhcRn)
Nothing FastString
fs)) = do
    let name' :: LHsExpr GhcRn
name' = SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
codeFromLabelName
    let inner :: LHsExpr GhcRn
inner = SrcSpan -> LHsExpr GhcRn -> HsType GhcRn -> LHsExpr GhcRn
hsTyApp SrcSpan
l LHsExpr GhcRn
name' (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit NoExtField
XTyLit GhcRn
noExtField (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
GHC.NoSourceText FastString
fs))
    -- Rewrite $ L l $ HsRnBracketOut noExtField (ExpBr noExtField inner) []
    (Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn)
forall a. (Name -> Rewrite a) -> Rewrite a
WithName ((Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn))
-> (Name -> Rewrite (LHsExpr GhcRn)) -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ \Name
n -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcRn -> LHsExpr GhcRn) -> HsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XSpliceE GhcRn -> HsSplice GhcRn -> HsExpr GhcRn
forall p. XSpliceE p -> HsSplice p -> HsExpr p
HsSpliceE NoExtField
XSpliceE GhcRn
noExtField (HsSplice GhcRn -> HsExpr GhcRn) -> HsSplice GhcRn -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ XTypedSplice GhcRn
-> SpliceDecoration -> IdP GhcRn -> LHsExpr GhcRn -> HsSplice GhcRn
forall id.
XTypedSplice id
-> SpliceDecoration -> IdP id -> LHsExpr id -> HsSplice id
HsTypedSplice NoExtField
XTypedSplice GhcRn
noExtField SpliceDecoration
hasParens IdP GhcRn
Name
n LHsExpr GhcRn
inner

transformCodeLabels Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedUnit
-------------------------------------------------------------------------------

transformUnit :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformUnit :: Names -> LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
transformUnit Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} (L SrcSpan
l (HsVar XVar GhcRn
_ (L SrcSpan
_ IdP GhcRn
name')))
    | IdP GhcRn
Name
name' Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
ghcUnitName = LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
forall a. a -> Rewrite a
Rewrite (SrcSpan -> Name -> LHsExpr GhcRn
hsVar SrcSpan
l Name
unitName)
  where
    ghcUnitName :: Name
ghcUnitName = DataCon -> Name
forall a. NamedThing a => a -> Name
GHC.getName (Boxity -> Int -> DataCon
GHC.tupleDataCon Boxity
GHC.Boxed Int
0)

transformUnit Names
_ LHsExpr GhcRn
_ = Rewrite (LHsExpr GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedTypeNats
-------------------------------------------------------------------------------

transformTypeNats :: Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeNats :: Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeNats Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsType GhcRn
e@(L SrcSpan
l (HsTyLit XTyLit GhcRn
_ (HsNumTy SourceText
_ Integer
_))) = do
    let name' :: LHsType GhcRn
name' = SrcSpan -> HsType GhcRn -> LHsType GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcRn -> LHsType GhcRn) -> HsType GhcRn -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted (Located (IdP GhcRn) -> HsType GhcRn)
-> Located (IdP GhcRn) -> HsType GhcRn
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
fromTypeNatName
    LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcRn -> LHsType GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcRn -> LHsType GhcRn) -> HsType GhcRn -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XAppTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy GhcRn
noExtField LHsType GhcRn
name' LHsType GhcRn
e
transformTypeNats Names
_ LHsType GhcRn
_ = Rewrite (LHsType GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- OverloadedTypeSymbols
-------------------------------------------------------------------------------

transformTypeSymbols :: Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeSymbols :: Names -> LHsType GhcRn -> Rewrite (LHsType GhcRn)
transformTypeSymbols Names {Name
CatNames
catNames :: CatNames
codeFromStringName :: Name
codeFromLabelName :: Name
conRightName :: Name
conLeftName :: Name
doBindName :: Name
doThenName :: Name
doPureName :: Name
composeName :: Name
voidName :: Name
birdName :: Name
apName :: Name
pureName :: Name
fmapName :: Name
fromTypeSymbolName :: Name
fromTypeNatName :: Name
fromLabelName :: Name
unitName :: Name
ifteName :: Name
consName :: Name
nilName :: Name
fromCharName :: Name
fromNaturalName :: Name
fromNumeralName :: Name
fromSymbolName :: Name
fromStringName :: Name
conRightName :: Names -> Name
conLeftName :: Names -> Name
doBindName :: Names -> Name
doThenName :: Names -> Name
doPureName :: Names -> Name
composeName :: Names -> Name
voidName :: Names -> Name
birdName :: Names -> Name
apName :: Names -> Name
pureName :: Names -> Name
fmapName :: Names -> Name
fromTypeSymbolName :: Names -> Name
fromTypeNatName :: Names -> Name
unitName :: Names -> Name
catNames :: Names -> CatNames
codeFromLabelName :: Names -> Name
fromLabelName :: Names -> Name
ifteName :: Names -> Name
consName :: Names -> Name
nilName :: Names -> Name
fromCharName :: Names -> Name
fromNaturalName :: Names -> Name
fromNumeralName :: Names -> Name
codeFromStringName :: Names -> Name
fromSymbolName :: Names -> Name
fromStringName :: Names -> Name
..} e :: LHsType GhcRn
e@(L SrcSpan
l (HsTyLit XTyLit GhcRn
_ (HsStrTy SourceText
_ FastString
_))) = do
    let name' :: LHsType GhcRn
name' = SrcSpan -> HsType GhcRn -> LHsType GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcRn -> LHsType GhcRn) -> HsType GhcRn -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted (Located (IdP GhcRn) -> HsType GhcRn)
-> Located (IdP GhcRn) -> HsType GhcRn
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Name -> GenLocated SrcSpan Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
fromTypeSymbolName
    LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a. a -> Rewrite a
Rewrite (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> LHsType GhcRn -> Rewrite (LHsType GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsType GhcRn -> LHsType GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsType GhcRn -> LHsType GhcRn) -> HsType GhcRn -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XAppTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy GhcRn
noExtField LHsType GhcRn
name' LHsType GhcRn
e
transformTypeSymbols Names
_ LHsType GhcRn
_ = Rewrite (LHsType GhcRn)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- RebindableApplication
-------------------------------------------------------------------------------

transformRebindableApplication :: RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformRebindableApplication :: RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformRebindableApplication RdrNames {RdrName
buildName :: RdrName
dollarName :: RdrName
buildName :: RdrNames -> RdrName
dollarName :: RdrNames -> RdrName
..} (L SrcSpan
l (HsApp XApp GhcPs
_ f :: LHsExpr GhcPs
f@(L SrcSpan
fl HsExpr GhcPs
_) x :: LHsExpr GhcPs
x@(L SrcSpan
xl HsExpr GhcPs
_)))
    = LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a. a -> Rewrite a
Rewrite
    (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XPar GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar NoExtField
XPar GhcPs
noExtField
    (LHsExpr GhcPs -> HsExpr GhcPs) -> LHsExpr GhcPs -> HsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (HsExpr GhcPs -> LHsExpr GhcPs) -> HsExpr GhcPs -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XOpApp GhcPs
-> LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs
forall p.
XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
OpApp NoExtField
XOpApp GhcPs
noExtField LHsExpr GhcPs
f (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' (XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField (SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' RdrName
dollarName))) LHsExpr GhcPs
x
  where
    l' :: SrcSpan
l' = SrcLoc -> SrcLoc -> SrcSpan
GHC.mkSrcSpan (SrcSpan -> SrcLoc
GHC.srcSpanEnd SrcSpan
fl) (SrcSpan -> SrcLoc
GHC.srcSpanStart SrcSpan
xl)
transformRebindableApplication RdrNames
_ LHsExpr GhcPs
_ = Rewrite (LHsExpr GhcPs)
forall a. Rewrite a
NoRewrite

-------------------------------------------------------------------------------
-- Constructors
-------------------------------------------------------------------------------

transformConstructors :: RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformConstructors :: RdrNames -> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
transformConstructors RdrNames {RdrName
buildName :: RdrName
dollarName :: RdrName
buildName :: RdrNames -> RdrName
dollarName :: RdrNames -> RdrName
..} (L SrcSpan
l (SectionR XSectionR GhcPs
_ (L SrcSpan
lop (HsVar XVar GhcPs
_ (L SrcSpan
_ IdP GhcPs
op))) LHsExpr GhcPs
arg))
    | IdP GhcPs
RdrName
op RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
GHC.consDataCon_RDR
    , (L SrcSpan
_ (HsVar XVar GhcPs
_ (L SrcSpan
_ln IdP GhcPs
n)), [LHsExpr GhcPs]
xs) <- LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
splitHsApps LHsExpr GhcPs
arg
    = LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a. a -> Rewrite a
Rewrite (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ RdrName -> [LHsExpr GhcPs] -> LHsExpr GhcPs
expr IdP GhcPs
RdrName
n [LHsExpr GhcPs]
xs
  where
    expr :: RdrName -> [LHsExpr GhcPs] -> LHsExpr GhcPs
expr RdrName
n [LHsExpr GhcPs]
args = SrcSpan -> LHsExpr GhcPs -> [LHsExpr GhcPs] -> LHsExpr GhcPs
hsApps_RDR SrcSpan
l
        (SrcSpan -> LHsExpr GhcPs -> HsType GhcPs -> LHsExpr GhcPs
hsTyApp_RDR SrcSpan
l
            (SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
lop (XVar GhcPs -> Located (IdP GhcPs) -> HsExpr GhcPs
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar NoExtField
XVar GhcPs
noExtField (SrcSpan -> RdrName -> GenLocated SrcSpan RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
lop RdrName
buildName)))
            (XTyLit GhcPs -> HsTyLit -> HsType GhcPs
forall pass. XTyLit pass -> HsTyLit -> HsType pass
HsTyLit NoExtField
XTyLit GhcPs
noExtField (SourceText -> FastString -> HsTyLit
HsStrTy SourceText
GHC.NoSourceText (OccName -> FastString
Plugins.occNameFS (RdrName -> OccName
GHC.rdrNameOcc RdrName
n)))))
        [ LHsExpr GhcPs
args' ]
      where
        args' :: LHsExpr GhcPs
args' = case [LHsExpr GhcPs]
args of
            [x] -> LHsExpr GhcPs
x
            [LHsExpr GhcPs]
_   -> SrcSpan -> HsExpr GhcPs -> LHsExpr GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XExplicitTuple GhcPs -> [LHsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple NoExtField
XExplicitTuple GhcPs
noExtField [ SrcSpan -> HsTupArg GhcPs -> LHsTupArg GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l' (XPresent GhcPs -> LHsExpr GhcPs -> HsTupArg GhcPs
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present NoExtField
XPresent GhcPs
noExtField LHsExpr GhcPs
x) | x :: LHsExpr GhcPs
x@(L SrcSpan
l' HsExpr GhcPs
_) <- [LHsExpr GhcPs]
args ] Boxity
Plugins.Boxed)

transformConstructors RdrNames
_ LHsExpr GhcPs
_ = Rewrite (LHsExpr GhcPs)
forall a. Rewrite a
NoRewrite

splitHsApps :: LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
splitHsApps :: LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
splitHsApps LHsExpr GhcPs
e = LHsExpr GhcPs
-> [LHsExpr GhcPs] -> (LHsExpr GhcPs, [LHsExpr GhcPs])
go LHsExpr GhcPs
e []
  where
    go :: LHsExpr GhcPs -> [LHsExpr GhcPs]
       -> (LHsExpr GhcPs, [LHsExpr GhcPs])
    go :: LHsExpr GhcPs
-> [LHsExpr GhcPs] -> (LHsExpr GhcPs, [LHsExpr GhcPs])
go (L SrcSpan
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
x))      [LHsExpr GhcPs]
xs = LHsExpr GhcPs
-> [LHsExpr GhcPs] -> (LHsExpr GhcPs, [LHsExpr GhcPs])
go LHsExpr GhcPs
f (LHsExpr GhcPs
x LHsExpr GhcPs -> [LHsExpr GhcPs] -> [LHsExpr GhcPs]
forall a. a -> [a] -> [a]
: [LHsExpr GhcPs]
xs)
    go LHsExpr GhcPs
f                        [LHsExpr GhcPs]
xs = (LHsExpr GhcPs
f, [LHsExpr GhcPs]
xs)



-------------------------------------------------------------------------------
-- Transform
-------------------------------------------------------------------------------

transformRn
    :: GHC.DynFlags
    -> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
    -> HsGroup GhcRn
    -> GHC.TcM (HsGroup GhcRn)
transformRn :: DynFlags
-> (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn))
-> HsGroup GhcRn
-> TcM (HsGroup GhcRn)
transformRn DynFlags
dflags LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
f = GenericM (IOEnv (Env TcGblEnv TcLclEnv))
-> GenericM (IOEnv (Env TcGblEnv TcLclEnv))
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
SYB.everywhereM ((LHsExpr GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn))
-> a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
SYB.mkM LHsExpr GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
transform') where
    transform' :: LHsExpr GhcRn -> GHC.TcM (LHsExpr GhcRn)
    transform' :: LHsExpr GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
transform' e :: LHsExpr GhcRn
e@(L SrcSpan
l HsExpr GhcRn
_) = do
        -- liftIO $ GHC.putLogMsg _dflags GHC.NoReason GHC.SevWarning _l (GHC.defaultErrStyle _dflags) $
        --     GHC.text "Expr" GHC.<+> GHC.ppr e GHC.<+> GHC.text (SYB.gshow e)
        Rewrite (LHsExpr GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
go (LHsExpr GhcRn -> Rewrite (LHsExpr GhcRn)
f LHsExpr GhcRn
e)
      where
        go :: Rewrite (LHsExpr GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
go Rewrite (LHsExpr GhcRn)
NoRewrite    = LHsExpr GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn
e
        go (Rewrite LHsExpr GhcRn
e') = LHsExpr GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcRn
e'
        go (Error DynFlags -> IO ()
err)  = do
            IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> IO ()
err DynFlags
dflags
            CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
forall (m :: * -> *) a. MonadFail m => CommandLineOption -> m a
fail CommandLineOption
"Error in Overloaded plugin"
        go (WithName Name -> Rewrite (LHsExpr GhcRn)
kont) = do
            Name
n <- OccName -> SrcSpan -> TcM Name
GHC.newNameAt (CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"olSplice") SrcSpan
l
            Rewrite (LHsExpr GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsExpr GhcRn)
go (Name -> Rewrite (LHsExpr GhcRn)
kont Name
n)

transformPs
    :: GHC.DynFlags
    -> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
#if MIN_VERSION_ghc(9,0,0)
    -> Located HsModule
    -> Plugins.Hsc (Located HsModule)
#else
    -> Located (HsModule GhcPs)
    -> Plugins.Hsc (Located (HsModule GhcPs))
#endif
transformPs :: DynFlags
-> (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs))
-> Located (HsModule GhcPs)
-> Hsc (Located (HsModule GhcPs))
transformPs DynFlags
dflags LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
f = GenericM Hsc -> GenericM Hsc
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
SYB.everywhereM ((LHsExpr GhcPs -> Hsc (LHsExpr GhcPs)) -> a -> Hsc a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
SYB.mkM LHsExpr GhcPs -> Hsc (LHsExpr GhcPs)
transform') where
    transform' :: LHsExpr GhcPs -> Plugins.Hsc (LHsExpr GhcPs)
    transform' :: LHsExpr GhcPs -> Hsc (LHsExpr GhcPs)
transform' e :: LHsExpr GhcPs
e@(L SrcSpan
_l HsExpr GhcPs
_) = do
        -- liftIO $ GHC.putLogMsg _dflags GHC.NoReason GHC.SevWarning _l (GHC.defaultErrStyle _dflags) $
        --     GHC.text "Expr" GHC.<+> GHC.ppr e GHC.<+> GHC.text (SYB.gshow e)
        Rewrite (LHsExpr GhcPs) -> Hsc (LHsExpr GhcPs)
forall (m :: * -> *).
MonadIO m =>
Rewrite (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
go (LHsExpr GhcPs -> Rewrite (LHsExpr GhcPs)
f LHsExpr GhcPs
e)
      where
        go :: Rewrite (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
go Rewrite (LHsExpr GhcPs)
NoRewrite    = LHsExpr GhcPs -> m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e
        go (Rewrite LHsExpr GhcPs
e') = LHsExpr GhcPs -> m (LHsExpr GhcPs)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsExpr GhcPs
e'
        go (Error DynFlags -> IO ()
err)  = do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> IO ()
err DynFlags
dflags
            -- Hsc doesn't have MonadFail instance
            IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs))
-> IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ IOError -> IO (LHsExpr GhcPs)
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO (LHsExpr GhcPs)) -> IOError -> IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> IOError
userError CommandLineOption
"Error in Overloaded plugin"
        go (WithName Name -> Rewrite (LHsExpr GhcPs)
_kont) = do
            IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs))
-> IO (LHsExpr GhcPs) -> m (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ IOError -> IO (LHsExpr GhcPs)
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO (LHsExpr GhcPs)) -> IOError -> IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> IOError
userError CommandLineOption
"Error in Overloaded plugin: WithName in Ps transform"

transformType
    :: GHC.DynFlags
    -> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
    -> HsGroup GhcRn
    -> GHC.TcM (HsGroup GhcRn)
transformType :: DynFlags
-> (LHsType GhcRn -> Rewrite (LHsType GhcRn))
-> HsGroup GhcRn
-> TcM (HsGroup GhcRn)
transformType DynFlags
dflags LHsType GhcRn -> Rewrite (LHsType GhcRn)
f = GenericM (IOEnv (Env TcGblEnv TcLclEnv))
-> GenericM (IOEnv (Env TcGblEnv TcLclEnv))
forall (m :: * -> *). Monad m => GenericM m -> GenericM m
SYB.everywhereM ((LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn))
-> a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a b.
(Monad m, Typeable a, Typeable b) =>
(b -> m b) -> a -> m a
SYB.mkM LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
transform') where
    transform' :: LHsType GhcRn -> GHC.TcM (LHsType GhcRn)
    transform' :: LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
transform' e :: LHsType GhcRn
e@(L SrcSpan
l HsType GhcRn
_) = Rewrite (LHsType GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
go (LHsType GhcRn -> Rewrite (LHsType GhcRn)
f LHsType GhcRn
e)
      where
        go :: Rewrite (LHsType GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
go Rewrite (LHsType GhcRn)
NoRewrite    = LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcRn
e
        go (Rewrite LHsType GhcRn
e') = LHsType GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
forall (m :: * -> *) a. Monad m => a -> m a
return LHsType GhcRn
e'
        go (Error DynFlags -> IO ()
err)  = do
            IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> IO ()
err DynFlags
dflags
            CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
forall (m :: * -> *) a. MonadFail m => CommandLineOption -> m a
fail CommandLineOption
"Error in Overloaded plugin"
        go (WithName Name -> Rewrite (LHsType GhcRn)
kont) = do
            Name
n <- OccName -> SrcSpan -> TcM Name
GHC.newNameAt (CommandLineOption -> OccName
GHC.mkVarOcc CommandLineOption
"olSplice") SrcSpan
l
            Rewrite (LHsType GhcRn)
-> IOEnv (Env TcGblEnv TcLclEnv) (LHsType GhcRn)
go (Name -> Rewrite (LHsType GhcRn)
kont Name
n)