irc-client (empty) → 0.2.3.0
raw patch · 8 files changed
+806/−0 lines, 8 filesdep +basedep +bytestringdep +conduitsetup-changed
Dependencies added: base, bytestring, conduit, data-default-class, irc-conduit, irc-ctcp, old-locale, stm, stm-conduit, text, time, transformers
Files
- LICENSE +13/−0
- Network/IRC/Client.hs +86/−0
- Network/IRC/Client/Handlers.hs +219/−0
- Network/IRC/Client/Internal.hs +167/−0
- Network/IRC/Client/Types.hs +161/−0
- Network/IRC/Client/Utils.hs +54/−0
- Setup.hs +2/−0
- irc-client.cabal +104/−0
+ LICENSE view
@@ -0,0 +1,13 @@+ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 ++ Copyright (C) 2004 Sam Hocevar <sam@hocevar.net> ++ Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. ++ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION ++ 0. You just DO WHAT THE FUCK YOU WANT TO.
+ Network/IRC/Client.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A simple IRC client library. Typical usage will be of this form:+--+-- > run :: ByteString -> Int -> Text -> IO ()+-- > run host port nick = do+-- > conn <- connect host port 1+-- > let cfg = defaultIRCConf nick+-- > let cfg' = cfg { _handlers = yourCustomEventHandlers : _handlers cfg }+-- > start conn cfg'+--+-- You shouldn't really need to tweak anything other than the event+-- handlers, as everything has been designed to be as simple as+-- possible.+module Network.IRC.Client+ ( -- * Initialisation+ connect+ , connectWithTLS+ , start+ , start'++ -- * Interaction+ , send+ , sendBS+ , disconnect++ -- * Defaults+ , defaultIRCConf+ , defaultDisconnectHandler+ , defaultEventHandlers++ -- * Types+ , module Network.IRC.Client.Types++ -- * Utilities+ , module Network.IRC.Client.Utils+ , rawMessage+ , toByteString+ ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (runReaderT)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Time.Clock (NominalDiffTime)+import Network.IRC.Client.Handlers+import Network.IRC.Client.Internal+import Network.IRC.Client.Types+import Network.IRC.Client.Utils+import Network.IRC.Conduit (ircClient, ircTLSClient, rawMessage, toByteString)++-- * Connecting to an IRC network++-- | Connect to a server without TLS.+connect :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig+connect = connect' ircClient defaultDisconnectHandler++-- | Connect to a server with TLS.+connectWithTLS :: MonadIO m => ByteString -> Int -> NominalDiffTime -> m ConnectionConfig+connectWithTLS = connect' ircTLSClient defaultDisconnectHandler++-- * Starting++-- | Run the event loop for a server, receiving messages and handing+-- them off to handlers as appropriate. Messages will be logged to+-- stdout.+start :: MonadIO m => ConnectionConfig -> InstanceConfig -> m ()+start cconf iconf = newIRCState cconf iconf >>= start'++-- | Like 'start', but use the provided initial state.+start' :: MonadIO m => IRCState -> m ()+start' = liftIO . runReaderT runner++-- * Default configuration++-- | Construct a default IRC configuration from a nick+defaultIRCConf :: Text -> InstanceConfig+defaultIRCConf n = InstanceConfig+ { _nick = n+ , _username = n+ , _realname = n+ , _channels = []+ , _ctcpVer = "irc-client-0.2.3.0"+ , _eventHandlers = defaultEventHandlers+ , _ignore = []+ }
+ Network/IRC/Client/Handlers.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The default event handlers. Handlers are invoked concurrently+-- when matching events are received from the server.+module Network.IRC.Client.Handlers+ ( -- * Event handlers+ defaultEventHandlers+ , pingHandler+ , ctcpPingHandler+ , ctcpVersionHandler+ , ctcpTimeHandler+ , welcomeNick+ , nickMangler++ -- * Disconnect handlers+ , defaultDisconnectHandler+ ) where++import Control.Applicative ((<$>))+import Control.Arrow (first)+import Control.Concurrent.STM (atomically, readTVar, writeTVar)+import Control.Monad (unless)+import Control.Monad.IO.Class (liftIO)+import Data.Char (isAlphaNum)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Text (Text, breakOn, takeEnd, toUpper)+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import Network.IRC.CTCP (fromCTCP)+import Network.IRC.Client.Types+import Network.IRC.Client.Utils+import Network.IRC.Client.Internal+import System.Locale (defaultTimeLocale)++import qualified Data.Text as T++-- * Event handlers++-- | The default event handlers, the following are included:+--+-- - respond to server @PING@ messages with a @PONG@;+-- - respond to CTCP @PING@ requests with a CTCP @PONG@;+-- - respond to CTCP @VERSION@ requests with the version string;+-- - respond to CTCP @TIME@ requests with the system time;+-- - update the nick upon receiving the welcome message, in case the+-- server modifies it;+-- - mangle the nick if the server reports a collision;+-- - update the channel list on @JOIN@ and @KICK@.+--+-- These event handlers are all exposed through the+-- Network.IRC.Client.Handlers module, so you can use them directly if+-- you are building up your 'InstanceConfig' from scratch.+--+-- If you are building a bot, you may want to write an event handler+-- to process messages representing commands.+defaultEventHandlers :: [EventHandler]+defaultEventHandlers =+ [ EventHandler "Respond to server PING requests" EPing pingHandler+ , EventHandler "Respond to CTCP PING requests" ECTCP ctcpPingHandler+ , EventHandler "Respond to CTCP VERSION requests" ECTCP ctcpVersionHandler+ , EventHandler "Respond to CTCP TIME requests" ECTCP ctcpTimeHandler+ , EventHandler "Update the nick upon welcome" ENumeric welcomeNick+ , EventHandler "Mangle the nick on collision" ENumeric nickMangler+ , EventHandler "Update the channel list on JOIN" ENumeric joinHandler+ , EventHandler "Update the channel lift on KICK" EKick kickHandler+ ]++-- | Respond to server @PING@ messages with a @PONG@.+pingHandler :: UnicodeEvent -> IRC ()+pingHandler ev = case _message ev of+ Ping s1 s2 -> send . Pong $ fromMaybe s1 s2+ _ -> return ()++-- | Respond to CTCP @PING@ requests with a CTCP @PONG@.+ctcpPingHandler :: UnicodeEvent -> IRC ()+ctcpPingHandler = ctcpHandler [("PING", return)]++-- | Respond to CTCP @VERSION@ requests with the version string.+ctcpVersionHandler :: UnicodeEvent -> IRC ()+ctcpVersionHandler = ctcpHandler [("VERSION", go)] where+ go _ = do+ ver <- _ctcpVer <$> instanceConfig+ return [ver]++-- | Respond to CTCP @TIME@ requests with the system time.+ctcpTimeHandler :: UnicodeEvent -> IRC ()+ctcpTimeHandler = ctcpHandler [("TIME", go)] where+ go _ = do+ now <- liftIO getCurrentTime+ return [T.pack $ formatTime defaultTimeLocale "%c" now]++-- | Update the nick upon welcome (numeric reply 001), as it may not+-- be what we requested (eg, in the case of a nick too long).+welcomeNick :: UnicodeEvent -> IRC ()+welcomeNick = numHandler [(001, go)] where+ go (srvNick:_) = do+ tvarI <- instanceConfigTVar++ liftIO . atomically $ do+ iconf <- readTVar tvarI+ writeTVar tvarI iconf { _nick = srvNick }+ go _ = return ()++-- | Mangle the nick if there's a collision (numeric replies 432, 433,+-- and 436) when we set it+nickMangler :: UnicodeEvent -> IRC ()+nickMangler = numHandler [ (432, go fresh)+ , (433, go mangle)+ , (436, go mangle)+ ]+ where+ go f (_:srvNick:_) = do+ theNick <- _nick <$> instanceConfig++ -- If the length of our nick and the server's idea of our nick+ -- differ, it was truncated - so calculate the allowable length.+ let nicklen = if T.length srvNick /= T.length theNick+ then Just $ T.length srvNick+ else Nothing++ setNick . trunc nicklen $ f srvNick+ go _ _ = return ()++ fresh n = if T.length n' == 0 then "f" else n'+ where n' = T.filter isAlphaNum n++ mangle n = (n <> "1") `fromMaybe` charsubst n++ -- Truncate a nick, if there is a known length limit.+ trunc len txt = maybe txt (`takeEnd` txt) len++ -- List of substring substitutions. It's important that these+ -- don't contain any loops!+ charsubst = transform [ ("i", "1")+ , ("I", "1")+ , ("l", "1")+ , ("L", "1")+ , ("o", "0")+ , ("O", "0")+ , ("A", "4")+ , ("0", "1")+ , ("1", "2")+ , ("2", "3")+ , ("3", "4")+ , ("4", "5")+ , ("5", "6")+ , ("6", "7")+ , ("7", "8")+ , ("8", "9")+ , ("9", "-")+ ]++ -- Attempt to transform some text by the substitutions.+ transform ((from, to):trs) txt = case breakOn' from txt of+ Just (before, after) -> Just $ before <> to <> after+ _ -> transform trs txt+ transform [] _ = Nothing++-- | Upon receiving a channel topic (numeric reply 332), add the+-- channel to the list (if not already present).+joinHandler :: UnicodeEvent -> IRC ()+joinHandler = numHandler [(332, go)] where+ go (c:_) = do+ tvarI <- instanceConfigTVar++ liftIO . atomically $ do+ iconf <- readTVar tvarI+ unless (c `elem` _channels iconf) $+ writeTVar tvarI iconf { _channels = c : _channels iconf }++ go _ = return ()++-- | Update the channel list upon being kicked.+kickHandler :: UnicodeEvent -> IRC ()+kickHandler ev = do+ theNick <- _nick <$> instanceConfig+ tvarI <- instanceConfigTVar++ case (_source ev, _message ev) of+ (Channel c _, Kick n _ _) | n == theNick -> liftIO . atomically $ delChan tvarI c+ | otherwise -> return ()+ _ -> return ()++-- *Misc++-- | The default disconnect handler: do nothing. You might want to+-- override this with one which reconnects.+defaultDisconnectHandler :: IRC ()+defaultDisconnectHandler = return ()++-- *Utils++-- | Match and handle a named CTCP+ctcpHandler :: [(Text, [Text] -> IRC [Text])] -> UnicodeEvent -> IRC ()+ctcpHandler hs ev = case (_source ev, _message ev) of+ (User n, Privmsg _ (Left ctcpbs)) ->+ let (verb, xs) = first toUpper $ fromCTCP ctcpbs+ in case lookup verb hs of+ Just f -> do+ args <- f xs+ send $ ctcpReply n verb args+ _ -> return ()+ _ -> return ()++-- | Match and handle a numeric reply+numHandler :: [(Int, [Text] -> IRC ())] -> UnicodeEvent -> IRC ()+numHandler hs ev = case _message ev of+ Numeric num xs -> maybe (return ()) ($xs) $ lookup num hs+ _ -> return ()++-- | Break some text on the first occurrence of a substring, removing+-- the substring from the second portion.+breakOn' :: Text -> Text -> Maybe (Text, Text)+breakOn' delim txt = if T.length after >= T.length delim+ then Just (before, T.drop (T.length delim) after)+ else Nothing+ where+ (before, after) = breakOn delim txt
+ Network/IRC/Client/Internal.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Most of the hairy code. This isn't all internal, due to messy+-- dependencies, but I've tried to make this as \"internal\" as+-- reasonably possible.+module Network.IRC.Client.Internal where++import Control.Applicative ((<$>))+import Control.Concurrent (forkIO)+import Control.Concurrent.STM (atomically, readTVar, retry)+import Control.Monad (unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (runReaderT)+import Data.ByteString (ByteString)+import Data.Conduit (Producer, Conduit, Consumer, (=$=), ($=), (=$), awaitForever, toProducer, yield)+import Data.Conduit.TMChan (closeTBMChan, isEmptyTBMChan, newTBMChanIO, sourceTBMChan, writeTBMChan)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Time.Clock (NominalDiffTime, getCurrentTime)+import Data.Time.Format (formatTime)+import Network.IRC.Conduit (IrcEvent, IrcMessage, floodProtector, rawMessage, toByteString)+import Network.IRC.Client.Types+import System.Locale (defaultTimeLocale)++-- * Connecting to an IRC network++-- | Connect to a server using the supplied connection function.+connect' :: MonadIO m+ => (Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ())+ -> IRC ()+ -> ByteString+ -> Int+ -> NominalDiffTime+ -> m ConnectionConfig+connect' f dcHandler host port flood = liftIO $ do+ queueS <- newTBMChanIO 16++ return ConnectionConfig+ { _func = f+ , _sendqueue = queueS+ , _server = host+ , _port = port+ , _flood = flood+ , _disconnect = dcHandler+ }++-- * Event loop++-- | The event loop.+runner :: IRC ()+runner = do+ state <- ircState++ -- Set the nick and username+ theNick <- _nick <$> instanceConfig+ theUser <- _username <$> instanceConfig+ theReal <- _realname <$> instanceConfig++ -- Initialise the IRC session+ let initialise = flip runReaderT state $ do+ sendBS $ rawMessage "USER" [encodeUtf8 theUser, "-", "-", encodeUtf8 theReal]+ send $ Nick theNick+ mapM_ (send . Join) . _channels <$> instanceConfig+ return ()++ -- Run the event loop, and call the disconnect handler if the remote+ -- end closes the socket.+ flood <- _flood <$> connectionConfig+ func <- _func <$> connectionConfig+ port <- _port <$> connectionConfig+ server <- _server <$> connectionConfig+ queue <- _sendqueue <$> connectionConfig++ antiflood <- liftIO $ floodProtector flood++ dchandler <- _disconnect <$> connectionConfig++ let source = toProducer $ sourceTBMChan queue $= antiflood $= logConduit False toByteString+ let sink = forgetful =$= logConduit True _raw =$ eventSink state++ liftIO $ func port server initialise sink source++ disconnect+ dchandler++-- | Forget failed decodings.+forgetful :: Monad m => Conduit (Either a b) m b+forgetful = awaitForever go where+ go (Left _) = return ()+ go (Right b) = yield b++-- | Block on receiving a message and invoke all matching handlers+-- concurrently.+eventSink :: MonadIO m => IRCState -> Consumer IrcEvent m ()+eventSink ircstate = awaitForever $ \event -> do+ let event' = decodeUtf8 <$> event+ ignored <- isIgnored ircstate event'+ unless ignored $ do+ handlers <- getHandlersFor event' . _eventHandlers <$> getInstanceConfig' ircstate+ liftIO $ mapM_ (\h -> forkIO $ runReaderT (h event') ircstate) handlers++-- | Check if an event is ignored or not.+isIgnored :: MonadIO m => IRCState -> UnicodeEvent -> m Bool+isIgnored ircstate ev = do+ iconf <- liftIO . atomically . readTVar . _instanceConfig $ ircstate+ let ignoreList = _ignore iconf++ return $+ case _source ev of+ User n -> (n, Nothing) `elem` ignoreList+ Channel c n -> ((n, Nothing) `elem` ignoreList) || ((n, Just c) `elem` ignoreList)+ Server _ -> False++-- |Get the event handlers for an event.+getHandlersFor :: Event a -> [EventHandler] -> [UnicodeEvent -> IRC ()]+getHandlersFor e ehs = [_eventFunc eh | eh <- ehs, _matchType eh `elem` [EEverything, eventType e]]++-- |A conduit which logs everything which goes through it.+logConduit :: MonadIO m => Bool -> (a -> ByteString) -> Conduit a m a+logConduit fromsrv f = awaitForever $ \x -> do+ -- Print the log+ liftIO $ do+ now <- getCurrentTime++ putStrLn $ unwords [ formatTime defaultTimeLocale "%c" now+ , if fromsrv then "<---" else "--->"+ , init . tail . show $ f x+ ]++ -- And pass the message on+ yield x++-- * Messaging++-- | Send a message as UTF-8, using TLS if enabled. This blocks if+-- messages are sent too rapidly.+send :: UnicodeMessage -> IRC ()+send = sendBS . fmap encodeUtf8++-- | Send a message, using TLS if enabled. This blocks if messages are+-- sent too rapidly.+sendBS :: IrcMessage -> IRC ()+sendBS msg = do+ queue <- _sendqueue <$> connectionConfig+ liftIO . atomically $ writeTBMChan queue msg++-- * Disconnecting++-- | Disconnect from the server, properly tearing down the TLS session+-- (if there is one).+disconnect :: IRC ()+disconnect = do+ queueS <- _sendqueue <$> connectionConfig++ -- Wait for all messages to be sent+ liftIO . atomically $ do+ empty <- isEmptyTBMChan queueS+ unless empty retry++ -- Then close the connection+ disconnectNow++-- | Disconnect immediately, without waiting for messages to be sent.+disconnectNow :: IRC ()+disconnectNow = do+ queueS <- _sendqueue <$> connectionConfig+ liftIO . atomically $ closeTBMChan queueS
+ Network/IRC/Client/Types.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE ImpredicativeTypes #-}++-- | Types for IRC clients. See also+-- <http://hackage.haskell.org/package/irc-conduit/docs/Network-IRC-Conduit.html Network.IRC.Conduit> and+-- <http://hackage.haskell.org/package/irc-ctcp-0.1.2.1/docs/Network-IRC-CTCP.html Network.IRC.CTCP>.+module Network.IRC.Client.Types+ ( module Network.IRC.Client.Types++ -- * Re-exported+ , Event(..)+ , Source(..)+ , Message(..)+ ) where++import Control.Applicative ((<$>))+import Control.Concurrent.STM (TVar, atomically, readTVar, newTVar, writeTVar)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (ReaderT, ask)+import Data.ByteString (ByteString)+import Data.Conduit (Consumer, Producer)+import Data.Conduit.TMChan (TBMChan)+import Data.Text (Text)+import Data.Time.Clock (NominalDiffTime)+import Network.IRC.Conduit (Event(..), Message(..), Source(..), IrcEvent, IrcMessage)++-- *Type synonyms+type UnicodeEvent = Event Text+type UnicodeSource = Source Text+type UnicodeMessage = Message Text++-- *State++-- | The IRC monad.+type IRC a = ReaderT IRCState IO a++data IRCState = IRCState { _connectionConfig :: ConnectionConfig+ -- ^Read-only connection configuration+ , _instanceConfig :: TVar InstanceConfig+ -- ^Mutable instance configuration in STM+ }++-- | Construct a new IRC state+newIRCState :: MonadIO m => ConnectionConfig -> InstanceConfig -> m IRCState+newIRCState cconf iconf = do+ tvar <- liftIO . atomically . newTVar $ iconf++ return IRCState+ { _connectionConfig = cconf+ , _instanceConfig = tvar+ }++-- | Access the entire state.+ircState :: IRC IRCState+ircState = ask++-- | Extract the connection configuration from an IRC state+getConnectionConfig :: IRCState -> ConnectionConfig+getConnectionConfig = _connectionConfig++-- | Extract the instance configuration from an IRC state+getInstanceConfig :: IRCState -> TVar InstanceConfig+getInstanceConfig = _instanceConfig++-- | Extract the current snapshot of the instance configuration from+-- an IRC state+getInstanceConfig' :: MonadIO m => IRCState -> m InstanceConfig+getInstanceConfig' = liftIO . atomically . readTVar . _instanceConfig++-- | Access the connection config+connectionConfig :: IRC ConnectionConfig+connectionConfig = _connectionConfig <$> ask++-- | Access the instance config TVar+instanceConfigTVar :: IRC (TVar InstanceConfig)+instanceConfigTVar = _instanceConfig <$> ask++-- | Access the instance config as it is right now.+instanceConfig :: IRC InstanceConfig+instanceConfig = instanceConfigTVar >>= liftIO . atomically . readTVar++-- | Overwrite the instance config, even if it has changed since we+-- looked at it.+putInstanceConfig :: InstanceConfig -> IRC ()+putInstanceConfig iconf = instanceConfigTVar >>= liftIO . atomically . flip writeTVar iconf++-- | The static state of an IRC server connection.+data ConnectionConfig = ConnectionConfig+ { _func :: Int -> ByteString -> IO () -> Consumer (Either ByteString IrcEvent) IO () -> Producer IO IrcMessage -> IO ()+ -- ^ Function to connect and start the conduits.+ , _sendqueue :: TBMChan IrcMessage+ -- ^ Message send queue.+ , _server :: ByteString+ -- ^ The server host.+ , _port :: Int+ -- ^ The server port.+ , _flood :: NominalDiffTime+ -- ^ The minimum time between two adjacent messages.+ , _disconnect :: IRC ()+ -- ^ Action to run if the remote server closes the connection.+ }++-- | The updateable state of an IRC connection.+data InstanceConfig = InstanceConfig+ { _nick :: Text+ -- ^ Client nick+ , _username :: Text+ -- ^ Client username+ , _realname :: Text+ -- ^ Client realname+ , _channels :: [Text]+ -- ^ Current channels+ , _ctcpVer :: Text+ -- ^ Response to CTCP VERSION+ , _eventHandlers :: [EventHandler]+ -- ^ The registered event handlers+ , _ignore :: [(Text, Maybe Text)]+ -- ^ List of nicks (optionally restricted to channels) to ignore+ -- messages from. No channel = global.+ }++-- *Events++-- | Types of events which can be caught.+data EventType+ = EEverything+ -- ^ Match all events+ | ENothing+ -- ^ Match no events+ | EPrivmsg | ENotice | ECTCP | ENick | EJoin | EPart | EQuit | EMode | ETopic | EInvite | EKick | EPing | ENumeric+ deriving (Eq, Show)++-- | A function which handles an event.+data EventHandler = EventHandler+ { _description :: Text+ -- ^ A description of the event handler.+ , _matchType :: EventType+ -- ^ Which type to be triggered by+ , _eventFunc :: UnicodeEvent -> IRC ()+ -- ^ The function to call.+ }++-- | Get the type of an event.+eventType :: Event a -> EventType+eventType e = case _message e of+ (Privmsg _ Right{}) -> EPrivmsg+ (Privmsg _ Left{}) -> ECTCP+ (Notice _ Right{}) -> ENotice+ (Notice _ Left{}) -> ECTCP++ Nick{} -> ENick+ Join{} -> EJoin+ Part{} -> EPart+ Quit{} -> EQuit+ Mode{} -> EMode+ Topic{} -> ETopic+ Invite{} -> EInvite+ Kick{} -> EKick+ Ping{} -> EPing+ Numeric{} -> ENumeric++ _ -> EEverything
+ Network/IRC/Client/Utils.hs view
@@ -0,0 +1,54 @@+-- |Commonly-used utility functions for IRC clients.+module Network.IRC.Client.Utils where++import Control.Concurrent.STM (TVar, STM, atomically, readTVar, writeTVar)+import Control.Monad.IO.Class (liftIO)+import Data.Text (Text)+import Network.IRC.CTCP (toCTCP)+import Network.IRC.Client.Internal (send)+import Network.IRC.Client.Types++-- | Update the nick in the instance configuration and also send an+-- update message to the server. This doesn't attempt to resolve nick+-- collisions, that's up to the event handlers.+setNick :: Text -> IRC ()+setNick new = do+ tvarI <- instanceConfigTVar++ liftIO . atomically $ do+ iconf <- readTVar tvarI+ writeTVar tvarI iconf { _nick = new }++ send $ Nick new++-- | Update the channel list in the instance configuration and also+-- part the channel.+leaveChannel :: Text -> Maybe Text -> IRC ()+leaveChannel chan reason = do+ tvarI <- instanceConfigTVar+ liftIO . atomically $ delChan tvarI chan++ send $ Part chan reason++-- | Remove a channel from the list without sending a part command (be+-- careful not to let the channel list get out of sync with the+-- real-world state if you use it for anything!)+delChan :: TVar InstanceConfig -> Text -> STM ()+delChan tvarI chan = do+ iconf <- readTVar tvarI+ writeTVar tvarI iconf { _channels = filter (/=chan) $ _channels iconf }++-- | Send a message to the source of an event.+reply :: UnicodeEvent -> Text -> IRC ()+reply ev txt = case _source ev of+ Channel c _ -> send $ Privmsg c $ Right txt+ User n -> send $ Privmsg n $ Right txt+ _ -> return ()++-- | Construct a @PRIVMSG@ containing a CTCP+ctcp :: Text -> Text -> [Text] -> UnicodeMessage+ctcp t command args = Privmsg t . Left $ toCTCP command args++-- | Construct a @NOTICE@ containing a CTCP+ctcpReply :: Text -> Text -> [Text] -> UnicodeMessage+ctcpReply t command args = Notice t . Left $ toCTCP command args
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ irc-client.cabal view
@@ -0,0 +1,104 @@+-- Initial idte.cabal generated by cabal init. For further documentation, +-- see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: irc-client++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.2.3.0++-- A short (one-line) description of the package.+synopsis: An IRC client library.++-- A longer description of the package.+description:+ An IRC client library built atop+ <http://hackage.haskell.org/package/irc-conduit irc-conduit>. Why+ another IRC client library, you cry? I didn't really find one that+ did what I wanted (specifically, handle connecting to servers and+ calling event handlers, possibly with TLS), but which didn't+ implement almost a full IRC bot for you. That takes out all the fun!+ .+ <http://hackage.haskell.org/package/irc-conduit irc-conduit> and+ <http://hackage.haskell.org/package/irc-ctcp irc-ctcp> are my+ solution to the first part of that, this is my solution to the+ latter. It's a simple IRC client library that does the basics for+ you, but isn't an all-singing, all-dancing, fully-featured IRC+ /application/. It is a merely a simple library.++-- URL for the project homepage or repository.+homepage: https://github.com/barrucadu/irc-client++-- URL where users should direct bug reports.+bug-reports: https://github.com/barrucadu/irc-client/issues++-- The license under which the package is released.+license: OtherLicense++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Michael Walker++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: mike@barrucadu.co.uk++-- A copyright notice.+-- copyright: ++category: Network++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10+++library+ -- Modules exported by the library.+ exposed-modules: Network.IRC.Client+ , Network.IRC.Client.Handlers+ , Network.IRC.Client.Types+ , Network.IRC.Client.Utils+ + -- Modules included in this library but not exported.+ other-modules: Network.IRC.Client.Internal+ + -- Compile with -Wall by default+ ghc-options: -Wall+ -fno-warn-unused-do-bind+ + -- LANGUAGE extensions used by modules in this package.+ -- other-extensions: + + -- Other library packages from which modules are imported.+ build-depends: base >=4.7 && <5+ , bytestring >=0.10+ , conduit >=1.2+ , data-default-class >=0.0.1+ , irc-conduit >=0.1+ , irc-ctcp >=0.1.2+ , stm >=2.4+ , stm-conduit >=2.5+ , text >=1.1+ , time >=1.4+ , transformers >=0.4+ , old-locale >=1.0+ + -- Directories containing source files.+ -- hs-source-dirs: + + -- Base language which the package is written in.+ default-language: Haskell2010+