{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}

module CheckedLiterals.Plugin (plugin) where

import GHC.Hs
import Prelude

import Control.Monad.Reader (Reader, ask, runReader)
import Data.Generics (Data, extM, gmapM)
import Data.Ratio.Extra qualified as RatioExtra
import GHC.Iface.Env (lookupOrig)
import GHC.Plugins hiding (rational, (<>))
import GHC.Tc.Types (TcGblEnv, TcM)
import GHC.Tc.Utils.Monad (getTopEnv)
import GHC.Types.SourceText (
  SourceText (NoSourceText, SourceText),
  il_value,
 )

import CheckedLiterals.Class.Integer (
  checkedNegativeIntegerLiteral,
  checkedPositiveIntegerLiteral,
 )
import CheckedLiterals.Class.Rational (
  checkedNegativeRationalLiteral,
  checkedPositiveRationalLiteral,
 )
import CheckedLiterals.Unchecked (uncheckedLiteral)
import Data.Ratio qualified as Ratio
import GHC.Types.SourceText qualified as SourceText
import Language.Haskell.TH qualified as TH

data HelperNames = HelperNames
  { HelperNames -> Name
checkedPositiveIntegerLiteralName :: Name
  , HelperNames -> Name
checkedNegativeIntegerLiteralName :: Name
  , HelperNames -> Name
checkedPositiveRationalLiteralName :: Name
  , HelperNames -> Name
checkedNegativeRationalLiteralName :: Name
  , HelperNames -> Name
uncheckedLiteralName :: Name
  }

type TransformM = Reader HelperNames

-- | The GHC plugin entry point
plugin :: Plugin
plugin :: Plugin
plugin =
  Plugin
defaultPlugin
    { renamedResultAction = renamedPlugin
    , pluginRecompile = purePlugin
    }

-- | Rewrite numeric literals after renaming, using exact Names for helper detection.
renamedPlugin :: [CommandLineOption] -> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedPlugin :: [CommandLineOption]
-> TcGblEnv -> HsGroup GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renamedPlugin [CommandLineOption]
_opts TcGblEnv
tcGblEnv HsGroup GhcRn
hsGroup = do
  helperNames <- TcM HelperNames
loadHelperNames
  let transformedGroup = Reader HelperNames (HsGroup GhcRn) -> HelperNames -> HsGroup GhcRn
forall r a. Reader r a -> r -> a
runReader (HsGroup GhcRn -> Reader HelperNames (HsGroup GhcRn)
transformHsGroup HsGroup GhcRn
hsGroup) HelperNames
helperNames
  pure (tcGblEnv, transformedGroup)

-- | Top-down traversal of HsGroup, transforming expressions and patterns.
transformHsGroup :: HsGroup GhcRn -> TransformM (HsGroup GhcRn)
transformHsGroup :: HsGroup GhcRn -> Reader HelperNames (HsGroup GhcRn)
transformHsGroup HsGroup GhcRn
hsGroup = (forall d. Data d => d -> ReaderT HelperNames Identity d)
-> HsGroup GhcRn -> Reader HelperNames (HsGroup GhcRn)
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d)
-> HsGroup GhcRn -> m (HsGroup GhcRn)
gmapM d -> TransformM d
forall d. Data d => d -> ReaderT HelperNames Identity d
transformData HsGroup GhcRn
hsGroup

transformData :: (Data a) => a -> TransformM a
transformData :: forall d. Data d => d -> ReaderT HelperNames Identity d
transformData =
  (forall d. Data d => d -> ReaderT HelperNames Identity d)
-> a -> ReaderT HelperNames Identity a
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM d -> TransformM d
forall d. Data d => d -> ReaderT HelperNames Identity d
transformData
    (a -> ReaderT HelperNames Identity a)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ReaderT
         HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> a
-> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LHsExpr GhcRn -> TransformM (LHsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
transformLHsExpr
    (a -> ReaderT HelperNames Identity a)
-> (GenLocated SrcSpanAnnA (Pat GhcRn)
    -> ReaderT
         HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn)))
