abhin4v/hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Restructed handlers project

Browse Source
This commit is contained in:
Abhinav Sarkar 2014-06-07 00:50:27 +05:30
parent 85cb92f1a0
commit ab22760c49
14 changed files with 178 additions and 148 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hask-irc-core/Network/IRC.hs Normal file
View File

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

3
hask-irc-core/hask-irc-core.cabal
View File

@ -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

26
hask-irc-handlers/Network/IRC/Handlers.hs
View File

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

6
hask-irc-handlers/Network/IRC/Handlers/Auth.hs
View File

@ -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
mkMsgHandler = MsgHandlerMaker "auth" go
authMsgHandlerMaker :: MsgHandlerMaker
authMsgHandlerMaker = MsgHandlerMaker "auth" go
where
helpMsg botNick = "Send a PM to get a new auth token. /msg " ++ nickToText botNick ++ " token"

6
hask-irc-handlers/Network/IRC/Handlers/Greet.hs
View File

@ -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
mkMsgHandler = MsgHandlerMaker "greeter" go
greetMsgHandlerMaker :: MsgHandlerMaker
greetMsgHandlerMaker = MsgHandlerMaker "greeter" go
where
go _ _ "greeter" = return . Just $ newMsgHandler { onMessage = greeter }
go _ _ "welcomer" = return . Just $ newMsgHandler { onMessage = welcomer }

6
hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs
View File

@ -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
mkMsgHandler = MsgHandlerMaker "messagelogger" go
messageLoggerMsgHandlerMaker :: MsgHandlerMaker
messageLoggerMsgHandlerMaker = MsgHandlerMaker "messagelogger" go
where
go botConfig _ "messagelogger" = do
state <- io $ newIORef Nothing

26
hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs
View File

@ -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
then return $ nck ++ " has only one nick"
else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks)
return . (nck ++) $ if length nicks == 1
then " has only one nick"
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"
else nck ++ " was last seen " ++ relativeTime lastSeenOn' now) ++
then " is online 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
mkMsgHandler = MsgHandlerMaker "nicktracker" go
nickTrackerMsgHandlerMaker :: MsgHandlerMaker
nickTrackerMsgHandlerMaker = MsgHandlerMaker "nicktracker" go
where
helpMsgs = mapFromList [
("!nicks", "Shows alternate nicks of the user. !nicks <nick>"),

53
hask-irc-handlers/Network/IRC/Handlers/NickTracker/Internal/Types.hs Normal file
View File

@ -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

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

@ -1,53 +1,9 @@
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Handlers.NickTracker.Types
(
CanonicalNick (..)
, NickTrack (..)
, getCanonicalNick
)
where
module Network.IRC.Handlers.NickTracker.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 :: !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
import Network.IRC.Handlers.NickTracker.Internal.Types

6
hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs
View File

@ -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
mkMsgHandler = MsgHandlerMaker "songsearch" go
songSearchMsgHandlerMaker :: MsgHandlerMaker
songSearchMsgHandlerMaker = MsgHandlerMaker "songsearch" go
where
helpMsg = "Search for song. !m <song> or !m <artist> - <song>"

8
hask-irc-handlers/Network/IRC/Handlers/Tell.hs
View File

@ -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
mkMsgHandler = MsgHandlerMaker "tell" go
tellMsgHandlerMaker :: MsgHandlerMaker
tellMsgHandlerMaker = MsgHandlerMaker "tell" go
where
go BotConfig { .. } eventChan "tell" = do
acid <- openLocalState emptyTells

54
hask-irc-handlers/Network/IRC/Handlers/Tell/Internal/Types.hs Normal file
View File

@ -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

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

@ -1,54 +1,9 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Handlers.Tell.Types
(
TellId (..)
, TellStatus (..)
, Tell (..)
, sendTell
) where
module Network.IRC.Handlers.Tell.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
import Network.IRC.Handlers.Tell.Internal.Types

3
hask-irc-handlers/hask-irc-handlers.cabal
View File

@ -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