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)
import Data.List (find, intercalate)
import Data.Settings.Types (showOption)
import FunBot.Memos (submitMemo)
import FunBot.Settings
import FunBot.Types (BotSession)
import Network.IRC.Fun.Bot.Behavior
import Network.IRC.Fun.Bot.Chat
import Network.IRC.Fun.Bot.Types
import Text.Printf (printf)

-- | The main command set, the only one currently
commandSet = CommandSet
    { prefix   = '!'
    , commands =
        [ makeCmdHelp commandSet
        , cmdInfo
        , cmdEcho
        , cmdPTell
        , cmdCTell
        , cmdGet
        , cmdSet
        , cmdReset
        , cmdEnable
        , cmdDisable
        ]
    }

-------------------------------------------------------------------------------
-- 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
    { names   = ["echo"]
    , respond = respondEcho
    , help    = "‘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`) . names) $ commands cset of
        Just cmd -> send $ help cmd
                        ++ "\nCommand names: "
                        ++ listNames Nothing Nothing True (names 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."
                (prefix cset)
    where
    cname' = case cname of
        []     -> cname
        (c:cs) -> if c == prefix cset then cs else cname

respondHelp cset _mchan _nick _params send =
     send $ help (makeCmdHelp cset)
         ++ "\nAvailable commands: "
         ++ listPrimaryNames (Just $ prefix cset) Nothing False (commands cset)

makeCmdHelp cset = Command
    { names   = ["help", "Help", "h", "?"]
    , respond = respondHelp cset
    , help    = "‘help [<command> | <setting>]’ - display help for the given \
                \command or settings option/section.\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
-------------------------------------------------------------------------------

respondInfo _mchan _nick ["intro"] send = send $
    "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’."
respondInfo _mchan _nick ["features"] send = send $
    "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 in Git repositories\n\
    \• Announcing RSS/Atom feed items\n\
    \• Leaving memos (requires enabling nick tracking for the channel)\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>."
respondInfo _mchan _nick ["contrib"] send = send $
    "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."
respondInfo _mchan _nick ["copying"] send = send $
    "♡ Copying is an act of love. Please copy, reuse and share me! \
    \Grab a copy of me from <https://notabug.org/fr33domlover/funbot>."
respondInfo _mchan _nick ["links"] send = send $
    "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"
respondInfo mchan nick [arg] _send =
    failBack mchan nick $ InvalidArg (Just 1) (Just arg)
respondInfo mchan nick args _send =
    failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1)

cmdInfo = Command
    { names   = ["info", "i"]
    , respond = respondInfo
    , help    = "‘info ( intro | features | contrib | copying | links)’ - \
                \display 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
    { names   = ["tell", "ptell"]
    , respond = respondTell True
    , help    = "‘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
    { names   = ["ctell"]
    , respond = respondTell False
    , help    = "‘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
    { names   = ["get"]
    , respond = respondGet
    , help    = "‘get <option>’ - get the value of a settings option at the \
                \given path"
    }

cmdSet = Command
    { names   = ["set"]
    , respond = respondSet
    , help    = "‘set <option> <value>’ - set a settings option at the given \
                \path to the given value"
    }

cmdReset = Command
    { names   = ["reset"]
    , respond = respondReset
    , help    = "‘reset <option>’ - set a settings option at the given path to \
                \its default value"
    }

cmdEnable = Command
    { names   = ["enable"]
    , respond = respondEnable
    , help    = "‘enable <option>’ - set a settings option at the given path \
                \to True"
    }

cmdDisable = Command
    { names   = ["disable"]
    , respond = respondDisable
    , help    = "‘disable <option>’ - set a settings option at the given path \
                \to False"
    }