-> a
-> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LPat GhcRn -> TransformM (LPat GhcRn)
GenLocated SrcSpanAnnA (Pat GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn))
transformLPat

loadHelperNames :: TcM HelperNames
loadHelperNames :: TcM HelperNames
loadHelperNames = do
  let lookupHelper :: Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper Name
quotedName = do
        helperModule <- ModuleName -> TcM Module
lookupHelperModule (Name -> ModuleName
quotedNameModuleName Name
quotedName)
        lookupOrig helperModule (mkVarOcc (TH.nameBase quotedName))
  Name -> Name -> Name -> Name -> Name -> HelperNames
HelperNames
    (Name -> Name -> Name -> Name -> Name -> HelperNames)
-> IOEnv (Env TcGblEnv TcLclEnv) Name
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Name -> Name -> Name -> Name -> HelperNames)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper 'checkedPositiveIntegerLiteral
    IOEnv
  (Env TcGblEnv TcLclEnv)
  (Name -> Name -> Name -> Name -> HelperNames)
-> IOEnv (Env TcGblEnv TcLclEnv) Name
-> IOEnv
     (Env TcGblEnv TcLclEnv) (Name -> Name -> Name -> HelperNames)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper 'checkedNegativeIntegerLiteral
    IOEnv (Env TcGblEnv TcLclEnv) (Name -> Name -> Name -> HelperNames)
-> IOEnv (Env TcGblEnv TcLclEnv) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Name -> Name -> HelperNames)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper 'checkedPositiveRationalLiteral
    IOEnv (Env TcGblEnv TcLclEnv) (Name -> Name -> HelperNames)
-> IOEnv (Env TcGblEnv TcLclEnv) Name
-> IOEnv (Env TcGblEnv TcLclEnv) (Name -> HelperNames)
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper 'checkedNegativeRationalLiteral
    IOEnv (Env TcGblEnv TcLclEnv) (Name -> HelperNames)
-> IOEnv (Env TcGblEnv TcLclEnv) Name -> TcM HelperNames
forall a b.
IOEnv (Env TcGblEnv TcLclEnv) (a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Name -> IOEnv (Env TcGblEnv TcLclEnv) Name
lookupHelper 'uncheckedLiteral

lookupHelperModule :: ModuleName -> TcM Module
lookupHelperModule :: ModuleName -> TcM Module
lookupHelperModule ModuleName
moduleName = do
  hscEnv <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
getTopEnv
  case lookupModuleWithSuggestions (hsc_units hscEnv) moduleName NoPkgQual of
    LookupFound Module
foundModule (UnitInfo, ModuleOrigin)
_ -> Module -> TcM Module
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Module
foundModule
    LookupResult
_ -> CommandLineOption -> TcM Module
forall a. HasCallStack => CommandLineOption -> a
panic CommandLineOption
"CheckedLiterals.Plugin: failed to resolve helper module"

quotedNameModuleName :: TH.Name -> ModuleName
quotedNameModuleName :: Name -> ModuleName
quotedNameModuleName Name
name =
  case Name -> Maybe CommandLineOption
TH.nameModule Name
name of
    Just CommandLineOption
moduleName -> CommandLineOption -> ModuleName
mkModuleName CommandLineOption
moduleName
    Maybe CommandLineOption
Nothing ->
      CommandLineOption -> ModuleName
forall a. HasCallStack => CommandLineOption -> a
panic (CommandLineOption -> ModuleName)
-> CommandLineOption -> ModuleName
forall a b. (a -> b) -> a -> b
$
        CommandLineOption
"CheckedLiterals.Plugin: quoted helper name is missing a module: "
          CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ Name -> CommandLineOption
forall a. Ppr a => a -> CommandLineOption
TH.pprint Name
name

-- | Transform a located expression using top-down traversal.
transformLHsExpr :: LHsExpr GhcRn -> TransformM (LHsExpr GhcRn)
transformLHsExpr :: LHsExpr GhcRn -> TransformM (LHsExpr GhcRn)
transformLHsExpr lexpr :: LHsExpr GhcRn
lexpr@(L SrcSpanAnnA
loc HsExpr GhcRn
expr) = do
  helperNames <- ReaderT HelperNames Identity HelperNames
forall r (m :: Type -> Type). MonadReader r m => m r
ask
  case expr of
    -- Check if this is an application to our checked literal functions. If so, stop recursing
    -- to avoid double transformation.
    HsApp XApp GhcRn
_ LHsExpr GhcRn
fun LHsExpr GhcRn
_ | HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp HelperNames
helperNames (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
fun) -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
lexpr
    -- Handle negation of fractional literals: detect (negate 3.14) patterns
    NegApp XNegApp GhcRn
_ (L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcRn
_ OverLit{ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsFractional FractionalLit
fracLit})) SyntaxExpr GhcRn
_ -> do
      let
        rational :: Rational
