Failure.hs

{- This file is part of irc-fun-bot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Network.IRC.Fun.Bot.Internal.Failure
    ( defaultRespondToChan
    , defaultRespondToUser
    , failToChannel
    , failToUser
    , failBack
    )
where

import Data.Char (toLower)
import Data.List (intersperse)
import Data.Monoid ((<>))
import Data.Text (Text)
import Formatting
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 Network.IRC.Fun.Types.Base

import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T

-- 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
    :: Maybe Char             -- Command prefix that was triggered
    -> CommandName            -- 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
    -> MsgContent
defaultResponse Nothing _cname _csets _ =
    MsgContent "Expected to find a default command prefix, but there’s none."
defaultResponse (Just cpref) _cname csets Nothing =
    MsgContent $
    sformat
        ( "Expected to find a command with prefix ‘"
        % char
        % "’, but there’s none. Available prefixes are: "
        % string
        )
        cpref
        (intersperse ' ' $ map csetPrefix csets)
defaultResponse (Just cpref) cname _csets (Just cset) =
    MsgContent $
    sformat
        ( "The command ‘"
        % char % stext
        % "’ isn’t available. Available commands for prefix ‘"
        % char
        % "’ are: "
        % stext
        )
        cpref (CI.foldedCase $ unCommandName cname)
        cpref
        (T.unwords $ map cmdName $ csetCommands cset)
    where
    cmdName = CI.original . unCommandName . head . cmdNames

-- | Send the default response to an IRC channel
defaultRespondToChan
    :: Channel                 -- Target channel
    -> Maybe Char              -- Command prefix that was triggered
    -> CommandName             -- Command name that was triggered
    -> Maybe (CommandSet e s)  -- The command set matching the prefix, if 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
    :: Nickname               -- Recipient nickname
    -> Maybe Char             -- Command prefix that was triggered
    -> CommandName            -- 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

-- Response message to send on failure
failureDescription :: Failure -> Text
failureDescription failure =
    case failure of
        WrongNumArgs ->
            "Wrong number of arguments"
        WrongNumArgsN Nothing Nothing ->
            failureDescription WrongNumArgs
        WrongNumArgsN (Just given) Nothing ->
            sformat ("Wrong number of arguments: " % int % " given") given
        WrongNumArgsN Nothing (Just expected) ->
            sformat
                ("Wrong number of arguments: " % int % " expected")
                expected
        WrongNumArgsN (Just given) (Just expected) ->
            sformat
                ( "Wrong number of arguments: "
                % int
                % " given, "
                % int
                % " expected"
                )
                given
                expected
        InvalidArgs -> "Invalid arguments"
        InvalidArg Nothing Nothing -> "Invalid argument found"
        InvalidArg (Just pos) Nothing ->
            sformat ("The " % ords % " argument is invalid") pos
        InvalidArg Nothing (Just param) ->
            sformat ("Invalid argument: ‘" % stext % "’") param
        InvalidArg (Just pos) (Just param) ->
            sformat
                ("The " % ords % " argument is invalid: ‘" % stext % "’")
                pos
                param
        OtherFail t -> "Command failed: " <> t

-- | Send message explaining a failure to an IRC channel.
failToChannel
    :: Channel  -- ^ Target channel
    -> Nickname -- ^ User to whom to refer
    -> Failure  -- ^ Problem indication
    -> Session e s ()
failToChannel chan nick failure =
    let lowerc t =
            case T.uncons t of
                Nothing     -> t
                Just (c, r) -> toLower c `T.cons` r
    in  sendToChannel chan $ MsgContent $
        unNickname nick <> ", " <> lowerc (failureDescription failure)

-- | Send message explaining a failure to an IRC user.
failToUser
    :: Nickname  -- ^ Target user
    -> Failure   -- ^ Problem indication
    -> Session e s ()
failToUser nick failure =
    sendToUser nick $ MsgContent $ failureDescription failure

-- | Send message explaining a failure back to the sender.
failBack
    :: Maybe Channel -- ^ Optional target channel, 'Nothing' means private
                     -- message
    -> Nickname      -- ^ 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