{- This file is part of funbot.
-
- Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
module FunBot.Commands
( commandSet
)
where
import Control.Monad (unless)
import Data.List (find, intercalate)
import Data.Settings.Types (showOption)
import FunBot.History (quote)
import FunBot.Memos (submitMemo)
import FunBot.Settings
import FunBot.Types (BotSession)
import FunBot.UserOptions
import Network.IRC.Fun.Bot.Behavior
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.State
import Network.IRC.Fun.Bot.Types
import Text.Printf (printf)
import Text.Read (readMaybe)
-- | The main command set, the only one currently
commandSet = CommandSet
{ csetPrefix = '!'
, csetCommands =
[ makeCmdHelp commandSet
, cmdInfo
, cmdEcho
, cmdPTell
, cmdCTell
, cmdGet
, cmdSet
, cmdReset
, cmdEnable
, cmdDisable
, cmdAddSpec
, cmdDeleteSpec
, cmdAddRepo
, cmdDeleteRepo
, cmdVisit
, cmdJoin
, cmdLeave
, cmdQuote
, cmdShowOpts
, cmdEnableHistory
, cmdDisableHistory
, cmdSetLines
, cmdEraseOpts
]
}
-------------------------------------------------------------------------------
-- Echo command
-- Send the input back to the IRC channel
-------------------------------------------------------------------------------
respondEcho _mchan _nick [] send = send " "
respondEcho _mchan _nick [param] send = send param
respondEcho _mchan _nick params send = send $ unwords params
cmdEcho = Command
{ cmdNames = ["echo"]
, cmdRespond = respondEcho
, cmdHelp = "‘echo <text>’ - display the given text. Probably not a \
\useful command. Exists as an example and for testing."
}
-------------------------------------------------------------------------------
-- Help command
-- Show command help strings
-------------------------------------------------------------------------------
-- Return a response function given a CommandSet
respondHelp cset _mchan _nick [cname] send =
case find ((cname' `elem`) . cmdNames) $ csetCommands cset of
Just cmd -> send $ cmdHelp cmd
++ "\nCommand names: "
++ listNames Nothing Nothing True (cmdNames cmd)
Nothing -> do
succ <- respondSettingsHelp cname send
unless succ $ send $ printf
"No such command, or invalid settings path. \
\Maybe try just ‘%vhelp’ without a parameter."
(csetPrefix cset)
where
cname' = case cname of
[] -> cname
(c:cs) -> if c == csetPrefix cset then cs else cname
respondHelp cset _mchan _nick _params send =
send $ cmdHelp (makeCmdHelp cset)
++ "\nAvailable commands: "
++ listPrimaryNames
(Just $ csetPrefix cset)
Nothing False
(csetCommands cset)
makeCmdHelp cset = Command
{ cmdNames = ["help", "Help", "h", "?"]
, cmdRespond = respondHelp cset
, cmdHelp =
"‘help [<command> | <setting>]’ - display help for the given \
\command or settings option/section. Also see ‘info’.\n\
\FunBot intends to provide interactive help, but some topics \
\may be missing. If that's the case, check out the user \
\manual (call ‘!info links’ for the URL) or ask in #freepost."
}
-------------------------------------------------------------------------------
-- Info command
-- Ask the bot to display some information
-------------------------------------------------------------------------------
topics =
[ ( "intro"
, "I’m fpbot. An instance of funbot, written in Haskell. I run in \
\#freepost (and some extra channels). Developed in the Freepost \
\community, I exist for fun, collaboration and learning. But I also \
\aim to provide useful tools, in particular to Freepost and related \
\projects and communities.\n\
\You can start by trying ‘!help’."
)
, ( "features"
, "This is a high-level list of features and subsystems I provide. It \
\will hopefully be kept up-to-date by updating it every time new \
\features are added.\n\
\• Help and information system (!help, !info)\n\
\• A settings system (!get, !set, etc.)\n\
\• Announcing commits, tags, merge requests, etc. in Git \
\repositories\n\
\• Announcing RSS/Atom feed items\n\
\• Leaving memos (requires enabling nick tracking for the channel)\n\
\• Announcing titles of URLs\n\
\• Logging and reporting channel activity\n\
\• Accepting events via an HTTP API, e.g. pastes added to a paste \
\bin\n\
\There is also an overview of the bot API features, useful to \
\contributors/developers, in the guide at \
\<http://rel4tion.org/projects/funbot/guide>."
)
, ( "contrib"
, "Thinking about contributing to my development? Opening a ticket, \
\fixing a bug, implementing a feature? Check out the project page at \
\<http://rel4tion.org/projects/funbot>, which links to the \
\contribution guide, to the tickets page and more."
)
, ( "copying"
, "♡ Copying is an act of love. Please copy, reuse and share me! Grab a \
\copy of me from <https://notabug.org/fr33domlover/funbot>."
)
, ( "links"
, "Website: http://rel4tion.org/projects/funbot\n\
\Code: https://notabug.org/fr33domlover/funbot\n\
\Tickets: http://rel4tion.org/projects/funbot/tickets\n\
\Roadmap: http://rel4tion.org/projects/funbot/ideas\n\
\Dev guide: http://rel4tion.org/projects/funbot/guide\n\
\User manual: http://rel4tion.org/projects/funbot/manual"
)
, ( "git-ann"
, "I can announce development related events, such as git commits and \
\merge requests. To see the list of repos being announced and their \
\settings, run ‘!get repos’. Each repo has a list of specifications, \
\one per target channel (most projects announce to a single channel, \
\some announce to two). You can modify the spec details using the \
\settings system (!get, !set, etc.). To add a new spec (channel) to \
\an existing repo, use the !add-spec command. To remove a spec, use \
\!delete-spec. To add and remove repos, use !add-repo and \
\!delete-repo respectively."
)
, ( "feeds"
, "TODO"
)
, ( "memos"
, "TODO"
)
, ( "channels"
, "Using bot commands, you can ask me to leave and join channels. The \
\list of channels I'm present in can therefore be controlled \
\dynamically. However, there is also an additional list of channels \
\in my configuration (in the source). Using !visit, you can ask me to \
\briefly join a channel. But I won't remember it next time. To make \
\me a permanent member, use !join. You can ask me to leave a channel \
\using !leave."
)
, ( "chan-history"
, "When you join a channel, I can send you the last messages sent there \
\so that you’ll know what was happenig before you came. You can \
\enable this per channel, and set the number of last messages you’d \
\like to see per channel. Note that the number of messages you’ll get \
\also depends on how many messages I myself remember for this \
\purpose (which is set in the Config.hs source file). See \
\‘!info user-options’ for usage instructions."
)
, ( "user-options"
, "I keep private per-user options which affect our interaction. These \
\options are /separate/ from the public settings system. The commands \
\for managing them are available only in private messages to me, and \
\don't work in IRC channels. You can view your preferences using \
\!show-opts. Edit them using !enable-history, !disable-history and \
\!set-history-lines. Reset them to defaults using !erase-opts."
)
, ( "quotes"
, "See the !quote command. It works, but quotes aren’t being \
\automatically published, so perhaps it isn’t very useful at the \
\moment. Perhaps unless you setup the publishing yourself."
)
]
respondInfo _mchan _nick [] send =
send $ "Topics: " ++ intercalate ", " (map fst topics)
respondInfo mchan nick [arg] send =
case lookup arg topics of
Just msg -> send msg
Nothing -> failBack mchan nick $ InvalidArg (Just 1) (Just arg)
respondInfo mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing
cmdInfo = Command
{ cmdNames = ["info", "i"]
, cmdRespond = respondInfo
, cmdHelp = "‘info’ - list topics. Also see ‘help’.\n\
\‘info <topic>’ - display topic information."
}
-------------------------------------------------------------------------------
-- Tell command
-- Tell something to some other user
-------------------------------------------------------------------------------
-- Given whether to always send privately, return a command response
respondTell priv mchan sender (recip:msghead:msgtail) _send =
submitMemo sender mchan recip priv (unwords $ msghead : msgtail)
respondTell _priv mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing
cmdPTell = Command
{ cmdNames = ["tell", "ptell"]
, cmdRespond = respondTell True
, cmdHelp =
"‘tell <nick> <text>’ - leave a memo for a user to see later. \
\Memos can be sent to the recipient privately, or publicly \
\in the channel in which they were submitted. With this \
\command, the memo will be sent privately. If that isn't your \
\intention, see the ctell command."
}
cmdCTell = Command
{ cmdNames = ["ctell"]
, cmdRespond = respondTell False
, cmdHelp =
"‘tell <nick> <text>’ - leave a memo for a user to see later. \
\Memos can be sent to the recipient privately, or publicly \
\in the channel in which they were submitted. With this \
\command, the memo will be sent in the same way it was \
\submitted: If you submit it in a channel, it will be sent to \
\the recipient in the same channel. If you submit using a \
\private message to me, I will also send it privately to the \
\recipient.\n\
\If that isn't your intention, see the tell command."
}
-------------------------------------------------------------------------------
-- Get, set, enable and disable commands
-- Manage bot settings
-------------------------------------------------------------------------------
respondGet _mchan _nick [] send = respondGet' "" send
respondGet _mchan _nick [path] send = respondGet' path send
respondGet mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
respondSet _mchan _nick [name, val] send = respondSet' name val send
respondSet mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2)
respondReset _mchan _nick [name] send = respondReset' name send
respondReset mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
-- Given a boolean, create an enable/disable response accordingly
respondBool val _mchan _nick [name] send =
respondSet' name (showOption val) send
respondBool _val mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
respondEnable = respondBool True
respondDisable = respondBool False
cmdGet = Command
{ cmdNames = ["get"]
, cmdRespond = respondGet
, cmdHelp = "‘get <option>’ - get the value of a settings option at the \
\given path"
}
cmdSet = Command
{ cmdNames = ["set"]
, cmdRespond = respondSet
, cmdHelp = "‘set <option> <value>’ - set a settings option at the \
\given path to the given value"
}
cmdReset = Command
{ cmdNames = ["reset"]
, cmdRespond = respondReset
, cmdHelp = "‘reset <option>’ - set a settings option at the given \
\path to its default value"
}
cmdEnable = Command
{ cmdNames = ["enable"]
, cmdRespond = respondEnable
, cmdHelp = "‘enable <option>’ - set a settings option at the given \
\path to True"
}
cmdDisable = Command
{ cmdNames = ["disable"]
, cmdRespond = respondDisable
, cmdHelp = "‘disable <option>’ - set a settings option at the given \
\path to False"
}
-------------------------------------------------------------------------------
-- Add-spec, delete-spec, add-repo, delete-repo commands
-- Manage git repo event announcement details
-------------------------------------------------------------------------------
respondAddSpec mchan nick [repo, owner, chan] send = do
succ <- addPushAnnSpec repo owner chan
if succ
then send "Git event announcement spec added."
else failBack mchan nick $ OtherFail "No such repo/owner pair found."
respondAddSpec mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 3)
cmdAddSpec = Command
{ cmdNames = ["add-spec"]
, cmdRespond = respondAddSpec
, cmdHelp = "‘add-spec <repo> <owner> <channel>’ - add a channel to \
\which git repo events will be announced, with default \
\settings"
}
respondDeleteSpec mchan nick [repo, owner, num] send =
case readMaybe num of
Nothing -> failBack mchan nick $ InvalidArg (Just 3) (Just num)
Just pos ->
if pos < 1
then failBack mchan nick $ InvalidArg (Just 3) (Just num)
else do
res <- deletePushAnnSpec repo owner (pos - 1)
case res of
Nothing -> send $ "Git event announcement spec "
++ num
++ " removed."
Just False -> failBack mchan nick $ OtherFail
"No such repo/owner pair found."
Just True -> failBack mchan nick $ OtherFail
"Spec number out of range."
respondDeleteSpec mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 3)
cmdDeleteSpec = Command
{ cmdNames = ["delete-spec"]
, cmdRespond = respondDeleteSpec
, cmdHelp = "‘delete-spec <repo> <owner> <num>’ - remove a git event \
\announcement specification with the given index number \
\(as found in the settings tree, i.e. starting from 1) \
\from the given repo."
}
invalid s = null s || '/' `elem` s
respondAddRepo mchan nick [repo, owner, chan] send
| invalid repo =
failBack mchan nick $ InvalidArg (Just 1) (Just repo)
| invalid owner =
failBack mchan nick $ InvalidArg (Just 2) (Just owner)
| otherwise = do
succ <- addRepo repo owner chan
if succ
then send "Git repo added."
else failBack mchan nick $ OtherFail
"This repo is already registered."
respondAddRepo mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 3)
cmdAddRepo = Command
{ cmdNames = ["add-repo"]
, cmdRespond = respondAddRepo
, cmdHelp = "‘add-repo <repo> <owner> <channel>’ - add a repo to \
\announce its events in the given channel, with default \
\settings."
}
respondDeleteRepo mchan nick [repo, owner] send = do
succ <- deleteRepo repo owner
if succ
then send "Git repo removed."
else failBack mchan nick $ OtherFail "No such repo/owner pair found."
respondDeleteRepo mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2)
cmdDeleteRepo = Command
{ cmdNames = ["delete-repo"]
, cmdRespond = respondDeleteRepo
, cmdHelp = "‘delete-repo <repo> <owner>’ - stop announcing events for \
\the given repo and remove its settings."
}
-------------------------------------------------------------------------------
-- Visit, join, leave commands
-- Manage bot channels
-------------------------------------------------------------------------------
respondVisit _mchan _nick [chan] send = do
memb <- botMemberOf chan
send $ if memb
then "I'm already a member of that channel. I think. Trying anyway."
else "Visiting " ++ chan
joinChannel chan Nothing
respondVisit mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
cmdVisit = Command
{ cmdNames = ["visit"]
, cmdRespond = respondVisit
, cmdHelp =
"‘visit <channel>’ - ask the bot to join a given channel, \
\without storing state. So the bot won't remember to join it \
\next time and default settings will be used. This is useful \
\for short tests perhaps. If you'd like the bot to become a \
\permanent member, use !join."
}
respondJoin _mchan _nick [chan] send = do
memb <- botMemberOf chan
sel <- channelSelected chan
send $ if memb && sel
then "I'm already a member of that channel. I think. Trying anyway."
else "Becoming a member of " ++ chan
joinChannel chan Nothing
addChannel chan
respondJoin mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
cmdJoin = Command
{ cmdNames = ["join"]
, cmdRespond = respondJoin
, cmdHelp =
"‘join <channel>’ - ask the bot to join a given channel, and \
\make them a permanent member, automatically joining on bot \
\restart. You can use !leave to make the bot leave. To invite \
\the bot just for a temporary session, use !visit."
}
respondLeave Nothing _nick [] send = send "This works only in a channel."
respondLeave (Just chan) nick [] send = do
unselectChannel chan
send $ "Leaving the channel for now. Bye! o/"
partChannel chan $ Just $ "Asked by " ++ nick ++ " to leave"
respondLeave mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 0)
cmdLeave = Command
{ cmdNames = ["leave"]
, cmdRespond = respondLeave
, cmdHelp =
"‘leave’ - ask the bot to leave the current channel, i.e. the \
\one in which this command has been used. If the channel was \
\selected for auto-joining, it is now unselected."
}
-------------------------------------------------------------------------------
-- Quote command
-- Record something someone said
-------------------------------------------------------------------------------
respondQuote (Just chan) _nick [target] _send = quote chan target
respondQuote Nothing _nick [_] _send = return ()
respondQuote mchan nick args _send =
failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)
cmdQuote = Command
{ cmdNames = ["quote"]
, cmdRespond = respondQuote
, cmdHelp = "‘quote <nick>’ - record the last message sent by <nick> \
\in the channel. The list of past quotes is publicly \
\available."
}
-------------------------------------------------------------------------------
-- Show-opts, enable-history, disable-history, set-history-lines,
-- set-history-lines, erase-opts commands
-- Manage user options
-------------------------------------------------------------------------------
priv = "That command works only in private conversation with me."
looksLikeChan [] = False
looksLikeChan (c:cs) = c `elem` "#+!&"
notchan chan = chan ++ " doesn't look like a channel name."
respondShowOpts (Just _chan) _nick _args send = send priv
respondShowOpts Nothing nick [] _send = sendChannels nick
respondShowOpts Nothing nick [chan] send =
if looksLikeChan chan
then sendHistoryOpts nick chan
else send $ notchan chan
respondShowOpts Nothing nick args _send =
failToUser nick $ WrongNumArgsN (Just $ length args) Nothing
cmdShowOpts = Command
{ cmdNames = ["show-opts", "show-options"]
, cmdRespond = respondShowOpts
, cmdHelp =
"‘show-opts’ - list channels for which you set history \
\display options.\n\
\‘show-opts <channel>’ - show history display options for the given \
\channel."
}
respondHistory _enable (Just _chan) _nick _args send = send priv
respondHistory enable Nothing nick [chan] send =
if looksLikeChan chan
then setEnabled nick chan enable
else send $ notchan chan
respondHistory _enable Nothing nick args _send =
failToUser nick $ WrongNumArgsN (Just $ length args) (Just 1)
cmdEnableHistory = Command
{ cmdNames = ["enable-history"]
, cmdRespond = respondHistory True
, cmdHelp = "‘enable-history <channel>’ - enable automatic history \
\private display for the given channel."
}
cmdDisableHistory = Command
{ cmdNames = ["disable-history"]
, cmdRespond = respondHistory False
, cmdHelp = "‘disable-history <channel>’ - disable automatic history \
\private display for the given channel."
}
respondSetLines (Just _chan) _nick _args send = send priv
respondSetLines Nothing nick [chan, len] send =
if looksLikeChan chan
then
case readMaybe len of
Nothing -> badLen
Just n ->
if n < 0
then badLen
else setMaxLines nick chan n
else send $ notchan chan
where
badLen = failToUser nick $ InvalidArg (Just 2) (Just len)
respondSetLines Nothing nick args _send =
failToUser nick $ WrongNumArgsN (Just $ length args) (Just 2)
cmdSetLines = Command
{ cmdNames = ["set-history-lines"]
, cmdRespond = respondSetLines
, cmdHelp = "‘set-history-lines <channel> <num>’ - set the maximal \
\number of channel history lines to display."
}
respondEraseOpts (Just _chan) _nick _args send = send priv
respondEraseOpts Nothing nick [] _send = eraseOpts nick
respondEraseOpts Nothing nick args _send =
failToUser nick $ WrongNumArgsN (Just $ length args) (Just 0)
cmdEraseOpts = Command
{ cmdNames = ["erase-opts", "erase-options"]
, cmdRespond = respondEraseOpts
, cmdHelp = "‘erase-opts’ - reset all your options back to defaults."
}