rational = Rational -> Rational
forall a. Num a => a -> a
negate (FractionalLit -> Rational
SourceText.rationalFromFractionalLit FractionalLit
fracLit)
        transformedExpr :: HsExpr GhcRn
transformedExpr =
          HelperNames
-> HsExpr GhcRn -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteral
            HelperNames
helperNames
            HsExpr GhcRn
expr
            (Rational -> FractionalLit -> CommandLineOption
fractionalLiteralDisplayText Rational
rational FractionalLit
fracLit)
            Rational
rational
      GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsExpr GhcRn
transformedExpr)

    -- Handle negation of integer literals: detect (negate literal) patterns
    NegApp XNegApp GhcRn
_ (L SrcSpanAnnA
_ (HsOverLit XOverLitE GhcRn
_ OverLit{ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsIntegral IntegralLit
intLit})) SyntaxExpr GhcRn
_ -> do
      let
        value :: Integer
value = IntegralLit -> Integer
il_value IntegralLit
intLit
        transformedExpr :: HsExpr GhcRn
transformedExpr = HelperNames -> HsExpr GhcRn -> Integer -> HsExpr GhcRn
makeCheckedLiteral HelperNames
helperNames HsExpr GhcRn
expr (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)
      GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc HsExpr GhcRn
transformedExpr)

    -- Transform positive fractional literals
    HsOverLit XOverLitE GhcRn
_ OverLit{ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsFractional FractionalLit
fracLit} -> do
      let rational :: Rational
rational = FractionalLit -> Rational
SourceText.rationalFromFractionalLit FractionalLit
fracLit
      GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> ReaderT
      HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$
        SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$
          HelperNames
-> HsExpr GhcRn -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteral
            HelperNames
helperNames
            HsExpr GhcRn
expr
            (Rational -> FractionalLit -> CommandLineOption
fractionalLiteralDisplayText Rational
rational FractionalLit
fracLit)
            Rational
rational

    -- Transform positive integer literals
    HsOverLit XOverLitE GhcRn
_ OverLit{ol_val :: forall p. HsOverLit p -> OverLitVal
ol_val = HsIntegral IntegralLit
intLit} -> do
      let value :: Integer
value = IntegralLit -> Integer
il_value IntegralLit
intLit
      GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> ReaderT
      HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ HelperNames -> HsExpr GhcRn -> Integer -> HsExpr GhcRn
makeCheckedLiteral HelperNames
helperNames HsExpr GhcRn
expr Integer
value

    -- For all other expressions, recurse into children (top-down)
    HsExpr GhcRn
_ -> SrcSpanAnnA
-> HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> ReaderT HelperNames Identity (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. Data d => d -> ReaderT HelperNames Identity d)
-> HsExpr GhcRn -> ReaderT HelperNames Identity (HsExpr GhcRn)
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> HsExpr GhcRn -> m (HsExpr GhcRn)
gmapM d -> TransformM d
forall d. Data d => d -> ReaderT HelperNames Identity d
transformData HsExpr GhcRn
expr

