Simplify command system
All that type class and language extension madness was completely and utterly unnecessary, but I only noticed it after I had already pushed the implementation. Oh well ¯\_(ツ)_/¯
This commit is contained in:
parent
fd4ae38eb1
commit
644ebcefc9
1 changed files with 6 additions and 31 deletions
|
|
@ -1,14 +1,7 @@
|
||||||
{-# LANGUAGE ExistentialQuantification #-}
|
-- | This module provides an abstraction for bot commands.
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
||||||
|
|
||||||
-- | This module provides an abstraction for bot commands in the form of the
|
|
||||||
-- 'Hook' type class and the 'Command' type.
|
|
||||||
|
|
||||||
module Haboli.Euphoria.Command
|
module Haboli.Euphoria.Command
|
||||||
( Hook(..)
|
( Command
|
||||||
, Command
|
|
||||||
, cmd
|
|
||||||
, runCommand
|
|
||||||
, runCommands
|
, runCommands
|
||||||
, respondingToCommands
|
, respondingToCommands
|
||||||
) where
|
) where
|
||||||
|
|
@ -18,34 +11,16 @@ import Control.Monad
|
||||||
import Haboli.Euphoria.Api
|
import Haboli.Euphoria.Api
|
||||||
import Haboli.Euphoria.Client
|
import Haboli.Euphoria.Client
|
||||||
|
|
||||||
-- | A hook is a way to react to new messages in a room. These typically don't
|
-- | If a command should block any further commands from executing on a message,
|
||||||
-- include the messages sent by the client itself.
|
-- it should return 'True'. Otherwise. it should return 'False'.
|
||||||
class Hook h where
|
type Command e = Message -> Client e Bool
|
||||||
-- | @reel h msg@ applies the hook @h@ to the 'Message' @msg@. If no further
|
|
||||||
-- hooks should be applied to this message, it should return 'True'.
|
|
||||||
-- Otherwise, it should return 'False'.
|
|
||||||
reel :: h e -> Message -> Client e Bool
|
|
||||||
|
|
||||||
-- | A wrapper around hooks that allows for heterogenous lists of hooks. In
|
|
||||||
-- other words, it lets you combine different 'Hook' instances into a single
|
|
||||||
-- list.
|
|
||||||
data Command e = forall h. (Hook h) => Command (h e)
|
|
||||||
|
|
||||||
-- | Wrap a hook. Notice how the @h@ type disappears: This function can convert
|
|
||||||
-- different 'Hook' instances into the same type.
|
|
||||||
cmd :: (Hook h) => h e -> Command e
|
|
||||||
cmd = Command
|
|
||||||
|
|
||||||
-- | Apply a 'Command' to a 'Message'. For more information, see 'reel'.
|
|
||||||
runCommand :: Command e -> Message -> Client e Bool
|
|
||||||
runCommand (Command h) = reel h
|
|
||||||
|
|
||||||
-- | Apply multiple 'Command's to a 'Message' in order until one returns 'True'.
|
-- | Apply multiple 'Command's to a 'Message' in order until one returns 'True'.
|
||||||
-- All commands following that one are not applied.
|
-- All commands following that one are not applied.
|
||||||
runCommands :: [Command e] -> Message -> Client e Bool
|
runCommands :: [Command e] -> Message -> Client e Bool
|
||||||
runCommands [] _ = pure False
|
runCommands [] _ = pure False
|
||||||
runCommands (c:cs) msg = do
|
runCommands (c:cs) msg = do
|
||||||
abort <- runCommand c msg
|
abort <- c msg
|
||||||
if abort
|
if abort
|
||||||
then pure True
|
then pure True
|
||||||
else runCommands cs msg
|
else runCommands cs msg
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue