Restructed handlers project

hask-irc-core/Network/IRC.hs

@@ -0,0 +1,8 @@
+module Network.IRC
+ (
+  module Network.IRC.Types,
+  module Network.IRC.Client
+  )where
+
+import Network.IRC.Types
+import Network.IRC.Client

hask-irc-core/hask-irc-core.cabal

@@ -69,7 +69,8 @@ library
                        transformers-base    >=0.4     && <0.5,
                        unix                 >=2.7     && <2.8
 
-  exposed-modules:     Network.IRC.Types,
+  exposed-modules:     Network.IRC,
+                       Network.IRC.Types,
                        Network.IRC.Client,
                        Network.IRC.Util
 

hask-irc-handlers/Network/IRC/Handlers.hs

@@ -1,20 +1,20 @@
 module Network.IRC.Handlers (allMsgHandlerMakers) where
 
-import qualified Network.IRC.Handlers.Auth          as Auth
+import Network.IRC.Handlers.Auth
-import qualified Network.IRC.Handlers.Greet         as Greet
+import Network.IRC.Handlers.Greet
-import qualified Network.IRC.Handlers.MessageLogger as Logger
+import Network.IRC.Handlers.MessageLogger
-import qualified Network.IRC.Handlers.NickTracker   as NickTracker
+import Network.IRC.Handlers.NickTracker
-import qualified Network.IRC.Handlers.SongSearch    as SongSearch
+import Network.IRC.Handlers.SongSearch
-import qualified Network.IRC.Handlers.Tell          as Tell
+import Network.IRC.Handlers.Tell
 
 import Network.IRC.Types
 
 allMsgHandlerMakers :: [MsgHandlerMaker]
-allMsgHandlerMakers = [
+allMsgHandlerMakers =
-    Auth.mkMsgHandler
+  [ authMsgHandlerMaker
-  , Greet.mkMsgHandler
+  , greetMsgHandlerMaker
-  , Logger.mkMsgHandler
+  , messageLoggerMsgHandlerMaker
-  , NickTracker.mkMsgHandler
+  , nickTrackerMsgHandlerMaker
-  , SongSearch.mkMsgHandler
+  , songSearchMsgHandlerMaker
-  , Tell.mkMsgHandler
+  , tellMsgHandlerMaker
   ]

hask-irc-handlers/Network/IRC/Handlers/Auth.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Network.IRC.Handlers.Auth (mkMsgHandler) where
+module Network.IRC.Handlers.Auth (authMsgHandlerMaker) where
 
 import qualified Data.UUID    as U
 import qualified Data.UUID.V4 as U
@@ -65,8 +65,8 @@ authEvent state event = case fromEvent event of
     return RespNothing
   _                                    -> return RespNothing
 
-mkMsgHandler :: MsgHandlerMaker
+authMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "auth" go
+authMsgHandlerMaker = MsgHandlerMaker "auth" go
   where
     helpMsg botNick = "Send a PM to get a new auth token. /msg " ++ nickToText botNick ++ " token"
 

hask-irc-handlers/Network/IRC/Handlers/Greet.hs

@@ -1,4 +1,4 @@
-module Network.IRC.Handlers.Greet (mkMsgHandler) where
+module Network.IRC.Handlers.Greet (greetMsgHandlerMaker) where
 
 import ClassyPrelude
 import Control.Monad.Reader (ask)
@@ -6,8 +6,8 @@ import Control.Monad.Reader (ask)
 import Network.IRC.Types
 import Network.IRC.Util
 
-mkMsgHandler :: MsgHandlerMaker
+greetMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "greeter" go
+greetMsgHandlerMaker = MsgHandlerMaker "greeter" go
   where
     go _ _ "greeter"  = return . Just $ newMsgHandler { onMessage = greeter }
     go _ _ "welcomer" = return . Just $ newMsgHandler { onMessage = welcomer }

hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 
-module Network.IRC.Handlers.MessageLogger (mkMsgHandler) where
+module Network.IRC.Handlers.MessageLogger (messageLoggerMsgHandlerMaker) where
 
 import qualified Data.Configurator       as CF
 import qualified Data.Text.Format        as TF
@@ -19,8 +19,8 @@ import Network.IRC.Util
 
 type LoggerState = Maybe (Handle, Day)
 
-mkMsgHandler :: MsgHandlerMaker
+messageLoggerMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "messagelogger" go
+messageLoggerMsgHandlerMaker = MsgHandlerMaker "messagelogger" go
   where
     go botConfig _ "messagelogger" = do
       state <- io $ newIORef Nothing

hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Network.IRC.Handlers.NickTracker (mkMsgHandler) where
+module Network.IRC.Handlers.NickTracker (nickTrackerMsgHandlerMaker) where
 
 import qualified Data.Configurator as CF
 import qualified Data.IxSet        as IS
@@ -18,7 +18,7 @@ import Data.Convertible     (convert)
 import Data.IxSet           (getOne, (@=))
 import Data.Time            (addUTCTime, NominalDiffTime)
 
-import Network.IRC.Handlers.NickTracker.Types
+import Network.IRC.Handlers.NickTracker.Internal.Types
 import Network.IRC.Types
 import Network.IRC.Util
 
@@ -101,7 +101,7 @@ updateNickTrack state user message msgTime = io $ do
     (_, Just (NickTrack { .. }))  -> return (message, msgTime, canonicalNick)
     _                             -> newCanonicalNick >>= \cn -> return (message, msgTime, cn)
 
-  saveNickTrack acid $ NickTrack nck cn (LastSeenOn msgTime) lastMessageOn' message'
+  saveNickTrack acid $ NickTrack nck cn msgTime lastMessageOn' message'
 
 handleNickChange :: MonadMsgHandler m => IORef NickTrackingState -> User -> Nick -> UTCTime -> m ()
 handleNickChange state user newNick msgTime = io $ do
@@ -119,7 +119,7 @@ handleNickChange state user newNick msgTime = io $ do
     _ -> return Nothing
 
   whenJust mInfo $ \(message, cn, lastMessageOn') ->
-    saveNickTrack acid $ NickTrack newNick cn (LastSeenOn msgTime) lastMessageOn' message
+    saveNickTrack acid $ NickTrack newNick cn msgTime lastMessageOn' message
 
 newCanonicalNick :: IO CanonicalNick
 newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom
@@ -141,22 +141,22 @@ withNickTracks f state message = io $ do
 handleNickCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [Command]
 handleNickCommand = withNickTracks $ \nck nickTracks _ -> do
   let nicks = map ((\(Nick n) -> n) . nick) nickTracks
-  if length nicks == 1
+  return . (nck ++) $ if length nicks == 1
-    then return $ nck ++ " has only one nick"
+    then " has only one nick"
-    else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks)
+    else "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks)
 
 handleSeenCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [Command]
 handleSeenCommand = withNickTracks $ \nck nickTracks onlineNicks -> do
-  let NickTrack { lastSeenOn = LastSeenOn lastSeenOn'
+  let NickTrack { lastSeenOn = lastSeenOn'
                 , nick       = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nickTracks
   let NickTrack { lastMessageOn = lastMessageOn'
                 , lastMessage   = lastMessage'
                 , nick          = Nick lastMessageAs } = maximumByEx (comparing lastMessageOn) nickTracks
   now <- io getCurrentTime
-  return $
+  return . (nck ++) $
     (if any (`member` onlineNicks) . map nick $ nickTracks
-      then nck ++ " is online now"
+      then " is online now"
-      else nck ++ " was last seen " ++ relativeTime lastSeenOn' now) ++
+      else " was last seen " ++ relativeTime lastSeenOn' now) ++
     (if nck /= lastSeenAs then " as " ++ lastSeenAs else "") ++
     (if clean lastMessage' == "" then "" else
       " and " ++ relativeTime lastMessageOn' now ++ " " ++ nck ++
@@ -186,8 +186,8 @@ stopNickTracker state = io $ do
   createArchive acid
   createCheckpointAndClose acid
 
-mkMsgHandler :: MsgHandlerMaker
+nickTrackerMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "nicktracker" go
+nickTrackerMsgHandlerMaker = MsgHandlerMaker "nicktracker" go
   where
     helpMsgs = mapFromList [
       ("!nicks", "Shows alternate nicks of the user. !nicks <nick>"),

hask-irc-handlers/Network/IRC/Handlers/NickTracker/Internal/Types.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Network.IRC.Handlers.NickTracker.Internal.Types where
+
+import ClassyPrelude
+import Control.Concurrent.Lifted (Chan, writeChan)
+import Data.Data                 (Data)
+import Data.IxSet                (IxSet, Indexable (..), ixSet, ixFun)
+import Data.SafeCopy             (base, deriveSafeCopy)
+
+import Network.IRC.Types
+
+newtype CanonicalNick = CanonicalNick { canonicalNickToText :: Text }
+                        deriving (Eq, Ord, Show, Data, Typeable)
+newtype LastSeenOn    = LastSeenOn UTCTime deriving (Eq, Ord, Show, Data, Typeable)
+
+data NickTrack = NickTrack {
+  nick          :: !Nick,
+  canonicalNick :: !CanonicalNick,
+  lastSeenOn    :: !UTCTime,
+  lastMessageOn :: !UTCTime,
+  lastMessage   :: !Text
+} deriving (Eq, Ord, Show, Data, Typeable)
+
+instance Indexable NickTrack where
+  empty = ixSet [ ixFun $ (: []) . nick
+                , ixFun $ (: []) . canonicalNick
+                , ixFun $ (: []) . LastSeenOn . lastSeenOn ]
+
+newtype NickTracking = NickTracking { nickTracking :: IxSet NickTrack }
+                       deriving (Eq, Ord, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''CanonicalNick)
+$(deriveSafeCopy 0 'base ''LastSeenOn)
+$(deriveSafeCopy 0 'base ''NickTrack)
+$(deriveSafeCopy 0 'base ''NickTracking)
+
+emptyNickTracking :: NickTracking
+emptyNickTracking = NickTracking empty
+
+data NickTrackRequest = NickTrackRequest Nick (MVar (Maybe NickTrack)) deriving (Eq, Typeable)
+
+instance Event NickTrackRequest
+
+instance Show NickTrackRequest where
+  show (NickTrackRequest nick _) = "NickTrackRequest[" ++ unpack (nickToText nick) ++ "]"
+
+getCanonicalNick :: Chan SomeEvent -> Nick -> IO (Maybe CanonicalNick)
+getCanonicalNick eventChan nick = do
+  reply   <- newEmptyMVar
+  request <- toEvent $ NickTrackRequest nick reply
+  writeChan eventChan request
+  map (map canonicalNick) $ takeMVar reply

hask-irc-handlers/Network/IRC/Handlers/NickTracker/Types.hs

@@ -1,53 +1,9 @@
-{-# LANGUAGE TemplateHaskell #-}
+module Network.IRC.Handlers.NickTracker.Types
+  (
+    CanonicalNick (..)
+  , NickTrack (..)
+  , getCanonicalNick
+  )
+where
 
-module Network.IRC.Handlers.NickTracker.Types where
+import Network.IRC.Handlers.NickTracker.Internal.Types
-
-import ClassyPrelude
-import Control.Concurrent.Lifted (Chan, writeChan)
-import Data.Data                 (Data)
-import Data.IxSet                (IxSet, Indexable (..), ixSet, ixFun)
-import Data.SafeCopy             (base, deriveSafeCopy)
-
-import Network.IRC.Types
-
-newtype CanonicalNick = CanonicalNick { canonicalNickToText :: Text }
-                        deriving (Eq, Ord, Show, Data, Typeable)
-newtype LastSeenOn    = LastSeenOn UTCTime deriving (Eq, Ord, Show, Data, Typeable)
-
-data NickTrack = NickTrack {
-  nick          :: !Nick,
-  canonicalNick :: !CanonicalNick,
-  lastSeenOn    :: !LastSeenOn,
-  lastMessageOn :: !UTCTime,
-  lastMessage   :: !Text
-} deriving (Eq, Ord, Show, Data, Typeable)
-
-instance Indexable NickTrack where
-  empty = ixSet [ ixFun $ (: []) . nick
-                , ixFun $ (: []) . canonicalNick
-                , ixFun $ (: []) . lastSeenOn ]
-
-newtype NickTracking = NickTracking { nickTracking :: IxSet NickTrack }
-                       deriving (Eq, Ord, Show, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''CanonicalNick)
-$(deriveSafeCopy 0 'base ''LastSeenOn)
-$(deriveSafeCopy 0 'base ''NickTrack)
-$(deriveSafeCopy 0 'base ''NickTracking)
-
-emptyNickTracking :: NickTracking
-emptyNickTracking = NickTracking empty
-
-data NickTrackRequest = NickTrackRequest Nick (MVar (Maybe NickTrack)) deriving (Eq, Typeable)
-
-instance Event NickTrackRequest
-
-instance Show NickTrackRequest where
-  show (NickTrackRequest nick _) = "NickTrackRequest[" ++ unpack (nickToText nick) ++ "]"
-
-getCanonicalNick :: Chan SomeEvent -> Nick -> IO (Maybe CanonicalNick)
-getCanonicalNick eventChan nick = do
-  reply   <- newEmptyMVar
-  request <- toEvent $ NickTrackRequest nick reply
-  writeChan eventChan request
-  map (map canonicalNick) $ takeMVar reply

hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TemplateHaskell #-}
 
-module Network.IRC.Handlers.SongSearch (mkMsgHandler) where
+module Network.IRC.Handlers.SongSearch (songSearchMsgHandlerMaker) where
 
 import qualified Data.Configurator as CF
 import qualified System.Log.Logger as HSL
@@ -20,8 +20,8 @@ import Network.IRC.Types
 
 $(deriveLoggers "HSL" [HSL.ERROR])
 
-mkMsgHandler :: MsgHandlerMaker
+songSearchMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "songsearch" go
+songSearchMsgHandlerMaker = MsgHandlerMaker "songsearch" go
   where
     helpMsg = "Search for song. !m <song> or !m <artist> - <song>"
 

hask-irc-handlers/Network/IRC/Handlers/Tell.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Network.IRC.Handlers.Tell (mkMsgHandler) where
+module Network.IRC.Handlers.Tell (tellMsgHandlerMaker) where
 
 import qualified Data.IxSet as IS
 
@@ -17,7 +17,7 @@ import Data.IxSet                ((@=))
 import Data.Text                 (split, strip)
 
 import Network.IRC.Handlers.NickTracker.Types
-import Network.IRC.Handlers.Tell.Types
+import Network.IRC.Handlers.Tell.Internal.Types
 import Network.IRC.Types
 import Network.IRC.Util
 
@@ -125,8 +125,8 @@ stopTell state = io $ do
   createArchive acid
   createCheckpointAndClose acid
 
-mkMsgHandler :: MsgHandlerMaker
+tellMsgHandlerMaker :: MsgHandlerMaker
-mkMsgHandler = MsgHandlerMaker "tell" go
+tellMsgHandlerMaker = MsgHandlerMaker "tell" go
   where
     go BotConfig { .. } eventChan "tell" = do
       acid  <- openLocalState emptyTells

hask-irc-handlers/Network/IRC/Handlers/Tell/Internal/Types.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Network.IRC.Handlers.Tell.Internal.Types where
+
+import ClassyPrelude
+import Control.Concurrent.Lifted (Chan, writeChan)
+import Data.Data                 (Data)
+import Data.IxSet                (IxSet, Indexable (..), ixSet, ixFun)
+import Data.SafeCopy             (base, deriveSafeCopy)
+
+import Network.IRC.Handlers.NickTracker.Types
+import Network.IRC.Types
+
+newtype TellId  = TellId Int deriving (Eq, Ord, Show, Data, Typeable, Num)
+data TellStatus = NewTell | DeliveredTell deriving (Eq, Ord, Show, Data, Typeable)
+
+data Tell = Tell {
+  tellId          :: !TellId,
+  tellFromNick    :: !Nick,
+  tellToNick      :: !CanonicalNick,
+  tellTopic       :: !(Maybe Text),
+  tellStatus      :: !TellStatus,
+  tellCreatedOn   :: !UTCTime,
+  tellDeliveredOn :: !(Maybe UTCTime),
+  tellContent     :: !Text
+} deriving (Eq, Ord, Show, Data, Typeable)
+
+instance Indexable Tell where
+  empty = ixSet [ ixFun $ (: []) . tellId
+                , ixFun $ (: []) . tellToNick
+                , ixFun $ (: []) . tellStatus ]
+
+data Tells = Tells { nextTellId :: TellId, tells :: IxSet Tell }
+             deriving (Eq, Ord, Show, Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''TellId)
+$(deriveSafeCopy 0 'base ''TellStatus)
+$(deriveSafeCopy 0 'base ''Tell)
+$(deriveSafeCopy 0 'base ''Tells)
+
+emptyTells :: Tells
+emptyTells = Tells (TellId 1) empty
+
+data TellRequest = TellRequest User Text deriving (Eq, Typeable)
+
+instance Event TellRequest
+
+instance Show TellRequest where
+  show (TellRequest user tell) =
+    "TellRequest[" ++ unpack (nickToText (userNick user) ++ ": " ++ tell) ++ "]"
+
+sendTell :: Chan SomeEvent -> User -> Text -> IO ()
+sendTell eventChan user tell = toEvent (TellRequest user tell) >>= writeChan eventChan

hask-irc-handlers/Network/IRC/Handlers/Tell/Types.hs

@@ -1,54 +1,9 @@
-{-# LANGUAGE DeriveDataTypeable #-}
+module Network.IRC.Handlers.Tell.Types
-{-# LANGUAGE TemplateHaskell #-}
+  (
+    TellId (..)
+  , TellStatus (..)
+  , Tell (..)
+  , sendTell
+  ) where
 
-module Network.IRC.Handlers.Tell.Types where
+import Network.IRC.Handlers.Tell.Internal.Types
-
-import ClassyPrelude
-import Control.Concurrent.Lifted (Chan, writeChan)
-import Data.Data                 (Data)
-import Data.IxSet                (IxSet, Indexable (..), ixSet, ixFun)
-import Data.SafeCopy             (base, deriveSafeCopy)
-
-import Network.IRC.Handlers.NickTracker.Types
-import Network.IRC.Types
-
-newtype TellId  = TellId Int deriving (Eq, Ord, Show, Data, Typeable, Num)
-data TellStatus = NewTell | DeliveredTell deriving (Eq, Ord, Show, Data, Typeable)
-
-data Tell = Tell {
-  tellId          :: !TellId,
-  tellFromNick    :: !Nick,
-  tellToNick      :: !CanonicalNick,
-  tellTopic       :: !(Maybe Text),
-  tellStatus      :: !TellStatus,
-  tellCreatedOn   :: !UTCTime,
-  tellDeliveredOn :: !(Maybe UTCTime),
-  tellContent     :: !Text
-} deriving (Eq, Ord, Show, Data, Typeable)
-
-instance Indexable Tell where
-  empty = ixSet [ ixFun $ (: []) . tellId
-                , ixFun $ (: []) . tellToNick
-                , ixFun $ (: []) . tellStatus ]
-
-data Tells = Tells { nextTellId :: TellId, tells :: IxSet Tell }
-             deriving (Eq, Ord, Show, Data, Typeable)
-
-$(deriveSafeCopy 0 'base ''TellId)
-$(deriveSafeCopy 0 'base ''TellStatus)
-$(deriveSafeCopy 0 'base ''Tell)
-$(deriveSafeCopy 0 'base ''Tells)
-
-emptyTells :: Tells
-emptyTells = Tells (TellId 1) empty
-
-data TellRequest = TellRequest User Text deriving (Eq, Typeable)
-
-instance Event TellRequest
-
-instance Show TellRequest where
-  show (TellRequest user tell) =
-    "TellRequest[" ++ unpack (nickToText (userNick user) ++ ": " ++ tell) ++ "]"
-
-sendTell :: Chan SomeEvent -> User -> Text -> IO ()
-sendTell eventChan user tell = toEvent (TellRequest user tell) >>= writeChan eventChan

hask-irc-handlers/hask-irc-handlers.cabal

@@ -86,6 +86,9 @@ library
                        Network.IRC.Handlers.Tell,
                        Network.IRC.Handlers.Tell.Types
 
+  other-modules:       Network.IRC.Handlers.NickTracker.Internal.Types,
+                       Network.IRC.Handlers.Tell.Internal.Types
+
   default-language:    Haskell2010
 
   ghc-options:         -Wall -fno-warn-unused-do-bind -O2 -funbox-strict-fields -fno-warn-orphans