-- | Transform any located pattern, regardless of context.
transformLPat :: LPat GhcRn -> TransformM (LPat GhcRn)
transformLPat :: LPat GhcRn -> TransformM (LPat GhcRn)
transformLPat lpat :: LPat GhcRn
lpat@(L SrcSpanAnnA
loc Pat GhcRn
pat) = do
  helperNames <- ReaderT HelperNames Identity HelperNames
forall r (m :: Type -> Type). MonadReader r m => m r
ask
  case pat of
    ViewPat XViewPat GhcRn
_ LHsExpr GhcRn
viewExpr LPat GhcRn
_
      | HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp HelperNames
helperNames (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
viewExpr) ->
          GenLocated SrcSpanAnnA (Pat GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
lpat
    NPat XNPat GhcRn
_ XRec GhcRn (HsOverLit GhcRn)
overLit Maybe (SyntaxExpr GhcRn)
negation SyntaxExpr GhcRn
_
      | Just HsExpr GhcRn
viewExpr <- HelperNames
-> HsOverLit GhcRn
-> Maybe (SyntaxExpr GhcRn)
-> Maybe (HsExpr GhcRn)
makeCheckedPatternViewExpr HelperNames
helperNames (GenLocated EpAnnCO (HsOverLit GhcRn) -> HsOverLit GhcRn
forall l e. GenLocated l e -> e
unLoc XRec GhcRn (HsOverLit GhcRn)
GenLocated EpAnnCO (HsOverLit GhcRn)
overLit) Maybe (SyntaxExpr GhcRn)
negation ->
          GenLocated SrcSpanAnnA (Pat GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn))
forall a. a -> ReaderT HelperNames Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (SrcSpanAnnA -> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (XViewPat GhcRn -> LHsExpr GhcRn -> LPat GhcRn -> Pat GhcRn
forall p. XViewPat p -> LHsExpr p -> LPat p -> Pat p
ViewPat XViewPat GhcRn
mkViewPatExt (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
viewExpr) LPat GhcRn
lpat))
    Pat GhcRn
_ -> SrcSpanAnnA -> Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (Pat GhcRn -> GenLocated SrcSpanAnnA (Pat GhcRn))
-> ReaderT HelperNames Identity (Pat GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall d. Data d => d -> ReaderT HelperNames Identity d)
-> Pat GhcRn -> ReaderT HelperNames Identity (Pat GhcRn)
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> Pat GhcRn -> m (Pat GhcRn)
gmapM d -> TransformM d
forall d. Data d => d -> ReaderT HelperNames Identity d
transformPatData Pat GhcRn
pat

transformPatData :: (Data a) => a -> TransformM a
transformPatData :: forall d. Data d => d -> ReaderT HelperNames Identity d
transformPatData =
  (forall d. Data d => d -> ReaderT HelperNames Identity d)
-> a -> ReaderT HelperNames Identity a
forall a (m :: Type -> Type).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM d -> TransformM d
forall d. Data d => d -> ReaderT HelperNames Identity d
transformPatData
    (a -> ReaderT HelperNames Identity a)
-> (GenLocated SrcSpanAnnA (Pat GhcRn)
    -> ReaderT
         HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn)))
-> a
-> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LPat GhcRn -> TransformM (LPat GhcRn)
GenLocated SrcSpanAnnA (Pat GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (Pat GhcRn))
transformLPat
    (a -> ReaderT HelperNames Identity a)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ReaderT
         HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> a
-> ReaderT HelperNames Identity a
forall (m :: Type -> Type) a b.
(Monad m, Typeable a, Typeable b) =>
(a -> m a) -> (b -> m b) -> a -> m a
`extM` LHsExpr GhcRn -> TransformM (LHsExpr GhcRn)
GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> ReaderT
     HelperNames Identity (GenLocated SrcSpanAnnA (HsExpr GhcRn))
transformLHsExpr

