Changed msg handler design to make them stateful, added core IRC msg handlers

.gitignore

@@ -5,3 +5,4 @@ cabal.sandbox.config
 dist
 config.cfg
 *sublime*
+logs

Main.hs

@@ -41,8 +41,8 @@ loadBotConfig configFile = do
         channel  <- CF.require cfg "channel"
         botNick  <- CF.require cfg "nick"
         timeout  <- CF.require cfg "timeout"
-        handlers <- CF.require cfg "handlers"
+        msghandlers <- CF.require cfg "msghandlers"
-        return $ BotConfig server port channel botNick timeout handlers cfg
+        return $ BotConfig server port channel botNick timeout msghandlers cfg
 
       case eBotConfig of
         Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k

Network/IRC/Client.hs

@@ -5,10 +5,11 @@ module Network.IRC.Client (run) where
 import qualified Data.Text.Format as TF
 import qualified Data.Text.Format.Params as TF
 
-import ClassyPrelude hiding (log)
+import ClassyPrelude
 import Control.Concurrent
-import Control.Monad.Reader hiding (forM_)
+import Control.Monad.Reader hiding (forM_, foldM)
-import Control.Monad.State hiding (forM_)
+import Control.Monad.State hiding (forM_, foldM)
+import Data.Maybe (fromJust)
 import Network
 import System.IO (hSetBuffering, BufferMode(..))
 import System.Timeout
@@ -20,14 +21,17 @@ import Network.IRC.Types
 oneSec :: Int
 oneSec = 1000000
 
-log :: Text -> IO ()
+debug :: Text -> IO ()
-log msg = getCurrentTime >>= \t -> TF.print "[{}] ** {}\n" $ TF.buildParams (t, msg)
+debug msg = do
+  time <- getCurrentTime
+  TF.print "[{}] {}\n" $ TF.buildParams (formatTime defaultTimeLocale "%F %T" time, msg)
 
 sendCommand :: Bot -> Command -> IO ()
 sendCommand Bot { .. } reply = do
+  time <- getCurrentTime
   let line = lineFromCommand botConfig reply
   TF.hprint socket "{}\r\n" $ TF.Only line
-  TF.print "> {}\n" $ TF.Only line
+  TF.print "[{}} > {}\n" $ TF.buildParams (formatTime defaultTimeLocale "%F %T" time, line)
 
 listen :: IRC ()
 listen = do
@@ -44,64 +48,92 @@ listen = do
       Nothing -> return Disconnected
       Just line -> do
         now <- getCurrentTime
-        TF.print "[{}] {}\n" $ TF.buildParams (now, line)
+        debug $ "< " ++ line
 
         let message = msgFromLine botConfig now line
         case message of
-          JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined
+          JoinMsg { .. } | userNick user == nick -> debug "Joined"          >> return Joined
-          KickMsg { .. } | kicked == nick        -> log "Kicked" >> return Kicked
+          KickMsg { .. } | kicked == nick        -> debug "Kicked"          >> return Kicked
-          _                                      -> do
+          ModeMsg { user = Self, .. }            -> sendCommand bot JoinCmd >> return status
-            forkIO $ case message of
+          _                                      -> return status
-              Ping { .. }                 -> sendCommand bot $ Pong msg
+
-              ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd
+        forM_ (msgHandlers botConfig) $ \msgHandlerName -> forkIO $ do
-              msg                         -> forM_ (handlers botConfig) $ \handlerName -> forkIO $ do
+          let mMsgHandler = getMsgHandler msgHandlerName
-                let mHandler = getHandler handlerName
+          case mMsgHandler of
-                case mHandler of
+            Nothing         -> debug $ "No msg handler found with name: " ++ msgHandlerName
-                  Nothing      -> log $ "No handler found with name: " ++ handlerName
+            Just msgHandler -> do
-                  Just handler -> do
+              let msgHandlerState = fromJust . lookup msgHandlerName $ msgHandlerStates
-                    mCmd <- runHandler handler botConfig msg
+              mCmd <- runMsgHandler msgHandler botConfig msgHandlerState message
-                    case mCmd of
+              case mCmd of
-                      Nothing  -> return ()
+                Nothing  -> return ()
-                      Just cmd -> sendCommand bot cmd
+                Just cmd -> sendCommand bot cmd
-            return status
+        return status
 
   put nStatus
   when (nStatus /= Disconnected) listen
 
 connect :: BotConfig -> IO Bot
 connect botConfig@BotConfig { .. } = do
