{-# LANGUAGE CPP #-}

module Data.Record.Anon.Internal.Plugin (plugin) where

import GHC.TcPlugin.API

import qualified GHC.Plugins

import Data.Record.Anon.Internal.Plugin.TC.NameResolution
import Data.Record.Anon.Internal.Plugin.TC.Rewriter
import Data.Record.Anon.Internal.Plugin.TC.Solver
import Data.Record.Anon.Internal.Plugin.Source

-- | The large-anon plugins
--
-- This consists of two plugins:
--
-- 1. The type checker plugin forms the heart of this package. It solves
--    the various constraints we have on rows, and computes type-level metadata.
-- 2. The source plugin offers syntactic sugar for record construction.
plugin :: GHC.Plugins.Plugin
plugin :: Plugin
plugin = Plugin
GHC.Plugins.defaultPlugin {
      GHC.Plugins.tcPlugin = \[CommandLineOption]
_args -> TcPlugin -> Maybe TcPlugin
forall a. a -> Maybe a
Just (TcPlugin -> Maybe TcPlugin) -> TcPlugin -> Maybe TcPlugin
forall a b. (a -> b) -> a -> b
$
        TcPlugin -> TcPlugin
mkTcPlugin TcPlugin
tcPlugin
    , GHC.Plugins.parsedResultAction = \[CommandLineOption]
args ModSummary
_modSummary ->
        (HsParsedModule -> Hsc HsParsedModule)
-> ParsedResult -> Hsc ParsedResult
forall {f :: * -> *}.
Functor f =>
(HsParsedModule -> f HsParsedModule)
-> ParsedResult -> f ParsedResult
ignoreMessages ((HsParsedModule -> Hsc HsParsedModule)
 -> ParsedResult -> Hsc ParsedResult)
-> (HsParsedModule -> Hsc HsParsedModule)
-> ParsedResult
-> Hsc ParsedResult
forall a b. (a -> b) -> a -> b
$ [CommandLineOption] -> HsParsedModule -> Hsc HsParsedModule
sourcePlugin [CommandLineOption]
args
    , GHC.Plugins.pluginRecompile =
        GHC.Plugins.purePlugin
    }
  where
#if __GLASGOW_HASKELL__ >= 904
    ignoreMessages :: (HsParsedModule -> f HsParsedModule)
-> ParsedResult -> f ParsedResult
ignoreMessages HsParsedModule -> f HsParsedModule
f (GHC.Plugins.ParsedResult HsParsedModule
modl PsMessages
msgs) =
            (\HsParsedModule
modl' -> HsParsedModule -> PsMessages -> ParsedResult
GHC.Plugins.ParsedResult HsParsedModule
modl' PsMessages
msgs) (HsParsedModule -> ParsedResult)
-> f HsParsedModule -> f ParsedResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsParsedModule -> f HsParsedModule
f HsParsedModule
modl
#else
    ignoreMessages = id
#endif

tcPlugin :: TcPlugin
tcPlugin :: TcPlugin
tcPlugin = TcPlugin {
      tcPluginInit :: TcPluginM 'Init ResolvedNames
tcPluginInit    = TcPluginM 'Init ResolvedNames
nameResolution
    , tcPluginSolve :: ResolvedNames -> TcPluginSolver
tcPluginSolve   = ResolvedNames -> TcPluginSolver
solve
    , tcPluginRewrite :: ResolvedNames -> UniqFM TyCon TcPluginRewriter
tcPluginRewrite = ResolvedNames -> UniqFM TyCon TcPluginRewriter
rewrite
    , tcPluginStop :: ResolvedNames -> TcPluginM 'Stop ()
tcPluginStop    = TcPluginM 'Stop () -> ResolvedNames -> TcPluginM 'Stop ()
forall a b. a -> b -> a
const (TcPluginM 'Stop () -> ResolvedNames -> TcPluginM 'Stop ())
-> TcPluginM 'Stop () -> ResolvedNames -> TcPluginM 'Stop ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM 'Stop ()
forall a. a -> TcPluginM 'Stop a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }