Behavior.hs

{- This file is part of irc-fun-bot.
 -
 - 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/>.
 -}

-- | This module provides utilities for working with the bot's behavior
-- definition. While the library handles event dispatch by itself, custom
-- commands and bot features may benefit from having this module available to
-- them (e.g. a bot's help system).
module Network.IRC.Fun.Bot.Behavior
    ( -- * Defining
      defaultBehavior
      -- * Searching
    , findCmdInSet
    , findCmdInSets
    , findCmd
    , findSet
    , searchCmds
    -- * Showing
    , listNames
    , listPrimaryNames
    )
where

import Data.Char (toLower)
import Data.List (find, isInfixOf)
import Network.IRC.Fun.Bot.Types
import Network.IRC.Fun.Bot.Util (maybeQuote, showNames)

-------------------------------------------------------------------------------
-- Defining
-------------------------------------------------------------------------------

-- | A default behavior definition which be convenienty overridden and extended
-- using record syntax. It currently simply doesn't do anything (pings do get
-- handled behind the scenes), but things like default responses and logging
-- could be added in the future.
defaultBehavior :: Behavior e s
defaultBehavior = Behavior
    { handleJoin        = \ _ _ -> return ()
    , handlePart        = \ _ _ _ -> return ()
    , handleQuit        = \ _ _ -> return ()
    , handleMsg         = \ _ _ _ _ -> return ()
    , handleBotMsg      = \ _ _ _ -> return ()
    , commandSets       = []
    , handlePersonalMsg = \ _ _ -> return ()
    , handleTopicChange = \ _ _ _ -> return ()
    , handleNames       = \ _ _ _ -> return ()
    }

-------------------------------------------------------------------------------
-- Searching
-------------------------------------------------------------------------------

-- | Take a command name (without prefix) and a command set, and return the
-- (leftmost) command which has that name, or 'Nothing' if there is no such
-- command.
findCmdInSet :: String -> CommandSet e s -> Maybe (Command e s)
findCmdInSet name = find ((name `elem`) . names) . commands

-- | Find a command in a list of command sets, using the given prefix character
-- and command name. This is a shortcut for 'findCmd' which doesn't return the
-- matched command set (for the cases you only need to find the command).
findCmdInSets :: Char -> String -> [CommandSet e s] -> Maybe (Command e s)
findCmdInSets cpref cname sets =
    case findCmd cpref cname sets of
        Just (Right cmd) -> Just cmd
        _                -> Nothing

-- | Find a command in a list of command sets, using the given prefix character
-- and command name. If the prefix isn't matched, 'Nothing' is returned. If
-- the prefix is matched but the command isn't, 'Just' 'Left' the command set
-- is returned. Otherwise, 'Just' 'Right' the matched command is returned.
findCmd :: Char             -- ^ Command prefix to search for
        -> String           -- ^ Command name to search for
        -> [CommandSet e s] -- ^ Command set in which to search
        -> Maybe (Either (CommandSet e s) (Command e s))
findCmd cpref cname sets =
    case findSet cpref sets of
        Nothing   -> Nothing
        Just cset ->
            case findCmdInSet cname cset of
                Nothing  -> Just $ Left cset
                Just cmd -> Just $ Right cmd

-- | Take a command prefix and a list of command sets, and return the
-- (leftmost) set which has that prefex, or 'Nothing' if there is no such set.
findSet :: Char -> [CommandSet e s] -> Maybe (CommandSet e s)
findSet p = find ((== p) . prefix)

-- | Search for commands by testing a search string against their textual
-- fields: Names and help strings. Each returned pair is a command and the
-- prefix under which it was found.
searchCmds :: String -> [CommandSet e s] -> [(Char, Command e s)]
searchCmds search = concatMap (f $ lower search)
    where
    lower = map toLower
    match s cmd = any (s `isInfixOf`) (map lower $ names cmd)
               || s `isInfixOf` (lower $ help cmd)
    f s cset = [(prefix cset, cmd) | cmd <- commands cset, match s cmd]

-------------------------------------------------------------------------------
-- Showing
-------------------------------------------------------------------------------

-- | Format a list of command names.
listNames :: Maybe Char   -- ^ Optionally prepend the prefix char to names
          -> Maybe Quotes -- ^ Optionally add quotes around the names
          -> Bool         -- ^ Whether to separate with commas (otherwise
                          --   spaces)
          -> [String]     -- ^ List of command names
          -> String
listNames pref qs comma =
    showNames qs (if comma then ", " else " ") . maybe id (map . (:)) pref

-- | Format a list of the primary names of the given commands.
listPrimaryNames :: Maybe Char     -- ^ Optionally prepend the prefix char to
                                   --   names
                 -> Maybe Quotes   -- ^ Optionally add quotes around the names
                 -> Bool           -- ^ Whether to separate with commas
                                   --   (otherwise spaces)
                 -> [Command e s]  -- ^ List of commands
                 -> String
listPrimaryNames pref qs comma = listNames pref qs comma . map (head . names)