packages feed

funbot-0.4: src/FunBot/Commands.hs

{- 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, when)
import Data.List (find, intercalate)
import Data.Settings.Types (showOption)
import FunBot.History (quote, reportHistory')
import FunBot.Memos (submitMemo)
import FunBot.Settings
import FunBot.Types (BotSession)
import FunBot.UserOptions
import FunBot.Util (getHistoryLines)
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 =
        [ cmdHelp'
        , cmdInfo
        , cmdEcho
        , cmdPTell
        , cmdCTell
        , cmdGet
        , cmdSet
        , cmdReset
        , cmdEnable
        , cmdDisable
        , cmdAddSpec
        , cmdDeleteSpec
        , cmdAddRepo
        , cmdDeleteRepo
        , cmdVisit
        , cmdJoin
        , cmdLeave
        , cmdQuote
        , cmdShowOpts
        , cmdEnableHistory
        , cmdDisableHistory
        , cmdSetLines
        , cmdEraseOpts
        , cmdAddShortcut
        , cmdDeleteShortcut
        , cmdShowHistory
        , cmdAddFeed
        , cmdDeleteFeed
        ]
    }

-------------------------------------------------------------------------------
-- 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
-------------------------------------------------------------------------------

respondHelp _mchan _nick [cname] send =
    case find ((cname' `elem`) . cmdNames) $ csetCommands commandSet of
        Just cmd -> send $ cmdHelp cmd
                        ++ "\nCommand names: "
                        ++ listNames Nothing Nothing True (cmdNames cmd)
        Nothing  -> do
            succ <- respondSettingsHelp cname send
            unless succ $ send
                "No such command, or invalid settings path. \
                \Maybe try just ‘!help’ without a parameter."
    where
    cname' = case cname of
        []     -> cname
        (c:cs) -> if c == csetPrefix commandSet then cs else cname

respondHelp _mchan nick _params send =
     send "!info intro    - about me\n\
          \!info commands - how to ask me to do things\n\
          \!info          - list of help/information topics\n\
          \!help help     - how to use this command\n\
          \All of these work both in channels and in private messages to me."

cmdHelp' = Command
    { cmdNames   = ["help", "Help", "h", "?"]
    , cmdRespond = respondHelp
    , 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\
        \• Expanding shortcuts (e.g. easily get a bug URL by its ID)\n\
        \• Logging and reporting channel activity\n\
        \• Welcoming new users\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 \
        \<https://notabug.org/fr33domlover/funbot/src/master/INSTALL.md>."
      )
    , ( "contrib"
      , "Thinking about contributing to my development? Opening a ticket, \
        \fixing a bug, implementing a feature? Check out the project page at \
        \<https://notabug.org/fr33domlover/funbot>, which links to the \
        \contribution guide, to the issues 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:     https://notabug.org/fr33domlover/funbot\n\
        \Issues:      https://notabug.org/fr33domlover/funbot/issues\n\
        \Dev guide:   https://notabug.org/fr33domlover/funbot/src/master/INSTALL.md\n\
        \User manual: http://rel4tion.org/projects/funbot/manual"
      )
    , ( "commands"
      , "A bot command is a specially formatted message sent either into an \
        \IRC channel, or privately to me. Such a message specifies at least \
        \the command name and a possibly empty list of whitespace-separated \
        \parameters. Commands may have more than one name, e.g. the ‘help’ \
        \command also has an alias ‘h’, among others. To see the details \
        \about which parameters a specific command takes, which name aliases \
        \it has and what it does, use ‘!help <command>’.\n\
        \A command can be sent to me using a message starting with a command \
        \prefix, e.g. ‘!echo hello’, or by starting a message with my \
        \nickname, e.g. ‘funbot: echo hello’. Some commands work only when \
        \used in a channel, some work only privately, some work in both \
        \cases.\n\
        \Use the ‘!info’ command to explore various aspects and features I \
        \provide. Both !help and !info can be used privately.\n\
        \Available commands: " ++
        unwords (map (head . cmdNames) $ csetCommands commandSet)
      )
    , ( "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"
      , "I can periodically visit news feeds (Atom, RSS, etc.) and report new \
        \items to IRC channels. You can add and remove feeds using !add-feed \
        \and !delete-feed respectively. You can use the settings system \
        \(!get, !set, etc.) to control feed item display: activate and \
        \deactivate feeds, change feed URLs, choose IRC channels in which new \
        \items of a given feed are reported and control which information is \
        \shown about new feed items reported."
      )
    , ( "memos"
      , "You can leave a message for an offline user, and I will send them \
        \the message when they come back. I can send them the message \
        \privately or in the same channel you sent it to me. See the !tell \
        \and !ctell commands. If you leave a memo for an online user, I will \
        \send it to them instantly instead of storing it for later - but for \
        \that to work, channel user list tracking needs to be enabled in my \
        \settings for the relevant channel(s)."
      )
    , ( "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 happening 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 my data files). See ‘!info user-options’ \
        \for usage instructions. If you'd like to see channel history once, \
        \without enabling the automatic service, see ‘!help show-history’."
      )
    , ( "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."
      )
    , ( "shortcuts"
      , "I can detect special strings in your messages and send longer forms \
        \of them, allowing you to define shortcuts. For example, you can \
        \mention a bug ID and I will send a bug tracker URL for that bug. I \
        \detect shortcuts by their prefix: Once you define a <prefix> string, \
        \I find occurrences of <prefix><word> in channel messages, and resend \
        \<word> into the channel, with <before> and <after> strings \
        \surrounding it, thus expanding the shortcut. For example, if \
        \<prefix>=BUG <before>=http://bug.org/ <after>=.html, then if you \
        \send a message containing BUG142, I will send \
        \http://bug.org/142.html into the channel. See the !add-shortcut and \
        \!delete-shortcut commands, and relevant settings."
      )
    ]

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,
-- get-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 do
            setEnabled nick chan enable
            hls <- getHistoryLines chan
            when (enable && hls < 1) $ send
                "Note that while you enabled personal history display, \
                \history logging is disabled for that channel, therefore you \
                \won't be getting history messages. Ask the bot maintainer(s) \
                \to enable it."
        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."
    }