-  log "Connecting ..."
+  debug "Connecting ..."
   socket <- connectToWithRetry
   hSetBuffering socket LineBuffering
-  hSetBuffering stdout LineBuffering
+  msgHandlerStates <- loadMsgHandlers botConfig
-  log "Connected"
+  debug "Connected"
-  return $ Bot botConfig socket
+  return $ Bot botConfig socket msgHandlerStates
   where
-    connectToWithRetry = connectTo server (PortNumber (fromIntegral port))
+    connectToWithRetry = connectTo (unpack server) (PortNumber (fromIntegral port))
                            `catch` (\(e :: SomeException) -> do
-                                      log ("Error while connecting: " ++ pack (show e) ++ ". Waiting.")
+                                      debug ("Error while connecting: " ++ pack (show e) ++ ". Waiting.")
                                       threadDelay (5 * oneSec)
                                       connectToWithRetry)
 
+loadMsgHandlers :: BotConfig -> IO MsgHandlerStates
+loadMsgHandlers botConfig@BotConfig { .. } =
+  flip (`foldM` mapFromList []) msgHandlers $ \hMap msgHandlerName -> do
+    debug $ "Loading msg handler: " ++ msgHandlerName
+    let mMsgHandler = getMsgHandler msgHandlerName
+    case mMsgHandler of
+      Nothing         -> debug ("No msg handler found with name: " ++ msgHandlerName) >> return hMap
+      Just msgHandler -> do
+        msgHandlerState <- initMsgHandler msgHandler botConfig
+        return $ insertMap msgHandlerName msgHandlerState hMap
+
+unloadMsgHandlers :: Bot -> IO ()
+unloadMsgHandlers Bot { .. } =
+  forM_ (mapToList msgHandlerStates) $ \(msgHandlerName, msgHandlerState) -> do
+    debug $ "Unloading msg handler: " ++ msgHandlerName
+    let mMsgHandler = getMsgHandler msgHandlerName
+    case mMsgHandler of
+      Nothing         -> debug ("No msg handler found with name: " ++ msgHandlerName)
+      Just msgHandler -> exitMsgHandler msgHandler botConfig msgHandlerState
+
+
 disconnect :: Bot -> IO ()
-disconnect bot = do
+disconnect bot@Bot { .. } = do
-  log "Disconnecting ..."
+  debug "Disconnecting ..."
-  hClose . socket $ bot
+  unloadMsgHandlers bot
-  log "Disconnected"
+  hClose socket
+  debug "Disconnected"
+
+addCoreMsgHandlers :: BotConfig -> BotConfig
+addCoreMsgHandlers botConfig =
+  botConfig { msgHandlers = hashNub $ msgHandlers botConfig ++ coreMsgHandlerNames }
 
 run :: BotConfig -> IO ()
-run botConfig = withSocketsDo $ do
+run botConfig' = withSocketsDo $ do
-  log "Running with config:"
+  hSetBuffering stdout LineBuffering
+  debug "Running with config:"
   print botConfig
   status <- run_
   case status of
-    Disconnected -> log "Connection timed out" >> run botConfig
+    Disconnected -> debug "Connection timed out" >> run botConfig
     Errored      -> return ()
     _            -> error "Unsupported status"
   where
+    botConfig = addCoreMsgHandlers botConfig'
     run_ = bracket (connect botConfig) disconnect $ \bot ->
       go bot `catch` \(e :: SomeException) -> do
-        log $ "Exception! " ++ pack (show e)
+        debug $ "Exception! " ++ pack (show e)
         return Errored
 
     go bot = do

Network/IRC/Handlers.hs