makeCheckedPatternViewExpr ::
  HelperNames ->
  HsOverLit GhcRn ->
  Maybe (SyntaxExpr GhcRn) ->
  Maybe (HsExpr GhcRn)
makeCheckedPatternViewExpr :: HelperNames
-> HsOverLit GhcRn
-> Maybe (SyntaxExpr GhcRn)
-> Maybe (HsExpr GhcRn)
makeCheckedPatternViewExpr HelperNames
helperNames HsOverLit GhcRn
overLit Maybe (SyntaxExpr GhcRn)
negation =
  case HsOverLit GhcRn
overLit.ol_val of
    HsIntegral IntegralLit
intLit ->
      let value :: Integer
value = Maybe SyntaxExprRn -> Integer -> Integer
forall a b. Num a => Maybe b -> a -> a
applyPatternNegation Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
negation (IntegralLit -> Integer
il_value IntegralLit
intLit)
       in HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HelperNames -> Integer -> HsExpr GhcRn
makeCheckedLiteralFunction HelperNames
helperNames Integer
value)
    HsFractional FractionalLit
fracLit ->
      let rational :: Rational
rational = Maybe SyntaxExprRn -> Rational -> Rational
forall a b. Num a => Maybe b -> a -> a
applyPatternNegation Maybe (SyntaxExpr GhcRn)
Maybe SyntaxExprRn
negation (FractionalLit -> Rational
SourceText.rationalFromFractionalLit FractionalLit
fracLit)
       in HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just
            ( HelperNames -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteralFunction
                HelperNames
helperNames
                (Rational -> FractionalLit -> CommandLineOption
fractionalLiteralDisplayText Rational
rational FractionalLit
fracLit)
                Rational
rational
            )
    HsIsString SourceText
_ FastString
_ -> Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing

applyPatternNegation :: (Num a) => Maybe b -> a -> a
applyPatternNegation :: forall a b. Num a => Maybe b -> a -> a
applyPatternNegation Maybe b
Nothing a
value = a
value
applyPatternNegation (Just b
_) a
value = a -> a
forall a. Num a => a -> a
negate a
value

mkViewPatExt :: XViewPat GhcRn
mkViewPatExt :: XViewPat GhcRn
mkViewPatExt = Maybe (HsExpr GhcRn)
XViewPat GhcRn
forall a. Maybe a
Nothing

#if MIN_VERSION_ghc(9,8,0)
unpackFSCompat :: FastString -> String
unpackFSCompat :: FastString -> CommandLineOption
unpackFSCompat = FastString -> CommandLineOption
unpackFS
#else
unpackFSCompat :: String -> String
unpackFSCompat = id
#endif

fractionalLiteralDisplayText :: Rational -> SourceText.FractionalLit -> String
fractionalLiteralDisplayText :: Rational -> FractionalLit -> CommandLineOption
fractionalLiteralDisplayText Rational
rational FractionalLit
fracLit =
  case FractionalLit -> SourceText
SourceText.fl_text FractionalLit
fracLit of
    SourceText FastString
sourceText ->
      let sourceTextStr :: CommandLineOption
sourceTextStr = FastString -> CommandLineOption
unpackFSCompat FastString
sourceText
       in case CommandLineOption
sourceTextStr of
            Char
'-' : CommandLineOption
_ -> CommandLineOption
sourceTextStr
            CommandLineOption
_ | Rational
rational Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 -> Char
'-' Char -> CommandLineOption -> CommandLineOption
forall a. a -> [a] -> [a]
: CommandLineOption
sourceTextStr
            CommandLineOption
_ -> CommandLineOption
sourceTextStr
    SourceText
NoSourceText ->
      Rational -> CommandLineOption
RatioExtra.showFixedPoint Rational
rational

{- FOURMOLU_DISABLE -}
-- | Check if an expression is an application to one of our checked literal functions
isCheckedLiteralApp :: HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp :: HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp HelperNames
helperNames HsExpr GhcRn
expr = case HsExpr GhcRn
expr of
  -- Direct reference to checked literal function
  HsVar XVar GhcRn
