{-# LANGUAGE RankNTypes, CPP #-}

module NoOp.Plugin
    ( plugin
    , noOp, undefInit, undefSolve, undefStop
    , mkPureTcPlugin, mkPureOptTcPlugin, mkImpureTcPlugin
    ) where

import GHC.Corroborate

plugin :: Plugin
plugin :: Plugin
plugin = TcPlugin -> Plugin
mkPureTcPlugin TcPlugin
noOp

noOp :: TcPlugin
noOp :: TcPlugin
noOp =
    TcPlugin :: forall s.
TcPluginM s
-> (s -> TcPluginSolver) -> (s -> TcPluginM ()) -> TcPlugin
TcPlugin
        { tcPluginInit :: TcPluginM ()
tcPluginInit = () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , tcPluginSolve :: () -> TcPluginSolver
tcPluginSolve = \()
_ [Ct]
_ [Ct]
_ [Ct]
_ -> TcPluginResult -> TcPluginM TcPluginResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TcPluginResult -> TcPluginM TcPluginResult)
-> TcPluginResult -> TcPluginM TcPluginResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginResult
TcPluginOk [] []
        , tcPluginStop :: () -> TcPluginM ()
tcPluginStop = TcPluginM () -> () -> TcPluginM ()
forall a b. a -> b -> a
const (TcPluginM () -> () -> TcPluginM ())
-> TcPluginM () -> () -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

-- WARNING: Can't use record update syntax for existentially qualified types.
-- SEE: https://gitlab.haskell.org/ghc/ghc/issues/2595
-- data TcPlugin = forall s. TcPlugin
--   { tcPluginInit  :: TcPluginM s
--   , tcPluginSolve :: s -> TcPluginSolver
--   , tcPluginStop  :: s -> TcPluginM ()
--   }

-- noOp { tcPluginInit = undefined }
undefInit :: TcPlugin
undefInit :: TcPlugin
undefInit =
    TcPlugin :: forall s.
TcPluginM s
-> (s -> TcPluginSolver) -> (s -> TcPluginM ()) -> TcPlugin
TcPlugin
        { tcPluginInit :: TcPluginM Any
tcPluginInit = TcPluginM Any
forall a. HasCallStack => a
undefined
        , tcPluginSolve :: Any -> TcPluginSolver
tcPluginSolve = \Any
_ [Ct]
_ [Ct]
_ [Ct]
_ -> TcPluginResult -> TcPluginM TcPluginResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TcPluginResult -> TcPluginM TcPluginResult)
-> TcPluginResult -> TcPluginM TcPluginResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginResult
TcPluginOk [] []
        , tcPluginStop :: Any -> TcPluginM ()
tcPluginStop = TcPluginM () -> Any -> TcPluginM ()
forall a b. a -> b -> a
const (TcPluginM () -> Any -> TcPluginM ())
-> TcPluginM () -> Any -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

-- noOp { tcPluginSolve = \_ _ _ _ -> undefined }
undefSolve :: TcPlugin
undefSolve :: TcPlugin
undefSolve =
    TcPlugin :: forall s.
TcPluginM s
-> (s -> TcPluginSolver) -> (s -> TcPluginM ()) -> TcPlugin
TcPlugin
        { tcPluginInit :: TcPluginM ()
tcPluginInit = () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , tcPluginSolve :: () -> TcPluginSolver
tcPluginSolve = \()
_ [Ct]
_ [Ct]
_ [Ct]
_ -> TcPluginM TcPluginResult
forall a. HasCallStack => a
undefined
        , tcPluginStop :: () -> TcPluginM ()
tcPluginStop = TcPluginM () -> () -> TcPluginM ()
forall a b. a -> b -> a
const (TcPluginM () -> () -> TcPluginM ())
-> TcPluginM () -> () -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

-- noOp { tcPluginStop = const undefined }
undefStop :: TcPlugin
undefStop :: TcPlugin
undefStop =
    TcPlugin :: forall s.
TcPluginM s
-> (s -> TcPluginSolver) -> (s -> TcPluginM ()) -> TcPlugin
TcPlugin
        { tcPluginInit :: TcPluginM ()
tcPluginInit = () -> TcPluginM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , tcPluginSolve :: () -> TcPluginSolver
tcPluginSolve = \()
_ [Ct]
_ [Ct]
_ [Ct]
_ -> TcPluginResult -> TcPluginM TcPluginResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TcPluginResult -> TcPluginM TcPluginResult)
-> TcPluginResult -> TcPluginM TcPluginResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginResult
TcPluginOk [] []
        , tcPluginStop :: () -> TcPluginM ()
tcPluginStop = TcPluginM () -> () -> TcPluginM ()
forall a b. a -> b -> a
const TcPluginM ()
forall a. HasCallStack => a
undefined
        }

mkPureTcPlugin :: TcPlugin -> Plugin
mkPureTcPlugin :: TcPlugin -> Plugin
mkPureTcPlugin TcPlugin
p =
    Plugin
defaultPlugin
        { tcPlugin :: TcPlugin
tcPlugin = Maybe TcPlugin -> TcPlugin
forall a b. a -> b -> a
const (Maybe TcPlugin -> TcPlugin) -> Maybe TcPlugin -> TcPlugin
forall a b. (a -> b) -> a -> b
$ TcPlugin -> Maybe TcPlugin
forall a. a -> Maybe a
Just TcPlugin
p
#if __GLASGOW_HASKELL__ >= 806
        , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
purePlugin
#endif
        }

mkImpureTcPlugin :: TcPlugin -> Plugin
mkImpureTcPlugin :: TcPlugin -> Plugin
mkImpureTcPlugin TcPlugin
p =
    Plugin
defaultPlugin
        { tcPlugin :: TcPlugin
tcPlugin = Maybe TcPlugin -> TcPlugin
forall a b. a -> b -> a
const (Maybe TcPlugin -> TcPlugin) -> Maybe TcPlugin -> TcPlugin
forall a b. (a -> b) -> a -> b
$ TcPlugin -> Maybe TcPlugin
forall a. a -> Maybe a
Just TcPlugin
p
#if __GLASGOW_HASKELL__ >= 806
        , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
impurePlugin
#endif
        }

mkPureOptTcPlugin :: ([CommandLineOption] -> Maybe TcPlugin) -> Plugin
mkPureOptTcPlugin :: TcPlugin -> Plugin
mkPureOptTcPlugin TcPlugin
p =
    Plugin
defaultPlugin
        { tcPlugin :: TcPlugin
tcPlugin = TcPlugin
p
#if __GLASGOW_HASKELL__ >= 806
        , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
purePlugin
#endif
        }