irc-fun-client 0.4.0.0 → 0.5.0.0
raw patch · 11 files changed
+616/−468 lines, 11 filesdep +bytestringdep +connectiondep +data-default-classdep −networkdep ~irc-fun-messages
Dependencies added: bytestring, connection, data-default-class, hashable, irc-fun-types, text
Dependencies removed: network
Dependency ranges changed: irc-fun-messages
Files
- NEWS +0/−125
- NEWS.md +159/−0
- irc-fun-client.cabal +10/−4
- src/Network/IRC/Fun/Client/ChannelLogger.hs +27/−22
- src/Network/IRC/Fun/Client/Commands.hs +103/−70
- src/Network/IRC/Fun/Client/Events.hs +105/−121
- src/Network/IRC/Fun/Client/IO.hs +137/−89
- src/Network/IRC/Fun/Client/Instances.hs +27/−0
- src/Network/IRC/Fun/Client/NickTracker.hs +23/−20
- src/Network/IRC/Fun/Client/Time.hs +7/−3
- src/Network/IRC/Fun/Client/Util.hs +18/−14
− NEWS
@@ -1,125 +0,0 @@-This file lists the user-visible interesting changes between releases. For a-full list of changes to the source, see the ChangeLog.----irc-fun-client 0.4.0.0 -- 2015-12-16-====================================--General, build and documentation changes:--* (None)--New APIs, features and enhancements:--* Prefix `Connection` record field names with `conn` to avoid collisions-* Add IRC receiving function variants for debugging--Bug fixes:--* (None)--Dependency changes:--* (None)------irc-fun-client 0.3.0.0 -- 2015-10-17-====================================--General, build and documentation changes:--* (None)--New APIs, features and enhancements:--* Add Pong event-* Add action message events (/me)--Bug fixes:--* (None)--Dependency changes:--* (None)------irc-fun-client 0.2.0.0 -- 2015-09-22-====================================--General, build and documentation changes:--* (None)--New APIs, features and enhancements:--* New event constructor, NickChange-* Channel logger can log nick changes-* New nickname tracker function, changeNick--Bug fixes:--* (None)--Dependency changes:--* (None)------irc-fun-client 0.1.1.0 -- 2015-09-10-====================================--General, build and documentation changes:--* (None)--New APIs, features and enhancements:--* Basic channel logger API-* Efficient and scalable time getter-* Channel member tracker--Bug fixes:--* (None)--Dependency changes:--* Add dependency: auto-update-* Add dependency: fast-logger-* Add dependency: time-* Add dependency: time-units-* Add dependency: unordered-containers------irc-fun-client 0.1.0.0 -- 2015-08-09-====================================--General, build and documentation changes:--* (This is the first release, so everything is new)--New APIs, features and enhancements:--* (This is the first release, so everything is a new feature)--Bug fixes:--* (This is just the first release, many bugs haven't been discovered yet)--Dependency changes:--* (This is the first release)
+ NEWS.md view
@@ -0,0 +1,159 @@+This file lists the user-visible interesting changes between releases. For a+full list of changes to the source, see the ChangeLog.++++irc-fun-client 0.5.0.0 -- 2016-01-27+====================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* `ircNoticeTo*` functions for sending notices instead of regular privmsg+* Move from `String` to strict `Text`+* TLS support+* The process of reading from the socket and examining the data now provides+ more details about the results, nothing is discarded++Bug fixes:++* (None)++Dependency changes:++* Add bytestring+ connection >= 0.2+ data-default-class+ hashable+ irc-fun-types+ text+* Require irc-fun-messages >= 0.3+* Remove network++++++irc-fun-client 0.4.0.0 -- 2015-12-16+====================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Prefix `Connection` record field names with `conn` to avoid collisions+* Add IRC receiving function variants for debugging++Bug fixes:++* (None)++Dependency changes:++* (None)++++++irc-fun-client 0.3.0.0 -- 2015-10-17+====================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Add Pong event+* Add action message events (/me)++Bug fixes:++* (None)++Dependency changes:++* (None)++++++irc-fun-client 0.2.0.0 -- 2015-09-22+====================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* New event constructor, NickChange+* Channel logger can log nick changes+* New nickname tracker function, changeNick++Bug fixes:++* (None)++Dependency changes:++* (None)++++++irc-fun-client 0.1.1.0 -- 2015-09-10+====================================++General, build and documentation changes:++* (None)++New APIs, features and enhancements:++* Basic channel logger API+* Efficient and scalable time getter+* Channel member tracker++Bug fixes:++* (None)++Dependency changes:++* Add dependency: auto-update+* Add dependency: fast-logger+* Add dependency: time+* Add dependency: time-units+* Add dependency: unordered-containers++++++irc-fun-client 0.1.0.0 -- 2015-08-09+====================================++General, build and documentation changes:++* (This is the first release, so everything is new)++New APIs, features and enhancements:++* (This is the first release, so everything is a new feature)++Bug fixes:++* (This is just the first release, many bugs haven't been discovered yet)++Dependency changes:++* (This is the first release)
irc-fun-client.cabal view
@@ -1,5 +1,5 @@ name: irc-fun-client-version: 0.4.0.0+version: 0.5.0.0 synopsis: Another library for writing IRC clients. description: This is an IRC client library that uses @irc-fun-messages@ library package@@ -15,7 +15,7 @@ copyright: ♡ Copying is an act of love. Please copy, reuse and share. category: Network, IRC build-type: Simple-extra-source-files: AUTHORS ChangeLog COPYING INSTALL NEWS README.md+extra-source-files: AUTHORS ChangeLog COPYING INSTALL NEWS.md README.md cabal-version: >=1.10 source-repository head@@ -28,6 +28,7 @@ , Network.IRC.Fun.Client.Commands , Network.IRC.Fun.Client.Events , Network.IRC.Fun.Client.IO+ , Network.IRC.Fun.Client.Instances , Network.IRC.Fun.Client.NickTracker , Network.IRC.Fun.Client.Time , Network.IRC.Fun.Client.Util@@ -35,9 +36,14 @@ -- other-extensions: build-depends: auto-update , base >=4.7 && <5- , irc-fun-messages >=0.2+ , bytestring+ , connection >=0.2+ , data-default-class+ , hashable+ , irc-fun-messages >=0.3+ , irc-fun-types , fast-logger >=2.4.1- , network >=2.3+ , text , time >=1.5 , time-units >=1 , unordered-containers >=0.2.5
src/Network/IRC/Fun/Client/ChannelLogger.hs view
@@ -29,42 +29,43 @@ import Control.Monad (liftM) import Data.Monoid ((<>))+import Data.Text (Text) import Network.IRC.Fun.Client.Events (Event (..))-import Network.IRC.Fun.Messages.TypeAliases (NickName, ChannelName)+import Network.IRC.Fun.Types import System.Log.FastLogger data Logger = Logger { loggerSet :: LoggerSet- , loggerGetTime :: IO String+ , loggerGetTime :: IO Text } data ChanLogEvent- = EnterChan NickName- | LeaveChan NickName- | MessageChan NickName String- | ActInChan NickName String- | RenameInChan NickName NickName+ = EnterChan Nickname+ | LeaveChan Nickname+ | MessageChan Nickname MsgContent+ | ActInChan Nickname MsgContent+ | RenameInChan Nickname Nickname deriving Show data LogEvent- = Enter NickName ChannelName- | Leave NickName ChannelName- | LeaveAll NickName- | Message NickName ChannelName String- | Action NickName ChannelName String- | Rename NickName NickName+ = Enter Nickname Channel+ | Leave Nickname Channel+ | LeaveAll Nickname+ | Message Nickname Channel MsgContent+ | Action Nickname Channel MsgContent+ | Rename Nickname Nickname deriving Show -- | Utility for constructing a log file path. logFilePath :: FilePath -- ^ Directory in which to place log files. Relative -- to the program's working directory, or absolute. -> String -- ^ Server label, e.g. @\"freenode\"@- -> ChannelName -- ^ IRC channel name, e.g. @\"#freepost\"@+ -> String -- ^ IRC channel name, e.g. @\"#freepost\"@ -> FilePath logFilePath dir server chan = dir ++ "/" ++ server ++ "." ++ chan ++ ".irc" -- | Create a logger for a given IRC channel.-newLogger :: IO String -- ^ Action which returns a formatted time string. You+newLogger :: IO Text -- ^ Action which returns a formatted time string. You -- can use "Network.IRC.Fun.Client.Time" to create such -- an action. -> FilePath -- ^ Path of the log file@@ -90,14 +91,18 @@ formatEvent :: ChanLogEvent -> LogStr formatEvent e = case e of- EnterChan nick -> "|-->| " <> toLogStr nick <> " has joined"- LeaveChan nick -> "|<--| " <> toLogStr nick <> " has left"- MessageChan nick msg -> "<" <> toLogStr nick <> "> " <> toLogStr msg- ActInChan nick msg -> "* " <> toLogStr nick <> " " <> toLogStr msg- RenameInChan old new -> "|---| " <> toLogStr old <> " is now known as "- <> toLogStr new+ EnterChan (Nickname nick) ->+ "|-->| " <> toLogStr nick <> " has joined"+ LeaveChan (Nickname nick) ->+ "|<--| " <> toLogStr nick <> " has left"+ MessageChan (Nickname nick) (MsgContent msg) ->+ "<" <> toLogStr nick <> "> " <> toLogStr msg+ ActInChan (Nickname nick) (MsgContent msg) ->+ "* " <> toLogStr nick <> " " <> toLogStr msg+ RenameInChan (Nickname old) (Nickname new) ->+ "|---| " <> toLogStr old <> " is now known as " <> toLogStr new -formatLine :: IO String -> ChanLogEvent -> IO LogStr+formatLine :: IO Text -> ChanLogEvent -> IO LogStr formatLine getTime event = do t <- getTime return $ toLogStr t <> " " <> formatEvent event
src/Network/IRC/Fun/Client/Commands.hs view
@@ -25,8 +25,10 @@ , ircPartMulti , ircPartAll , ircSendToUser+ , ircNoticeToUser , ircActToUser , ircSendToChannel+ , ircNoticeToChannel , ircActToChannel , ircQuit )@@ -35,23 +37,27 @@ import Control.Monad (unless) import Data.Maybe (fromMaybe, isNothing) import Network.IRC.Fun.Messages-import Network.IRC.Fun.Messages.Types+import Network.IRC.Fun.Types import Network.IRC.Fun.Client.IO +import qualified Data.Text as T+ -- | Log in as an IRC user with nickname and optional password, using the given -- connection parameters.-ircLogin :: Handle -- ^ Handle to the open socket, returned from- -- 'ircConnect'- -> Connection -- ^ Connection configuration- -> Bool -- ^ Whether you want to be invisible (mode @+i@)- -> Bool -- ^ Whether you want to see wallops (mode @+w@)- -> IO ()-ircLogin h conn i w = do- let pass = fromMaybe "" $ connPassword conn- nick = connNick conn- unless (null pass) $ hPutIrc h $ PassMessage pass- hPutIrc h $ UserMessage nick i w nick- hPutIrc h $ NickMessage nick+ircLogin+ :: Connection -- ^ Handle to the open socket, returned from 'ircConnect'+ -> ConnConfig -- ^ Connection configuration+ -> Bool -- ^ Whether you want to be invisible (mode @+i@)+ -> Bool -- ^ Whether you want to see wallops (mode @+w@)+ -> IO ()+ircLogin c cfg i w = do+ case connPassword cfg of+ Just pass -> hPutIrc c $ PassMessage pass+ Nothing -> return ()+ let nick = connNickname cfg+ t = unNickname nick+ hPutIrc c $ UserMessage (Username t) i w (RealName t)+ hPutIrc c $ NickMessage nick -- | IRC servers send PING messages at regular intervals to test the presence -- of an active client, at least if no other activity is detected on the@@ -61,84 +67,111 @@ -- Therefore, an IRC client usually listens to these PINGs and sends back PONG -- messages. This function sends a PONG. The parameters should simply be the -- ones received in the PING message.-ircPong :: Handle -- ^ Handle to the open socket- -> String -- ^ Server name- -> Maybe String -- ^ Optional server to forward to- -> IO ()-ircPong h s ms = hPutIrc h $ PongMessage s ms+ircPong+ :: Connection -- ^ Handle to the open socket+ -> Hostname -- ^ Server name+ -> Maybe Hostname -- ^ Optional server to forward to+ -> IO ()+ircPong c s ms = hPutIrc c $ PongMessage s ms -- | Join an IRC channel.-ircJoin :: Handle -- ^ Handle to the open socket- -> String -- ^ Channel name- -> Maybe String -- ^ Optional channel key (password)- -> IO ()-ircJoin h chan key = ircJoinMulti h [(chan, key)]+ircJoin+ :: Connection -- ^ Handle to the open socket+ -> Channel -- ^ Channel name+ -> Maybe ChannelKey -- ^ Optional channel key (password)+ -> IO ()+ircJoin c chan key = ircJoinMulti c [(chan, key)] -- | Join one or more IRC channels.-ircJoinMulti :: Handle -- ^ Handle to the open socket- -> [(String, Maybe String)] -- ^ List of channels and optional- -- keys- -> IO ()+ircJoinMulti+ :: Connection -- ^ Handle to the open socket+ -> [(Channel, Maybe ChannelKey)] -- ^ List of channels and optional keys+ -> IO () ircJoinMulti _ [] = return ()-ircJoinMulti h l = do+ircJoinMulti c l = do let nokey = [ chan | (chan, Nothing) <- l ] (chans, keys) = unzip [ (chan, key) | (chan, (Just key)) <- l ]- unless (null nokey) $ hPutIrc h $ JoinMessage $ Just (nokey, [])- unless (null chans) $ hPutIrc h $ JoinMessage $ Just (chans, keys)+ unless (null nokey) $ hPutIrc c $ JoinMessage $ Just (nokey, [])+ unless (null chans) $ hPutIrc c $ JoinMessage $ Just (chans, keys) -- | Leave an IRC channel.-ircPart :: Handle- -> String- -> Maybe String- -> IO ()-ircPart h chan = ircPartMulti h [chan]+ircPart+ :: Connection+ -> Channel+ -> Maybe Comment+ -> IO ()+ircPart c chan = ircPartMulti c [chan] -- | Leave one or more IRC channels.-ircPartMulti :: Handle- -> [String]- -> Maybe String- -> IO ()+ircPartMulti+ :: Connection+ -> [Channel]+ -> Maybe Comment+ -> IO () ircPartMulti _ [] _ = return ()-ircPartMulti h chans msg = hPutIrc h $ PartMessage chans msg+ircPartMulti c chans msg = hPutIrc c $ PartMessage chans msg -- | Leave all IRC channels you joined.-ircPartAll :: Handle -> IO ()-ircPartAll h = hPutIrc h $ JoinMessage Nothing+ircPartAll :: Connection -> IO ()+ircPartAll c = hPutIrc c $ JoinMessage Nothing -- | Send a private message to an IRC user.-ircSendToUser :: Handle -- ^ Handle to the open socket- -> String -- ^ The user's nickname- -> String -- ^ The message to send- -> IO ()-ircSendToUser h nick msg =- hPutIrc h $ PrivMsgMessage (UserTarget (Just nick) Nothing Nothing) msg+ircSendToUser+ :: Connection -- ^ Handle to the open socket+ -> Nickname -- ^ The user's nickname+ -> MsgContent -- ^ The message to send+ -> IO ()+ircSendToUser c nick msg =+ hPutIrc c $ PrivMsgMessage (UserTarget (Just nick) Nothing Nothing) msg +-- | Send a private notice to an IRC user.+ircNoticeToUser+ :: Connection -- ^ Handle to the open socket+ -> Nickname -- ^ The user's nickname+ -> MsgContent -- ^ The message to send+ -> IO ()+ircNoticeToUser c nick msg =+ hPutIrc c $ NoticeMessage (UserTarget (Just nick) Nothing Nothing) msg+ -- | Send a private /me message to an IRC user.-ircActToUser :: Handle -- ^ Handle to the open socket- -> String -- ^ The user's nickname- -> String -- ^ The message to send- -> IO ()-ircActToUser h nick msg =- hPutIrc h $ PrivActionMessage (UserTarget (Just nick) Nothing Nothing) msg+ircActToUser+ :: Connection -- ^ Handle to the open socket+ -> Nickname -- ^ The user's nickname+ -> MsgContent -- ^ The message to send+ -> IO ()+ircActToUser c nick msg =+ hPutIrc c $ PrivActionMessage (UserTarget (Just nick) Nothing Nothing) msg -- | Send a message to an IRC channel.-ircSendToChannel :: Handle -- ^ Handle to the open socket- -> String -- ^ The channel name- -> String -- ^ The message to send- -> IO ()-ircSendToChannel h chan msg =- hPutIrc h $ PrivMsgMessage (ChannelTarget chan) msg+ircSendToChannel+ :: Connection -- ^ Handle to the open socket+ -> Channel -- ^ The channel name+ -> MsgContent -- ^ The message to send+ -> IO ()+ircSendToChannel c chan msg =+ hPutIrc c $ PrivMsgMessage (ChannelTarget chan) msg +-- | Send a notice to an IRC channel.+ircNoticeToChannel+ :: Connection -- ^ Handle to the open socket+ -> Channel -- ^ The channel name+ -> MsgContent -- ^ The message to send+ -> IO ()+ircNoticeToChannel c chan msg =+ hPutIrc c $ NoticeMessage (ChannelTarget chan) msg+ -- | Send a \/me message to an IRC channel.-ircActToChannel :: Handle -- ^ Handle to the open socket- -> String -- ^ The channel name- -> String -- ^ The message to send- -> IO ()-ircActToChannel h chan msg =- hPutIrc h $ PrivActionMessage (ChannelTarget chan) msg+ircActToChannel+ :: Connection -- ^ Handle to the open socket+ -> Channel -- ^ The channel name+ -> MsgContent -- ^ The message to send+ -> IO ()+ircActToChannel c chan msg =+ hPutIrc c $ PrivActionMessage (ChannelTarget chan) msg -- | Finish the IRC session, asking the server to close the connection.-ircQuit :: Handle -- ^ Handle to the open socket- -> Maybe String -- ^ Optional message, e.g. the reason you quit- -> IO ()-ircQuit h m = hPutIrc h $ QuitMessage m+ircQuit+ :: Connection -- ^ Handle to the open socket+ -> Maybe Comment -- ^ Optional message, e.g. the reason you quit+ -> IO ()+ircQuit c m = hPutIrc c $ QuitMessage m
src/Network/IRC/Fun/Client/Events.hs view
@@ -13,195 +13,179 @@ - <http://creativecommons.org/publicdomain/zero/1.0/>. -} +{-# LANGUAGE OverloadedStrings #-}+ -- | This module allows you to identify IRC events. Events are a wrapper around -- IRC messages, which provide a logical layer convenient to work with (while -- IRC messages have their lower level aspects, being plain protocol messages). module Network.IRC.Fun.Client.Events ( Event (..)- , ChannelPrivacy (..)- , Privilege (..) , detectEvents , hGetIrcEventsOnce- , hGetIrcEventsOnce' , hGetIrcEvents- , hGetIrcEvents' ) where import Control.Monad (unless) import Data.Maybe (fromMaybe, isNothing)-import Network.IRC.Fun.Client.IO (Handle, hGetIrcOnce, hGetIrcOnce')+import Data.Text (Text)+import Network.IRC.Fun.Client.IO (Connection, Result (..), hGetIrcOnce) import Network.IRC.Fun.Messages-import Network.IRC.Fun.Messages.Types+import Network.IRC.Fun.Types -- | An event triggered by an IRC message sent from the server. data Event -- | A ping was sent to the bot. The parameters are the server name and -- optionally a server to forward the response to. They can be passed as-is -- directly to the PONG response.- = Ping String (Maybe String)+ = Ping Hostname (Maybe Hostname) -- | A ping response sent by the server.- | Pong String (Maybe String)+ | Pong Hostname (Maybe Hostname) -- | One or more users have been kicked from a channel for an optionally -- given reason. Parameters: Channel, nicknames, reason.- | Kick String [String] (Maybe String)+ | Kick Channel [Nickname] (Maybe Comment) -- | A user joined a channel. Parameters: Channel, nickname.- | Join String String+ | Join Channel Nickname -- | A user left a channel, optionally with a given reason. Parameters: -- Channel, nickname, reason.- | Part String String (Maybe String)+ | Part Channel Nickname (Maybe Comment) -- | A user left the network, optonally for the given reason. Parameters: -- Nickname, reason.- | Quit String (Maybe String)+ | Quit Nickname (Maybe Comment) -- | TODO | Mode -- | Message sent in a channel by a user. The last parameter indicates -- whether the message is actually a notice. If yes, the client shouldn't -- automatically send a response. Parameters: Channel, nickname, message, -- whether notice.- | ChannelMessage String String String Bool+ | ChannelMessage Channel Nickname MsgContent Bool -- | A channel message that is a virtual action (/me).- | ChannelAction String String String+ | ChannelAction Channel Nickname MsgContent -- | A private message sent specifically to the client from a user. The -- last parameter indicates whether the message is actually a notice. If -- yes, the client shouldn't send any automatic response. Parameters: -- Nickname, message, whether notice.- | PrivateMessage String String Bool+ | PrivateMessage Nickname MsgContent Bool -- | A private message that is a virtual action (/me).- | PrivateAction String String+ | PrivateAction Nickname MsgContent -- | A user's nickname has changed. Parameters: Old nick, new nick.- | NickChange String String+ | NickChange Nickname Nickname -- | Channel topic change. Parameterss: Channel, nickname of user who -- changed the topic, new topic content.- | Topic String String String+ | Topic Channel Nickname ChannelTopic -- | The client has been invited to a channel by another user. Parameters: -- Channel, nickname of inviting user.- | Invite String String+ | Invite Channel Nickname -- | The server sent a list of nicknames present in a channel. Parameters: -- Channel privacy mode, channel name, list of users. Each list item is a -- pair of a user privilege level in the channel, and the user's nickname.- | Names ChannelPrivacy String [(Privilege, String)]- -- Unrecognized or unimplemented event. The parameter contains (possibly- -- empty) input.- | OtherEvent String+ | Names ChannelPrivacy Channel [(Privilege, Nickname)]+ -- | Unused, unrecognized or unimplemented event. A successfuly analyzed+ -- IRC message not (yet) recognized by this library as any of the client+ -- events above. Error message provided too. This event can be a result of+ -- an error or bug, missing features in this library or simply an IRC+ -- message that isn't interesting to an IRC client. Or perhaps the IRC+ -- server sent an invalid/empty message.+ | OtherSpecific (Either SpecificReply SpecificMessage) Text+ -- | Unrecognized or unimplemented event. An IRC protocol message not known+ -- to the message analyzer or whose analysis has failed. Error message+ -- provided too.+ | OtherGeneric GenericMessage Text+ -- | An IRC protocol message whose parsing has failed.+ | OtherRaw Text+ -- | Some other unrecognized event. The parameter contains possibly empty+ -- input.+ | OtherEvent Text deriving Show -detectMessageEvents :: SpecificMessage -> Either String [Event]+detectMessageEvents :: SpecificMessage -> [Event] detectMessageEvents sm@(SpecificMessage mpref msg) = case msg of- NickMessage newnick ->- if null sender- then err- else one $ NickChange sender newnick- QuitMessage reason ->- if null sender- then err- else one $ Quit sender reason- JoinMessage (Just ([chan], [])) ->- if null sender- then err- else one $ Join chan sender- JoinMessage _ -> err- PartMessage [chan] reason ->- if null sender- then err- else one $ Part chan sender reason- PartMessage _ _ -> err- TopicMessage [] _ -> err- TopicMessage chan topic ->- if null sender- then other- else one $ Topic chan sender $ fromMaybe "" topic- PingMessage s ms -> one $ Ping s ms- PongMessage s ms -> one $ Pong s ms- KickMessage [] _ _ -> err- KickMessage _ [] _ -> err- KickMessage [chan] nicks comment ->- one $ Kick chan nicks comment- KickMessage chans nicks comment ->+ NickMessage newnick -> withSender $ \ sender ->+ one $ NickChange sender newnick+ QuitMessage reason -> withSender $ \ sender ->+ one $ Quit sender reason+ JoinMessage (Just ([chan], [])) -> withSender $ \ sender ->+ one $ Join chan sender+ JoinMessage _ -> other "Expected JOIN with a single channel and no key"+ PartMessage [chan] reason -> withSender $ \ sender ->+ one $ Part chan sender reason+ PartMessage _ _ -> other "Expected PART with a single channel"+ TopicMessage _ Nothing -> other "Expected a topic in TOPIC"+ TopicMessage chan (Just topic) -> withSender $ \ sender ->+ one $ Topic chan sender topic+ PingMessage s ms ->+ one $ Ping s ms+ PongMessage s ms ->+ one $ Pong s ms+ KickMessage [] _ _ -> other "Empty channel list"+ KickMessage _ [] _ -> other "Empty nickname list"+ KickMessage [chan] nicks comment ->+ one $ Kick chan (map u2n nicks) comment+ KickMessage chans nicks comment -> if length chans == length nicks- then some $- map (\ (c, n) -> Kick c [n] comment) $ zip chans nicks- else err- PrivMsgMessage _ [] -> other- PrivMsgMessage (ChannelTarget chan) text ->- if null sender- then other- else one $ ChannelMessage chan sender text False- PrivMsgMessage (UserTarget _ _ _) text ->- if null sender- then err- else one $ PrivateMessage sender text False- PrivMsgMessage (MaskTarget _) _ -> other- PrivActionMessage (ChannelTarget chan) text ->- if null sender- then other- else one $ ChannelAction chan sender text- PrivActionMessage (UserTarget _ _ _) text ->- if null sender- then err- else one $ PrivateAction sender text- PrivActionMessage (MaskTarget _) _ -> other- _ -> other+ then map (\ (c, n) -> Kick c [u2n n] comment) $ zip chans nicks+ else other "Channel and nickname lists not in same length"+ PrivMsgMessage (ChannelTarget chan) mc -> withSender $ \ sender ->+ one $ ChannelMessage chan sender mc False+ PrivMsgMessage (UserTarget _ _ _) mc -> withSender $ \ sender ->+ one $ PrivateMessage sender mc False+ PrivMsgMessage (MaskTarget _) _ -> other "Expected user/channel target"+ PrivActionMessage (ChannelTarget chan) mc -> withSender $ \ sender ->+ one $ ChannelAction chan sender mc+ PrivActionMessage (UserTarget _ _ _) mc -> withSender $ \ sender ->+ one $ PrivateAction sender mc+ PrivActionMessage (MaskTarget _) _ -> other "Expected user/chan target"+ _ -> other "Currently not recognized as a client event" where- other = Right [OtherEvent $ show sm]- one e = Right [e]- some = Right- err = Left $ show sm- sender =+ one e = [e]+ other = one . OtherSpecific (Right sm)+ withSender f = case mpref of- Just (Nick n _ _) -> n- Nothing -> ""+ Just (PrefixNick n _ _) -> f n+ Just (PrefixServer _) ->+ other "Expected nickname in prefix, but found server"+ Nothing ->+ other "Expected nickname in prefix, but no prefix found"+ u2n (Username u) = Nickname u -detectReplyEvents :: SpecificReply -> Either String [Event]+detectReplyEvents :: SpecificReply -> [Event] detectReplyEvents sr@(SpecificReply _sender _target rpl) = case rpl of NamesReply priv chan pnicks -> one $ Names priv chan pnicks- _ -> other+ _ -> other "Currently not recognized as a client event" where- other = Right [OtherEvent $ show sr]- one e = Right [e]- err = Left $ show sr+ one e = [e]+ other = one . OtherSpecific (Left sr) --- | Try to generate events from an IRC message. If it fails, 'Left' an error--- message is returned. Otherwise, 'Right' a list of generated events is--- returned.-detectEvents :: Either SpecificReply SpecificMessage- -> Either String [Event]+-- | Try to generate events from an IRC message.+detectEvents :: Either SpecificReply SpecificMessage -> [Event] detectEvents = either detectReplyEvents detectMessageEvents --- | Receive IRC events. If parsing and detecting the events fails, 'Nothing'--- is returned.-hGetIrcEventsOnce :: Handle -> IO (Maybe [Event])-hGetIrcEventsOnce h =- hGetIrcOnce h >>= return . \ r ->- case r of- Nothing -> Nothing- Just spec -> either (const Nothing) Just $ detectEvents spec---- | A variant of 'hGetIrcEventsOnce' which returns 'Left' an error message if--- parsing or detection fails.-hGetIrcEventsOnce' :: Handle -> IO (Either String [Event])-hGetIrcEventsOnce' h = do- res <- hGetIrcOnce' h+-- | Receive IRC events. If parsing the message fails, one of the @Other*@+-- events is returned according to the error.+hGetIrcEventsOnce :: Connection -> IO [Event]+hGetIrcEventsOnce c = do+ res <- hGetIrcOnce c return $ case res of- Left s -> Left s- Right spec -> detectEvents spec+ ParsingFailed t -> [OtherRaw t]+ AnalysisFailed gm err -> [OtherGeneric gm err]+ GotReply sr -> detectReplyEvents sr+ GotMessage sm -> detectMessageEvents sm -- | Receive the next valid (successfully parsed and detected) series of IRC--- events.-hGetIrcEvents :: Handle -> IO [Event]-hGetIrcEvents h = hGetIrcEventsOnce h >>= maybe (hGetIrcEvents h) return---- | A variant of 'hGetIrcEvents' which returns a list of error messages for--- received IRC lines whose parsing/event detection failed.-hGetIrcEvents' :: Handle -> IO ([String], [Event])-hGetIrcEvents' h = do+-- events, in the second element. The first element is failure events (i.e. one+-- of the @Other*@ constructors) received before that, if there were any.+hGetIrcEvents :: Connection -> IO ([Event], [Event])+hGetIrcEvents c = do (l, m) <- f [] return (reverse l, m) where f errs = do- res <- hGetIrcEventsOnce' h+ res <- hGetIrcEventsOnce c case res of- Left s -> f $ s : errs- Right es -> return (errs, es)+ [o@OtherSpecific {}] -> f $ o : errs+ [o@OtherGeneric {}] -> f $ o : errs+ [o@OtherRaw {}] -> f $ o : errs+ [o@OtherEvent {}] -> f $ o : errs+ _ -> return (errs, res)
src/Network/IRC/Fun/Client/IO.hs view
@@ -13,163 +13,211 @@ - <http://creativecommons.org/publicdomain/zero/1.0/>. -} +{-# LANGUAGE OverloadedStrings #-}+ module Network.IRC.Fun.Client.IO- ( Connection (..)- , Handle+ ( ConnConfig ()+ , defConnConfig+ , connServer+ , connPort+ , connTls+ , connNickname+ , connPassword+ , ConnContext ()+ , initConnContext+ , Connection () , ircConnect , ircDisconnect , hPutIrcRaw , hPutIrcGeneric , hPutIrc+ , Result (..) , hGetIrcRaw , hGetIrcGenericOnce- , hGetIrcGenericOnce' , hGetIrcGeneric- , hGetIrcGeneric' , hGetIrcOnce- , hGetIrcOnce' , hGetIrc- , hGetIrc' ) where import Control.Exception (bracketOnError) import Control.Monad (liftM)+import Data.ByteString.Char8 (ByteString, unsnoc)+import Data.Default.Class import Data.Maybe (fromMaybe)+import Data.Text (Text, unpack)+import Data.Text.Encoding (decodeUtf8With, encodeUtf8)+import Data.Text.Encoding.Error (lenientDecode) import Network.IRC.Fun.Messages-import Network.IRC.Fun.Messages.Types-import Network.Socket-import System.IO+import Network.IRC.Fun.Types +import qualified Network.Connection as NC+ -- | Details of the connection to IRC.-data Connection = Connection- { -- | IRC Server address, e.g. @"irc.freenode.net"@- connServer :: String+data ConnConfig = ConnConfig+ { -- | IRC Server address, e.g. @"irc.freenode.net"@. It may also be an IP+ -- address.+ connServer :: Hostname -- | IRC server port, @6667@ should be a safe default- , connPort :: Int- -- | Whether to make an encrypted connection via TLS (not implemented)+ , connPort :: PortNumber+ -- | Whether to make an encrypted connection via TLS , connTls :: Bool -- | IRC nickname for the bot, e.g. @"funbot"@- , connNick :: String+ , connNickname :: Nickname -- | Connection password, use if the nickname is registered- , connPassword :: Maybe String+ , connPassword :: Maybe Password } deriving (Eq, Show) +instance Default ConnConfig where+ def = ConnConfig+ { connServer = Hostname "irc.freenode.net"+ , connPort = PortNumber 6667+ , connTls = False+ , connNickname = Nickname "rand0m-n1ck"+ , connPassword = Nothing+ }++-- | TODO+defConnConfig :: ConnConfig+defConnConfig = def++-- | TODO+newtype ConnContext = ConnContext { unCtx :: NC.ConnectionContext }++-- | TODO+initConnContext :: IO ConnContext+initConnContext = fmap ConnContext NC.initConnectionContext++-- | TODO+newtype Connection = Connection { unConn :: NC.Connection }+ -- | Connect to an IRC server using the given connection parameters, and return -- a handle to the open socket. This just opens a TCP connection, without -- sending any IRC commands.-ircConnect :: Connection -> IO Handle-ircConnect conn = do- let hints = defaultHints- { addrSocketType = Stream- , addrFlags = [AI_ADDRCONFIG]+ircConnect :: ConnContext -> ConnConfig -> IO Connection+ircConnect ctx cfg = do+ let params = NC.ConnectionParams+ { NC.connectionHostname =+ unpack $ unHostname $ connServer cfg+ , NC.connectionPort =+ fromInteger $ toInteger $ unPortNumber $ connPort cfg+ , NC.connectionUseSecure =+ if connTls cfg+ then Just def+ else Nothing+ , NC.connectionUseSocks =+ Nothing }- addrs <- getAddrInfo (Just hints)- (Just $ connServer conn)- (Just $ show $ connPort conn)- let addr = head addrs bracketOnError- (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))- (\ sock -> close sock >> putStrLn "Connection failed") $- \ sock -> do- connect sock (addrAddress addr)- handle <- socketToHandle sock ReadWriteMode- hSetBuffering handle LineBuffering- encoding <- mkTextEncoding "UTF-8//TRANSLIT"- hSetEncoding handle encoding- hSetNewlineMode handle (NewlineMode CRLF CRLF)- return handle+ (NC.connectTo (unCtx ctx) params)+ (\ conn -> NC.connectionClose conn >> putStrLn "Connection closed")+ (return . Connection) -- | Disconnect from IRC by closing the client's side of the connection. This -- function is mainly provided for completeness. You should probably use the -- QUIT command of IRC to quit the network in a manner coordinated with the -- server.-ircDisconnect :: Handle -> IO ()-ircDisconnect = hClose+ircDisconnect :: Connection -> IO ()+ircDisconnect = NC.connectionClose . unConn +decode :: ByteString -> Text+decode = decodeUtf8With lenientDecode++encode :: Text -> ByteString+encode = encodeUtf8+ -- | Send an IRC command, given in string form, to the server. The given -- command string shouldn't contain any newlines.-hPutIrcRaw :: Handle -> String -> IO ()-hPutIrcRaw = hPutStrLn+hPutIrcRaw :: Connection -> Text -> IO ()+hPutIrcRaw c = NC.connectionPut (unConn c) . encode -- | Send an IRC message represented in generic form to the server.-hPutIrcGeneric :: Handle -> GenericMessage -> IO ()-hPutIrcGeneric h = hPutIrcRaw h . serializeMessage+hPutIrcGeneric :: Connection -> GenericMessage -> IO ()+hPutIrcGeneric c = hPutIrcRaw c . serializeMessage -- | Send an IRC message to the server.-hPutIrc :: Handle -> Message -> IO ()-hPutIrc h = hPutIrcGeneric h . buildMessage . SpecificMessage Nothing+hPutIrc :: Connection -> Message -> IO ()+hPutIrc c = hPutIrcGeneric c . buildMessage . SpecificMessage Nothing +-- | Result of receiving a message from an IRC server and examining it.+data Result+ -- | Parsing the text line received into a generic IRC protocol message+ -- failed. The text line received is provided.+ = ParsingFailed Text+ -- | Parsing succeeded, but analyzing the message into a recognized IRC+ -- command failed. The successfully parsed message and an analysis error+ -- message are provided.+ | AnalysisFailed GenericMessage Text+ -- | Successfully received and IRC reply.+ | GotReply SpecificReply+ -- | Successfully received an IRC message (named command).+ | GotMessage SpecificMessage+ -- | Receive an IRC message, given in string form, from the server. The -- resulting string won't contain newlines.-hGetIrcRaw :: Handle -> IO String-hGetIrcRaw = hGetLine+hGetIrcRaw :: Connection -> IO Text+hGetIrcRaw c = do+ bs <- NC.connectionGetLine 4096 (unConn c)+ let bs' =+ case unsnoc bs of+ Just (s, '\r') -> s+ _ -> bs+ return $ decode bs' -- | Receive an IRC message in generic form from the server. If parsing the--- message read from the server fails, 'Nothing' is returned.-hGetIrcGenericOnce :: Handle -> IO (Maybe GenericMessage)-hGetIrcGenericOnce h = liftM parseMessage $ hGetIrcRaw h---- | A variant of 'hGetIrcGenericOnce' which returns 'Left' the message if--- parsing fails.-hGetIrcGenericOnce' :: Handle -> IO (Either String GenericMessage)-hGetIrcGenericOnce' h = do- line <- hGetIrcRaw h+-- message read from the server fails, the plain message text is returned.+hGetIrcGenericOnce :: Connection -> IO (Either Text GenericMessage)+hGetIrcGenericOnce c = do+ line <- hGetIrcRaw c return $ case parseMessage line of Just msg -> Right msg Nothing -> Left line -- | Receive the next valid (successfully parsed) IRC message in generic form--- from the server.-hGetIrcGeneric :: Handle -> IO GenericMessage-hGetIrcGeneric h = hGetIrcGenericOnce h >>= maybe (hGetIrcGeneric h) return---- | A variant of 'hGetIrcGeneric' which also returns a list of erronous IRC--- lines received.-hGetIrcGeneric' :: Handle -> IO ([String], GenericMessage)-hGetIrcGeneric' h = do+-- from the server, and a list of erronous IRC lines received before it, if+-- there are any.+hGetIrcGeneric :: Connection -> IO ([Text], GenericMessage)+hGetIrcGeneric c = do (l, gm) <- f [] return (reverse l, gm) where f errs = do- res <- hGetIrcGenericOnce' h+ res <- hGetIrcGenericOnce c case res of Left s -> f $ s : errs Right gm -> return (errs, gm) --- | Receive an IRC message from the server. If parsing the message read from--- the server fails, 'Nothing' is returned.-hGetIrcOnce :: Handle -> IO (Maybe (Either SpecificReply SpecificMessage))-hGetIrcOnce h = hGetIrcGenericOnce h >>=- return . maybe Nothing ((either (const Nothing) Just) . analyze)---- | A variant of 'hGetIrcOnce' which returns 'Left' some information if--- parsing/analysis fails.-hGetIrcOnce' :: Handle- -> IO (Either String (Either SpecificReply SpecificMessage))-hGetIrcOnce' h = do- res <- hGetIrcGenericOnce' h+-- | Receive an IRC message from the server.+hGetIrcOnce :: Connection -> IO Result+hGetIrcOnce c = do+ res <- hGetIrcGenericOnce c return $ case res of- Left s -> Left s+ Left t -> ParsingFailed t Right gm -> case analyze gm of- Left err -> Left $ err ++ " : " ++ show gm- Right spec -> Right spec---- | Receive the next valid (successfully parsed) IRC message from the server.-hGetIrc :: Handle -> IO (Either SpecificReply SpecificMessage)-hGetIrc h = hGetIrcOnce h >>= maybe (hGetIrc h) return+ Left err -> AnalysisFailed gm err+ Right spec -> either GotReply GotMessage spec --- | A variant of 'hGetIrc' which also returns a list of error messages for--- IRC lines whose parsing failed.-hGetIrc' :: Handle -> IO ([String], Either SpecificReply SpecificMessage)-hGetIrc' h = do+-- | Receive the next valid (successfully analyzed) IRC message from the+-- server, and a list of error messages and IRC lines whose parsing failed,+-- received before it, if any. A 'Left' failure item is a plain text IRC line+-- received whose parsing has failed, and a 'Right' failure item is a generic+-- message (i.e. parsing succeeded) whose analysis has failed, and it is+-- provided along with an error description.+hGetIrc+ :: Connection+ -> IO ( [Either Text (GenericMessage, Text)]+ , Either SpecificReply SpecificMessage+ )+hGetIrc c = do (l, m) <- f [] return (reverse l, m) where f errs = do- res <- hGetIrcOnce' h+ res <- hGetIrcOnce c case res of- Left s -> f $ s : errs- Right m -> return (errs, m)+ ParsingFailed t -> f $ Left t : errs+ AnalysisFailed gm err -> f $ Right (gm, err) : errs+ GotReply sr -> return (errs, Left sr)+ GotMessage sm -> return (errs, Right sm)
+ src/Network/IRC/Fun/Client/Instances.hs view
@@ -0,0 +1,27 @@+{- This file is part of irc-fun-client.+ -+ - Written in 2015 by fr33domlover <fr33domlover@riseup.net>.+ -+ - ♡ Copying is an act of love. Please copy, reuse and share.+ -+ - The author(s) have dedicated all copyright and related and neighboring+ - rights to this software to the public domain worldwide. This software is+ - distributed without any warranty.+ -+ - You should have received a copy of the CC0 Public Domain Dedication along+ - with this software. If not, see+ - <http://creativecommons.org/publicdomain/zero/1.0/>.+ -}++{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}++-- | This module exports some typeclasses instances for some of the newtypes+-- in "Network.IRC.Fun.Messages.Types".+module Network.IRC.Fun.Client.Instances () where++import Data.Hashable (Hashable)+import Network.IRC.Fun.Types++deriving instance Hashable Nickname++deriving instance Hashable Channel
src/Network/IRC/Fun/Client/NickTracker.hs view
@@ -1,6 +1,6 @@ {- This file is part of irc-fun-client. -- - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ - Written in 2015, 2016 by fr33domlover <fr33domlover@rel4tion.org>. - - ♡ Copying is an act of love. Please copy, reuse and share. -@@ -37,20 +37,22 @@ ) where +import Network.IRC.Fun.Client.Instances+import Network.IRC.Fun.Types+ import qualified Data.HashMap.Lazy as M import qualified Data.HashSet as S-import Network.IRC.Fun.Messages.TypeAliases -newtype ChannelTracker = ChannelTracker (S.HashSet NickName)+newtype ChannelTracker = ChannelTracker (S.HashSet Nickname) -newtype NetworkTracker = NetworkTracker (M.HashMap ChannelName ChannelTracker)+newtype NetworkTracker = NetworkTracker (M.HashMap Channel ChannelTracker) -- | Check whether a nickname is present in a channel.-isMemberOf :: NickName -> ChannelTracker -> Bool+isMemberOf :: Nickname -> ChannelTracker -> Bool nick `isMemberOf` (ChannelTracker nicks) = nick `S.member` nicks -- | Check whether a nickname is present in a channel.-isInChannel :: NickName -> ChannelName -> NetworkTracker -> Bool+isInChannel :: Nickname -> Channel -> NetworkTracker -> Bool isInChannel nick chan (NetworkTracker cts) = case M.lookup chan cts of Nothing -> False@@ -60,12 +62,12 @@ applySnd f (x, y) = (x, f y) -- | Check in which channels a nickname is present.-presence :: NickName -> NetworkTracker -> [ChannelName]+presence :: Nickname -> NetworkTracker -> [Channel] presence nick (NetworkTracker cts) = [ chan | (chan, True) <- map (applySnd (nick `isMemberOf`)) $ M.toList cts] -- | Record a channel with the given present nicknames.-newChannel :: [NickName] -> ChannelTracker+newChannel :: [Nickname] -> ChannelTracker newChannel nicks = ChannelTracker $ S.fromList nicks -- | Create new tracker.@@ -73,11 +75,11 @@ newNetwork = NetworkTracker $ M.empty -- | Record a nickname being present in a channel.-addMember :: NickName -> ChannelTracker -> ChannelTracker+addMember :: Nickname -> ChannelTracker -> ChannelTracker addMember nick (ChannelTracker nicks) = ChannelTracker $ S.insert nick nicks -- | Record a nickname being present in a channel.-addToChannel :: ChannelName -> NickName -> NetworkTracker -> NetworkTracker+addToChannel :: Channel -> Nickname -> NetworkTracker -> NetworkTracker addToChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts where f chans =@@ -91,7 +93,7 @@ -- | Record a nickname change. Remove old nickname from the channels in which -- it's present, and add the new nickname to them.-changeNick :: NickName -> NickName -> NetworkTracker -> NetworkTracker+changeNick :: Nickname -> Nickname -> NetworkTracker -> NetworkTracker changeNick old new (NetworkTracker cts) = NetworkTracker $ f cts where f chans =@@ -101,38 +103,39 @@ in chansN `M.union` chans -- | Record a channel with the given present nicknames.-addChannel :: ChannelName -> [NickName] -> NetworkTracker -> NetworkTracker+addChannel :: Channel -> [Nickname] -> NetworkTracker -> NetworkTracker addChannel chan nicks (NetworkTracker cts) = NetworkTracker $ f cts where f = M.insert chan $ newChannel nicks -- | Record a channel not having a given nickname anymore.-removeMember :: NickName -> ChannelTracker -> ChannelTracker+removeMember :: Nickname -> ChannelTracker -> ChannelTracker removeMember nick (ChannelTracker nicks) = ChannelTracker $ S.delete nick nicks -- | Record a channel not having a given nickname anymore.-removeFromChannel :: ChannelName- -> NickName- -> NetworkTracker- -> NetworkTracker+removeFromChannel+ :: Channel+ -> Nickname+ -> NetworkTracker+ -> NetworkTracker removeFromChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts where f chans = M.adjust (removeMember nick) chan chans -- | Record a nickname not being present in any channel anymore.-removeFromNetwork :: NickName -> NetworkTracker -> NetworkTracker+removeFromNetwork :: Nickname -> NetworkTracker -> NetworkTracker removeFromNetwork nick (NetworkTracker cts) = NetworkTracker $ f cts where f = M.map (removeMember nick) -- | Remove a channel from the tracker.-removeChannel :: ChannelName -> NetworkTracker -> NetworkTracker+removeChannel :: Channel -> NetworkTracker -> NetworkTracker removeChannel chan (NetworkTracker cts) = NetworkTracker $ f cts where f = M.delete chan -- | Remove channels from the tracker.-removeChannels :: [ChannelName] -> NetworkTracker -> NetworkTracker+removeChannels :: [Channel] -> NetworkTracker -> NetworkTracker removeChannels chans (NetworkTracker cts) = NetworkTracker $ f cts where f ts = ts `M.difference` M.fromList (zip chans (repeat ()))
src/Network/IRC/Fun/Client/Time.hs view
@@ -1,6 +1,6 @@ {- This file is part of irc-fun-client. -- - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ - Written in 2015 by fr33domlover <fr33domlover@riseup.net>. - - ♡ Copying is an act of love. Please copy, reuse and share. -@@ -25,16 +25,20 @@ where import Control.AutoUpdate+import Data.Text (Text, pack) import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import Data.Time.Units (Second, toMicroseconds) -format = formatTime defaultTimeLocale "%F %T"+format :: UTCTime -> Text+format = pack . formatTime defaultTimeLocale "%F %T" +action :: IO (UTCTime, Text) action = do t <- getCurrentTime return (t, format t) +settings :: UpdateSettings (UTCTime, Text) settings = defaultUpdateSettings { updateFreq = fromInteger $ toMicroseconds (1 :: Second) , updateAction = action@@ -42,5 +46,5 @@ -- | Make a getter which returns the current time, and a formatted time string -- for use in IRC logs.-currentTimeGetter :: IO (IO (UTCTime, String))+currentTimeGetter :: IO (IO (UTCTime, Text)) currentTimeGetter = mkAutoUpdate settings
src/Network/IRC/Fun/Client/Util.hs view
@@ -1,6 +1,6 @@ {- This file is part of irc-fun-client. -- - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.+ - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>. - - ♡ Copying is an act of love. Please copy, reuse and share. -@@ -20,7 +20,10 @@ import Data.Char (isAlphaNum) import Data.List (isPrefixOf)+import Network.IRC.Fun.Types +import qualified Data.Text as T+ isNameChar :: Char -> Bool isNameChar c = isAlphaNum c || c `elem` "-_|" @@ -30,17 +33,18 @@ -- inside a longer word. For example, \"ron\" isn't really mentioned in -- \"asynchronic\". Therefore, this function is a bit smarter about this, -- trying to capturing real mentions, and works quite well in practice.-mentions :: String -- ^ Message content- -> String -- ^ Nickname- -> Bool-msg `mentions` nick = m msg nick True+mentions :: MsgContent -> Nickname -> Bool+(MsgContent mc) `mentions` (Nickname n) = m mc n True where- m "" _ _ = False- m msg@(c:cs) nick previnc =- if not previnc && nick `isPrefixOf` msg- then case drop (length nick) msg of- "" -> True- (d:ds) -> if not (isNameChar d)- then True- else m cs nick $ isNameChar c- else m cs nick $ isNameChar c+ m msg nick previnc =+ case T.uncons msg of+ Nothing -> False+ Just (c, r) ->+ if not previnc && nick `T.isPrefixOf` msg+ then case T.uncons $ T.drop (T.length nick) msg of+ Nothing -> True+ Just (d, s) ->+ if isNameChar d+ then m r nick $ isNameChar c+ else True+ else m r nick $ isNameChar c