_ LIdP GhcRn
name -> HelperNames -> Name -> Bool
isCheckedLiteralName HelperNames
helperNames (LIdP GhcRn -> Name
getNameFromLocatedOcc LIdP GhcRn
name)
  -- Parentheses do not change helper identity.
#if MIN_VERSION_ghc(9,10,0)
  HsPar XPar GhcRn
_ LHsExpr GhcRn
innerExpr -> HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp HelperNames
helperNames (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
innerExpr)
#else
  HsPar _ _ innerExpr _ -> isCheckedLiteralApp helperNames (unLoc innerExpr)
#endif
  -- Type application to checked literal function, e.g.: checkedPositiveIntegerLiteral @N
#if MIN_VERSION_ghc(9,10,0)
  HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
funExpr LHsWcType (NoGhcTc GhcRn)
_ -> HelperNames -> HsExpr GhcRn -> Bool
isCheckedLiteralApp HelperNames
helperNames (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
funExpr)
#else
  HsAppType _ funExpr _ _ -> isCheckedLiteralApp helperNames (unLoc funExpr)
#endif
  HsExpr GhcRn
_ -> Bool
False
{- FOURMOLU_ENABLE -}

-- | Check if a name is one of our checked literal functions or uncheckedLiteral
isCheckedLiteralName :: HelperNames -> Name -> Bool
isCheckedLiteralName :: HelperNames -> Name -> Bool
isCheckedLiteralName HelperNames
helperNames Name
name =
  Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== HelperNames
helperNames.checkedPositiveIntegerLiteralName
    Bool -> Bool -> Bool
|| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== HelperNames
helperNames.checkedNegativeIntegerLiteralName
    Bool -> Bool -> Bool
|| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== HelperNames
helperNames.checkedPositiveRationalLiteralName
    Bool -> Bool -> Bool
|| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== HelperNames
helperNames.checkedNegativeRationalLiteralName
    Bool -> Bool -> Bool
|| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== HelperNames
helperNames.uncheckedLiteralName

#if MIN_VERSION_ghc(9,14,0)
getNameFromLocatedOcc :: LIdOccP GhcRn -> Name
getNameFromLocatedOcc = unLocWithUserRdr
#else
getNameFromLocatedOcc :: LIdP GhcRn -> Name
getNameFromLocatedOcc :: LIdP GhcRn -> Name
getNameFromLocatedOcc = LIdP GhcRn -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc
#endif

#if MIN_VERSION_ghc(9,14,0)
mkLocatedOcc :: Name -> LIdOccP GhcRn
mkLocatedOcc = noLocA . noUserRdr
#else
mkLocatedOcc :: Name -> LIdP GhcRn
mkLocatedOcc :: Name -> LIdP GhcRn
mkLocatedOcc = Name -> LIdP GhcRn
Name -> GenLocated SrcSpanAnnN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA
#endif

-- | Build the expression, e.g.: checkedPositiveIntegerLiteral @N e
makeCheckedLiteral :: HelperNames -> HsExpr GhcRn -> Integer -> HsExpr GhcRn
makeCheckedLiteral :: HelperNames -> HsExpr GhcRn -> Integer -> HsExpr GhcRn
makeCheckedLiteral HelperNames
helperNames HsExpr GhcRn
expr Integer
value = HsExpr GhcRn
fullApp
 where
  withTypeApp :: HsExpr GhcRn
withTypeApp = HelperNames -> Integer -> HsExpr GhcRn
makeCheckedLiteralFunction HelperNames
helperNames Integer
value
#if MIN_VERSION_ghc(9,10,0)
  fullApp :: HsExpr GhcRn
fullApp = XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
withTypeApp) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
expr)
#else
  fullApp = HsApp noAnn (noLocA withTypeApp) (noLocA expr)
#endif

