{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

{-| Provide a pure API for GHC internals.

All GHC operations should go through this API, to isolate
the rest of the logic from GHC internals logic, which can
include breaking changes between versions.
-}
module Skeletest.Internal.GHC (
  Plugin,
  PluginDef (..),
  Ctx (..),
  GhcRn,
  mkPlugin,

  -- * ParsedModule
  ParsedModule (..),
  FunDef (..),

  -- ** Expressions
  HsExpr,
  HsExprData (..),
  hsExprCon,
  hsExprVar,
  hsExprApps,
  hsExprList,
  hsExprRecordCon,
  hsExprLitString,
  hsExprLam,
  hsExprCase,
  getExpr,
  getLoc,
  renderHsExpr,

  -- ** Types
  HsType (..),

  -- ** Patterns
  HsPat (..),

  -- ** Names
  HsName,
  hsName,
  hsVarName,
  hsFieldName,
  getHsName,
) where

import Control.Monad.Catch (handleJust)
import Control.Monad.Trans.Class qualified as Trans
import Control.Monad.Trans.State (StateT, evalStateT)
import Control.Monad.Trans.State qualified as State
import Data.Data (Data)
import Data.Data qualified as Data
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Typeable qualified as Typeable
import GHC (
  GenLocated (..),
  GhcPass (..),
  GhcPs,
  GhcRn,
  IsPass,
  unLoc,
 )
import GHC qualified
import GHC.Driver.Main qualified as GHC
import GHC.Plugins qualified as GHC hiding (getHscEnv)
import GHC.Tc.Errors.Types qualified as GHC
import GHC.Tc.Utils.Monad qualified as GHC
import GHC.Types.Name qualified as GHC.Name
import GHC.Types.Name.Cache qualified as GHC (NameCache)
import GHC.Types.SourceText qualified as GHC.SourceText
import GHC.Utils.Error qualified as GHC
import Language.Haskell.TH.Syntax qualified as TH
import System.IO.Unsafe (unsafePerformIO)

#if !MIN_VERSION_base(4, 20, 0)
import Data.Foldable (foldl')
#endif

import Skeletest.Internal.Error (
  SkeletestError (CompilationError),
  invariantViolation,
 )
import Skeletest.Internal.GHC.Compat (genLoc)
import Skeletest.Internal.GHC.Compat qualified as GHC.Compat
import Skeletest.Internal.Utils.Text (showT)

-- Has to be exactly GHC's Plugin type, for GHC to register it correctly.
type Plugin = GHC.Plugin

-- | Our pure definition of PluginDef, agnostic of GHC version.
data PluginDef = PluginDef
  { PluginDef -> Bool
isPure :: Bool
  , PluginDef -> [String] -> ModuleName -> ParsedModule -> ParsedModule
modifyParsed :: [GHC.CommandLineOption] -> ModuleName -> ParsedModule -> ParsedModule
  , PluginDef
-> [String] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
onRename :: [GHC.CommandLineOption] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
  }

data Ctx = Ctx
  { Ctx -> HsName GhcRn -> HsName GhcRn -> Bool
matchesName :: HsName GhcRn -> HsName GhcRn -> Bool
  }

type ModuleName = Text

mkPlugin :: PluginDef -> Plugin
mkPlugin :: PluginDef -> Plugin
mkPlugin PluginDef{Bool
[String] -> ModuleName -> ParsedModule -> ParsedModule
[String] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
isPure :: PluginDef -> Bool
modifyParsed :: PluginDef -> [String] -> ModuleName -> ParsedModule -> ParsedModule
onRename :: PluginDef
-> [String] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
isPure :: Bool
modifyParsed :: [String] -> ModuleName -> ParsedModule -> ParsedModule
onRename :: [String] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
..} =
  Plugin
GHC.defaultPlugin
    { GHC.pluginRecompile = if isPure then GHC.purePlugin else GHC.impurePlugin
    , GHC.parsedResultAction = \[String]
opts ModSummary
modInfo ParsedResult
result -> do
        let
          moduleName :: ModuleName
moduleName = GenModule Unit -> ModuleName
forall {unit}. GenModule unit -> ModuleName
getModuleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModSummary -> GenModule Unit
GHC.ms_mod ModSummary
modInfo
          parsedModule :: ParsedModule
parsedModule = Located (HsModule GhcPs) -> ParsedModule
initParsedModule (Located (HsModule GhcPs) -> ParsedModule)
-> (ParsedResult -> Located (HsModule GhcPs))
-> ParsedResult
-> ParsedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsParsedModule -> Located (HsModule GhcPs)
GHC.hpm_module (HsParsedModule -> Located (HsModule GhcPs))
-> (ParsedResult -> HsParsedModule)
-> ParsedResult
-> Located (HsModule GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedResult -> HsParsedModule
GHC.parsedResultModule (ParsedResult -> ParsedModule) -> ParsedResult -> ParsedModule
forall a b. (a -> b) -> a -> b
$ ParsedResult
result
          ParsedModule{[(HsName GhcPs, Maybe FunDef)]
moduleFuncs :: [(HsName GhcPs, Maybe FunDef)]
moduleFuncs :: ParsedModule -> [(HsName GhcPs, Maybe FunDef)]
moduleFuncs} = [String] -> ModuleName -> ParsedModule -> ParsedModule
modifyParsed [String]
opts ModuleName
moduleName ParsedModule
parsedModule
        [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls <-
          CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> Hsc [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. CompilePs a -> Hsc a
runCompilePs (CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> Hsc [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
    -> CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> Hsc [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> CompilePs [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> CompilePs a -> CompilePs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (CompilePs [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
 -> CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ([CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
    -> CompilePs [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]])
-> [CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> CompilePs [[GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
 -> Hsc [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> [CompilePs [GenLocated SrcSpanAnnA (HsDecl GhcPs)]]
-> Hsc [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$
            [ HsName GhcPs -> FunDef -> CompilePs [LHsDecl GhcPs]
forall (m :: * -> *).
MonadCompile m GhcPs =>
HsName GhcPs -> FunDef -> m [LHsDecl GhcPs]
compileFunDef HsName GhcPs
funName FunDef
funDef
            | (HsName GhcPs
funName, Just FunDef
funDef) <- [(HsName GhcPs, Maybe FunDef)]
moduleFuncs
            ]
        ParsedResult -> Hsc ParsedResult
forall a. a -> Hsc a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (ParsedResult -> Hsc ParsedResult)
-> (ParsedResult -> ParsedResult)
-> ParsedResult
-> Hsc ParsedResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HsParsedModule -> HsParsedModule) -> ParsedResult -> ParsedResult
modifyParsedResultModule ((HsParsedModule -> HsParsedModule)
 -> ParsedResult -> ParsedResult)
-> (([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
     -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> HsParsedModule -> HsParsedModule)
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> ParsedResult
-> ParsedResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (HsModule GhcPs) -> Located (HsModule GhcPs))
-> HsParsedModule -> HsParsedModule
modifyHpmModule ((Located (HsModule GhcPs) -> Located (HsModule GhcPs))
 -> HsParsedModule -> HsParsedModule)
-> (([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
     -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> Located (HsModule GhcPs) -> Located (HsModule GhcPs))
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> HsParsedModule
-> HsParsedModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsModule GhcPs -> HsModule GhcPs)
-> Located (HsModule GhcPs) -> Located (HsModule GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((HsModule GhcPs -> HsModule GhcPs)
 -> Located (HsModule GhcPs) -> Located (HsModule GhcPs))
-> (([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
     -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    -> HsModule GhcPs -> HsModule GhcPs)
-> ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> Located (HsModule GhcPs)
-> Located (HsModule GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LHsDecl GhcPs] -> [LHsDecl GhcPs])
-> HsModule GhcPs -> HsModule GhcPs
([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
-> HsModule GhcPs -> HsModule GhcPs
forall {p}.
([XRec p (HsDecl p)] -> [XRec p (HsDecl p)])
-> HsModule p -> HsModule p
modifyModDecls) ([GenLocated SrcSpanAnnA (HsDecl GhcPs)]
newDecls <>)
          (ParsedResult -> Hsc ParsedResult)
-> ParsedResult -> Hsc ParsedResult
forall a b. (a -> b) -> a -> b
$ ParsedResult
result
    , GHC.renamedResultAction = \[String]
opts TcGblEnv
gblEnv HsGroup GhcRn
group -> do
        NameCache
nameCache <- HscEnv -> NameCache
GHC.hsc_NC (HscEnv -> NameCache)
-> (Env TcGblEnv TcLclEnv -> HscEnv)
-> Env TcGblEnv TcLclEnv
-> NameCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
GHC.env_top (Env TcGblEnv TcLclEnv -> NameCache)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) NameCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
GHC.getEnv
        let
          moduleName :: ModuleName
moduleName = GenModule Unit -> ModuleName
forall {unit}. GenModule unit -> ModuleName
getModuleName (GenModule Unit -> ModuleName) -> GenModule Unit -> ModuleName
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> GenModule Unit
GHC.tcg_mod TcGblEnv
gblEnv
          ctx :: Ctx
ctx =
            Ctx
              { matchesName :: HsName GhcRn -> HsName GhcRn -> Bool
matchesName = NameCache -> HsName GhcRn -> HsName GhcRn -> Bool
matchesNameImpl NameCache
nameCache
              }
        HsGroup GhcRn
group' <- CompileRn (HsGroup GhcRn) -> TcM (HsGroup GhcRn)
forall a. CompileRn a -> TcM a
runCompileRn (CompileRn (HsGroup GhcRn) -> TcM (HsGroup GhcRn))
-> CompileRn (HsGroup GhcRn) -> TcM (HsGroup GhcRn)
forall a b. (a -> b) -> a -> b
$ (HsExpr GhcRn -> HsExpr GhcRn)
-> HsGroup GhcRn -> CompileRn (HsGroup GhcRn)
forall (m :: * -> *).
MonadCompile m GhcRn =>
(HsExpr GhcRn -> HsExpr GhcRn)
-> HsGroup GhcRn -> m (HsGroup GhcRn)
modifyModuleExprs ([String] -> Ctx -> ModuleName -> HsExpr GhcRn -> HsExpr GhcRn
onRename [String]
opts Ctx
ctx ModuleName
moduleName) HsGroup GhcRn
group
        (TcGblEnv, HsGroup GhcRn) -> TcM (TcGblEnv, HsGroup GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv
gblEnv, HsGroup GhcRn
group')
    }
 where
  getModuleName :: GenModule unit -> ModuleName
getModuleName GHC.Module{ModuleName
moduleName :: ModuleName
moduleName :: forall unit. GenModule unit -> ModuleName
moduleName} = String -> ModuleName
Text.pack (String -> ModuleName) -> String -> ModuleName
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
GHC.moduleNameString ModuleName
moduleName

  modifyParsedResultModule :: (HsParsedModule -> HsParsedModule) -> ParsedResult -> ParsedResult
modifyParsedResultModule HsParsedModule -> HsParsedModule
f ParsedResult
x = ParsedResult
x{GHC.parsedResultModule = f $ GHC.parsedResultModule x}
  modifyHpmModule :: (Located (HsModule GhcPs) -> Located (HsModule GhcPs))
-> HsParsedModule -> HsParsedModule
modifyHpmModule Located (HsModule GhcPs) -> Located (HsModule GhcPs)
f HsParsedModule
x = HsParsedModule
x{GHC.hpm_module = f $ GHC.hpm_module x}
  modifyModDecls :: ([XRec p (HsDecl p)] -> [XRec p (HsDecl p)])
-> HsModule p -> HsModule p
modifyModDecls [XRec p (HsDecl p)] -> [XRec p (HsDecl p)]
f HsModule p
x = HsModule p
x{GHC.hsmodDecls = f $ GHC.hsmodDecls x}

{----- ParsedModule -----}

data ParsedModule = ParsedModule
  { ParsedModule -> [(HsName GhcPs, Maybe FunDef)]
moduleFuncs :: [(HsName GhcPs, Maybe FunDef)]
  }

data FunDef = FunDef
  { FunDef -> HsType GhcPs
funType :: HsType GhcPs
  , FunDef -> [HsPat GhcPs]
funPats :: [HsPat GhcPs]
  , FunDef -> HsExpr GhcPs
funBody :: HsExpr GhcPs
  }

initParsedModule :: GHC.Located (GHC.HsModule GhcPs) -> ParsedModule
initParsedModule :: Located (HsModule GhcPs) -> ParsedModule
initParsedModule (L SrcSpan
_ GHC.HsModule{[LHsDecl GhcPs]
hsmodDecls :: forall p. HsModule p -> [LHsDecl p]
hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls}) =
  ParsedModule
    { moduleFuncs :: [(HsName GhcPs, Maybe FunDef)]
moduleFuncs =
        [ (HsName GhcPs
funName, Maybe FunDef
forall a. Maybe a
Nothing)
        | Just HsName GhcPs
funName <- (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> Maybe (HsName GhcPs))
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> [Maybe (HsName GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (HsDecl GhcPs -> Maybe (HsName GhcPs)
getValName (HsDecl GhcPs -> Maybe (HsName GhcPs))
-> (GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
-> Maybe (HsName GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
unLoc) [LHsDecl GhcPs]
[GenLocated SrcSpanAnnA (HsDecl GhcPs)]
hsmodDecls
        ]
    }
 where
  getValName :: HsDecl GhcPs -> Maybe (HsName GhcPs)
getValName = \case
    GHC.ValD XValD GhcPs
_ GHC.FunBind{LIdP GhcPs
fun_id :: LIdP GhcPs
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id} -> HsName GhcPs -> Maybe (HsName GhcPs)
forall a. a -> Maybe a
Just (HsName GhcPs -> Maybe (HsName GhcPs))
-> (LIdP GhcPs -> HsName GhcPs)
-> LIdP GhcPs
-> Maybe (HsName GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP GhcPs -> HsName GhcPs
forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName (IdP GhcPs -> HsName GhcPs)
-> (GenLocated SrcSpanAnnN (IdP GhcPs) -> IdP GhcPs)
-> GenLocated SrcSpanAnnN (IdP GhcPs)
-> HsName GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN (IdP GhcPs) -> IdP GhcPs
forall l e. GenLocated l e -> e
unLoc (LIdP GhcPs -> Maybe (HsName GhcPs))
-> LIdP GhcPs -> Maybe (HsName GhcPs)
forall a b. (a -> b) -> a -> b
$ LIdP GhcPs
fun_id
    HsDecl GhcPs
_ -> Maybe (HsName GhcPs)
forall a. Maybe a
Nothing

{----- modifyModuleExprs -----}

modifyModuleExprs ::
  forall m.
  (MonadCompile m GhcRn) =>
  (HsExpr GhcRn -> HsExpr GhcRn) ->
  GHC.HsGroup GhcRn ->
  m (GHC.HsGroup GhcRn)
modifyModuleExprs :: forall (m :: * -> *).
MonadCompile m GhcRn =>
(HsExpr GhcRn -> HsExpr GhcRn)
-> HsGroup GhcRn -> m (HsGroup GhcRn)
modifyModuleExprs HsExpr GhcRn -> HsExpr GhcRn
f = HsGroup GhcRn -> m (HsGroup GhcRn)
forall a. Data a => a -> m a
go
 where
  go :: (Data a) => a -> m a
  go :: forall a. Data a => a -> m a
go = (forall a. Data a => a -> m a) -> a -> m a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
Data.gmapM ((forall a. Data a => a -> m a) -> a -> m a)
-> (forall a. Data a => a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ \d
x -> d -> m d
forall a. Data a => a -> m a
updateExpr d
x m d -> (d -> m d) -> m d
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= d -> m d
forall a. Data a => a -> m a
go

  updateExpr :: (Data a) => a -> m a
  updateExpr :: forall a. Data a => a -> m a
updateExpr (a
x :: a) =
    case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
Typeable.eqT @(GHC.LHsExpr GhcRn) @a of
      Just LHsExpr GhcRn :~: a
Typeable.Refl -> HsExpr GhcRn -> m a
HsExpr GhcRn -> m (LHsExpr GhcRn)
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
compileHsExpr (HsExpr GhcRn -> m a) -> (a -> HsExpr GhcRn) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn -> HsExpr GhcRn
f (HsExpr GhcRn -> HsExpr GhcRn)
-> (a -> HsExpr GhcRn) -> a -> HsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HsExpr GhcRn
LHsExpr GhcRn -> HsExpr GhcRn
parseHsExpr (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
x
      Maybe (LHsExpr GhcRn :~: a)
Nothing -> a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

{----- HsExpr -----}

-- | A Haskell expression that is either:
--     1. A parsed expression from the compiler
--          * ghcExpr is Just
--          * hsExpr is not HsExprOther if the expression is something
--            we care about parsing, otherwise HsExprOther
--     3. A new expression we're creating
--          * ghcExpr is Nothing
--          * hsExpr is not HsExprOther
--
-- Invariants:
--   * If ghcExpr is Just, hsExpr must not have been modified
--   * if ghcExpr is Nothing, hsExpr is not HsExprOther
data HsExpr p = HsExprUnsafe
  { forall p. HsExpr p -> Maybe (GhcLHsExpr p)
ghcExpr :: Maybe (GhcLHsExpr p)
  , forall p. HsExpr p -> HsExprData p
hsExpr :: HsExprData p
  }
  deriving (Int -> HsExpr p -> ShowS
[HsExpr p] -> ShowS
HsExpr p -> String
(Int -> HsExpr p -> ShowS)
-> (HsExpr p -> String) -> ([HsExpr p] -> ShowS) -> Show (HsExpr p)
forall p. Int -> HsExpr p -> ShowS
forall p. [HsExpr p] -> ShowS
forall p. HsExpr p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> HsExpr p -> ShowS
showsPrec :: Int -> HsExpr p -> ShowS
$cshow :: forall p. HsExpr p -> String
show :: HsExpr p -> String
$cshowList :: forall p. [HsExpr p] -> ShowS
showList :: [HsExpr p] -> ShowS
Show)

data HsExprData p
  = HsExprCon (HsName p)
  | HsExprVar (HsName p)
  | HsExprApps (HsExpr p) [HsExpr p]
  | HsExprOp (HsExpr p) (HsExpr p) (HsExpr p) -- lhs op rhs
  | HsExprList [HsExpr p]
  | HsExprRecordCon (HsName p) [(HsName p, HsExpr p)]
  | HsExprLitString Text
  | HsExprLam [HsPat p] (HsExpr p)
  | HsExprCase (HsExpr p) [(HsPat p, HsExpr p)]
  | HsExprOther
  deriving (Int -> HsExprData p -> ShowS
[HsExprData p] -> ShowS
HsExprData p -> String
(Int -> HsExprData p -> ShowS)
-> (HsExprData p -> String)
-> ([HsExprData p] -> ShowS)
-> Show (HsExprData p)
forall p. Int -> HsExprData p -> ShowS
forall p. [HsExprData p] -> ShowS
forall p. HsExprData p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> HsExprData p -> ShowS
showsPrec :: Int -> HsExprData p -> ShowS
$cshow :: forall p. HsExprData p -> String
show :: HsExprData p -> String
$cshowList :: forall p. [HsExprData p] -> ShowS
showList :: [HsExprData p] -> ShowS
Show)

getExpr :: HsExpr p -> HsExprData p
getExpr :: forall p. HsExpr p -> HsExprData p
getExpr HsExprUnsafe{HsExprData p
hsExpr :: forall p. HsExpr p -> HsExprData p
hsExpr :: HsExprData p
hsExpr} = HsExprData p
hsExpr

getLoc :: HsExpr p -> Maybe GHC.SrcSpan
getLoc :: forall p. HsExpr p -> Maybe SrcSpan
getLoc HsExprUnsafe{Maybe (GhcLHsExpr p)
ghcExpr :: forall p. HsExpr p -> Maybe (GhcLHsExpr p)
ghcExpr :: Maybe (GhcLHsExpr p)
ghcExpr} = GhcLHsExpr p -> SrcSpan
forall p. GhcLHsExpr p -> SrcSpan
getLoc' (GhcLHsExpr p -> SrcSpan) -> Maybe (GhcLHsExpr p) -> Maybe SrcSpan
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GhcLHsExpr p)
ghcExpr
 where
  getLoc' :: GhcLHsExpr p -> GHC.SrcSpan
  getLoc' :: forall p. GhcLHsExpr p -> SrcSpan
getLoc' = \case
    GhcLHsExprPs LHsExpr GhcPs
e -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    GhcLHsExprRn LHsExpr GhcRn
e -> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e

renderHsExpr :: HsExpr GhcRn -> Text
renderHsExpr :: HsExpr GhcRn -> ModuleName
renderHsExpr = \case
  HsExprUnsafe{ghcExpr :: forall p. HsExpr p -> Maybe (GhcLHsExpr p)
ghcExpr = Just GhcLHsExpr GhcRn
e} -> GhcLHsExpr GhcRn -> ModuleName
forall a. Show a => a -> ModuleName
showT GhcLHsExpr GhcRn
e
  HsExprUnsafe{hsExpr :: forall p. HsExpr p -> HsExprData p
hsExpr = HsExprData GhcRn
e} -> HsExprData GhcRn -> ModuleName
forall a. Show a => a -> ModuleName
showT HsExprData GhcRn
e

newHsExpr :: HsExprData p -> HsExpr p
newHsExpr :: forall p. HsExprData p -> HsExpr p
newHsExpr HsExprData p
e =
  HsExprUnsafe
    { ghcExpr :: Maybe (GhcLHsExpr p)
ghcExpr = Maybe (GhcLHsExpr p)
forall a. Maybe a
Nothing
    , hsExpr :: HsExprData p
hsExpr = HsExprData p
e
    }

hsExprCon :: HsName p -> HsExpr p
hsExprCon :: forall p. HsName p -> HsExpr p
hsExprCon = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p)
-> (HsName p -> HsExprData p) -> HsName p -> HsExpr p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsName p -> HsExprData p
forall p. HsName p -> HsExprData p
HsExprCon

hsExprVar :: HsName p -> HsExpr p
hsExprVar :: forall p. HsName p -> HsExpr p
hsExprVar = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p)
-> (HsName p -> HsExprData p) -> HsName p -> HsExpr p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsName p -> HsExprData p
forall p. HsName p -> HsExprData p
HsExprVar

hsExprApps :: HsExpr p -> [HsExpr p] -> HsExpr p
hsExprApps :: forall p. HsExpr p -> [HsExpr p] -> HsExpr p
hsExprApps HsExpr p
f [HsExpr p]
xs = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p) -> HsExprData p -> HsExpr p
forall a b. (a -> b) -> a -> b
$ HsExpr p -> [HsExpr p] -> HsExprData p
forall p. HsExpr p -> [HsExpr p] -> HsExprData p
HsExprApps HsExpr p
f [HsExpr p]
xs

hsExprList :: [HsExpr p] -> HsExpr p
hsExprList :: forall p. [HsExpr p] -> HsExpr p
hsExprList = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p)
-> ([HsExpr p] -> HsExprData p) -> [HsExpr p] -> HsExpr p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HsExpr p] -> HsExprData p
forall p. [HsExpr p] -> HsExprData p
HsExprList

hsExprRecordCon :: HsName p -> [(HsName p, HsExpr p)] -> HsExpr p
hsExprRecordCon :: forall p. HsName p -> [(HsName p, HsExpr p)] -> HsExpr p
hsExprRecordCon HsName p
conName [(HsName p, HsExpr p)]
fields = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p) -> HsExprData p -> HsExpr p
forall a b. (a -> b) -> a -> b
$ HsName p -> [(HsName p, HsExpr p)] -> HsExprData p
forall p. HsName p -> [(HsName p, HsExpr p)] -> HsExprData p
HsExprRecordCon HsName p
conName [(HsName p, HsExpr p)]
fields

hsExprLitString :: Text -> HsExpr p
hsExprLitString :: forall p. ModuleName -> HsExpr p
hsExprLitString = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p)
-> (ModuleName -> HsExprData p) -> ModuleName -> HsExpr p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> HsExprData p
forall p. ModuleName -> HsExprData p
HsExprLitString

hsExprLam :: [HsPat p] -> HsExpr p -> HsExpr p
hsExprLam :: forall p. [HsPat p] -> HsExpr p -> HsExpr p
hsExprLam [HsPat p]
args HsExpr p
body = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p) -> HsExprData p -> HsExpr p
forall a b. (a -> b) -> a -> b
$ [HsPat p] -> HsExpr p -> HsExprData p
forall p. [HsPat p] -> HsExpr p -> HsExprData p
HsExprLam [HsPat p]
args HsExpr p
body

hsExprCase :: HsExpr p -> [(HsPat p, HsExpr p)] -> HsExpr p
hsExprCase :: forall p. HsExpr p -> [(HsPat p, HsExpr p)] -> HsExpr p
hsExprCase HsExpr p
e [(HsPat p, HsExpr p)]
branches = HsExprData p -> HsExpr p
forall p. HsExprData p -> HsExpr p
newHsExpr (HsExprData p -> HsExpr p) -> HsExprData p -> HsExpr p
forall a b. (a -> b) -> a -> b
$ HsExpr p -> [(HsPat p, HsExpr p)] -> HsExprData p
forall p. HsExpr p -> [(HsPat p, HsExpr p)] -> HsExprData p
HsExprCase HsExpr p
e [(HsPat p, HsExpr p)]
branches

parseHsExpr :: GHC.LHsExpr GhcRn -> HsExpr GhcRn
parseHsExpr :: LHsExpr GhcRn -> HsExpr GhcRn
parseHsExpr = LHsExpr GhcRn -> HsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr
 where
  goExpr :: GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr GenLocated SrcSpanAnnA (HsExpr GhcRn)
e =
    HsExprUnsafe
      { ghcExpr :: Maybe (GhcLHsExpr GhcRn)
ghcExpr = GhcLHsExpr GhcRn -> Maybe (GhcLHsExpr GhcRn)
forall a. a -> Maybe a
Just (GhcLHsExpr GhcRn -> Maybe (GhcLHsExpr GhcRn))
-> GhcLHsExpr GhcRn -> Maybe (GhcLHsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcRn -> GhcLHsExpr GhcRn
GhcLHsExprRn LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e
      , hsExpr :: HsExprData GhcRn
hsExpr = GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExprData GhcRn
goData GenLocated SrcSpanAnnA (HsExpr GhcRn)
e
      }

  goData :: GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExprData GhcRn
goData = \case
    L SrcSpanAnnA
_ (GHC.HsVar XVar GhcRn
_ LIdP GhcRn
name) ->
      if (OccName -> NameSpace
GHC.occNameSpace (OccName -> NameSpace) -> (Name -> OccName) -> Name -> NameSpace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall a. NamedThing a => a -> OccName
GHC.getOccName) (GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc LIdP GhcRn
GenLocated SrcSpanAnnN Name
name) NameSpace -> NameSpace -> Bool
forall a. Eq a => a -> a -> Bool
== NameSpace
GHC.Name.dataName
        then HsName GhcRn -> HsExprData GhcRn
forall p. HsName p -> HsExprData p
HsExprCon (IdP GhcRn -> HsName GhcRn
Name -> HsName GhcRn
forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName (Name -> HsName GhcRn)
-> (LIdP GhcRn -> Name) -> LIdP GhcRn -> HsName GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIdP GhcRn -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l. GenLocated l Name -> Name
GHC.Compat.unLocWithUserRdr (LIdP GhcRn -> HsName GhcRn) -> LIdP GhcRn -> HsName GhcRn
forall a b. (a -> b) -> a -> b
$ LIdP GhcRn
name)
        else HsName GhcRn -> HsExprData GhcRn
forall p. HsName p -> HsExprData p
HsExprVar (IdP GhcRn -> HsName GhcRn
Name -> HsName GhcRn
forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName (Name -> HsName GhcRn)
-> (LIdP GhcRn -> Name) -> LIdP GhcRn -> HsName GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIdP GhcRn -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l. GenLocated l Name -> Name
GHC.Compat.unLocWithUserRdr (LIdP GhcRn -> HsName GhcRn) -> LIdP GhcRn -> HsName GhcRn
forall a b. (a -> b) -> a -> b
$ LIdP GhcRn
name)
    e :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
e@(L SrcSpanAnnA
_ GHC.HsApp{}) ->
      let (GenLocated SrcSpanAnnA (HsExpr GhcRn)
f, [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
xs) = GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn),
    [GenLocated SrcSpanAnnA (HsExpr GhcRn)])
collectApps GenLocated SrcSpanAnnA (HsExpr GhcRn)
e
       in HsExpr GhcRn -> [HsExpr GhcRn] -> HsExprData GhcRn
forall p. HsExpr p -> [HsExpr p] -> HsExprData p
HsExprApps (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr GenLocated SrcSpanAnnA (HsExpr GhcRn)
f) ((GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)] -> [HsExpr GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
xs)
    L SrcSpanAnnA
_ (GHC.OpApp XOpApp GhcRn
_ LHsExpr GhcRn
lhs LHsExpr GhcRn
op LHsExpr GhcRn
rhs) ->
      HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn -> HsExprData GhcRn
forall p. HsExpr p -> HsExpr p -> HsExpr p -> HsExprData p
HsExprOp (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
lhs) (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
op) (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhs)
    L SrcSpanAnnA
_ (GHC.RecordCon XRecordCon GhcRn
_ XRec GhcRn (ConLikeP GhcRn)
conName GHC.HsRecFields{[LHsRecField GhcRn (LHsExpr GhcRn)]
rec_flds :: [LHsRecField GhcRn (LHsExpr GhcRn)]
rec_flds :: forall p arg. HsRecFields p arg -> [LHsRecField p arg]
rec_flds}) ->
      HsName GhcRn -> [(HsName GhcRn, HsExpr GhcRn)] -> HsExprData GhcRn
forall p. HsName p -> [(HsName p, HsExpr p)] -> HsExprData p
HsExprRecordCon (IdP GhcRn -> HsName GhcRn
Name -> HsName GhcRn
forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName (Name -> HsName GhcRn)
-> (XRec GhcRn (ConLikeP GhcRn) -> Name)
-> XRec GhcRn (ConLikeP GhcRn)
-> HsName GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcRn (ConLikeP GhcRn) -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l. GenLocated l Name -> Name
GHC.Compat.unLocWithUserRdr (XRec GhcRn (ConLikeP GhcRn) -> HsName GhcRn)
-> XRec GhcRn (ConLikeP GhcRn) -> HsName GhcRn
forall a b. (a -> b) -> a -> b
$ XRec GhcRn (ConLikeP GhcRn)
conName) ([(HsName GhcRn, HsExpr GhcRn)] -> HsExprData GhcRn)
-> [(HsName GhcRn, HsExpr GhcRn)] -> HsExprData GhcRn
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> (HsName GhcRn, HsExpr GhcRn))
-> [GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> [(HsName GhcRn, HsExpr GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
  (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> (HsName GhcRn, HsExpr GhcRn)
getRecField (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
   (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> (HsName GhcRn, HsExpr GhcRn))
-> (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
         (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
        (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> (HsName GhcRn, HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
     (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc) [LHsRecField GhcRn (LHsExpr GhcRn)]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
      (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
rec_flds
    L SrcSpanAnnA
_ par :: HsExpr GhcRn
par@GHC.HsPar{} -> LHsExpr GhcRn -> HsExprData GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExprData GhcRn
goData (LHsExpr GhcRn -> HsExprData GhcRn)
-> LHsExpr GhcRn -> HsExprData GhcRn
forall a b. (a -> b) -> a -> b
$ HsExpr GhcRn -> LHsExpr GhcRn
GHC.Compat.unHsPar HsExpr GhcRn
par
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
_ -> HsExprData GhcRn
forall p. HsExprData p
HsExprOther

  getRecField :: HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn))
  (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> (HsName GhcRn, HsExpr GhcRn)
getRecField GHC.HsFieldBind{hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
hfbLHS = GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
field, hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr} =
    (IdP GhcRn -> HsName GhcRn
Name -> HsName GhcRn
forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName (Name -> HsName GhcRn)
-> (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn) -> Name)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
-> HsName GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN Name -> Name)
-> (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
    -> GenLocated SrcSpanAnnN Name)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcRn -> LIdP GhcRn
FieldOcc GhcRn -> GenLocated SrcSpanAnnN Name
GHC.Compat.foLabel (FieldOcc GhcRn -> GenLocated SrcSpanAnnN Name)
-> (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
    -> FieldOcc GhcRn)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
-> GenLocated SrcSpanAnnN Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn) -> FieldOcc GhcRn
forall l e. GenLocated l e -> e
unLoc (GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn) -> HsName GhcRn)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn) -> HsName GhcRn
forall a b. (a -> b) -> a -> b
$ GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcRn)
field, GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
goExpr GenLocated SrcSpanAnnA (HsExpr GhcRn)
expr)

  -- Collect an application of the form `((f a) b) c` and return `f [a, b, c]`
  collectApps :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn),
    [GenLocated SrcSpanAnnA (HsExpr GhcRn)])
collectApps = \case
    L SrcSpanAnnA
_ (GHC.HsApp XApp GhcRn
_ LHsExpr GhcRn
l LHsExpr GhcRn
r) -> let (GenLocated SrcSpanAnnA (HsExpr GhcRn)
f, [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
xs) = GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn),
    [GenLocated SrcSpanAnnA (HsExpr GhcRn)])
collectApps LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
l in (GenLocated SrcSpanAnnA (HsExpr GhcRn)
f, [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
xs [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
forall a. Semigroup a => a -> a -> a
<> [LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
r])
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
e -> (GenLocated SrcSpanAnnA (HsExpr GhcRn)
e, [])

{----- HsType -----}

data HsType p
  = HsTypeCon (HsName p)
  | HsTypeApps (HsType p) [HsType p]
  | HsTypeTuple [HsType p]

{----- HsPat -----}

data HsPat p
  = HsPatCon (HsName p) [HsPat p]
  | HsPatVar (HsName p)
  | HsPatRecord (HsName p) [(HsName p, HsPat p)]
  | HsPatWild
  deriving (Int -> HsPat p -> ShowS
[HsPat p] -> ShowS
HsPat p -> String
(Int -> HsPat p -> ShowS)
-> (HsPat p -> String) -> ([HsPat p] -> ShowS) -> Show (HsPat p)
forall p. Int -> HsPat p -> ShowS
forall p. [HsPat p] -> ShowS
forall p. HsPat p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> HsPat p -> ShowS
showsPrec :: Int -> HsPat p -> ShowS
$cshow :: forall p. HsPat p -> String
show :: HsPat p -> String
$cshowList :: forall p. [HsPat p] -> ShowS
showList :: [HsPat p] -> ShowS
Show)

{----- HsName -----}

data HsName p
  = HsName TH.Name
  | HsVarName Text
  | HsGhcName (GhcIdP p)
  deriving (Int -> HsName p -> ShowS
[HsName p] -> ShowS
HsName p -> String
(Int -> HsName p -> ShowS)
-> (HsName p -> String) -> ([HsName p] -> ShowS) -> Show (HsName p)
forall p. Int -> HsName p -> ShowS
forall p. [HsName p] -> ShowS
forall p. HsName p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall p. Int -> HsName p -> ShowS
showsPrec :: Int -> HsName p -> ShowS
$cshow :: forall p. HsName p -> String
show :: HsName p -> String
$cshowList :: forall p. [HsName p] -> ShowS
showList :: [HsName p] -> ShowS
Show, HsName p -> HsName p -> Bool
(HsName p -> HsName p -> Bool)
-> (HsName p -> HsName p -> Bool) -> Eq (HsName p)
forall p. HsName p -> HsName p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall p. HsName p -> HsName p -> Bool
== :: HsName p -> HsName p -> Bool
$c/= :: forall p. HsName p -> HsName p -> Bool
/= :: HsName p -> HsName p -> Bool
Eq)

hsName :: TH.Name -> HsName p
hsName :: forall p. Name -> HsName p
hsName = Name -> HsName p
forall p. Name -> HsName p
HsName

hsVarName :: Text -> HsName p
hsVarName :: forall p. ModuleName -> HsName p
hsVarName = ModuleName -> HsName p
forall p. ModuleName -> HsName p
HsVarName

hsFieldName :: TH.Name -> String -> HsName p
hsFieldName :: forall p. Name -> String -> HsName p
hsFieldName Name
conName String
fieldName =
  Name -> HsName p
forall p. Name -> HsName p
HsName (Name -> HsName p) -> Name -> HsName p
forall a b. (a -> b) -> a -> b
$
    String -> String -> String -> String -> Name
TH.mkNameG_fld
      (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Name -> Maybe String
TH.namePackage Name
conName)
      (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Name -> Maybe String
TH.nameModule Name
conName)
      (Name -> String
TH.nameBase Name
conName)
      String
fieldName

hsGhcName :: forall p. (IsPass p) => GHC.IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName :: forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> HsName (GhcPass p)
hsGhcName = GhcIdP (GhcPass p) -> HsName (GhcPass p)
forall p. GhcIdP p -> HsName p
HsGhcName (GhcIdP (GhcPass p) -> HsName (GhcPass p))
-> (IdGhcP p -> GhcIdP (GhcPass p))
-> IdGhcP p
-> HsName (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p (p ~ 'Parsed) => IdGhcP p -> GhcIdP (GhcPass p)
RdrName -> GhcIdP GhcPs
IdGhcP p -> GhcIdP (GhcPass p)
GhcIdPs (p ~ 'Renamed) => IdGhcP p -> GhcIdP (GhcPass p)
Name -> GhcIdP GhcRn
IdGhcP p -> GhcIdP (GhcPass p)
GhcIdRn

fromTHName :: GHC.NameCache -> TH.Name -> GHC.Name
fromTHName :: NameCache -> Name -> Name
fromTHName NameCache
nameCache Name
name =
  case IO (Maybe Name) -> Maybe Name
forall a. IO a -> a
unsafePerformIO (IO (Maybe Name) -> Maybe Name) -> IO (Maybe Name) -> Maybe Name
forall a b. (a -> b) -> a -> b
$ NameCache -> Name -> IO (Maybe Name)
GHC.thNameToGhcNameIO NameCache
nameCache Name
name of
    Just Name
n -> Name
n
    Maybe Name
Nothing -> String -> Name
forall a. HasCallStack => String -> a
invariantViolation (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"Could not get Name for `" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
forall a. Show a => a -> String
show Name
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"`"

matchesNameImpl :: GHC.NameCache -> HsName GhcRn -> HsName GhcRn -> Bool
matchesNameImpl :: NameCache -> HsName GhcRn -> HsName GhcRn -> Bool
matchesNameImpl NameCache
nameCache HsName GhcRn
n1 HsName GhcRn
n2 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Name -> Name -> Bool) -> Maybe Name -> Maybe (Name -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName GhcRn -> Maybe Name
go HsName GhcRn
n1 Maybe (Name -> Bool) -> Maybe Name -> Maybe Bool
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HsName GhcRn -> Maybe Name
go HsName GhcRn
n2
 where
  go :: HsName GhcRn -> Maybe Name
go = \case
    HsName Name
name -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ NameCache -> Name -> Name
fromTHName NameCache
nameCache Name
name
    HsVarName ModuleName
_ -> Maybe Name
forall a. Maybe a
Nothing -- new names will never match
    HsGhcName GhcIdP GhcRn
name -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ GhcIdP GhcRn -> IdP GhcRn
forall p. GhcIdP p -> IdP p
unGhcIdP GhcIdP GhcRn
name

getHsName :: HsName p -> Text
getHsName :: forall p. HsName p -> ModuleName
getHsName = \case
  HsName Name
name -> String -> ModuleName
Text.pack (String -> ModuleName) -> (Name -> String) -> Name -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
TH.nameBase (Name -> ModuleName) -> Name -> ModuleName
forall a b. (a -> b) -> a -> b
$ Name
name
  HsVarName ModuleName
name -> ModuleName
name
  HsGhcName (GhcIdPs RdrName
name) -> String -> ModuleName
Text.pack (String -> ModuleName)
-> (RdrName -> String) -> RdrName -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
GHC.occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
GHC.rdrNameOcc (RdrName -> ModuleName) -> RdrName -> ModuleName
forall a b. (a -> b) -> a -> b
$ RdrName
name
  HsGhcName (GhcIdRn Name
name) -> String -> ModuleName
Text.pack (String -> ModuleName) -> (Name -> String) -> Name -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> String
GHC.occNameString (OccName -> String) -> (Name -> OccName) -> Name -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
GHC.nameOccName (Name -> ModuleName) -> Name -> ModuleName
forall a b. (a -> b) -> a -> b
$ Name
name

{----- Compilation -----}

class (Monad m) => MonadHasNameCache m where
  getNameCache :: m GHC.NameCache
class (Monad m) => MonadCompileName m p where
  mkIdP :: Text -> m (GHC.IdP p)

type MonadCompile m p = (MonadHasNameCache m, MonadCompileName m p)

newtype CompilePs a = CompilePs (GHC.Hsc a)
  deriving ((forall a b. (a -> b) -> CompilePs a -> CompilePs b)
-> (forall a b. a -> CompilePs b -> CompilePs a)
-> Functor CompilePs
forall a b. a -> CompilePs b -> CompilePs a
forall a b. (a -> b) -> CompilePs a -> CompilePs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompilePs a -> CompilePs b
fmap :: forall a b. (a -> b) -> CompilePs a -> CompilePs b
$c<$ :: forall a b. a -> CompilePs b -> CompilePs a
<$ :: forall a b. a -> CompilePs b -> CompilePs a
Functor, Functor CompilePs
Functor CompilePs =>
(forall a. a -> CompilePs a)
-> (forall a b. CompilePs (a -> b) -> CompilePs a -> CompilePs b)
-> (forall a b c.
    (a -> b -> c) -> CompilePs a -> CompilePs b -> CompilePs c)
-> (forall a b. CompilePs a -> CompilePs b -> CompilePs b)
-> (forall a b. CompilePs a -> CompilePs b -> CompilePs a)
-> Applicative CompilePs
forall a. a -> CompilePs a
forall a b. CompilePs a -> CompilePs b -> CompilePs a
forall a b. CompilePs a -> CompilePs b -> CompilePs b
forall a b. CompilePs (a -> b) -> CompilePs a -> CompilePs b
forall a b c.
(a -> b -> c) -> CompilePs a -> CompilePs b -> CompilePs c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> CompilePs a
pure :: forall a. a -> CompilePs a
$c<*> :: forall a b. CompilePs (a -> b) -> CompilePs a -> CompilePs b
<*> :: forall a b. CompilePs (a -> b) -> CompilePs a -> CompilePs b
$cliftA2 :: forall a b c.
(a -> b -> c) -> CompilePs a -> CompilePs b -> CompilePs c
liftA2 :: forall a b c.
(a -> b -> c) -> CompilePs a -> CompilePs b -> CompilePs c
$c*> :: forall a b. CompilePs a -> CompilePs b -> CompilePs b
*> :: forall a b. CompilePs a -> CompilePs b -> CompilePs b
$c<* :: forall a b. CompilePs a -> CompilePs b -> CompilePs a
<* :: forall a b. CompilePs a -> CompilePs b -> CompilePs a
Applicative, Applicative CompilePs
Applicative CompilePs =>
(forall a b. CompilePs a -> (a -> CompilePs b) -> CompilePs b)
-> (forall a b. CompilePs a -> CompilePs b -> CompilePs b)
-> (forall a. a -> CompilePs a)
-> Monad CompilePs
forall a. a -> CompilePs a
forall a b. CompilePs a -> CompilePs b -> CompilePs b
forall a b. CompilePs a -> (a -> CompilePs b) -> CompilePs b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. CompilePs a -> (a -> CompilePs b) -> CompilePs b
>>= :: forall a b. CompilePs a -> (a -> CompilePs b) -> CompilePs b
$c>> :: forall a b. CompilePs a -> CompilePs b -> CompilePs b
>> :: forall a b. CompilePs a -> CompilePs b -> CompilePs b
$creturn :: forall a. a -> CompilePs a
return :: forall a. a -> CompilePs a
Monad)

runCompilePs :: CompilePs a -> GHC.Hsc a
runCompilePs :: forall a. CompilePs a -> Hsc a
runCompilePs (CompilePs Hsc a
m) = Hsc a
m

instance MonadHasNameCache CompilePs where
  getNameCache :: CompilePs NameCache
getNameCache = HscEnv -> NameCache
GHC.hsc_NC (HscEnv -> NameCache) -> CompilePs HscEnv -> CompilePs NameCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Hsc HscEnv -> CompilePs HscEnv
forall a. Hsc a -> CompilePs a
CompilePs Hsc HscEnv
GHC.getHscEnv
instance MonadCompileName CompilePs GhcPs where
  mkIdP :: ModuleName -> CompilePs (IdP GhcPs)
mkIdP = RdrName -> CompilePs RdrName
forall a. a -> CompilePs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RdrName -> CompilePs RdrName)
-> (ModuleName -> RdrName) -> ModuleName -> CompilePs RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpace -> FastString -> RdrName
GHC.mkUnqual NameSpace
GHC.Name.varName (FastString -> RdrName)
-> (ModuleName -> FastString) -> ModuleName -> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
fsText

newtype CompileRn a = CompileRn (StateT (Map Text GHC.Name) GHC.TcM a)
  deriving ((forall a b. (a -> b) -> CompileRn a -> CompileRn b)
-> (forall a b. a -> CompileRn b -> CompileRn a)
-> Functor CompileRn
forall a b. a -> CompileRn b -> CompileRn a
forall a b. (a -> b) -> CompileRn a -> CompileRn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CompileRn a -> CompileRn b
fmap :: forall a b. (a -> b) -> CompileRn a -> CompileRn b
$c<$ :: forall a b. a -> CompileRn b -> CompileRn a
<$ :: forall a b. a -> CompileRn b -> CompileRn a
Functor, Functor CompileRn
Functor CompileRn =>
(forall a. a -> CompileRn a)
-> (forall a b. CompileRn (a -> b) -> CompileRn a -> CompileRn b)
-> (forall a b c.
    (a -> b -> c) -> CompileRn a -> CompileRn b -> CompileRn c)
-> (forall a b. CompileRn a -> CompileRn b -> CompileRn b)
-> (forall a b. CompileRn a -> CompileRn b -> CompileRn a)
-> Applicative CompileRn
forall a. a -> CompileRn a
forall a b. CompileRn a -> CompileRn b -> CompileRn a
forall a b. CompileRn a -> CompileRn b -> CompileRn b
forall a b. CompileRn (a -> b) -> CompileRn a -> CompileRn b
forall a b c.
(a -> b -> c) -> CompileRn a -> CompileRn b -> CompileRn c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> CompileRn a
pure :: forall a. a -> CompileRn a
$c<*> :: forall a b. CompileRn (a -> b) -> CompileRn a -> CompileRn b
<*> :: forall a b. CompileRn (a -> b) -> CompileRn a -> CompileRn b
$cliftA2 :: forall a b c.
(a -> b -> c) -> CompileRn a -> CompileRn b -> CompileRn c
liftA2 :: forall a b c.
(a -> b -> c) -> CompileRn a -> CompileRn b -> CompileRn c
$c*> :: forall a b. CompileRn a -> CompileRn b -> CompileRn b
*> :: forall a b. CompileRn a -> CompileRn b -> CompileRn b
$c<* :: forall a b. CompileRn a -> CompileRn b -> CompileRn a
<* :: forall a b. CompileRn a -> CompileRn b -> CompileRn a
Applicative, Applicative CompileRn
Applicative CompileRn =>
(forall a b. CompileRn a -> (a -> CompileRn b) -> CompileRn b)
-> (forall a b. CompileRn a -> CompileRn b -> CompileRn b)
-> (forall a. a -> CompileRn a)
-> Monad CompileRn
forall a. a -> CompileRn a
forall a b. CompileRn a -> CompileRn b -> CompileRn b
forall a b. CompileRn a -> (a -> CompileRn b) -> CompileRn b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. CompileRn a -> (a -> CompileRn b) -> CompileRn b
>>= :: forall a b. CompileRn a -> (a -> CompileRn b) -> CompileRn b
$c>> :: forall a b. CompileRn a -> CompileRn b -> CompileRn b
>> :: forall a b. CompileRn a -> CompileRn b -> CompileRn b
$creturn :: forall a. a -> CompileRn a
return :: forall a. a -> CompileRn a
Monad)

runCompileRn :: CompileRn a -> GHC.TcM a
runCompileRn :: forall a. CompileRn a -> TcM a
runCompileRn (CompileRn StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
m) = IOEnv (Env TcGblEnv TcLclEnv) a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall {a}.
IOEnv (Env TcGblEnv TcLclEnv) a -> IOEnv (Env TcGblEnv TcLclEnv) a
handleCompilationError (IOEnv (Env TcGblEnv TcLclEnv) a
 -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall a b. (a -> b) -> a -> b
$ StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
-> Map ModuleName Name -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
m Map ModuleName Name
forall k a. Map k a
Map.empty
 where
  handleCompilationError :: IOEnv (Env TcGblEnv TcLclEnv) a -> IOEnv (Env TcGblEnv TcLclEnv) a
handleCompilationError =
    (SkeletestError -> Maybe (IOEnv (Env TcGblEnv TcLclEnv) a))
-> (IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> (b -> m a) -> m a -> m a
handleJust
      ( \case
          CompilationError Maybe SrcSpan
mloc ModuleName
msg -> IOEnv (Env TcGblEnv TcLclEnv) a
-> Maybe (IOEnv (Env TcGblEnv TcLclEnv) a)
forall a. a -> Maybe a
Just (IOEnv (Env TcGblEnv TcLclEnv) a
 -> Maybe (IOEnv (Env TcGblEnv TcLclEnv) a))
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> Maybe (IOEnv (Env TcGblEnv TcLclEnv) a)
forall a b. (a -> b) -> a -> b
$ do
            SrcSpan -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) a
forall a. SrcSpan -> TcRnMessage -> TcRn a
GHC.failAt (SrcSpan -> Maybe SrcSpan -> SrcSpan
forall a. a -> Maybe a -> a
fromMaybe SrcSpan
GHC.noSrcSpan Maybe SrcSpan
mloc) (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) a
forall a b. (a -> b) -> a -> b
$ ModuleName -> TcRnMessage
mkTcError ModuleName
msg
          SkeletestError
_ -> Maybe (IOEnv (Env TcGblEnv TcLclEnv) a)
forall a. Maybe a
Nothing
      )
      IOEnv (Env TcGblEnv TcLclEnv) a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall a. a -> a
id

  mkTcError :: ModuleName -> TcRnMessage
mkTcError = DiagnosticMessage -> TcRnMessage
forall a.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> TcRnMessage
GHC.mkTcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> (ModuleName -> DiagnosticMessage) -> ModuleName -> TcRnMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcHint] -> SDoc -> DiagnosticMessage
GHC.mkPlainError [GhcHint]
GHC.noHints (SDoc -> DiagnosticMessage)
-> (ModuleName -> SDoc) -> ModuleName -> DiagnosticMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
forall doc. IsLine doc => String -> doc
GHC.text (String -> SDoc) -> (ModuleName -> String) -> ModuleName -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
Text.unpack

instance MonadHasNameCache CompileRn where
  getNameCache :: CompileRn NameCache
getNameCache = HscEnv -> NameCache
GHC.hsc_NC (HscEnv -> NameCache)
-> (Env TcGblEnv TcLclEnv -> HscEnv)
-> Env TcGblEnv TcLclEnv
-> NameCache
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
GHC.env_top (Env TcGblEnv TcLclEnv -> NameCache)
-> CompileRn (Env TcGblEnv TcLclEnv) -> CompileRn NameCache
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT
  (Map ModuleName Name)
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Env TcGblEnv TcLclEnv)
-> CompileRn (Env TcGblEnv TcLclEnv)
forall a.
StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
-> CompileRn a
CompileRn (StateT
   (Map ModuleName Name)
   (IOEnv (Env TcGblEnv TcLclEnv))
   (Env TcGblEnv TcLclEnv)
 -> CompileRn (Env TcGblEnv TcLclEnv))
-> (IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
    -> StateT
         (Map ModuleName Name)
         (IOEnv (Env TcGblEnv TcLclEnv))
         (Env TcGblEnv TcLclEnv))
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> CompileRn (Env TcGblEnv TcLclEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> StateT
     (Map ModuleName Name)
     (IOEnv (Env TcGblEnv TcLclEnv))
     (Env TcGblEnv TcLclEnv)
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Map ModuleName Name) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift) IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
GHC.getEnv
instance MonadCompileName CompileRn GhcRn where
  mkIdP :: ModuleName -> CompileRn (IdP GhcRn)
mkIdP ModuleName
name = do
    Map ModuleName Name
nameMap <- StateT
  (Map ModuleName Name)
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Map ModuleName Name)
-> CompileRn (Map ModuleName Name)
forall a.
StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
-> CompileRn a
CompileRn StateT
  (Map ModuleName Name)
  (IOEnv (Env TcGblEnv TcLclEnv))
  (Map ModuleName Name)
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
    case ModuleName -> Map ModuleName Name -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
name Map ModuleName Name
nameMap of
      Just Name
name' -> Name -> CompileRn Name
forall a. a -> CompileRn a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name'
      Maybe Name
Nothing -> do
        Unique
uniq <- (StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) Unique
-> CompileRn Unique
forall a.
StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
-> CompileRn a
CompileRn (StateT
   (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) Unique
 -> CompileRn Unique)
-> (TcM Unique
    -> StateT
         (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) Unique)
-> TcM Unique
-> CompileRn Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TcM Unique
-> StateT
     (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) Unique
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Map ModuleName Name) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift) TcM Unique
forall (m :: * -> *). MonadUnique m => m Unique
GHC.getUniqueM
        let name' :: Name
name' = Unique -> FastString -> Name
GHC.mkSystemVarName Unique
uniq (ModuleName -> FastString
fsText ModuleName
name)
        StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) ()
-> CompileRn ()
forall a.
StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) a
-> CompileRn a
CompileRn (StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) ()
 -> CompileRn ())
-> StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) ()
-> CompileRn ()
forall a b. (a -> b) -> a -> b
$ Map ModuleName Name
-> StateT (Map ModuleName Name) (IOEnv (Env TcGblEnv TcLclEnv)) ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (ModuleName -> Name -> Map ModuleName Name -> Map ModuleName Name
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ModuleName
name Name
name' Map ModuleName Name
nameMap)
        Name -> CompileRn Name
forall a. a -> CompileRn a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Name
name'

compileHsName ::
  forall p m.
  (GHC.IsPass p, MonadCompile m (GhcPass p)) =>
  HsName (GhcPass p) ->
  m (GHC.IdP (GhcPass p))
compileHsName :: forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName = \case
  HsName Name
name -> do
    NameCache
nameCache <- m NameCache
forall (m :: * -> *). MonadHasNameCache m => m NameCache
getNameCache
    IdGhcP p -> m (IdGhcP p)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdGhcP p -> m (IdGhcP p))
-> (Name -> IdGhcP p) -> Name -> m (IdGhcP p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p (p ~ 'Parsed) => Name -> IdGhcP p
Name -> RdrName
Name -> IdGhcP p
forall thing. NamedThing thing => thing -> RdrName
GHC.getRdrName (p ~ 'Renamed) => Name -> IdGhcP p
Name -> Name
Name -> IdGhcP p
forall a. a -> a
id (Name -> m (IdGhcP p)) -> Name -> m (IdGhcP p)
forall a b. (a -> b) -> a -> b
$ NameCache -> Name -> Name
fromTHName NameCache
nameCache Name
name
  HsVarName ModuleName
name -> forall (m :: * -> *) p.
MonadCompileName m p =>
ModuleName -> m (IdP p)
mkIdP @_ @(GhcPass p) ModuleName
name
  HsGhcName GhcIdP (GhcPass p)
name -> IdP (GhcPass p) -> m (IdP (GhcPass p))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdP (GhcPass p) -> m (IdP (GhcPass p)))
-> IdP (GhcPass p) -> m (IdP (GhcPass p))
forall a b. (a -> b) -> a -> b
$ GhcIdP (GhcPass p) -> IdP (GhcPass p)
forall p. GhcIdP p -> IdP p
unGhcIdP GhcIdP (GhcPass p)
name

compileFunDef :: (MonadCompile m GhcPs) => HsName GhcPs -> FunDef -> m [GHC.LHsDecl GhcPs]
compileFunDef :: forall (m :: * -> *).
MonadCompile m GhcPs =>
HsName GhcPs -> FunDef -> m [LHsDecl GhcPs]
compileFunDef HsName GhcPs
funName FunDef{[HsPat GhcPs]
HsType GhcPs
HsExpr GhcPs
funType :: FunDef -> HsType GhcPs
funPats :: FunDef -> [HsPat GhcPs]
funBody :: FunDef -> HsExpr GhcPs
funType :: HsType GhcPs
funPats :: [HsPat GhcPs]
funBody :: HsExpr GhcPs
..} = do
  RdrName
name <- HsName GhcPs -> m (IdP GhcPs)
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName GhcPs
funName
  GenLocated SrcSpanAnnA (HsType GhcPs)
ty <- HsType GhcPs -> m (LHsType GhcPs)
forall (m :: * -> *).
MonadCompile m GhcPs =>
HsType GhcPs -> m (LHsType GhcPs)
compileHsType HsType GhcPs
funType
  [GenLocated SrcSpanAnnA (Pat GhcPs)]
pats <- (HsPat GhcPs -> m (GenLocated SrcSpanAnnA (Pat GhcPs)))
-> [HsPat GhcPs] -> m [GenLocated SrcSpanAnnA (Pat GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsPat GhcPs -> m (LPat GhcPs)
HsPat GhcPs -> m (GenLocated SrcSpanAnnA (Pat GhcPs))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsPat (GhcPass p) -> m (LPat (GhcPass p))
compileHsPat [HsPat GhcPs]
funPats
  GenLocated SrcSpanAnnA (HsExpr GhcPs)
body <- HsExpr GhcPs -> m (LHsExpr GhcPs)
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
compileHsExpr HsExpr GhcPs
funBody
  [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
-> m [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    [ IdP GhcPs -> LHsType GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall {pass} {ann} {ann} {a} {ann}.
(XHsWC pass (GenLocated (SrcAnn ann) (HsSigType pass))
 ~ NoExtField,
 XSigD pass ~ NoExtField, XHsSig pass ~ NoExtField,
 XRec pass (IdP pass) ~ GenLocated (SrcAnn ann) (IdP pass),
 XRec pass (HsSigType pass)
 ~ GenLocated (SrcAnn ann) (HsSigType pass),
 XTypeSig pass ~ EpAnn a, XHsOuterImplicit pass ~ NoExtField) =>
IdP pass
-> XRec pass (HsType pass) -> GenLocated (SrcAnn ann) (HsDecl pass)
mkSigD IdP GhcPs
RdrName
name LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ty
    , HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsDecl GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> (HsBindLR GhcPs GhcPs -> HsDecl GhcPs)
-> HsBindLR GhcPs GhcPs
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XValD GhcPs -> HsBindLR GhcPs GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
GHC.ValD XValD GhcPs
NoExtField
GHC.noExtField (HsBindLR GhcPs GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> HsBindLR GhcPs GhcPs -> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$
        XFunBind GhcPs GhcPs
-> LIdP GhcPs
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> HsBindLR GhcPs GhcPs
forall idL idR.
XFunBind idL idR
-> LIdP idL -> MatchGroup idR (LHsExpr idR) -> HsBindLR idL idR
GHC.FunBind XFunBind GhcPs GhcPs
NoExtField
GHC.noExtField (RdrName -> GenLocated SrcSpanAnnN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc RdrName
name) (MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
 -> HsBindLR GhcPs GhcPs)
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsBindLR GhcPs GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> XRec
     GhcPs [LMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
GHC.MG XMG GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
Origin
GHC.FromSource (GenLocated
   SrcSpanAnnL
   [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> ([GenLocated
       SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))])
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> MatchGroup GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated
   SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc ([GenLocated
    SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
 -> HsBindLR GhcPs GhcPs)
-> [GenLocated
      SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> HsBindLR GhcPs GhcPs
forall a b. (a -> b) -> a -> b
$
          [ Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     SrcSpanAnnA (Match GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc
              GHC.Match
                { m_ext :: XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_ext = XCMatch (GhcPass Any) Any
XCMatch GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall (p :: Pass) b. XCMatch (GhcPass p) b
GHC.Compat.xMatch
                , m_ctxt :: HsMatchContext GhcPs
m_ctxt = LIdP GhcPs -> EpAnn () -> HsMatchContext GhcPs
GHC.Compat.mkPrefixFunRhs (RdrName -> GenLocated SrcSpanAnnN RdrName
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc RdrName
name) EpAnn ()
forall a. EpAnn a
GHC.noAnn
                , m_pats :: [LPat GhcPs]
m_pats = [LPat GhcPs] -> [LPat GhcPs]
forall p. [LPat p] -> [LPat p]
GHC.Compat.toMatchArgs [LPat GhcPs]
[GenLocated SrcSpanAnnA (Pat GhcPs)]
pats
                , m_grhss :: GRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
m_grhss =
                    GHC.GRHSs
                      { grhssExt :: XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
grhssExt = XCGRHSs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnnComments
GHC.emptyComments
                      , grhssGRHSs :: [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
grhssGRHSs = NonEmpty (LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall p body. NonEmpty (LGRHS p body) -> [LGRHS p body]
GHC.Compat.toGrhssGRHSs (NonEmpty (LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
 -> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))])
-> NonEmpty (LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [LGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))]
forall a b. (a -> b) -> a -> b
$ GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
-> [GuardLStmt GhcPs]
-> GenLocated SrcSpanAnnA (HsExpr GhcPs)
-> GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GHC.GRHS XCGRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
EpAnn GrhsAnn
forall a. EpAnn a
GHC.noAnn [] GenLocated SrcSpanAnnA (HsExpr GhcPs)
body) GenLocated
  (SrcAnn NoEpAnns)
  (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))]
-> NonEmpty
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| []
                      , grhssLocalBinds :: HsLocalBinds GhcPs
grhssLocalBinds = XEmptyLocalBinds GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
GHC.EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
NoExtField
GHC.noExtField
                      }
                }
          ]
    ]
 where
  mkSigD :: IdP pass
-> XRec pass (HsType pass) -> GenLocated (SrcAnn ann) (HsDecl pass)
mkSigD IdP pass
name XRec pass (HsType pass)
ty =
    HsDecl pass -> GenLocated (SrcAnn ann) (HsDecl pass)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc
      (HsDecl pass -> GenLocated (SrcAnn ann) (HsDecl pass))
-> (HsSigType pass -> HsDecl pass)
-> HsSigType pass
-> GenLocated (SrcAnn ann) (HsDecl pass)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XSigD pass -> Sig pass -> HsDecl pass
forall p. XSigD p -> Sig p -> HsDecl p
GHC.SigD XSigD pass
NoExtField
GHC.noExtField
      (Sig pass -> HsDecl pass)
-> (HsSigType pass -> Sig pass) -> HsSigType pass -> HsDecl pass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTypeSig pass
-> [XRec pass (IdP pass)] -> LHsSigWcType pass -> Sig pass
forall pass.
XTypeSig pass -> [LIdP pass] -> LHsSigWcType pass -> Sig pass
GHC.TypeSig XTypeSig pass
EpAnn a
forall a. EpAnn a
GHC.noAnn [IdP pass -> GenLocated (SrcAnn ann) (IdP pass)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc IdP pass
name]
      (HsWildCardBndrs pass (GenLocated (SrcAnn ann) (HsSigType pass))
 -> Sig pass)
-> (HsSigType pass
    -> HsWildCardBndrs pass (GenLocated (SrcAnn ann) (HsSigType pass)))
-> HsSigType pass
-> Sig pass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XHsWC pass (GenLocated (SrcAnn ann) (HsSigType pass))
-> GenLocated (SrcAnn ann) (HsSigType pass)
-> HsWildCardBndrs pass (GenLocated (SrcAnn ann) (HsSigType pass))
forall pass thing.
XHsWC pass thing -> thing -> HsWildCardBndrs pass thing
GHC.HsWC XHsWC pass (GenLocated (SrcAnn ann) (HsSigType pass))
NoExtField
GHC.noExtField
      (GenLocated (SrcAnn ann) (HsSigType pass)
 -> HsWildCardBndrs pass (GenLocated (SrcAnn ann) (HsSigType pass)))
-> (HsSigType pass -> GenLocated (SrcAnn ann) (HsSigType pass))
-> HsSigType pass
-> HsWildCardBndrs pass (GenLocated (SrcAnn ann) (HsSigType pass))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType pass -> GenLocated (SrcAnn ann) (HsSigType pass)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc
      (HsSigType pass -> GenLocated (SrcAnn ann) (HsDecl pass))
-> HsSigType pass -> GenLocated (SrcAnn ann) (HsDecl pass)
forall a b. (a -> b) -> a -> b
$ XHsSig pass
-> HsOuterSigTyVarBndrs pass
-> XRec pass (HsType pass)
-> HsSigType pass
forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
GHC.HsSig XHsSig pass
NoExtField
GHC.noExtField (XHsOuterImplicit pass -> HsOuterSigTyVarBndrs pass
forall flag pass.
XHsOuterImplicit pass -> HsOuterTyVarBndrs flag pass
GHC.HsOuterImplicit XHsOuterImplicit pass
NoExtField
GHC.noExtField) XRec pass (HsType pass)
ty

compileHsType :: (MonadCompile m GhcPs) => HsType GhcPs -> m (GHC.LHsType GhcPs)
compileHsType :: forall (m :: * -> *).
MonadCompile m GhcPs =>
HsType GhcPs -> m (LHsType GhcPs)
compileHsType = HsType GhcPs -> m (LHsType GhcPs)
HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
go
 where
  go :: HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
go = \case
    HsTypeCon HsName GhcPs
name -> do
      HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> (IdP GhcPs -> HsType GhcPs)
-> IdP GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTyVar GhcPs -> PromotionFlag -> LIdP GhcPs -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
GHC.HsTyVar XTyVar GhcPs
EpAnn [AddEpAnn]
forall a. EpAnn a
GHC.noAnn PromotionFlag
GHC.NotPromoted (GenLocated SrcSpanAnnN (IdP GhcPs) -> HsType GhcPs)
-> (IdP GhcPs -> GenLocated SrcSpanAnnN (IdP GhcPs))
-> IdP GhcPs
-> HsType GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdP GhcPs -> GenLocated SrcSpanAnnN (IdP GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (IdP GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> m (IdP GhcPs) -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName GhcPs -> m (IdP GhcPs)
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName GhcPs
name
    HsTypeApps HsType GhcPs
ty0 [HsType GhcPs]
tys -> do
      GenLocated SrcSpanAnnA (HsType GhcPs)
ty0' <- HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
go HsType GhcPs
ty0
      [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys' <- (HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsType GhcPs] -> m [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
go [HsType GhcPs]
tys
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> m (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GenLocated SrcSpanAnnA (HsType GhcPs)
l GenLocated SrcSpanAnnA (HsType GhcPs)
r -> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XAppTy GhcPs -> LHsType GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
GHC.HsAppTy XAppTy GhcPs
NoExtField
GHC.noExtField LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
l LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
r) GenLocated SrcSpanAnnA (HsType GhcPs)
ty0' [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys'
    HsTypeTuple [HsType GhcPs]
tys -> do
      [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys' <- (HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsType GhcPs] -> m [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
go [HsType GhcPs]
tys
      GenLocated SrcSpanAnnA (HsType GhcPs)
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> m (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> (HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsType GhcPs
-> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> HsType GhcPs -> m (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a b. (a -> b) -> a -> b
$ XTupleTy GhcPs -> HsTupleSort -> [LHsType GhcPs] -> HsType GhcPs
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
GHC.HsTupleTy XTupleTy GhcPs
EpAnn AnnParen
forall a. EpAnn a
GHC.noAnn HsTupleSort
GHC.HsBoxedOrConstraintTuple [LHsType GhcPs]
[GenLocated SrcSpanAnnA (HsType GhcPs)]
tys'

compileHsPat ::
  forall p m.
  (IsPass p, MonadCompile m (GhcPass p)) =>
  HsPat (GhcPass p) ->
  m (GHC.LPat (GhcPass p))
compileHsPat :: forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsPat (GhcPass p) -> m (LPat (GhcPass p))
compileHsPat = HsPat (GhcPass p) -> m (XRec (GhcPass p) (Pat (GhcPass p)))
HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
go
 where
  go :: HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
go = \case
    HsPatCon HsName (GhcPass p)
conName [HsPat (GhcPass p)]
args -> do
      GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
conName' <- HsName (GhcPass p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
fromConName HsName (GhcPass p)
conName
      HsConDetails
  (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
  (HsRecFields
     (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
con <- [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> HsConDetails
     (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
     (HsRecFields
        (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
forall arg tyargs rec. [arg] -> HsConDetails tyargs arg rec
GHC.Compat.mkPrefixCon ([GenLocated SrcSpanAnnA (Pat (GhcPass p))]
 -> HsConDetails
      (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
      (HsRecFields
         (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))))
-> m [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
-> m (HsConDetails
        (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
        (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
        (HsRecFields
           (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> [HsPat (GhcPass p)]
-> m [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
go [HsPat (GhcPass p)]
args
      GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> (Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> Pat (GhcPass p)
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
        XConPat (GhcPass p)
-> XRec (GhcPass p) (ConLikeP (GhcPass p))
-> HsConPatDetails (GhcPass p)
-> Pat (GhcPass p)
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
GHC.ConPat
          (forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XConPat (GhcPass p)
EpAnn [AddEpAnn]
(p ~ 'Parsed) => XConPat (GhcPass p)
forall a. EpAnn a
GHC.noAnn XConPat (GhcPass p)
NoExtField
(p ~ 'Renamed) => XConPat (GhcPass p)
GHC.noExtField)
          XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
conName'
          HsConPatDetails (GhcPass p)
HsConDetails
  (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
  (HsRecFields
     (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
con
    HsPatVar HsName (GhcPass p)
name -> do
      GenLocated (Anno (IdGhcP p)) (IdGhcP p)
name' <- forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p (p ~ 'Parsed) =>
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
IdGhcP p -> GenLocated SrcSpanAnnN (IdGhcP p)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (p ~ 'Renamed) =>
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
IdGhcP p -> GenLocated SrcSpanAnnN (IdGhcP p)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> m (IdGhcP p) -> m (GenLocated (Anno (IdGhcP p)) (IdGhcP p))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName (GhcPass p) -> m (IdP (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName (GhcPass p)
name
      GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> (Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> Pat (GhcPass p)
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a b. (a -> b) -> a -> b
$ XVarPat (GhcPass p) -> LIdP (GhcPass p) -> Pat (GhcPass p)
forall p. XVarPat p -> LIdP p -> Pat p
GHC.VarPat XVarPat (GhcPass p)
NoExtField
GHC.noExtField LIdP (GhcPass p)
GenLocated (Anno (IdGhcP p)) (IdGhcP p)
name'
    HsPatRecord HsName (GhcPass p)
conName [(HsName (GhcPass p), HsPat (GhcPass p))]
fields -> do
      GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
conName' <- HsName (GhcPass p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
fromConName HsName (GhcPass p)
conName
      HsConDetails
  (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
  (HsRecFields
     (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
con <- HsRecFields (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> HsConDetails
     (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
     (HsRecFields
        (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
GHC.RecCon (HsRecFields (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
 -> HsConDetails
      (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
      (HsRecFields
         (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))))
-> m (HsRecFields
        (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> m (HsConDetails
        (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
        (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
        (HsRecFields
           (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> [(HsName (GhcPass p), HsPat (GhcPass p))]
-> m (HsRecFields
        (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
forall (p :: Pass) (m :: * -> *) arg x.
(IsPass p, MonadCompile m (GhcPass p)) =>
(x -> m arg)
-> [(HsName (GhcPass p), x)] -> m (HsRecFields (GhcPass p) arg)
compileRecFields HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
go [(HsName (GhcPass p), HsPat (GhcPass p))]
fields
      GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> (Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> Pat (GhcPass p)
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
        XConPat (GhcPass p)
-> XRec (GhcPass p) (ConLikeP (GhcPass p))
-> HsConPatDetails (GhcPass p)
-> Pat (GhcPass p)
forall p.
XConPat p -> XRec p (ConLikeP p) -> HsConPatDetails p -> Pat p
GHC.ConPat
          (forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XConPat (GhcPass p)
EpAnn [AddEpAnn]
(p ~ 'Parsed) => XConPat (GhcPass p)
forall a. EpAnn a
GHC.noAnn XConPat (GhcPass p)
NoExtField
(p ~ 'Renamed) => XConPat (GhcPass p)
GHC.noExtField)
          XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
conName'
          HsConPatDetails (GhcPass p)
HsConDetails
  (HsConPatTyArg (GhcPass (NoGhcTcPass p)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
  (HsRecFields
     (GhcPass p) (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
con
    HsPat (GhcPass p)
HsPatWild -> do
      GenLocated SrcSpanAnnA (Pat (GhcPass p))
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (Pat (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> (Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p)))
-> Pat (GhcPass p)
-> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pat (GhcPass p) -> GenLocated SrcSpanAnnA (Pat (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> Pat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall a b. (a -> b) -> a -> b
$ XWildPat (GhcPass p) -> Pat (GhcPass p)
forall p. XWildPat p -> Pat p
GHC.WildPat (XWildPat (GhcPass p) -> Pat (GhcPass p))
-> XWildPat (GhcPass p) -> Pat (GhcPass p)
forall a b. (a -> b) -> a -> b
$ forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XWildPat (GhcPass p)
NoExtField
(p ~ 'Parsed) => XWildPat (GhcPass p)
GHC.noExtField XWildPat (GhcPass p)
NoExtField
(p ~ 'Renamed) => XWildPat (GhcPass p)
GHC.noExtField

  fromConName :: HsName (GhcPass p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
fromConName = (IdGhcP p
 -> GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
-> m (IdGhcP p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> XRec (GhcPass p) (ConLikeP (GhcPass p))
genLocConLikeP @p) (m (IdGhcP p)
 -> m (GenLocated
         (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))))
-> (HsName (GhcPass p) -> m (IdGhcP p))
-> HsName (GhcPass p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsName (GhcPass p) -> m (IdP (GhcPass p))
HsName (GhcPass p) -> m (IdGhcP p)
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName

compileHsExpr ::
  forall p m.
  (IsPass p, MonadCompile m (GhcPass p)) =>
  HsExpr (GhcPass p) ->
  m (GHC.LHsExpr (GhcPass p))
compileHsExpr :: forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
compileHsExpr = HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr
 where
  goExpr :: HsExpr (GhcPass p) -> m (GHC.LHsExpr (GhcPass p))
  goExpr :: HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr = \case
    HsExprUnsafe{ghcExpr :: forall p. HsExpr p -> Maybe (GhcLHsExpr p)
ghcExpr = Just GhcLHsExpr (GhcPass p)
e} -> LHsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LHsExpr (GhcPass p) -> m (LHsExpr (GhcPass p)))
-> LHsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ GhcLHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
forall p. GhcLHsExpr p -> LHsExpr p
unGhcLHsExpr GhcLHsExpr (GhcPass p)
e
    HsExprUnsafe{hsExpr :: forall p. HsExpr p -> HsExprData p
hsExpr = HsExprData (GhcPass p)
e} -> HsExprData (GhcPass p) -> m (LHsExpr (GhcPass p))
goData HsExprData (GhcPass p)
e

  goData :: HsExprData (GhcPass p) -> m (GHC.LHsExpr (GhcPass p))
  goData :: HsExprData (GhcPass p) -> m (LHsExpr (GhcPass p))
goData = \case
    HsExprCon HsName (GhcPass p)
name -> do
      HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (IdGhcP p -> HsExpr (GhcPass p))
-> IdGhcP p
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar (GhcPass p)
NoExtField
GHC.noExtField (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> HsExpr (GhcPass p))
-> (IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> IdGhcP p
-> HsExpr (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> LIdOccP (GhcPass p)
genLocIdP @p (IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (IdGhcP p) -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName (GhcPass p) -> m (IdP (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName (GhcPass p)
name
    HsExprVar HsName (GhcPass p)
name -> do
      HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (IdGhcP p -> HsExpr (GhcPass p))
-> IdGhcP p
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XVar (GhcPass p) -> LIdP (GhcPass p) -> HsExpr (GhcPass p)
forall p. XVar p -> LIdP p -> HsExpr p
GHC.HsVar XVar (GhcPass p)
NoExtField
GHC.noExtField (GenLocated (Anno (IdGhcP p)) (IdGhcP p) -> HsExpr (GhcPass p))
-> (IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p))
-> IdGhcP p
-> HsExpr (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> LIdOccP (GhcPass p)
genLocIdP @p (IdGhcP p -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (IdGhcP p) -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName (GhcPass p) -> m (IdP (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName (GhcPass p)
name
    HsExprApps HsExpr (GhcPass p)
f [HsExpr (GhcPass p)]
xs -> do
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
f' <- HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr HsExpr (GhcPass p)
f
      [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
xs' <- (HsExpr (GhcPass p)
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [HsExpr (GhcPass p)]
-> m [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
goExpr [HsExpr (GhcPass p)]
xs
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
l GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
r -> HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
forall (p :: Pass).
LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
GHC.Compat.hsApp LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
l LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
r) (LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parens LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
f') ((GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall a b. (a -> b) -> [a] -> [b]
map LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parens [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
xs')
    HsExprOp HsExpr (GhcPass p)
_ HsExpr (GhcPass p)
_ HsExpr (GhcPass p)
_ ->
      String -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. HasCallStack => String -> a
invariantViolation String
"Compiling HsExprOp not yet supported"
    HsExprList [HsExpr (GhcPass p)]
exprs -> do
      [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
exprs' <- (HsExpr (GhcPass p)
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [HsExpr (GhcPass p)]
-> m [GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
goExpr [HsExpr (GhcPass p)]
exprs
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> (HsExpr (GhcPass p)
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p)
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
        XExplicitList (GhcPass p)
-> [LHsExpr (GhcPass p)] -> HsExpr (GhcPass p)
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
GHC.ExplicitList
          (forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XExplicitList (GhcPass p)
EpAnn AnnList
(p ~ 'Parsed) => XExplicitList (GhcPass p)
forall a. EpAnn a
GHC.noAnn XExplicitList (GhcPass p)
NoExtField
(p ~ 'Renamed) => XExplicitList (GhcPass p)
GHC.noExtField)
          [LHsExpr (GhcPass p)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass p))]
exprs'
    HsExprRecordCon HsName (GhcPass p)
con [(HsName (GhcPass p), HsExpr (GhcPass p))]
fields -> do
      GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
con' <- forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> XRec (GhcPass p) (ConLikeP (GhcPass p))
genLocConLikeP @p (IdGhcP p
 -> GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
-> m (IdGhcP p)
-> m (GenLocated
        (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsName (GhcPass p) -> m (IdP (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName (GhcPass p)
con
      HsRecFields
  (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
fields' <- (HsExpr (GhcPass p)
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [(HsName (GhcPass p), HsExpr (GhcPass p))]
-> m (HsRecFields
        (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall (p :: Pass) (m :: * -> *) arg x.
(IsPass p, MonadCompile m (GhcPass p)) =>
(x -> m arg)
-> [(HsName (GhcPass p), x)] -> m (HsRecFields (GhcPass p) arg)
compileRecFields HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
goExpr [(HsName (GhcPass p), HsExpr (GhcPass p))]
fields
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> (HsExpr (GhcPass p)
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p)
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> HsExpr (GhcPass p)
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
        XRecordCon (GhcPass p)
-> XRec (GhcPass p) (ConLikeP (GhcPass p))
-> HsRecordBinds (GhcPass p)
-> HsExpr (GhcPass p)
forall p.
XRecordCon p -> XRec p (ConLikeP p) -> HsRecordBinds p -> HsExpr p
GHC.RecordCon
          (forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XRecordCon (GhcPass p)
EpAnn [AddEpAnn]
(p ~ 'Parsed) => XRecordCon (GhcPass p)
forall a. EpAnn a
GHC.noAnn XRecordCon (GhcPass p)
NoExtField
(p ~ 'Renamed) => XRecordCon (GhcPass p)
GHC.noExtField)
          XRec (GhcPass p) (ConLikeP (GhcPass p))
GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
con'
          HsRecordBinds (GhcPass p)
HsRecFields
  (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
fields'
    HsExprLitString ModuleName
s -> do
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (LHsExpr (GhcPass p))
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (LHsExpr (GhcPass p)))
-> (HsLit (GhcPass p)
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsLit (GhcPass p)
-> m (LHsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (HsLit (GhcPass p) -> HsExpr (GhcPass p))
-> HsLit (GhcPass p)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsLit (GhcPass p) -> HsExpr (GhcPass p)
forall (p :: Pass). HsLit (GhcPass p) -> HsExpr (GhcPass p)
GHC.Compat.hsLit (HsLit (GhcPass p) -> m (LHsExpr (GhcPass p)))
-> HsLit (GhcPass p) -> m (LHsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$
        XHsString (GhcPass p) -> FastString -> HsLit (GhcPass p)
forall x. XHsString x -> FastString -> HsLit x
GHC.HsString XHsString (GhcPass p)
SourceText
GHC.SourceText.NoSourceText (ModuleName -> FastString
fsText ModuleName
s)
    HsExprLam [HsPat (GhcPass p)]
pats HsExpr (GhcPass p)
expr -> do
      [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats' <- (HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p))))
-> [HsPat (GhcPass p)]
-> m [GenLocated SrcSpanAnnA (Pat (GhcPass p))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HsPat (GhcPass p) -> m (LPat (GhcPass p))
HsPat (GhcPass p) -> m (GenLocated SrcSpanAnnA (Pat (GhcPass p)))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsPat (GhcPass p) -> m (LPat (GhcPass p))
compileHsPat [HsPat (GhcPass p)]
pats
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
expr' <- HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr HsExpr (GhcPass p)
expr
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> (MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
    -> HsExpr (GhcPass p))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchGroup (GhcPass p) (LHsExpr (GhcPass p)) -> HsExpr (GhcPass p)
MatchGroup
  (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
forall (p :: Pass).
MatchGroup (GhcPass p) (LHsExpr (GhcPass p)) -> HsExpr (GhcPass p)
GHC.Compat.hsLamSingle (MatchGroup
   (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
        XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> XRec
     (GhcPass p)
     [LMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
GHC.MG XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
origin (GenLocated
   SrcSpanAnnL
   [GenLocated
      SrcSpanAnnA
      (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
 -> MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> ([GenLocated
       SrcSpanAnnA
       (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))])
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated
   SrcSpanAnnA
   (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc ([GenLocated
    SrcSpanAnnA
    (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
 -> MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [GenLocated
      SrcSpanAnnA
      (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$
          [ Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated
     SrcSpanAnnA
     (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
 -> GenLocated
      SrcSpanAnnA
      (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
-> Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated
     SrcSpanAnnA
     (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall a b. (a -> b) -> a -> b
$
              GHC.Match
                { m_ext :: XCMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
m_ext = XCMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
XCMatch (GhcPass Any) Any
forall (p :: Pass) b. XCMatch (GhcPass p) b
GHC.Compat.xMatch
                , m_ctxt :: HsMatchContext (GhcPass p)
m_ctxt = HsMatchContext (GhcPass p)
forall fn. HsMatchContext fn
GHC.Compat.lamAltSingle
                , m_pats :: [LPat (GhcPass p)]
m_pats = [LPat (GhcPass p)] -> [LPat (GhcPass p)]
forall p. [LPat p] -> [LPat p]
GHC.Compat.toMatchArgs [LPat (GhcPass p)]
[GenLocated SrcSpanAnnA (Pat (GhcPass p))]
pats'
                , m_grhss :: GRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
m_grhss =
                    GHC.GRHSs
                      { grhssExt :: XCGRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
grhssExt = XCGRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
EpAnnComments
GHC.emptyComments
                      , grhssGRHSs :: [LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
grhssGRHSs = NonEmpty
  (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [LGRHS
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
forall p body. NonEmpty (LGRHS p body) -> [LGRHS p body]
GHC.Compat.toGrhssGRHSs (NonEmpty
   (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
 -> [LGRHS
       (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))])
-> NonEmpty
     (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [LGRHS
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
forall a b. (a -> b) -> a -> b
$ GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (XCGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [GuardLStmt (GhcPass p)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GHC.GRHS XCGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
EpAnn GrhsAnn
forall a. EpAnn a
GHC.noAnn [] GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
expr') GenLocated
  (SrcAnn NoEpAnns)
  (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> NonEmpty
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| []
                      , grhssLocalBinds :: HsLocalBinds (GhcPass p)
grhssLocalBinds = XEmptyLocalBinds (GhcPass p) (GhcPass p)
-> HsLocalBinds (GhcPass p)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
GHC.EmptyLocalBinds XEmptyLocalBinds (GhcPass p) (GhcPass p)
NoExtField
GHC.noExtField
                      }
                }
          ]
    HsExprCase HsExpr (GhcPass p)
expr [(HsPat (GhcPass p), HsExpr (GhcPass p))]
matches -> do
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
expr' <- HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr HsExpr (GhcPass p)
expr
      [GenLocated
   SrcSpanAnnA
   (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
matches' <-
        [m (GenLocated
      SrcSpanAnnA
      (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))]
-> m [GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
          [ do
              GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat' <- HsPat (GhcPass p) -> m (LPat (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsPat (GhcPass p) -> m (LPat (GhcPass p))
compileHsPat HsPat (GhcPass p)
pat
              GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
body' <- HsExpr (GhcPass p) -> m (LHsExpr (GhcPass p))
goExpr HsExpr (GhcPass p)
body
              GenLocated
  SrcSpanAnnA
  (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> m (GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated
   SrcSpanAnnA
   (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
 -> m (GenLocated
         SrcSpanAnnA
         (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))))
-> (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
    -> GenLocated
         SrcSpanAnnA
         (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
-> Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated
     SrcSpanAnnA
     (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
 -> m (GenLocated
         SrcSpanAnnA
         (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))))
-> Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
forall a b. (a -> b) -> a -> b
$
                GHC.Match
                  { m_ext :: XCMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
m_ext = XCMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
XCMatch (GhcPass Any) Any
forall (p :: Pass) b. XCMatch (GhcPass p) b
GHC.Compat.xMatch
                  , m_ctxt :: HsMatchContext (GhcPass p)
m_ctxt = HsMatchContext (GhcPass p)
forall fn. HsMatchContext fn
GHC.CaseAlt
                  , m_pats :: [LPat (GhcPass p)]
m_pats = [LPat (GhcPass p)] -> [LPat (GhcPass p)]
forall p. [LPat p] -> [LPat p]
GHC.Compat.toMatchArgs [LPat (GhcPass p)
GenLocated SrcSpanAnnA (Pat (GhcPass p))
pat']
                  , m_grhss :: GRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
m_grhss =
                      GHC.GRHSs
                        { grhssExt :: XCGRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
grhssExt = XCGRHSs (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
EpAnnComments
GHC.emptyComments
                        , grhssGRHSs :: [LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
grhssGRHSs = NonEmpty
  (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [LGRHS
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
forall p body. NonEmpty (LGRHS p body) -> [LGRHS p body]
GHC.Compat.toGrhssGRHSs (NonEmpty
   (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
 -> [LGRHS
       (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))])
-> NonEmpty
     (LGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [LGRHS
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
forall a b. (a -> b) -> a -> b
$ GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated
     (SrcAnn NoEpAnns)
     (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (XCGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> [GuardLStmt (GhcPass p)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
GHC.GRHS XCGRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
EpAnn GrhsAnn
forall a. EpAnn a
GHC.noAnn [] GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
body') GenLocated
  (SrcAnn NoEpAnns)
  (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> NonEmpty
     (GenLocated
        (SrcAnn NoEpAnns)
        (GRHS (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))))
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| []
                        , grhssLocalBinds :: HsLocalBinds (GhcPass p)
grhssLocalBinds = XEmptyLocalBinds (GhcPass p) (GhcPass p)
-> HsLocalBinds (GhcPass p)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
GHC.EmptyLocalBinds XEmptyLocalBinds (GhcPass p) (GhcPass p)
NoExtField
GHC.noExtField
                        }
                  }
          | (HsPat (GhcPass p)
pat, HsExpr (GhcPass p)
body) <- [(HsPat (GhcPass p), HsExpr (GhcPass p))]
matches
          ]
      GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> (MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc
        (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> (MatchGroup
      (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
    -> HsExpr (GhcPass p))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XCase (GhcPass p)
-> LHsExpr (GhcPass p)
-> MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
-> HsExpr (GhcPass p)
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
GHC.HsCase (forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XCase (GhcPass p)
EpAnn EpAnnHsCase
(p ~ 'Parsed) => XCase (GhcPass p)
forall a. EpAnn a
GHC.noAnn XCase (GhcPass p)
HsMatchContext GhcTc
(p ~ 'Renamed) => XCase (GhcPass p)
forall fn. HsMatchContext fn
GHC.CaseAlt) LHsExpr (GhcPass p)
GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
expr'
        (MatchGroup
   (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
 -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a b. (a -> b) -> a -> b
$ XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> XRec
     (GhcPass p)
     [LMatch (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))]
-> MatchGroup
     (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall p body.
XMG p body -> XRec p [LMatch p body] -> MatchGroup p body
GHC.MG XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
origin ([GenLocated
   SrcSpanAnnA
   (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
-> GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc [GenLocated
   SrcSpanAnnA
   (Match (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p))))]
matches')
    HsExprData (GhcPass p)
HsExprOther ->
      String -> m (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
forall a. HasCallStack => String -> a
invariantViolation String
"Compiling HsExprOther not supported"

  origin :: XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
origin = forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
Origin
(p ~ 'Parsed) =>
XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
GHC.FromSource XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
Origin
(p ~ 'Renamed) =>
XMG (GhcPass p) (GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
GHC.FromSource

  parens :: (IsPass p) => GHC.LHsExpr (GhcPass p) -> GHC.LHsExpr (GhcPass p)
  parens :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
parens = \case
    e :: LHsExpr (GhcPass p)
e@(L SrcSpanAnnA
_ GHC.HsPar{}) -> LHsExpr (GhcPass p)
e
    e :: LHsExpr (GhcPass p)
e@(L SrcSpanAnnA
_ GHC.HsApp{}) -> HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
forall (p :: Pass). LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
GHC.Compat.hsPar LHsExpr (GhcPass p)
e
    e :: LHsExpr (GhcPass p)
e@(L SrcSpanAnnA
_ GHC.SectionL{}) -> HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
forall (p :: Pass). LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
GHC.Compat.hsPar LHsExpr (GhcPass p)
e
    e :: LHsExpr (GhcPass p)
e@(L SrcSpanAnnA
_ GHC.SectionR{}) -> HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsExpr (GhcPass p) -> GenLocated SrcSpanAnnA (HsExpr (GhcPass p)))
-> HsExpr (GhcPass p)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass p))
forall a b. (a -> b) -> a -> b
$ LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
forall (p :: Pass). LHsExpr (GhcPass p) -> HsExpr (GhcPass p)
GHC.Compat.hsPar LHsExpr (GhcPass p)
e
    LHsExpr (GhcPass p)
e -> LHsExpr (GhcPass p)
e

{----- FastString -----}

fsText :: Text -> GHC.FastString
fsText :: ModuleName -> FastString
fsText = String -> FastString
GHC.fsLit (String -> FastString)
-> (ModuleName -> String) -> ModuleName -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
Text.unpack

{----- Utilities -----}

data GhcIdP p where
  GhcIdPs :: GHC.RdrName -> GhcIdP GhcPs
  GhcIdRn :: GHC.Name -> GhcIdP GhcRn

instance Show (GhcIdP p) where
  show :: GhcIdP p -> String
show = \case
    GhcIdPs RdrName
name -> RdrName -> String
forall a. Outputable a => a -> String
renderOutputable RdrName
name
    GhcIdRn Name
name -> Name -> String
forall a. Outputable a => a -> String
renderOutputable Name
name

instance Eq (GhcIdP p) where
  GhcIdPs RdrName
n1 == :: GhcIdP p -> GhcIdP p -> Bool
== GhcIdPs RdrName
n2 = RdrName
n1 RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== RdrName
n2
  GhcIdRn Name
n1 == GhcIdRn Name
n2 = Name
n1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n2

unGhcIdP :: GhcIdP p -> GHC.IdP p
unGhcIdP :: forall p. GhcIdP p -> IdP p
unGhcIdP = \case
  GhcIdPs RdrName
n -> IdP p
RdrName
n
  GhcIdRn Name
n -> IdP p
Name
n

data GhcLHsExpr p where
  GhcLHsExprPs :: GHC.LHsExpr GhcPs -> GhcLHsExpr GhcPs
  GhcLHsExprRn :: GHC.LHsExpr GhcRn -> GhcLHsExpr GhcRn

instance Show (GhcLHsExpr p) where
  show :: GhcLHsExpr p -> String
show = \case
    GhcLHsExprPs LHsExpr GhcPs
e -> GenLocated SrcSpanAnnA (HsExpr GhcPs) -> String
forall a. Outputable a => a -> String
renderOutputable LHsExpr GhcPs
GenLocated SrcSpanAnnA (HsExpr GhcPs)
e
    GhcLHsExprRn LHsExpr GhcRn
e -> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> String
forall a. Outputable a => a -> String
renderOutputable LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
e

unGhcLHsExpr :: GhcLHsExpr p -> GHC.LHsExpr p
unGhcLHsExpr :: forall p. GhcLHsExpr p -> LHsExpr p
unGhcLHsExpr = \case
  GhcLHsExprPs LHsExpr GhcPs
e -> LHsExpr p
LHsExpr GhcPs
e
  GhcLHsExprRn LHsExpr GhcRn
e -> LHsExpr p
LHsExpr GhcRn
e

newtype GhcFixity = GhcFixity GHC.Fixity

instance Show GhcFixity where
  show :: GhcFixity -> String
show (GhcFixity Fixity
fixity) = Fixity -> String
forall a. Outputable a => a -> String
renderOutputable Fixity
fixity

renderOutputable :: (GHC.Outputable a) => a -> String
renderOutputable :: forall a. Outputable a => a -> String
renderOutputable = SDoc -> String
GHC.showSDocUnsafe (SDoc -> String) -> (a -> SDoc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
GHC.ppr

onPsOrRn :: forall p a. (IsPass p) => ((p ~ 'GHC.Parsed) => a) -> ((p ~ 'GHC.Renamed) => a) -> a
onPsOrRn :: forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn (p ~ 'Parsed) => a
ps (p ~ 'Renamed) => a
rn =
  case forall (p :: Pass). IsPass p => GhcPass p
GHC.ghcPass @p of
    GhcPass p
GhcPs -> a
(p ~ 'Parsed) => a
ps
    GhcPass p
GhcRn -> a
(p ~ 'Renamed) => a
rn
    GhcPass p
GhcTc -> String -> a
forall a. HasCallStack => String -> a
invariantViolation String
"onPsOrRn found GhcTc"

compileRecFields ::
  forall p m arg x.
  (IsPass p, MonadCompile m (GhcPass p)) =>
  (x -> m arg) ->
  [(HsName (GhcPass p), x)] ->
  m (GHC.HsRecFields (GhcPass p) arg)
compileRecFields :: forall (p :: Pass) (m :: * -> *) arg x.
(IsPass p, MonadCompile m (GhcPass p)) =>
(x -> m arg)
-> [(HsName (GhcPass p), x)] -> m (HsRecFields (GhcPass p) arg)
compileRecFields x -> m arg
f [(HsName (GhcPass p), x)]
fields = do
  [GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)]
fields' <-
    [m (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg))]
-> m [GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ do
          FieldOcc (GhcPass p)
field' <- HsName (GhcPass p) -> m (FieldOcc (GhcPass p))
compileFieldOcc HsName (GhcPass p)
field
          arg
x' <- x -> m arg
f x
x
          GenLocated
  SrcSpanAnnA
  (HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)
-> m (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)
 -> m (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)))
-> (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg
-> m (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsFieldBind
  (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg
-> GenLocated
     SrcSpanAnnA
     (HsFieldBind
        (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (HsFieldBind
   (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg
 -> m (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)))
-> HsFieldBind
     (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg
-> m (GenLocated
        SrcSpanAnnA
        (HsFieldBind
           (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg))
forall a b. (a -> b) -> a -> b
$
            GHC.HsFieldBind
              { hfbAnn :: XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
hfbAnn = XHsFieldBind (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p)))
EpAnn [AddEpAnn]
forall a. EpAnn a
GHC.noAnn
              , hfbLHS :: GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
hfbLHS = FieldOcc (GhcPass p)
-> GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc FieldOcc (GhcPass p)
field'
              , hfbRHS :: arg
hfbRHS = arg
x'
              , hfbPun :: Bool
hfbPun = Bool
False
              }
      | (HsName (GhcPass p)
field, x
x) <- [(HsName (GhcPass p), x)]
fields
      ]
  HsRecFields (GhcPass p) arg -> m (HsRecFields (GhcPass p) arg)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsRecFields (GhcPass p) arg -> m (HsRecFields (GhcPass p) arg))
-> HsRecFields (GhcPass p) arg -> m (HsRecFields (GhcPass p) arg)
forall a b. (a -> b) -> a -> b
$ [LHsRecField (GhcPass p) arg] -> HsRecFields (GhcPass p) arg
forall (p :: Pass) arg.
[LHsRecField (GhcPass p) arg] -> HsRecFields (GhcPass p) arg
GHC.Compat.mkHsRecFields [LHsRecField (GhcPass p) arg]
[GenLocated
   SrcSpanAnnA
   (HsFieldBind
      (GenLocated (SrcAnn NoEpAnns) (FieldOcc (GhcPass p))) arg)]
fields'
 where
  compileFieldOcc :: HsName (GhcPass p) -> m (FieldOcc (GhcPass p))
compileFieldOcc HsName (GhcPass p)
field = do
    IdGhcP p
name <- HsName (GhcPass p) -> m (IdP (GhcPass p))
forall (p :: Pass) (m :: * -> *).
(IsPass p, MonadCompile m (GhcPass p)) =>
HsName (GhcPass p) -> m (IdP (GhcPass p))
compileHsName HsName (GhcPass p)
field
    FieldOcc (GhcPass p) -> m (FieldOcc (GhcPass p))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldOcc (GhcPass p) -> m (FieldOcc (GhcPass p)))
-> FieldOcc (GhcPass p) -> m (FieldOcc (GhcPass p))
forall a b. (a -> b) -> a -> b
$
      forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p
        GHC.FieldOcc
          { foExt :: XCFieldOcc (GhcPass p)
foExt = XCFieldOcc (GhcPass p)
NoExtField
GHC.noExtField
          , foLabel :: XRec (GhcPass p) RdrName
foLabel = IdGhcP p -> GenLocated SrcSpanAnnN (IdGhcP p)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc IdGhcP p
name
          }
        (Name -> FieldOcc GhcRn
GHC.Compat.fieldOccRn Name
IdGhcP p
name)

genLocConLikeP ::
  forall p.
  (IsPass p) =>
  GHC.IdP (GhcPass p) ->
  GHC.XRec (GhcPass p) (GHC.ConLikeP (GhcPass p))
genLocConLikeP :: forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> XRec (GhcPass p) (ConLikeP (GhcPass p))
genLocConLikeP = forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p (p ~ 'Parsed) =>
IdGhcP p
-> GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
RdrName -> GenLocated SrcSpanAnnN RdrName
IdGhcP p
-> GenLocated (Anno (ConLikeP (GhcPass p))) (ConLikeP (GhcPass p))
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Name -> GenLocated SrcSpanAnnN Name
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Name -> GenLocated SrcSpanAnnN Name)
-> (Name -> Name) -> Name -> GenLocated SrcSpanAnnN Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
GHC.Compat.noUserRdr)

genLocIdP ::
  forall p.
  (IsPass p) =>
  GHC.IdP (GhcPass p) ->
  GHC.Compat.LIdOccP (GhcPass p)
genLocIdP :: forall (p :: Pass).
IsPass p =>
IdP (GhcPass p) -> LIdOccP (GhcPass p)
genLocIdP = forall (p :: Pass) a.
IsPass p =>
((p ~ 'Parsed) => a) -> ((p ~ 'Renamed) => a) -> a
onPsOrRn @p (p ~ 'Parsed) =>
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
RdrName -> GenLocated SrcSpanAnnN RdrName
IdGhcP p -> GenLocated (Anno (IdGhcP p)) (IdGhcP p)
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Name -> GenLocated SrcSpanAnnN Name
forall e ann. e -> GenLocated (SrcAnn ann) e
genLoc (Name -> GenLocated SrcSpanAnnN Name)
-> (Name -> Name) -> Name -> GenLocated SrcSpanAnnN Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name
GHC.Compat.noUserRdr)