-------------------------------------------------------------------------------
-- Add-shortcut, delete-shortcut commands
-- Manage shortcuts
-------------------------------------------------------------------------------

respondAddShortcut mchan nick [label, chan] send =
    if looksLikeChan chan
        then do
            succ <- addShortcut label chan
            if succ
                then send "Shortcut added."
                else failBack mchan nick $ OtherFail
                     "This shortcut is already registered."
        else send $ notchan chan
respondAddShortcut mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2)

cmdAddShortcut = Command
    { cmdNames   = ["add-shortcut"]
    , cmdRespond = respondAddShortcut
    , cmdHelp    = "‘add-shortcut <label> <channel>’ - add a shortcut to \
                   \apply in the given channel, with default dummy settings. \
                   \The label is just for convenient reference; pick a short \
                   \meaningful one."
    }

respondDeleteShortcut mchan nick [label] send = do
    succ <- deleteShortcut label
    if succ
        then send "Shortcut removed."
        else failBack mchan nick $ OtherFail "No such shortcut found."
respondDeleteShortcut mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)

cmdDeleteShortcut = Command
    { cmdNames   = ["delete-shortcut"]
    , cmdRespond = respondDeleteShortcut
    , cmdHelp    = "‘delete-shortcut <label>’ - remove the shortcut with the \
                   \given label completely. If you just want to change the \
                   \channels in which it applies, see the \
                   \“shortcuts.<label>.channels” settings option."
    }

-------------------------------------------------------------------------------
-- Show-history command
-- Show channel history
-------------------------------------------------------------------------------

respondShowHistory (Just chan) nick [mins] _send =
    case readMaybe mins of
        Nothing -> badMins
        Just m  ->
            if m < 0
                then badMins
                else reportHistory' nick chan m
    where
    badMins = failToChannel chan nick $ InvalidArg (Just 1) (Just mins)
respondShowHistory mchan nick [mins, chan] _send =
    case readMaybe mins of
        Nothing -> badMins
        Just m  ->
            if m < 0
            then badMins
            else reportHistory' nick chan m
    where
    badMins = failBack mchan nick $ InvalidArg (Just 1) (Just mins)
respondShowHistory mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing

cmdShowHistory = Command
    { cmdNames   = ["show-history"]
    , cmdRespond = respondShowHistory
    , cmdHelp    =
        "‘show-history <mins>’           - Receive (privately) the channel \
        \history log for the last <mins> minutes, for the channel in which \
        \the command is used. The result may contain less than <mins> minutes \
        \because it also depends on the number of messages the bot \
        \remembers.\n\
        \‘show-history <mins> <channel>’ - The same, for the specified \
        \channel. Use this variant in a private message to the bot."
    }

-------------------------------------------------------------------------------
-- Add-feed and delete-feed commands
-- Add and remove news feeds to watch
-------------------------------------------------------------------------------

respondAddFeed mchan nick [label, url] send = do
    succ <- addFeed label url
    if succ
        then send "News feed added."
        else failBack mchan nick $ OtherFail "This label already exists."
respondAddFeed mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2)

cmdAddFeed = Command
    { cmdNames   = ["add-feed"]
    , cmdRespond = respondAddFeed
    , cmdHelp    =
        "‘add-feed <label> <url>’ - add a news feed to watch and announce its \
        \new items to IRC channels. By default the list of IRC channels is \
        \empty; use the settings system (!set) to set one or more channels to \
        \which items will be announced."
    }

respondDeleteFeed mchan nick [label] send = do
    succ <- deleteFeed label
    if succ
        then send "News feed removed."
        else failBack mchan nick $ OtherFail "No such label found."
respondDeleteFeed mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)

cmdDeleteFeed = Command
    { cmdNames   = ["delete-feed"]
    , cmdRespond = respondDeleteFeed
    , cmdHelp    =
        "‘delete-feed <label>’ - stop announcing items of the given news feed \
        \and remove its settings. If you just want to disable the feed, \
        \without deleting the settings, use the settings system to deactivate \
        \it."
    }