{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
module Lambdabot.Plugin.Misc.Error (errorPlugin, failOnLoad, errorOnLoad) where

import Lambdabot.Config
import Lambdabot.Plugin

import Control.Monad

config "failOnLoad"  [t| Bool |] [| False |]
config "errorOnLoad" [t| Bool |] [| False |]

errorPlugin :: Module ()
errorPlugin :: Module ()
errorPlugin = forall st. Module st
newModule
    { moduleCmds :: ModuleT () LB [Command (ModuleT () LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"error")
            { help :: Cmd (ModuleT () LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Throw an error, see what lambdabot does with it!"
            , process :: String -> Cmd (ModuleT () LB) ()
process = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
            }
        , (String -> Command Identity
command String
"fail")
            { help :: Cmd (ModuleT () LB) ()
help = forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Throw an error, see what lambdabot does with it!"
            , process :: String -> Cmd (ModuleT () LB) ()
process = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
            }
        ]
    , moduleInit :: ModuleT () LB ()
moduleInit = do
        Bool
shouldFail <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Bool
failOnLoad
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldFail (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Error module hates the world!")
        
        Bool
shouldError <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Bool
errorOnLoad
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldError (forall a. HasCallStack => String -> a
error String
"Error module hates the world!")
    }