@@ -1,33 +1,44 @@
-{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude #-}
+{-# LANGUAGE RecordWildCards, OverloadedStrings, NoImplicitPrelude, FlexibleContexts #-}
 
-module Network.IRC.Handlers (getHandler) where
+module Network.IRC.Handlers (coreMsgHandlerNames, getMsgHandler) where
+
+import qualified Network.IRC.Handlers.Core as C
+import qualified Network.IRC.Handlers.SongSearch as SS
 
 import ClassyPrelude
+import Control.Monad.Reader
 import Data.Text (strip)
 
-import Network.IRC.Handlers.SongSearch
 import Network.IRC.Types
 
 clean :: Text -> Text
 clean = toLower . strip
 
-getHandler :: HandlerName -> Maybe Handler
+coreMsgHandlerNames :: [Text]
-getHandler "greeter"    = Just $ Handler greeter
+coreMsgHandlerNames = ["pingpong", "messagelogger"]
-getHandler "welcomer"   = Just $ Handler welcomer
-getHandler "songsearch" = Just $ Handler songSearch
-getHandler _            = Nothing
 
-greeter :: Monad m => BotConfig -> Message -> m (Maybe Command)
+getMsgHandler :: MsgHandlerName -> Maybe MsgHandler
-greeter _ ChannelMsg { .. } = case find (== clean msg) greetings of
+getMsgHandler "greeter"  = Just $ newMsgHandler { msgHandlerRun = greeter }
+getMsgHandler "welcomer" = Just $ newMsgHandler { msgHandlerRun = welcomer }
+getMsgHandler name       = listToMaybe $ mapMaybe (\f -> f name)
+                           [C.getMsgHandler, SS.getMsgHandler]
+
+
+greeter ::  MonadMsgHandler m => Message -> m (Maybe Command)
+greeter ChannelMsg { .. } = case find (== clean msg) greetings of
     Nothing       -> return Nothing
     Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user
   where
     greetings = ["hi", "hello", "hey", "sup", "bye"
                 , "good morning", "good evening", "good night"
                 , "ohayo", "oyasumi"]
-greeter _ _ = return Nothing
+greeter _ = return Nothing
 
-welcomer :: Monad m => BotConfig -> Message -> m (Maybe Command)
+welcomer :: MonadMsgHandler m => Message -> m (Maybe Command)
-welcomer BotConfig { .. } JoinMsg { .. }
+welcomer JoinMsg { .. } = do
-  | userNick user /= botNick = return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
+  BotConfig { .. } <- ask
-welcomer _ _ = return Nothing
+  if userNick user /= botNick
+    then return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
+    else return Nothing
+
+welcomer _ = return Nothing

Network/IRC/Handlers/Core.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE RecordWildCards, NoImplicitPrelude, OverloadedStrings, FlexibleContexts #-}
+
+module Network.IRC.Handlers.Core (getMsgHandler) where
+
+import qualified Data.Configurator as C
+import qualified Data.Text.Format as TF
+import qualified Data.Text.Format.Params as TF
+
+import ClassyPrelude hiding (try, (</>), (<.>))
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Dynamic
+import System.Directory
+import System.FilePath
+import System.IO
+
+import Network.IRC.Types
+
+getMsgHandler :: MsgHandlerName -> Maybe MsgHandler
+getMsgHandler "pingpong"      = Just $ newMsgHandler { msgHandlerRun = pingPong }
+getMsgHandler "messagelogger" = Just $ newMsgHandler { msgHandlerInit = initMessageLogger
+                                                     , msgHandlerRun  = messageLogger
+                                                     , msgHandlerExit = exitMessageLogger }
+getMsgHandler _               = Nothing
+
+pingPong :: MonadMsgHandler m => Message -> m (Maybe Command)
+pingPong Ping { .. } = return . Just $ Pong msg
+pingPong _           = return Nothing
+
+initMessageLogger :: MonadMsgHandler m => m ()
+initMessageLogger = do
+  BotConfig { .. } <- ask
+  logFileHandle <- liftIO $ do
+    logFileDir <- C.require config "messagelogger.logdir"
+    createDirectoryIfMissing True logFileDir
+    let logFilePath = logFileDir </> unpack botNick <.> "log"
+    logFileHandle <- openFile logFilePath AppendMode
+    hSetBuffering logFileHandle LineBuffering
+    return logFileHandle
+  put $ toDyn logFileHandle
+
+exitMessageLogger :: MonadMsgHandler m => m ()
+exitMessageLogger = do
+  mHandle <- map fromDynamic get
+  case mHandle of
+    Nothing -> return ()
+    Just logFileHandle -> liftIO $ hClose logFileHandle
+
+messageLogger :: MonadMsgHandler m => Message -> m (Maybe Command)
+messageLogger ChannelMsg { .. } = do
+  logFileHandle <- map (`fromDyn` error "No log file set") get
+  let time = formatTime defaultTimeLocale "%F %T" msgTime
+  liftIO $ TF.hprint logFileHandle "[{}] {}: {}\n" $ TF.buildParams (time, userNick user, msg)
+  return Nothing
+messageLogger _ = return Nothing

Network/IRC/Handlers/SongSearch.hs

@@ -1,11 +1,12 @@
-{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, NoImplicitPrelude #-}
+{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, NoImplicitPrelude, FlexibleContexts #-}
 
-module Network.IRC.Handlers.SongSearch (songSearch) where
+module Network.IRC.Handlers.SongSearch (getMsgHandler) where
 
 import qualified Data.Configurator as CF
 
 import ClassyPrelude hiding (try)
 import Control.Exception
+import Control.Monad.Reader
 import Data.Aeson
 import Data.Aeson.Types (emptyArray)
 import Data.Text (strip)
@@ -14,6 +15,10 @@ import Network.HTTP.Base
 
 import Network.IRC.Types
 
+getMsgHandler :: MsgHandlerName -> Maybe MsgHandler
+getMsgHandler "songsearch" = Just $ newMsgHandler { msgHandlerRun = songSearch }
+getMsgHandler _            = Nothing
+
 data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
             deriving (Show, Eq)
 
@@ -22,9 +27,11 @@ instance FromJSON Song where
     parseJSON a | a == emptyArray = return NoSong
     parseJSON _                   = mempty
 
-songSearch :: MonadIO m => BotConfig -> Message -> m (Maybe Command)
+songSearch :: MonadMsgHandler m => Message -> m (Maybe Command)
-songSearch BotConfig { .. } ChannelMsg { .. }
+songSearch ChannelMsg { .. } =  if "!m " `isPrefixOf` msg
-  | "!m " `isPrefixOf` msg = liftIO $ do
+  then do
+    BotConfig { .. } <- ask
+    liftIO $ do
       let query = strip . drop 3 $ msg
       mApiKey <- CF.lookup config "songsearch.tinysong_apikey"
       map (Just . ChannelMsgReply) $ case mApiKey of
@@ -40,5 +47,5 @@ songSearch BotConfig { .. } ChannelMsg { .. }
             Right song                     -> case song of
               Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url
               NoSong      -> "No song found for: " ++ query
-  | otherwise = return Nothing
+  else return Nothing
-songSearch _ _ = return Nothing
+songSearch _ = return Nothing

Network/IRC/Protocol.hs

@@ -10,20 +10,20 @@ import Network.IRC.Types
 
 msgFromLine :: BotConfig -> UTCTime -> Text -> Message
 msgFromLine (BotConfig { .. }) time line
-  | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
+  | "PING :" `isPrefixOf` line = Ping time (drop 6 line) line
   | otherwise = case command of
-      "JOIN"    -> JoinMsg time user
+      "JOIN"    -> JoinMsg time user line
-      "QUIT"    -> QuitMsg time user message
+      "QUIT"    -> QuitMsg time user message line
-      "PART"    -> PartMsg time user message
+      "PART"    -> PartMsg time user message line
-      "KICK"    -> KickMsg time user kicked kickReason
+      "KICK"    -> KickMsg time user kicked kickReason line
       "MODE"    -> if source == botNick
-        then ModeMsg time Self target message []
+        then ModeMsg time Self target message [] line
-        else ModeMsg time user target mode modeArgs
+        else ModeMsg time user target mode modeArgs line
-      "NICK"    -> NickMsg time user (drop 1 target)
+      "NICK"    -> NickMsg time user (drop 1 target) line
       "PRIVMSG" -> if target == channel
-        then ChannelMsg time user message
+        then ChannelMsg time user message line
-        else PrivMsg time user message
+        else PrivMsg time user message line
-      _         -> OtherMsg time source command target message
+      _         -> OtherMsg time source command target message line
   where
     isSpc      = (== ' ')
     isNotSpc   = not . isSpc
@@ -46,4 +46,3 @@ lineFromCommand (BotConfig { .. }) reply = case reply of
   JoinCmd                         -> "JOIN " ++ channel
   ChannelMsgReply { .. }          -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
   PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg
-

Network/IRC/Types.hs

@@ -1,53 +1,60 @@
 {-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE  NoImplicitPrelude, OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleContexts #-}
 
-module Network.IRC.Types where
+module Network.IRC.Types
+  (Channel, Nick, MsgHandlerName,
+   User (..), Message (..), Command (..),
+   BotConfig (..), BotStatus (..), Bot (..),
+   IRC, runIRC,
+   MonadMsgHandler, runMsgHandler, initMsgHandler, exitMsgHandler,
+   MsgHandlerState, MsgHandlerStates, MsgHandler (..), newMsgHandler)
+where
 
 import ClassyPrelude
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Configurator.Types
+import Data.Dynamic
 
-type Channel     = Text
+type Channel        = Text
-type Nick        = Text
+type Nick           = Text
-type HandlerName = Text
+type MsgHandlerName = Text
 
-newtype Handler = Handler {
+data User = Self | User { userNick :: !Nick, userServer :: !Text }
-  runHandler :: forall m . (MonadIO m) => BotConfig -> Message -> m (Maybe Command)
-}
-
-data User = Self | User { userNick :: Nick, userServer :: Text }
             deriving (Show, Eq)
 
 data Message =
-    ChannelMsg { time :: UTCTime, user   :: User, msg     :: Text }
+    ChannelMsg { msgTime  :: !UTCTime, user   :: !User, msg     :: !Text, msgLine :: !Text }
-  | PrivMsg    { time :: UTCTime, user   :: User, msg     :: Text }
+  | PrivMsg    { msgTime  :: !UTCTime, user   :: !User, msg     :: !Text, msgLine :: !Text }
-  | Ping       { time :: UTCTime, msg    :: Text }
+  | Ping       { msgTime  :: !UTCTime, msg    :: !Text, msgLine :: !Text }
-  | JoinMsg    { time :: UTCTime, user   :: User }
+  | JoinMsg    { msgTime  :: !UTCTime, user   :: !User, msgLine :: !Text }
-  | ModeMsg    { time :: UTCTime, user   :: User, target  :: Text , mode   :: Text, modeArgs :: [Text] }
+  | ModeMsg    { msgTime  :: !UTCTime, user   :: !User, target  :: !Text, mode    :: !Text
-  | NickMsg    { time :: UTCTime, user   :: User, nick    :: Text }
+               , modeArgs :: ![Text], msgLine :: !Text }
-  | QuitMsg    { time :: UTCTime, user   :: User, msg     :: Text }
+  | NickMsg    { msgTime  :: !UTCTime, user   :: !User, nick    :: !Text, msgLine :: !Text }
-  | PartMsg    { time :: UTCTime, user   :: User, msg     :: Text }
+  | QuitMsg    { msgTime  :: !UTCTime, user   :: !User, msg     :: !Text, msgLine :: !Text }
-  | KickMsg    { time :: UTCTime, user   :: User, kicked  :: Text , msg    :: Text }
+  | PartMsg    { msgTime  :: !UTCTime, user   :: !User, msg     :: !Text, msgLine :: !Text }
-  | OtherMsg   { time :: UTCTime, source :: Text, command :: Text , target :: Text, msg      :: Text }
+  | KickMsg    { msgTime  :: !UTCTime, user   :: !User, kicked  :: !Text, msg     :: !Text
+               , msgLine  :: !Text }
+  | OtherMsg   { msgTime  :: !UTCTime, source :: !Text, command :: !Text, target  :: !Text
+               , msg      :: !Text,   msgLine :: !Text }
   deriving (Show, Eq)
 
 data Command =
-    Pong            { rmsg  :: Text }
+    Pong            { rmsg  :: !Text }
-  | ChannelMsgReply { rmsg  :: Text }
+  | ChannelMsgReply { rmsg  :: !Text }
-  | PrivMsgReply    { ruser :: User, rmsg :: Text }
+  | PrivMsgReply    { ruser :: !User, rmsg :: !Text }
   | NickCmd
   | UserCmd
   | JoinCmd
   deriving (Show, Eq)
 
-data BotConfig = BotConfig { server     :: String
+data BotConfig = BotConfig { server      :: !Text
-                           , port       :: Int
+                           , port        :: !Int
-                           , channel    :: Text
+                           , channel     :: !Text
-                           , botNick    :: Text
+                           , botNick     :: !Text
-                           , botTimeout :: Int
+                           , botTimeout  :: !Int
-                           , handlers   :: [HandlerName]
+                           , msgHandlers :: ![MsgHandlerName]
-                           , config     :: Config }
+                           , config      :: !Config }
 
 instance Show BotConfig where
   show BotConfig { .. } = "server = " ++ show server ++ "\n" ++
@@ -55,15 +62,62 @@ instance Show BotConfig where
                           "channel = " ++ show channel ++ "\n" ++
                           "nick = " ++ show botNick ++ "\n" ++
                           "timeout = " ++ show botTimeout ++ "\n" ++
-                          "handlers = " ++ show handlers ++ "\n"
+                          "handlers = " ++ show msgHandlers
 
-data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show)
+type MsgHandlerStates = Map MsgHandlerName MsgHandlerState
+
+data Bot = Bot { botConfig        :: !BotConfig
+               , socket           :: !Handle
+               , msgHandlerStates :: !MsgHandlerStates}
 
 data BotStatus = Connected | Disconnected | Joined | Kicked | Errored
                  deriving (Show, Eq)
 
 newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
-                deriving (Functor, Monad, MonadIO, MonadReader Bot, MonadState BotStatus)
+                deriving ( Functor
+                         , Applicative
+                         , Monad
+                         , MonadIO
+                         , MonadReader Bot
+                         , MonadState BotStatus)
 
 runIRC :: Bot -> BotStatus -> IRC a -> IO BotStatus
 runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC
+
+type MsgHandlerState = Dynamic
+
+newtype MsgHandlerT a = MsgHandlerT { _runMsgHandler :: StateT MsgHandlerState (ReaderT BotConfig IO) a }
+                     deriving ( Functor
+                              , Applicative
+                              , Monad
+                              , MonadIO
+                              , MonadState MsgHandlerState
+                              , MonadReader BotConfig)
+
+class ( MonadIO m, Applicative m
+      , MonadState MsgHandlerState m, MonadReader BotConfig m) => MonadMsgHandler m where
+  msgHandler :: MsgHandlerT a -> m a
+
+instance MonadMsgHandler MsgHandlerT where
+  msgHandler = id
+
+runMsgHandler :: MsgHandler -> BotConfig -> MsgHandlerState -> Message -> IO (Maybe Command)
+runMsgHandler MsgHandler { .. } botConfig msgHandlerState =
+  flip runReaderT botConfig . flip evalStateT msgHandlerState . _runMsgHandler . msgHandlerRun
+
+initMsgHandler :: MsgHandler -> BotConfig -> IO MsgHandlerState
+initMsgHandler MsgHandler { .. } botConfig =
+  flip runReaderT botConfig . flip execStateT (toDyn ()) . _runMsgHandler $ msgHandlerInit
+
+exitMsgHandler :: MsgHandler -> BotConfig -> MsgHandlerState -> IO ()
+exitMsgHandler MsgHandler { .. } botConfig msgHandlerState =
+  flip runReaderT botConfig . flip evalStateT msgHandlerState . _runMsgHandler $ msgHandlerExit
+
+data MsgHandler = MsgHandler { msgHandlerInit :: !(forall m . MonadMsgHandler m => m ())
+                             , msgHandlerRun  :: !(forall m . MonadMsgHandler m => Message -> m (Maybe Command))
+                             , msgHandlerExit :: !(forall m . MonadMsgHandler m => m ()) }
+
+newMsgHandler :: MsgHandler
+newMsgHandler = MsgHandler { msgHandlerInit = return ()
+                           , msgHandlerRun  = const $ return Nothing
+                           , msgHandlerExit = return () }

config.cfg.template

@@ -2,7 +2,7 @@ server = "irc.freenode.net"
 port = 6667
 channel = "#testtesttest"
 nick = "haskman"
-handlers = ["greeter", "welcomer", "songsearch"]
+msghandlers = ["greeter", "welcomer", "songsearch"]
 
 songsearch {
   tinysong_apikey = "xxxyyyzzz"

hask-irc.cabal

@@ -52,14 +52,14 @@ library
   build-depends:       base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
                        network >=2.3 && <2.5, configurator >= 0.2, time >=1.4.0,
                        curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3,
-                       classy-prelude ==0.9.1, text-format >= 0.3.1
+                       classy-prelude ==0.9.1, text-format >= 0.3.1, filepath >=1.3, directory >=1.2
 
   exposed-modules:     Network.IRC.Types, Network.IRC.Protocol,
                        Network.IRC.Handlers, Network.IRC.Client
 
   default-language:    Haskell2010
 
-  ghc-options:         -Wall -fno-warn-unused-do-bind -O2 -funbox-strict-fields
+  ghc-options:         -Wall -fno-warn-unused-do-bind -O2 -funbox-strict-fields -fno-warn-orphans
 
 
 executable hask-irc
@@ -76,7 +76,7 @@ executable hask-irc
   build-depends:       base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
                        network >=2.3 && <2.5, configurator >= 0.2, time >=1.4.0,
                        curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP, transformers >=0.3,
-                       classy-prelude ==0.9.1, text-format >= 0.3.1
+                       classy-prelude ==0.9.1, text-format >= 0.3.1, filepath >=1.3, directory >=1.2
 
   -- Directories containing source files.
   -- hs-source-dirs:
@@ -84,5 +84,5 @@ executable hask-irc
   -- Base language which the package is written in.
   default-language:    Haskell2010
 
-  ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields
+  ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields -fno-warn-orphans