testsuite/tests/plugins/echo-plugin/Echo.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

module Echo (plugin) where

import GHC.Plugins
import GHC.Tc.Plugin
import GHC.Tc.Utils.Monad
import qualified GHC.Tc.Utils.Monad as Utils
import GHC.Types.Unique.FM ( emptyUFM )

plugin :: Plugin
plugin = mkPureOptTcPlugin optCallCount

mkPureOptTcPlugin :: ([CommandLineOption] -> Maybe Utils.TcPlugin) -> Plugin
mkPureOptTcPlugin p =
    defaultPlugin
        { tcPlugin = p
        , pluginRecompile = impurePlugin
        }

newtype State = State{callref :: IORef Int}

optCallCount :: [CommandLineOption] -> Maybe Utils.TcPlugin
optCallCount opts = Just $
    Utils.TcPlugin
        { tcPluginInit = return . State =<< (unsafeTcPluginTcM $ newMutVar 1)

        , tcPluginSolve = \State{callref = c} _ _ _ -> do
            n <- unsafeTcPluginTcM $ readMutVar c
            let msg = if null opts then "" else mconcat opts
            tcPluginIO . putStrLn $ "Echo TcPlugin " ++ msg ++ "#" ++ show n
            unsafeTcPluginTcM $ writeMutVar c (n + 1)
            return $ TcPluginOk [] []

        , tcPluginRewrite = \ _ -> emptyUFM
        , tcPluginStop = const $ return ()
        }