makeCheckedLiteralFunction :: HelperNames -> Integer -> HsExpr GhcRn
makeCheckedLiteralFunction :: HelperNames -> Integer -> HsExpr GhcRn
makeCheckedLiteralFunction HelperNames
helperNames Integer
value = HsExpr GhcRn
withTypeApp
 where
  funcName :: Name
funcName
    | Integer
value Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = HelperNames
helperNames.checkedPositiveIntegerLiteralName
    | Bool
otherwise = HelperNames
helperNames.checkedNegativeIntegerLiteralName
  funcVar :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
funcVar = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> LIdP GhcRn
mkLocatedOcc Name
funcName))
  tyLit :: HsTyLit (NoGhcTc GhcRn)
tyLit = XNumTy (NoGhcTc GhcRn) -> Integer -> HsTyLit (NoGhcTc GhcRn)
forall pass. XNumTy pass -> Integer -> HsTyLit pass
HsNumTy XNumTy (NoGhcTc GhcRn)
SourceText
NoSourceText (Integer -> Integer
forall a. Num a => a -> a
abs Integer
value)
#if MIN_VERSION_ghc(9,10,0)
  typeArg :: HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
typeArg = XHsWC
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
-> HsWildCardBndrs
     (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC [] (HsType (NoGhcTc GhcRn)
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XTyLit (NoGhcTc GhcRn)
-> HsTyLit (NoGhcTc GhcRn) -> HsType (NoGhcTc GhcRn)
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit (NoGhcTc GhcRn)
NoExtField
noExtField HsTyLit (NoGhcTc GhcRn)
tyLit))
  withTypeApp :: HsExpr GhcRn
withTypeApp = XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
funcVar LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
typeArg
#else
  typeArg = HsWC [] (noLocA (HsTyLit noExtField tyLit))
  atToken = L NoTokenLoc (HsTok @"@")
  withTypeApp = HsAppType noExtField funcVar atToken typeArg
#endif

{- | Build the expression for rational literals, e.g.:
checkedPositiveRationalLiteral @"3.14" @314 @100 (3.14)
-}
makeCheckedRationalLiteral :: HelperNames -> HsExpr GhcRn -> String -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteral :: HelperNames
-> HsExpr GhcRn -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteral HelperNames
helperNames HsExpr GhcRn
expr CommandLineOption
stringRepr Rational
rational = HsExpr GhcRn
fullApp
 where
  withAllTypeApps :: HsExpr GhcRn
withAllTypeApps = HelperNames -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteralFunction HelperNames
helperNames CommandLineOption
stringRepr Rational
rational
#if MIN_VERSION_ghc(9,10,0)
  fullApp :: HsExpr GhcRn
fullApp = XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
withAllTypeApps) (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
expr)
#else
  fullApp = HsApp noAnn (noLocA withAllTypeApps) (noLocA expr)
#endif

makeCheckedRationalLiteralFunction :: HelperNames -> String -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteralFunction :: HelperNames -> CommandLineOption -> Rational -> HsExpr GhcRn
makeCheckedRationalLiteralFunction HelperNames
helperNames CommandLineOption
stringRepr Rational
rational = HsExpr GhcRn
withAllTypeApps
 where
  funcName :: Name
funcName
    | Rational
rational Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 = HelperNames
helperNames.checkedPositiveRationalLiteralName
    | Bool
otherwise = HelperNames
helperNames.checkedNegativeRationalLiteralName
  funcVar :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
funcVar = HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (Name -> LIdP GhcRn
mkLocatedOcc Name
funcName))

  -- Type-level literals
  strTyLit :: HsTyLit (NoGhcTc GhcRn)
strTyLit = XStrTy (NoGhcTc GhcRn) -> FastString -> HsTyLit (NoGhcTc GhcRn)
forall pass. XStrTy pass -> FastString -> HsTyLit pass
HsStrTy XStrTy (NoGhcTc GhcRn)
SourceText
NoSourceText (CommandLineOption -> FastString
mkFastString CommandLineOption
stringRepr)
  numTyLit :: HsTyLit (NoGhcTc GhcRn)
numTyLit = XNumTy (NoGhcTc GhcRn) -> Integer -> HsTyLit (NoGhcTc GhcRn)
forall pass. XNumTy pass -> Integer -> HsTyLit pass
HsNumTy XNumTy (NoGhcTc GhcRn)
SourceText
NoSourceText (Integer -> Integer
forall a. Num a => a -> a
abs (Rational -> Integer
forall a. Ratio a -> a
Ratio.numerator Rational
rational))
  denTyLit :: HsTyLit (NoGhcTc GhcRn)
denTyLit = XNumTy (NoGhcTc GhcRn) -> Integer -> HsTyLit (NoGhcTc GhcRn)
forall pass. XNumTy pass -> Integer -> HsTyLit pass
HsNumTy XNumTy (NoGhcTc GhcRn)
SourceText
NoSourceText (Integer -> Integer
forall a. Num a => a -> a
abs (Rational -> Integer
forall a. Ratio a -> a
Ratio.denominator Rational
rational))
#if MIN_VERSION_ghc(9,10,0)
  strTypeArg :: HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
strTypeArg = XHsWC
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
-> HsWildCardBndrs
     (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC [] (HsType (NoGhcTc GhcRn)
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XTyLit (NoGhcTc GhcRn)
-> HsTyLit (NoGhcTc GhcRn) -> HsType (NoGhcTc GhcRn)
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit (NoGhcTc GhcRn)
NoExtField
noExtField HsTyLit (NoGhcTc GhcRn)
strTyLit))
  numTypeArg :: HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
numTypeArg = XHsWC
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
-> HsWildCardBndrs
     (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC [] (HsType (NoGhcTc GhcRn)
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XTyLit (NoGhcTc GhcRn)
-> HsTyLit (NoGhcTc GhcRn) -> HsType (NoGhcTc GhcRn)
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit (NoGhcTc GhcRn)
NoExtField
noExtField HsTyLit (NoGhcTc GhcRn)
numTyLit))
  denTypeArg :: HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
denTypeArg = XHsWC
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
-> HsWildCardBndrs
     (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
HsWC [] (HsType (NoGhcTc GhcRn)
-> GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn))
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XTyLit (NoGhcTc GhcRn)
-> HsTyLit (NoGhcTc GhcRn) -> HsType (NoGhcTc GhcRn)
forall pass. XTyLit pass -> HsTyLit pass -> HsType pass
HsTyLit XTyLit (NoGhcTc GhcRn)
NoExtField
noExtField HsTyLit (NoGhcTc GhcRn)
denTyLit))
  withStrTypeApp :: HsExpr GhcRn
withStrTypeApp = XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
funcVar LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
strTypeArg
  withNumTypeApp :: HsExpr GhcRn
withNumTypeApp = XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
withStrTypeApp) LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
numTypeArg
  withAllTypeApps :: HsExpr GhcRn
withAllTypeApps = XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcRn
NoExtField
noExtField (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA HsExpr GhcRn
withNumTypeApp) LHsWcType (NoGhcTc GhcRn)
HsWildCardBndrs
  (NoGhcTc GhcRn) (GenLocated SrcSpanAnnA (HsType (NoGhcTc GhcRn)))
denTypeArg
#else
  strTypeArg = HsWC [] (noLocA (HsTyLit noExtField strTyLit))
  numTypeArg = HsWC [] (noLocA (HsTyLit noExtField numTyLit))
  denTypeArg = HsWC [] (noLocA (HsTyLit noExtField denTyLit))
  atToken = L NoTokenLoc (HsTok @"@")
  withStrTypeApp = HsAppType noExtField funcVar atToken strTypeArg
  withNumTypeApp = HsAppType noExtField (noLocA withStrTypeApp) atToken numTypeArg
  withAllTypeApps = HsAppType noExtField (noLocA withNumTypeApp) atToken denTypeArg
#endif