diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -3,7 +3,7 @@ $ darcs changes --repo http://dev.rel4tion.org/fr33domlover/irc-fun-bot -There is also a web interface at which, among other +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 diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -3,6 +3,33 @@ +irc-fun-bot 0.3.0.0 -- 2015-09-22 +================================= + +General, build and documentation changes: + +* (None) + +New APIs, features and enhancements: + +* Allow sending commands in private messages +* Version control support (via Git) for state file +* Nick change event available, and new nick tracker action: changeNick +* New config option, stateRepo, to specify the git repo for state file + +Bug fixes: + +* (None) + +Dependency changes: + +* Add json-state +* Require irc-fun-client >= 0.2.0.0 + + + + + irc-fun-bot 0.2.0.0 -- 2015-09-10 ================================= diff --git a/irc-fun-bot.cabal b/irc-fun-bot.cabal --- a/irc-fun-bot.cabal +++ b/irc-fun-bot.cabal @@ -1,5 +1,5 @@ name: irc-fun-bot -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Library for writing fun IRC bots. description: One day an idea came up on the #freepost IRC channel: We didn't need much of @@ -52,9 +52,9 @@ build-depends: aeson , base >=4.7 && <5 , fast-logger - , irc-fun-client >=0.1.1.0 + , irc-fun-client >=0.2.0.0 , irc-fun-messages - , settings + , json-state , time , time-interval , time-units diff --git a/src/Network/IRC/Fun/Bot/Behavior.hs b/src/Network/IRC/Fun/Bot/Behavior.hs --- a/src/Network/IRC/Fun/Bot/Behavior.hs +++ b/src/Network/IRC/Fun/Bot/Behavior.hs @@ -54,6 +54,7 @@ , handleBotMsg = \ _ _ _ -> return () , commandSets = [] , handlePersonalMsg = \ _ _ -> return () + , handleNickChange = \ _ _ -> return () , handleTopicChange = \ _ _ _ -> return () , handleNames = \ _ _ _ -> return () } diff --git a/src/Network/IRC/Fun/Bot/Chat.hs b/src/Network/IRC/Fun/Bot/Chat.hs --- a/src/Network/IRC/Fun/Bot/Chat.hs +++ b/src/Network/IRC/Fun/Bot/Chat.hs @@ -34,12 +34,14 @@ -- * Sending Messages , sendToChannel , sendToUser + , sendBack , failToChannel , failToUser + , failBack -- * Other Utilities , putIrc ) where import Network.IRC.Fun.Bot.Internal.Chat -import Network.IRC.Fun.Bot.Internal.Failure (failToChannel, failToUser) +import Network.IRC.Fun.Bot.Internal.Failure diff --git a/src/Network/IRC/Fun/Bot/Internal/Chat.hs b/src/Network/IRC/Fun/Bot/Internal/Chat.hs --- a/src/Network/IRC/Fun/Bot/Internal/Chat.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Chat.hs @@ -28,6 +28,7 @@ , partAll , sendToUser , sendToChannel + , sendBack , putIrc ) where @@ -200,6 +201,18 @@ sendToUser nick msg = do h <- askHandle liftIO $ mapM_ (ircSendToUser h nick) $ lines msg + +-- | Send a message back to the sender. If a channel is specified, send to the +-- channel. If not, send a private message. +sendBack :: Maybe String -- ^ Channel name, specify if replying to a message + -- sent in a channel. Otherwise pass 'Nothing'. + -> String -- ^ The sender 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 () +sendBack (Just chan) _nick msg = sendToChannel chan msg +sendBack Nothing nick msg = sendToUser nick msg ------------------------------------------------------------------------------- -- Other Utilities diff --git a/src/Network/IRC/Fun/Bot/Internal/Event.hs b/src/Network/IRC/Fun/Bot/Internal/Event.hs --- a/src/Network/IRC/Fun/Bot/Internal/Event.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Event.hs @@ -46,8 +46,8 @@ import qualified Data.HashMap.Lazy as M import Data.Maybe (catMaybes, fromMaybe, maybeToList) import Data.List (stripPrefix) -import Network.IRC.Fun.Bot.Internal.Chat (pong) -import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan) +import Network.IRC.Fun.Bot.Internal.Chat (pong, sendBack) +import Network.IRC.Fun.Bot.Internal.Failure import Network.IRC.Fun.Bot.Internal.Nicks import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS) import Network.IRC.Fun.Bot.Internal.Types hiding (Logger) @@ -304,6 +304,7 @@ C.ChannelMessage channel nick msg False -> Just $ Message channel nick msg $ msg `mentions` bnick C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg + C.NickChange oldnick newnick -> Just $ NickChange oldnick newnick C.Topic channel nick topic -> Just $ TopicChange channel nick topic C.Names priv chan pnicks -> Just $ Names chan priv pnicks _ -> Nothing @@ -344,21 +345,29 @@ -- 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 :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix - -> String -- Command name - -> [String] -- List of parameters - -> String -- Channel in which the command was triggered - -> String -- Nickname of user who triggered the command +runCommand :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix + -> String -- Command name + -> [String] -- List of parameters + -> Maybe 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 +runCommand cpref cname cparams mchan sender = do csets <- askBehaviorS commandSets case findCommand cpref cname csets of Nothing -> - defaultRespondToChan channel cpref cname Nothing + case mchan of + Just chan -> defaultRespondToChan chan cpref cname Nothing + Nothing -> defaultRespondToUser sender cpref cname Nothing Just (Left cset) -> - defaultRespondToChan channel (Just $ prefix cset) cname (Just cset) + case mchan of + Just chan -> + defaultRespondToChan + chan (Just $ prefix cset) cname (Just cset) + Nothing -> + defaultRespondToUser + sender (Just $ prefix cset) cname (Just cset) Just (Right cmd) -> - respond cmd channel sender cparams + respond cmd mchan sender cparams (sendBack mchan sender) -- React to a bot event. handleBotEvent :: Event -> Session e s () @@ -383,9 +392,13 @@ Notice mchan sender msg -> return () BotMessage chan sender msg -> handleBotMsg b chan sender msg BotCommand (Channel chan sender) cpref cname cargs -> - runCommand cpref cname cargs chan sender - BotCommand _ _ _ _ -> return () + runCommand cpref cname cargs (Just chan) sender + BotCommand (User sender) cpref cname cargs -> + runCommand cpref cname cargs Nothing sender PersonalMessage sender msg -> handlePersonalMsg b sender msg + NickChange oldnick newnick -> do + changeNick oldnick newnick + handleNickChange b oldnick newnick TopicChange chan nick topic -> handleTopicChange b chan nick topic Names chan priv pnicks -> do tracked <- channelIsTracked chan diff --git a/src/Network/IRC/Fun/Bot/Internal/Failure.hs b/src/Network/IRC/Fun/Bot/Internal/Failure.hs --- a/src/Network/IRC/Fun/Bot/Internal/Failure.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Failure.hs @@ -18,12 +18,13 @@ , defaultRespondToUser , failToChannel , failToUser + , failBack ) where import Data.Char (toLower) import Data.List (intercalate) -import Network.IRC.Fun.Bot.Internal.Chat (sendToChannel, sendToUser) +import Network.IRC.Fun.Bot.Internal.Chat (sendToChannel, sendToUser, sendBack) import Network.IRC.Fun.Bot.Internal.State (askBehaviorS) import Network.IRC.Fun.Bot.Internal.Types import Text.Printf (printf) @@ -58,7 +59,7 @@ :: String -- Target channel -> Maybe Char -- Command prefix that was triggered -> String -- Command name that was triggered - -> Maybe (CommandSet e s) -- The command set matching the prefix, is one + -> Maybe (CommandSet e s) -- The command set matching the prefix, if one -- was found -> Session e s () defaultRespondToChan chan cpref cname cset = do @@ -110,24 +111,29 @@ 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 +-- | 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 = +failToChannel chan nick 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 +-- | 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 = +failToUser nick failure = sendToUser nick $ failureDescription failure + +-- | Send message explaining a failure back to the sender. +failBack :: Maybe String -- ^ Optional target channel, 'Nothing' means private + -- message + -> String -- ^ Target user nickname + -> Failure -- ^ Problem indication + -> Session e s () +failBack (Just chan) nick failure = failToChannel chan nick failure +failBack Nothing nick failure = failToUser nick failure diff --git a/src/Network/IRC/Fun/Bot/Internal/Nicks.hs b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs --- a/src/Network/IRC/Fun/Bot/Internal/Nicks.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Nicks.hs @@ -24,6 +24,7 @@ , isInChannel , presence , addMember + , changeNick , addChannel , removeMemberOnce , removeMember @@ -134,6 +135,13 @@ addMember chan nick = modify $ \ s -> s { tracker = f $ tracker s } where f = NT.addToChannel chan nick + +-- | Record a nickname change. Remove old nickname from the channels in which +-- it's present, and add the new nickname to them. +changeNick :: String -> String -> Session e s () +changeNick old new = modify $ \ s -> s { tracker = f $ tracker s } + where + f = NT.changeNick old new -- | Record a channel with the given present nicknames. addChannel :: String -> [String] -> Session e s () diff --git a/src/Network/IRC/Fun/Bot/Internal/Persist.hs b/src/Network/IRC/Fun/Bot/Internal/Persist.hs --- a/src/Network/IRC/Fun/Bot/Internal/Persist.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Persist.hs @@ -24,13 +24,13 @@ where import Control.Applicative -import Control.Monad (mzero) +import Control.Monad (liftM, mzero) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.RWS import Data.Aeson import qualified Data.HashMap.Lazy as M import Data.Maybe (isJust) -import Data.Settings.Persist +import Data.JsonState import Data.Time.Interval import Data.Time.Units (Microsecond) import Network.IRC.Fun.Bot.Internal.IrcLog (makeLogger) @@ -89,7 +89,8 @@ loadBotState :: BotEnv e s -> s -> IO (BotState s) loadBotState env pub = do - r <- loadSettings $ stateFile $ config env + let conf = config env + r <- loadState $ stateFilePath (stateFile conf) (stateRepo conf) case r of Left (False, e) -> error $ "Failed to read state file: " ++ e Left (True, e) -> error $ "Failed to parse state file: " ++ e @@ -98,7 +99,8 @@ mkSaveBotState :: Config -> IO (BotState s -> IO ()) mkSaveBotState conf = let iv = fromInteger $ microseconds $ saveInterval conf :: Microsecond - in mkSaveSettings iv (stateFile conf) + msg = "auto commit by irc-fun-bot" + in mkSaveStateChoose iv (stateFile conf) (stateRepo conf) msg saveBotState :: Session e s () saveBotState = do diff --git a/src/Network/IRC/Fun/Bot/Internal/Types.hs b/src/Network/IRC/Fun/Bot/Internal/Types.hs --- a/src/Network/IRC/Fun/Bot/Internal/Types.hs +++ b/src/Network/IRC/Fun/Bot/Internal/Types.hs @@ -55,9 +55,15 @@ -- | Directory path under which IRC log files will be placed. Relative to -- the bot process working directory, or absolute. , logDir :: FilePath + -- | Directory path for the state file. This enables Git commits of the + -- state file. A relative (to the bot process working dir) or absolute + -- path to the Git repository. You must create the directory yourself if + -- it doesn't exist, but repo will be auto-created for you if needed. + , stateRepo :: Maybe FilePath -- | Filename into the bot state managed by this library will be stored. - -- The custom part of the state isn't handled. Path relative to the bot - -- process working directory, or absolute. + -- The custom part of the state isn't handled. If 'stateDir' is + -- 'Nothing', this is a path relative to the bot process working + -- directory, or absolute. Otherwise, it's relative to the 'stateDir'. , stateFile :: FilePath -- | Minimal time interval between state saves. For example, to say -- \"don't write state to file more than once per three seconds\", set @@ -118,10 +124,16 @@ -- -- Parameters: -- - -- (1) Channel in which the command was triggered + -- (1) Channel in which the command was triggered, if any -- (2) Nickname of user who triggered the command -- (3) Command parameters given - , respond :: String -> String -> [String] -> Session e s () + -- (4) Action for sending a message back to the sender, same as using + -- @sendBack@ with the channel and nickname + , respond :: Maybe String + -> String + -> [String] + -> (String -> Session e s ()) + -> Session e s () -- | Help string for the command, explaining it purpose, its parameters -- and its usage, possibly giving an example. May contain newlines. @@ -215,6 +227,8 @@ -- given nickname (1st parameter) and with the given content (2nd -- parameter). | PersonalMessage String String + -- | Old nick, new nick. + | NickChange String String -- | Channel, nickname, topic | TopicChange String String String -- | The server sent a list of nicknames present in a channel. Parameters: @@ -238,6 +252,7 @@ , handleBotMsg :: String -> String -> String -> Session e s () , commandSets :: [CommandSet e s] , handlePersonalMsg :: String -> String -> Session e s () + , handleNickChange :: String -> String -> Session e s () , handleTopicChange :: String -> String -> String -> Session e s () -- | Handle a channel member list received. Parameters: --