diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,1 @@ +fr33domlover diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,121 @@ +Creative Commons Legal Code + +CC0 1.0 Universal + + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE + LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN + ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS + INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES + REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS + PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM + THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED + HEREUNDER. + +Statement of Purpose + +The laws of most jurisdictions throughout the world automatically confer +exclusive Copyright and Related Rights (defined below) upon the creator +and subsequent owner(s) (each and all, an "owner") of an original work of +authorship and/or a database (each, a "Work"). + +Certain owners wish to permanently relinquish those rights to a Work for +the purpose of contributing to a commons of creative, cultural and +scientific works ("Commons") that the public can reliably and without fear +of later claims of infringement build upon, modify, incorporate in other +works, reuse and redistribute as freely as possible in any form whatsoever +and for any purposes, including without limitation commercial purposes. +These owners may contribute to the Commons to promote the ideal of a free +culture and the further production of creative, cultural and scientific +works, or to gain reputation or greater distribution for their Work in +part through the use and efforts of others. + +For these and/or other purposes and motivations, and without any +expectation of additional consideration or compensation, the person +associating CC0 with a Work (the "Affirmer"), to the extent that he or she +is an owner of Copyright and Related Rights in the Work, voluntarily +elects to apply CC0 to the Work and publicly distribute the Work under its +terms, with knowledge of his or her Copyright and Related Rights in the +Work and the meaning and intended legal effect of CC0 on those rights. + +1. Copyright and Related Rights. A Work made available under CC0 may be +protected by copyright and related or neighboring rights ("Copyright and +Related Rights"). Copyright and Related Rights include, but are not +limited to, the following: + + i. the right to reproduce, adapt, distribute, perform, display, + communicate, and translate a Work; + ii. moral rights retained by the original author(s) and/or performer(s); +iii. publicity and privacy rights pertaining to a person's image or + likeness depicted in a Work; + iv. rights protecting against unfair competition in regards to a Work, + subject to the limitations in paragraph 4(a), below; + v. rights protecting the extraction, dissemination, use and reuse of data + in a Work; + vi. database rights (such as those arising under Directive 96/9/EC of the + European Parliament and of the Council of 11 March 1996 on the legal + protection of databases, and under any national implementation + thereof, including any amended or successor version of such + directive); and +vii. other similar, equivalent or corresponding rights throughout the + world based on applicable law or treaty, and any national + implementations thereof. + +2. Waiver. To the greatest extent permitted by, but not in contravention +of, applicable law, Affirmer hereby overtly, fully, permanently, +irrevocably and unconditionally waives, abandons, and surrenders all of +Affirmer's Copyright and Related Rights and associated claims and causes +of action, whether now known or unknown (including existing as well as +future claims and causes of action), in the Work (i) in all territories +worldwide, (ii) for the maximum duration provided by applicable law or +treaty (including future time extensions), (iii) in any current or future +medium and for any number of copies, and (iv) for any purpose whatsoever, +including without limitation commercial, advertising or promotional +purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each +member of the public at large and to the detriment of Affirmer's heirs and +successors, fully intending that such Waiver shall not be subject to +revocation, rescission, cancellation, termination, or any other legal or +equitable action to disrupt the quiet enjoyment of the Work by the public +as contemplated by Affirmer's express Statement of Purpose. + +3. Public License Fallback. Should any part of the Waiver for any reason +be judged legally invalid or ineffective under applicable law, then the +Waiver shall be preserved to the maximum extent permitted taking into +account Affirmer's express Statement of Purpose. In addition, to the +extent the Waiver is so judged Affirmer hereby grants to each affected +person a royalty-free, non transferable, non sublicensable, non exclusive, +irrevocable and unconditional license to exercise Affirmer's Copyright and +Related Rights in the Work (i) in all territories worldwide, (ii) for the +maximum duration provided by applicable law or treaty (including future +time extensions), (iii) in any current or future medium and for any number +of copies, and (iv) for any purpose whatsoever, including without +limitation commercial, advertising or promotional purposes (the +"License"). The License shall be deemed effective as of the date CC0 was +applied by Affirmer to the Work. Should any part of the License for any +reason be judged legally invalid or ineffective under applicable law, such +partial invalidity or ineffectiveness shall not invalidate the remainder +of the License, and in such case Affirmer hereby affirms that he or she +will not (i) exercise any of his or her remaining Copyright and Related +Rights in the Work or (ii) assert any associated claims and causes of +action with respect to the Work, in either case contrary to Affirmer's +express Statement of Purpose. + +4. Limitations and Disclaimers. + + a. No trademark or patent rights held by Affirmer are waived, abandoned, + surrendered, licensed or otherwise affected by this document. + b. Affirmer offers the Work as-is and makes no representations or + warranties of any kind concerning the Work, express, implied, + statutory or otherwise, including without limitation warranties of + title, merchantability, fitness for a particular purpose, non + infringement, or the absence of latent or other defects, accuracy, or + the present or absence of errors, whether or not discoverable, all to + the greatest extent permissible under applicable law. + c. Affirmer disclaims responsibility for clearing rights of other persons + that may apply to the Work or any use thereof, including without + limitation any person's Copyright and Related Rights in the Work. + Further, Affirmer disclaims responsibility for obtaining any necessary + consents, permissions or other rights required for any use of the + Work. + d. Affirmer understands and acknowledges that Creative Commons is not a + party to this document and has no duty or obligation with respect to + this CC0 or use of the Work. diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,17 @@ +The changes are recorded by the version control system, Darcs. To see a log +quickly from the terminal, run: + + $ darcs changes --repo http://dev.rel4tion.org/fr33domlover/irc-fun-bot + +There is also a web interface at which, among other +things, can display the history log. + +To see the log in a local clone, first get a copy of the repository if you +haven't yet: + + $ darcs get http://dev.rel4tion.org/fr33domlover/irc-fun-bot + +Then move into the newly created directory and run darcs: + + $ cd irc-fun-bot + $ darcs changes diff --git a/INSTALL b/INSTALL new file mode 100644 --- /dev/null +++ b/INSTALL @@ -0,0 +1,13 @@ +Install from Hackage: + + $ cabal install irc-fun-bot + +Install from unpacked release tarball or source repo: + + $ cd irc-fun-bot + $ cabal install + +Just play with it without installing: + + $ cabal build + $ cabal repl diff --git a/NEWS b/NEWS new file mode 100644 --- /dev/null +++ b/NEWS @@ -0,0 +1,23 @@ +This file lists the user-visible interesting changes between releases. For a +full list of changes to the source, see the ChangeLog. + + + +irc-fun-bot 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) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,14 @@ +See the .cabal file for more info and link to project website the version +control. + +The official download location is Hackage: + + + +This library is free software, and is committed to software freedom. It is +released to the public domain using the CC0 Public Domain Dedication. For the +boring "legal" details see the file 'COPYING'. + +See the file 'INSTALL' for hints on installation. The file 'ChangeLog' explains +how to see the history log of the changes done in the code. 'NEWS' provides a +friendly overview of the changes for each release. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/irc-fun-bot.cabal b/irc-fun-bot.cabal new file mode 100644 --- /dev/null +++ b/irc-fun-bot.cabal @@ -0,0 +1,48 @@ +name: irc-fun-bot +version: 0.1.0.0 +synopsis: Very simple library for writing fun IRC bots. +description: + One day an idea came up on the #freepost IRC channel: We didn't need much of + the serious features IRC bots provide, but we could develop an IRC bot + collaboratively, for fun and for learning new skills and languages! I also + thought this is a great chance for people to quickly see their code in real + use, which is motivating when learning programming, and it's a chance to + introduce Haskell to the community. + . + And so, this library was started. The API is inspired by the @Irc@ package + and some other IRC client related packages. +homepage: http://rel4tion.org/projects/irc-fun-bot/ +bug-reports: http://rel4tion.org/projects/irc-fun-bot/tickets/ +license: PublicDomain +license-file: COPYING +author: fr33domlover +maintainer: fr33domlover@riseup.net +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 +cabal-version: >=1.10 + +source-repository head + type: darcs + location: http://dev.rel4tion.org/fr33domlover/irc-fun-bot + +library + exposed-modules: Network.IRC.Fun.Bot + , Network.IRC.Fun.Bot.Behavior + , Network.IRC.Fun.Bot.Chat + , Network.IRC.Fun.Bot.State + , Network.IRC.Fun.Bot.Types + , Network.IRC.Fun.Bot.Util + other-modules: Network.IRC.Fun.Bot.Internal.Chat + , Network.IRC.Fun.Bot.Internal.Event + , Network.IRC.Fun.Bot.Internal.Failure + , Network.IRC.Fun.Bot.Internal.State + , Network.IRC.Fun.Bot.Internal.Types + -- other-extensions: + build-depends: base >=4.7 && <5 + , irc-fun-client + , irc-fun-messages + , transformers >=0.4.3 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Network/IRC/Fun/Bot.hs b/src/Network/IRC/Fun/Bot.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot.hs @@ -0,0 +1,88 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module allows you to define bot event handlers and commands, and then +-- just run event source and sink threads in your @main@ function and let them +-- handle all the details. +module Network.IRC.Fun.Bot + ( runBot + ) +where + +import Control.Concurrent (forkIO) +import Control.Concurrent.Chan +import Control.Monad (forever) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS (ask) +import Network.IRC.Fun.Bot.Internal.Event (matchEvent, handleEvent) +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Bot.Chat (login, joinConfig, run) +import Network.IRC.Fun.Client.Events (hGetIrcEvents) + +-- Get the bot ready for listening to IRC messages. +startBot :: Session e s () +startBot = do + liftIO $ putStrLn "Bot: Logging in as IRC user with nickname" + login + liftIO $ putStrLn "Bot: Joining IRC channels" + joinConfig + +-- Wait for an IRC event, then handle it according to bot behavior definition. +listenToEvent :: Chan (Either Event a) -> EventHandler e s a -> Session e s () +listenToEvent chan handler = do + event <- liftIO $ readChan chan + either handleEvent handler event + +-- Collect IRC events from the server and push into a 'Chan' for the main +-- thread to handle. +listenToIrc :: BotEnv e s -> Chan (Either Event a) -> IO () +listenToIrc bot chan = do + putStrLn "Bot: IRC event source listening to IRC events" + forever $ do + ircEvents <- hGetIrcEvents $ handle bot + let match e = matchEvent e (config bot) (commandSets $ behavior bot) + botEvents = map match ircEvents + mapM_ print botEvents + writeList2Chan chan $ map Left botEvents + +-- Connect, login, join. Then listen to events and handle them, forever. +botSession :: [EventSource e s a] -> EventHandler e s a -> Session e s () +botSession sources handler = do + chan <- liftIO newChan + bot <- ask + liftIO $ forkIO $ listenToIrc bot chan + let launch s = forkIO $ s (config bot) + (custom bot) + (writeChan chan . Right) + (writeList2Chan chan . map Right) + liftIO $ mapM_ launch sources + startBot + liftIO $ putStrLn "Bot: Event sink listening to events" + forever $ listenToEvent chan handler + +-- | Start the bot and run its event loop. The bot will listen to messages from +-- the IRC server and other provided sources, and will respond according to the +-- behavior definitions. +runBot :: Config -- ^ IRC connection configuration + -> Behavior e s -- ^ Behavior definition for IRC events + -> [EventSource e s a] -- ^ Additional event source threads to run + -> EventHandler e s a -- ^ Handler for events coming from those sources + -> e -- ^ Custom bot environment (read-only state) + -> s -- ^ Initial state to hold in the background + -> IO () +runBot conf behavior sources handler env state = do + putStrLn "Bot: Starting" + run conf behavior env state $ botSession sources handler + putStrLn "Bot: Disconnected" diff --git a/src/Network/IRC/Fun/Bot/Behavior.hs b/src/Network/IRC/Fun/Bot/Behavior.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Behavior.hs @@ -0,0 +1,134 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module provides utilities for working with the bot's behavior +-- definition. While the library handles event dispatch by itself, custom +-- commands and bot features may benefit from having this module available to +-- them (e.g. a bot's help system). +module Network.IRC.Fun.Bot.Behavior + ( -- * Defining + defaultBehavior + -- * Searching + , findCmdInSet + , findCmdInSets + , findCmd + , findSet + , searchCmds + -- * Showing + , listNames + , listPrimaryNames + ) +where + +import Data.Char (toLower) +import Data.List (find, isInfixOf) +import Network.IRC.Fun.Bot.Types +import Network.IRC.Fun.Bot.Util (maybeQuote, showNames) + +------------------------------------------------------------------------------- +-- Defining +------------------------------------------------------------------------------- + +-- | A default behavior definition which be convenienty overridden and extended +-- using record syntax. It currently simply doesn't do anything (pings do get +-- handled behind the scenes), but things like default responses and logging +-- could be added in the future. +defaultBehavior :: Behavior e s +defaultBehavior = Behavior + { handleJoin = \ _ _ -> return () + , handlePart = \ _ _ _ -> return () + , handleQuit = \ _ _ -> return () + , handleMsg = \ _ _ _ _ -> return () + , handleBotMsg = \ _ _ _ -> return () + , commandSets = [] + , handlePersonalMsg = \ _ _ -> return () + , handleTopicChange = \ _ _ _ -> return () + , handleNames = \ _ _ _ -> return () + } + +------------------------------------------------------------------------------- +-- Searching +------------------------------------------------------------------------------- + +-- | Take a command name (without prefix) and a command set, and return the +-- (leftmost) command which has that name, or 'Nothing' if there is no such +-- command. +findCmdInSet :: String -> CommandSet e s -> Maybe (Command e s) +findCmdInSet name = find ((name `elem`) . names) . commands + +-- | Find a command in a list of command sets, using the given prefix character +-- and command name. This is a shortcut for 'findCmd' which doesn't return the +-- matched command set (for the cases you only need to find the command). +findCmdInSets :: Char -> String -> [CommandSet e s] -> Maybe (Command e s) +findCmdInSets cpref cname sets = + case findCmd cpref cname sets of + Just (Right cmd) -> Just cmd + _ -> Nothing + +-- | Find a command in a list of command sets, using the given prefix character +-- and command name. If the prefix isn't matched, 'Nothing' is returned. If +-- the prefix is matched but the command isn't, 'Just' 'Left' the command set +-- is returned. Otherwise, 'Just' 'Right' the matched command is returned. +findCmd :: Char -- ^ Command prefix to search for + -> String -- ^ Command name to search for + -> [CommandSet e s] -- ^ Command set in which to search + -> Maybe (Either (CommandSet e s) (Command e s)) +findCmd cpref cname sets = + case findSet cpref sets of + Nothing -> Nothing + Just cset -> + case findCmdInSet cname cset of + Nothing -> Just $ Left cset + Just cmd -> Just $ Right cmd + +-- | Take a command prefix and a list of command sets, and return the +-- (leftmost) set which has that prefex, or 'Nothing' if there is no such set. +findSet :: Char -> [CommandSet e s] -> Maybe (CommandSet e s) +findSet p = find ((== p) . prefix) + +-- | Search for commands by testing a search string against their textual +-- fields: Names and help strings. Each returned pair is a command and the +-- prefix under which it was found. +searchCmds :: String -> [CommandSet e s] -> [(Char, Command e s)] +searchCmds search = concatMap (f $ lower search) + where + lower = map toLower + match s cmd = any (s `isInfixOf`) (map lower $ names cmd) + || s `isInfixOf` (lower $ help cmd) + f s cset = [(prefix cset, cmd) | cmd <- commands cset, match s cmd] + +------------------------------------------------------------------------------- +-- Showing +------------------------------------------------------------------------------- + +-- | Format a list of command names. +listNames :: Maybe Char -- ^ Optionally prepend the prefix char to names + -> Maybe Quotes -- ^ Optionally add quotes around the names + -> Bool -- ^ Whether to separate with commas (otherwise + -- spaces) + -> [String] -- ^ List of command names + -> String +listNames pref qs comma = + showNames qs (if comma then ", " else " ") . maybe id (map . (:)) pref + +-- | Format a list of the primary names of the given commands. +listPrimaryNames :: Maybe Char -- ^ Optionally prepend the prefix char to + -- names + -> Maybe Quotes -- ^ Optionally add quotes around the names + -> Bool -- ^ Whether to separate with commas + -- (otherwise spaces) + -> [Command e s] -- ^ List of commands + -> String +listPrimaryNames pref qs comma = listNames pref qs comma . map (head . names) diff --git a/src/Network/IRC/Fun/Bot/Chat.hs b/src/Network/IRC/Fun/Bot/Chat.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Chat.hs @@ -0,0 +1,45 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module provides IRC commands the bot can do within a bot session. +-- They conveniently wrap the details of IRC connections and messages. +module Network.IRC.Fun.Bot.Chat + ( -- * Connection Management + disconnect + --, reconnect + , quit + -- * Session Management + , run + , login + , pong + -- * Channels + , joinChannel + , joinMulti + , joinConfig + , partChannel + , partMulti + , partAll + -- * Sending Messages + , sendToChannel + , sendToUser + , failToChannel + , failToUser + -- * Other Utilities + , putIrc + ) +where + +import Network.IRC.Fun.Bot.Internal.Chat +import Network.IRC.Fun.Bot.Internal.Failure (failToChannel, failToUser) diff --git a/src/Network/IRC/Fun/Bot/Internal/Chat.hs b/src/Network/IRC/Fun/Bot/Internal/Chat.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Chat.hs @@ -0,0 +1,205 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Network.IRC.Fun.Bot.Internal.Chat + ( disconnect + --, reconnect + , quit + , run + , login + , pong + , joinChannel + , joinMulti + , joinConfig + , partChannel + , partMulti + , partAll + , sendToUser + , sendToChannel + , putIrc + ) +where + +import Control.Exception (bracket) +import Control.Monad.IO.Class (liftIO) +import Control.Monad.Trans.RWS (runRWST) +import Network.IRC.Fun.Bot.Internal.State +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Client.Commands +import Network.IRC.Fun.Client.IO (ircConnect, ircDisconnect, hPutIrc) +import Network.IRC.Fun.Messages.Types (Message) + +------------------------------------------------------------------------------- +-- Connection Management +------------------------------------------------------------------------------- + +-- | Disconnect from IRC by closing the bot's side of the connection. This +-- function is mainly provided for completeness and cases of error. You should +-- probably use the QUIT command of IRC to quit the network in a manner +-- coordinated with the server. +-- +-- After disconnection, make sure not to send more IRC commands. +disconnect :: Session e s () +disconnect = askHandle >>= liftIO . ircDisconnect + +-- Disconnect from the IRC server and connect again. This includes +-- identifying with the bot's nickname and joining IRC channels. +-- +-- This operation closes the bot session. It opens a new one, and returns it. +--botReconnect :: Session s (Session e s ()) +--botReconnect = do +-- disconnect + +-- | Finish the IRC session, asking the server to close the connection. +quit :: Maybe String -- ^ Optional message, e.g. the reason for quitting + -> Session e s () +quit reason = do + h <- askHandle + liftIO $ ircQuit h reason + +------------------------------------------------------------------------------- +-- Session Management +------------------------------------------------------------------------------- + +-- Run a bot session computation +runSession :: BotEnv e s -> BotState s -> Session e s a -> IO a +runSession bot state session = do + (a, _, _) <- runRWST session bot state + return a + +-- | Connect to an IRC server and run the bot session +run :: Config -- ^ IRC configuration + -> Behavior e s -- ^ Bot behavior definition + -> e -- ^ Custom bot environment (read-only state) + -> s -- ^ Initial custom bot state + -> Session e s a -- ^ Session definition + -> IO a +run conf beh env state session = do + putStrLn "Bot: Connecting to IRC server" + bracket + (ircConnect $ connection conf) + ircDisconnect + (\ h -> runSession (BotEnv conf beh h env) (BotState state) session) + +-- | Log in as an IRC user and identify with the bot's nickname and password. +-- This is the first thing to do after 'botConnect'ing to the server. +login :: Session e s () +login = do + h <- askHandle + conn <- askConfigS connection + liftIO $ ircLogin h conn False False + +-- | 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 +-- connection. The server closes the connection automatically if a PONG +-- response isn't sent from the client within a certain amount of time. +-- +-- Therefore, an IRC client (both humans users and bots) 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. +pong :: String -- ^ Server name + -> Maybe String -- ^ Optional server to forward to + -> Session e s () +pong server1 mserver2 = do + h <- askHandle + liftIO $ ircPong h server1 mserver2 + +------------------------------------------------------------------------------- +-- Channels +------------------------------------------------------------------------------- + +-- | Join an IRC channel. +joinChannel :: String -- ^ Channel name + -> Maybe String -- ^ Optional channel key (password) + -> Session e s () +joinChannel channel key = do + h <- askHandle + liftIO $ ircJoin h channel key + +-- | Join one or more IRC channels. +joinMulti :: [(String, Maybe String)] -- ^ List of channels and optional keys + -> Session e s () +joinMulti channels = do + h <- askHandle + liftIO $ ircJoinMulti h channels + +-- | Join the IRC channels listed in the configuration, without leaving any +-- other channels the bot already joined. +joinConfig :: Session e s () +joinConfig = do + chans <- askConfigS channels + joinMulti $ map (flip (,) Nothing) chans --TODO avoid unnecessary JOINs? + +-- | Leave an IRC channel. +partChannel :: String -- ^ Channel name + -> Maybe String -- ^ Optional part message, e.g. the reason for + -- leaving + -> Session e s () +partChannel channel reason = do + h <- askHandle + liftIO $ ircPart h channel reason + +-- | Leave one or more IRC channels. +partMulti :: [String] -- ^ List of channel names + -> Maybe String -- ^ Optional part message, e.g. the reason for + -- leaving + -> Session e s () +partMulti chans reason = do + h <- askHandle + liftIO $ ircPartMulti h chans reason + +-- | Leave all IRC channels the bot joined. +partAll :: Session e s () +partAll = askHandle >>= liftIO . ircPartAll + +------------------------------------------------------------------------------- +-- Sending Messages +------------------------------------------------------------------------------- + +-- | Send a message to an IRC channel. +-- +-- This usually requires that the bot joins the channel first, because many +-- channels have the +n flag set. This flag forbids sending a messages into +-- a channel from outside it. +sendToChannel :: String -- ^ The channel name + -> String -- ^ The message to send. It may contain newlines, in + -- which case it will be split into multiple messages + -- and sent sequentially. + -> Session e s () +sendToChannel channel msg = do + h <- askHandle + liftIO $ mapM_ (ircSendToChannel h channel) $ lines msg + +-- | Send a private message to an IRC user. +sendToUser :: String -- ^ The user's nickname + -> String -- ^ The message to send. It may contain newlines, in + -- which case it will be split into multiple messages + -- and sent sequentially. + -> Session e s () +sendToUser nick msg = do + h <- askHandle + liftIO $ mapM_ (ircSendToUser h nick) $ lines msg + +------------------------------------------------------------------------------- +-- Other Utilities +------------------------------------------------------------------------------- + +-- | Send an IRC message to the server. This should only be used if the other +-- wrappers don't provide what you need. If that's the case, it may be a good +-- idea for reusability to add a new wrapper. +putIrc :: Message -> Session e s () +putIrc msg = do + h <- askHandle + liftIO $ hPutIrc h msg diff --git a/src/Network/IRC/Fun/Bot/Internal/Event.hs b/src/Network/IRC/Fun/Bot/Internal/Event.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Event.hs @@ -0,0 +1,114 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Network.IRC.Fun.Bot.Internal.Event + ( matchEvent + , handleEvent + ) +where + +import Data.Char (isSpace) +import Data.List (find, isPrefixOf) +import Network.IRC.Fun.Bot.Internal.Chat (pong) +import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan) +import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS) +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Bot.Behavior (findCmd) +import qualified Network.IRC.Fun.Client.Events as C (Event (..)) +import Network.IRC.Fun.Client.IO (nick) +import Network.IRC.Fun.Client.Util (mentions) + +matchEvent :: C.Event -> Config -> [CommandSet e s] -> Event +matchEvent event conf csets = + case event of + C.Ping server1 server2 -> Ping server1 server2 + C.Kick channel nicks reason -> Kick channel nicks reason + C.Join channel nick -> Join channel nick + C.Part channel nick reason -> Part channel nick reason + C.Quit nick reason -> Quit nick reason + C.Mode -> other + C.ChannelMessage channel nick msg False + | not (null msg) && head msg `elem` map prefix csets -> + let w = words $ tail msg + in BotCommand channel nick (head msg) + (if null w then "" else head w) + (if null w then [] else tail w) + | bnick `isPrefixOf` msg -> + let msg' = drop (length bnick) msg + msg'' = + if null msg' + then [] + else dropWhile isSpace $ tail msg' + in if null msg' || head msg' `elem` ",:" + then BotMessage channel nick msg'' + else Message channel nick msg $ msg `mentions` bnick + | otherwise -> + Message channel nick msg $ msg `mentions` bnick + C.ChannelMessage channel nick msg True -> + Notice (Just channel) nick msg + C.PrivateMessage nick msg False -> PersonalMessage nick msg + C.PrivateMessage nick msg True -> Notice Nothing nick msg + C.Topic channel nick topic -> + TopicChange channel nick topic + C.Invite channel nick -> other + C.Names priv chan pnicks -> Names chan priv pnicks + C.OtherEvent s -> other + where + bnick = nick (connection conf) + other = OtherEvent $ show event + +-- Run the command with the given prefix character, command name and list of +-- parameters. If a command with the given prefix and name isn't found, the bot +-- sends a default friendly response. +runCommand :: Char -- Command prefix + -> String -- Command name + -> [String] -- List of parameters + -> String -- Channel in which the command was triggered + -> String -- Nickname of user who triggered the command + -> Session e s () +runCommand cpref cname cparams channel sender = do + csets <- askBehaviorS commandSets + case findCmd cpref cname csets of + Nothing -> + defaultRespondToChan channel cpref cname Nothing + Just (Left cset) -> + defaultRespondToChan channel cpref cname (Just cset) + Just (Right cmd) -> + respond cmd channel sender cparams + +-- | React to an IRC event. +handleEvent :: Event -> Session e s () +handleEvent event = do + b <- askBehavior + case event of + Ping s1 s2 -> pong s1 s2 + Kick chan users why -> return () + Join chan nick -> handleJoin b chan nick + Part chan nick why -> handlePart b chan nick why + Quit nick why -> handleQuit b nick why + Message chan sender msg mentioned -> + handleMsg b chan sender msg mentioned + Notice mchan sender msg -> return () + BotMessage chan sender msg -> + handleBotMsg b chan sender msg + BotCommand chan sender cpref cname cargs -> + runCommand cpref cname cargs chan sender + PersonalMessage sender msg -> + handlePersonalMsg b sender msg + TopicChange chan nick topic -> + handleTopicChange b chan nick topic + Names chan priv pnicks -> + handleNames b chan priv pnicks + OtherEvent s -> return () diff --git a/src/Network/IRC/Fun/Bot/Internal/Failure.hs b/src/Network/IRC/Fun/Bot/Internal/Failure.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Failure.hs @@ -0,0 +1,131 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Network.IRC.Fun.Bot.Internal.Failure + ( defaultRespondToChan + , defaultRespondToUser + , failToChannel + , failToUser + ) +where + +import Data.Char (toLower) +import Data.List (intercalate) +import Network.IRC.Fun.Bot.Internal.Chat (sendToChannel, sendToUser) +import Network.IRC.Fun.Bot.Internal.State (askBehaviorS) +import Network.IRC.Fun.Bot.Internal.Types +import Text.Printf (printf) + +-- Get the default response string in case the command isn't found in the sets. +-- This assumes the same response is set both to channels and to users in +-- private conversations, which could change in the future. Right now only +-- channel commands are supported by the bot anyway. +defaultResponse :: Char -- Command prefix that was triggered + -> String -- Command name that was triggered + -> [CommandSet e s] -- Available command sets + -> Maybe (CommandSet e s) -- The command set matching the + -- prefix, if one was found + -> String +defaultResponse cpref _cname csets Nothing = + printf "Expected to find a command with prefix ‘%v’, but there’s none. \ + \Available prefixes are: ‘%v’." + cpref $ + intercalate "’, ‘" $ map ((: []) . prefix) csets +defaultResponse cpref cname _csets (Just cset) = + printf "The command ‘%v%v’ isn’t available. Available commands for prefix \ + \‘%v’ are: ‘%v’." + cpref + cname + cpref $ + intercalate "’, ‘" $ map (head . names) $ commands cset + +-- | Send the default response to an IRC channel +defaultRespondToChan + :: String -- Target channel + -> Char -- Command prefix that was triggered + -> String -- Command name that was triggered + -> Maybe (CommandSet e s) -- The command set matching the prefix, is one + -- was found + -> Session e s () +defaultRespondToChan chan cpref cname cset = do + csets <- askBehaviorS commandSets + sendToChannel chan $ defaultResponse cpref cname csets cset + +-- | Send the default response to an IRC user +defaultRespondToUser + :: String -- Recipient nickname + -> Char -- Command prefix that was triggered + -> String -- Command name that was triggered + -> Maybe (CommandSet e s) -- The command set matching the prefix, is one + -- was found + -> Session e s () +defaultRespondToUser nick cpref cname cset = do + csets <- askBehaviorS commandSets + sendToUser nick $ defaultResponse cpref cname csets cset + +-- Determine number suffix when counting things +suffix :: Integral a => a -> String +suffix 1 = "st" +suffix 2 = "nd" +suffix 3 = "rd" +suffix _ = "th" + +-- Response message to send on failure +failureDescription :: Failure -> String +failureDescription failure = + case failure of + WrongNumArgs -> + "Wrong number of arguments" + WrongNumArgsN Nothing Nothing -> + failureDescription WrongNumArgs + WrongNumArgsN (Just given) Nothing -> + printf "Wrong number of arguments: %v given" given + WrongNumArgsN Nothing (Just expected) -> + printf "Wrong number of arguments: %v expected" expected + WrongNumArgsN (Just given) (Just expected) -> + printf "Wrong number of arguments: %v given, %v expected" + given + expected + InvalidArgs -> "Invalid arguments" + InvalidArg Nothing Nothing -> "Invalid argument found" + InvalidArg (Just pos) Nothing -> + printf "The %v%v argument is invalid" pos (suffix pos) + InvalidArg Nothing (Just param) -> + printf "Invalid argument: ‘%v’" param + InvalidArg (Just pos) (Just param) -> + printf "The %v%v argument is invalid: ‘%v’" pos (suffix pos) param + OtherFail s -> "Command failed: " ++ s + +-- | Send message explaining a failure to an IRC channel +failToChannel :: String -- ^ Target channel + -> String -- ^ User to whom to refer +-- -> Char -- ^ Command prefix that was triggered +-- -> String -- ^ Command name that was triggered + -> Failure -- ^ Problem indication + -> Session e s () +failToChannel chan nick {-_cpref _cname-} failure = + let lowerc [] = [] + lowerc (c:cs) = toLower c : cs + in sendToChannel chan $ + nick ++ ", " ++ lowerc (failureDescription failure) + +-- | Send message explaining a failure to an IRC user +failToUser :: String -- ^ Target user +-- -> Char -- ^ Command prefix that was triggered +-- -> String -- ^ Command name that was triggered + -> Failure -- ^ Problem indication + -> Session e s () +failToUser nick {-_cpref _cname-} failure = + sendToUser nick $ failureDescription failure diff --git a/src/Network/IRC/Fun/Bot/Internal/State.hs b/src/Network/IRC/Fun/Bot/Internal/State.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/State.hs @@ -0,0 +1,80 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Network.IRC.Fun.Bot.Internal.State + ( askConfig + , askConfigS + , askBehavior + , askBehaviorS + , askEnv + , askEnvS + , askHandle + , getState + , getStateS + , putState + , modifyState + ) +where + +import Control.Monad.Trans.RWS +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Client.IO (Handle) + +-- | Fetch the bot configuration. +askConfig :: Session e s Config +askConfig = asks config + +-- | Retrieve a function of the bot configuration. +askConfigS :: (Config -> a) -> Session e s a +askConfigS f = asks $ f . config + +-- | Fetch the bot behavior definition. +askBehavior :: Session e s (Behavior e s) +askBehavior = asks behavior + +-- | Retrieve a function of the bot behavior definition. +askBehaviorS :: (Behavior e s -> a) -> Session e s a +askBehaviorS f = asks $ f . behavior + +-- | Fetch the bot environment, i.e. read-only state. +askEnv :: Session e s e +askEnv = asks custom + +-- | Retrieve a function of the bot environment. +askEnvS :: (e -> a) -> Session e s a +askEnvS f = asks $ f . custom + +-- | Fetch the bot session socket handle. +askHandle :: Session e s Handle +askHandle = asks handle + +-- | Fetch the current value of the state within the session. +getState :: Session e s s +getState = gets public + +-- | Get a specific component of the state, using a projection function +-- supplied. +getStateS :: (s -> a) -> Session e s a +getStateS f = gets $ f . public + +-- | Set the state within the session. +putState :: s -> Session e s () +putState st = modify $ \ old -> old { public = st } + +-- | Update the state to the result of applying a function to the current +-- state. +modifyState :: (s -> s) -> Session e s () +modifyState f = + modify $ \ old@(BotState { public = st }) -> old { public = f st } diff --git a/src/Network/IRC/Fun/Bot/Internal/Types.hs b/src/Network/IRC/Fun/Bot/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Internal/Types.hs @@ -0,0 +1,248 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +module Network.IRC.Fun.Bot.Internal.Types + ( Config (..) + , Failure (..) + , Command (..) + , CommandSet (..) + , BotEnv (..) + , BotState (..) + , Session (..) + , ChannelPrivacy (..) + , Privilege (..) + , Event (..) + , Behavior (..) + , EventSource + , EventHandler + , Quotes (..) + ) +where + +import Control.Monad.Trans.RWS (RWST) +import Network.IRC.Fun.Client.IO (Connection, Handle) +import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..)) + +-- | Configuration for the bot connection to IRC. +data Config = Config + { -- | Connection details, including nickname and optional password + connection :: Connection + -- | List of channels to join, e.g. @["#freepost", "#rel4tion"]@ + , channels :: [String] + } + deriving (Eq, Show) + +-- | Describes wrong usage of a bot command. +data Failure + -- | The number of arguments given is wrong + = WrongNumArgs + -- | \ arguments were given, instead of \ + | WrongNumArgsN (Maybe Int) (Maybe Int) + -- | At least one of the arguments is invalid + | InvalidArgs + -- | Argument in position \ and value \ + -- invalid + | InvalidArg (Maybe Int) (Maybe String) + -- | Some other error, with a given description + | OtherFail String + deriving (Eq, Show) + +-- | A bot command, triggered by a message sent to an IRC channel the bot has +-- joined. +-- +-- The type parameter @e@ is the type of environment, i.e. real-only state. The +-- type parameter @s@ is the type of the writable state the bot holds. For +-- example, maybe you want your bot to keep a list of to-do items and manage it +-- using bot commands. The bot state is where you store the to-do list. +data Command e s = Command + { -- | The command's name string, e.g. @"echo"@. More than one name is + -- allowed per command, so that localized names and shortcuts can be made + -- available. + -- + -- The first name in the list is considered the /primary name/. When one + -- name is shown, e.g. in help messages, it will be the primary name. + names :: [String] + + -- | What to do in response to the command being triggered by an IRC + -- user. The bot can send an IRC message back to the channel, or modify + -- its state, or both. + -- + -- The returned value is in the 'Session' monad (it is really 'RWST' + -- behind the scenes), which allows the bot to access the configuration + -- and bot state, store and load data from files, communicate through the + -- network (e.g. download RSS feeds) and more. + -- + -- Parameters: + -- + -- (1) Channel in which the command was triggered + -- (2) Nickname of user who triggered the command + -- (3) Command parameters given + , respond :: String -> String -> [String] -> Session e s () + + -- | Help string for the command, explaining it purpose, its parameters + -- and its usage, possibly giving an example. May contain newlines. + , help :: String + } + +-- | The bot recognizes commands by picking IRC channel messages which begin +-- with a special character, the command prefix. It's possible to have several +-- prefixes, maybe give each its own role or meaning. A command set is a set of +-- commands which share a prefix. +-- +-- A command can be in more than one set. +-- +-- Common prefixes are @'!', '\@', '>', ':'@. +data CommandSet e s = CommandSet + { prefix :: Char + , commands :: [Command e s] + } + +-- Read-only bot environment. +-- +-- The full environment is exposed to commands, which is both power and +-- responsibility. For example, uncareful use of the handle (this is a handle +-- to the TCP socket) could cause parsing issues or disconnection. The 'Config' +-- contains the bot's nickname password, which shouldn't be shared publicly. +-- +-- At the same time, you can send any custom message you wish to the IRC +-- server, even if the libraries don't support it directly, or you could use +-- the password to automatically re-identify in case of any problem with +-- NickServ. And so on. +data BotEnv e s = BotEnv + { config :: Config + , behavior :: Behavior e s + , handle :: Handle + , custom :: e + } + +-- Readable and writable bot state. Contains internal state used by this +-- library, and public state managed by the bot's behavior logic. +newtype BotState s = BotState { public :: s } + +-- | Bot monad. It provides read-only bot environment (e.g. the configuration), +-- read-writable bot state (for use by bot commands) and IO. +type Session e s = RWST (BotEnv e s) () (BotState s) IO + +-- An event triggered by an IRC message sent from the server. +data Event + -- | A ping was sent to the bot. The parameters contain the arguments + -- passed, which should be passed in the Pong. + = Ping String (Maybe String) + -- | Users (2nd parameter) have been kicked from a channel (1st parameter) + -- for a given reason (3rd parameter). + | Kick String [String] (Maybe String) + -- | A user (2nd parameter) joined a channel (1st parameter). + | Join String String + -- | A user (2nd parameter) left a channel (1st parameter), 3rd=reason. + | Part String String (Maybe String) + -- | User, reason. + | Quit String (Maybe String) + -- | Message (3rd parameter) sent in a channel (1st parameter) by a user + -- with the given nickname (2nd parameter). The last parameter says whether + -- the bot's nick is mentioned in the message. + | Message String String String Bool + -- | Like 'Message', but this is a notice. The bot shouldn't send a + -- response (but it can modify its state etc.). First parameter: Just + -- channel, or Nothing. The latter means a private message. + | Notice (Maybe String) String String + -- | Message (3rd parameter) referring to the bot sent by nick (2nd + -- parameter) in a channel (1st parameter). The message begins with the + -- bot's nick, followed by a colon or a comma. That part is however removed + -- from the 3rd parameter. For example, if the message was + -- \"funbot, hello!\" then the 3rd parameter will be \"hello!\". + | BotMessage String String String + -- | A bot command, which is a message with a special prefix, was sent to + -- a channel. Parameters: Channel, sender nickname, prefix character, + -- command name, command arguments. + | BotCommand String String Char String [String] + -- | A private message sent specifically to the bot, from a user with the + -- given nickname (1st parameter) and with the given content (2nd + -- parameter). + | PersonalMessage String String + -- | Channel, nickname, topic + | TopicChange String String String + -- | Unrecognized or unimplemented event. The parameter contains (possibly + -- empty) input. + | OtherEvent String + -- | 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 String ChannelPrivacy [(Privilege, String)] + deriving Show + +-- | Bot behavior definition. +data Behavior e s = Behavior + { handleJoin :: String -> String -> Session e s () + , handlePart :: String -> String -> Maybe String -> Session e s () + , handleQuit :: String -> Maybe String -> Session e s () + , handleMsg :: String -> String -> String -> Bool -> Session e s () + , handleBotMsg :: String -> String -> String -> Session e s () + , commandSets :: [CommandSet e s] + , handlePersonalMsg :: String -> String -> Session e s () + , handleTopicChange :: String -> String -> String -> Session e s () + -- | Handle a channel member list received. Parameters: + -- + -- (1) Channel name + -- (2) Channel privacy + -- (3) List of channel members: their privilege level in the channel and + -- their nicknames + , handleNames :: String + -> ChannelPrivacy + -> [(Privilege, String)] + -> Session e s () + } + +-- | An 'IO' action, possibly running forever, which produces events for the +-- bot to process. These event sources are run by the bot in dedicated threads. +-- +-- Type parameters: +-- +-- * @e@ - custom bot environment type +-- * @s@ - custom bot state type +-- * @a@ - event type +type EventSource e s a + = Config + -- ^ The bot configuration. The event source may find this useful. + -> e + -- ^ The bot's custom environment. The event source may find this useful. + -> (a -> IO ()) + -- ^ A non-blocking 'IO' action which sends a given event to the + -- processing queue. + -> ([a] -> IO ()) + -- ^ A non-blocking 'IO' action which sends a given list of events to the + -- processing queue. + -> IO () + +-- | A bot session action which reacts to a single event which came from an +-- 'EventSource'. +-- +-- Type parameters: +-- +-- * @e@ - custom bot environment type +-- * @s@ - custom bot state type +-- * @a@ - event type +type EventHandler e s a = a -> Session e s () + +-- | Quote types for string formatting. +data Quotes + -- | Single quote on each side of the formatted string. The parameter sets + -- whether to use Unicode (otherwise use ASCII fallback). + = SingleQuotes Bool + -- | Double quote on each side of the formatted string. The parameter sets + -- whether to use Unicode (otherwise use ASCII fallback). + | DoubleQuotes Bool + -- | Backtick on each side of the formatted string. + | BackTicks + deriving (Eq, Show) diff --git a/src/Network/IRC/Fun/Bot/State.hs b/src/Network/IRC/Fun/Bot/State.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/State.hs @@ -0,0 +1,32 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module provides access functions for working with the state stored +-- within a bot session. +module Network.IRC.Fun.Bot.State + ( askConfig + , askConfigS + , askBehavior + , askBehaviorS + , askEnv + , askEnvS + , getState + , getStateS + , putState + , modifyState + ) +where + +import Network.IRC.Fun.Bot.Internal.State diff --git a/src/Network/IRC/Fun/Bot/Types.hs b/src/Network/IRC/Fun/Bot/Types.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Types.hs @@ -0,0 +1,32 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module provides the datatypes. +module Network.IRC.Fun.Bot.Types + ( Connection (..) + , Config (..) + , Failure (..) + , Command (..) + , CommandSet (..) + , Session + , Behavior (..) + , EventSource + , EventHandler + , Quotes (..) + ) +where + +import Network.IRC.Fun.Bot.Internal.Types +import Network.IRC.Fun.Client.IO (Connection (..)) diff --git a/src/Network/IRC/Fun/Bot/Util.hs b/src/Network/IRC/Fun/Bot/Util.hs new file mode 100644 --- /dev/null +++ b/src/Network/IRC/Fun/Bot/Util.hs @@ -0,0 +1,50 @@ +{- This file is part of irc-fun-bot. + - + - Written in 2015 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | This module collects smaller general purpose utilities which may be useful +-- to bot authors. +module Network.IRC.Fun.Bot.Util + ( quote + , maybeQuote + , showNames + ) +where + +import Data.List (intercalate) +import Network.IRC.Fun.Bot.Types (Quotes (..)) + +-- | Add quotes to a string. +quote :: Quotes -> String -> String +quote (SingleQuotes True) s = '‘' : s ++ "’" +quote (SingleQuotes False) s = '\'' : s ++ "'" +quote (DoubleQuotes True) s = '“' : s ++ "”" +quote (DoubleQuotes False) s = '"' : s ++ "\"" +quote BackTicks s = '`' : s ++ "`" + +-- | Optionally add quotes to a string. +maybeQuote :: Maybe Quotes -> String -> String +maybeQuote = maybe id quote + +-- | Format a list of labels. +-- +-- >>> putStrLn $ showNames (Just $ SingleQuotes False) +-- >>> ", " +-- >>> ["one", "two", "three"] +-- 'one', 'two', 'three' +showNames :: Maybe Quotes -- ^ Optionally wrap labels with quotes + -> String -- ^ Separate between labels, e.g. spaces or newline + -> [String] -- ^ List of labels + -> String +showNames qs sep = intercalate sep . map (maybeQuote qs)