{- 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/>.
 -}

module Network.IRC.Fun.Bot.Internal.Types
    ( Config (..)
    , Failure (..)
    , Command (..)
    , CommandSet (..)
    , BotEnv (..)
    , BotState (..)
    , Session (..)
    , ChannelPrivacy (..)
    , Privilege (..)
    , Event (..)
    , Behavior (..)
    , EventSource
    , EventHandler
    , Quotes (..)
    )
where

import Control.Monad.Trans.RWS (RWST)
import Network.IRC.Fun.Client.IO (Connection, Handle)
import Network.IRC.Fun.Client.Events (ChannelPrivacy (..), Privilege (..))

-- | Configuration for the bot connection to IRC.
data Config = Config
    { -- | Connection details, including nickname and optional password
      connection :: Connection
      -- | List of channels to join, e.g. @["#freepost", "#rel4tion"]@
    , channels   :: [String]
    }
    deriving (Eq, Show)

-- | Describes wrong usage of a bot command.
data Failure
    -- | The number of arguments given is wrong
    = WrongNumArgs
    -- | \<first-param\> arguments were given, instead of \<second-param\>
    | WrongNumArgsN (Maybe Int) (Maybe Int)
    -- | At least one of the arguments is invalid
    | InvalidArgs
    -- | Argument in position \<first-param\> and value \<second-param\>
    -- invalid
    | InvalidArg (Maybe Int) (Maybe String)
    -- | Some other error, with a given description
    | OtherFail String
    deriving (Eq, Show)

-- | A bot command, triggered by a message sent to an IRC channel the bot has
-- joined.
--
-- The type parameter @e@ is the type of environment, i.e. real-only state. The
-- type parameter @s@ is the type of the writable state the bot holds. For
-- example, maybe you want your bot to keep a list of to-do items and manage it
-- using bot commands. The bot state is where you store the to-do list.
data Command e s = Command
    { -- | The command's name string, e.g. @"echo"@. More than one name is
      -- allowed per command, so that localized names and shortcuts can be made
      -- available.
      --
      -- The first name in the list is considered the /primary name/. When one
      -- name is shown, e.g. in help messages, it will be the primary name.
      names   :: [String]

      -- | What to do in response to the command being triggered by an IRC
      -- user. The bot can send an IRC message back to the channel, or modify
      -- its state, or both.
      --
      -- The returned value is in the 'Session' monad (it is really 'RWST'
      -- behind the scenes), which allows the bot to access the configuration
      -- and bot state, store and load data from files, communicate through the
      -- network (e.g. download RSS feeds) and more.
      --
      -- Parameters:
      --
      -- (1) Channel in which the command was triggered
      -- (2) Nickname of user who triggered the command
      -- (3) Command parameters given
    , respond :: String -> String -> [String] -> Session e s ()

      -- | Help string for the command, explaining it purpose, its parameters
      -- and its usage, possibly giving an example. May contain newlines.
    , help    :: String
    }

-- | The bot recognizes commands by picking IRC channel messages which begin
-- with a special character, the command prefix. It's possible to have several
-- prefixes, maybe give each its own role or meaning. A command set is a set of
-- commands which share a prefix.
--
-- A command can be in more than one set.
--
-- Common prefixes are @'!', '\@', '>', ':'@.
data CommandSet e s = CommandSet
    { prefix   :: Char
    , commands :: [Command e s]
    }

-- Read-only bot environment.
--
-- The full environment is exposed to commands, which is both power and
-- responsibility. For example, uncareful use of the handle (this is a handle
-- to the TCP socket) could cause parsing issues or disconnection. The 'Config'
-- contains the bot's nickname password, which shouldn't be shared publicly.
--
-- At the same time, you can send any custom message you wish to the IRC
-- server, even if the libraries don't support it directly, or you could use
-- the password to automatically re-identify in case of any problem with
-- NickServ. And so on.
data BotEnv e s = BotEnv
    { config   :: Config
    , behavior :: Behavior e s
    , handle   :: Handle
    , custom   :: e
    }

-- Readable and writable bot state. Contains internal state used by this
-- library, and public state managed by the bot's behavior logic.
newtype BotState s = BotState { public :: s }

-- | Bot monad. It provides read-only bot environment (e.g. the configuration),
-- read-writable bot state (for use by bot commands) and IO.
type Session e s = RWST (BotEnv e s) () (BotState s) IO

-- An event triggered by an IRC message sent from the server.
data Event
    -- | A ping was sent to the bot. The parameters contain the arguments
    -- passed, which should be passed in the Pong.
    = Ping String (Maybe String)
    -- | Users (2nd parameter) have been kicked from a channel (1st parameter)
    -- for a given reason (3rd parameter).
    | Kick String [String] (Maybe String)
    -- | A user (2nd parameter) joined a channel (1st parameter).
    | Join String String
    -- | A user (2nd parameter) left a channel (1st parameter), 3rd=reason.
    | Part String String (Maybe String)
    -- | User, reason.
    | Quit String (Maybe String)
    -- | Message (3rd parameter) sent in a channel (1st parameter) by a user
    -- with the given nickname (2nd parameter). The last parameter says whether
    -- the bot's nick is mentioned in the message.
    | Message String String String Bool
    -- | Like 'Message', but this is a notice. The bot shouldn't send a
    -- response (but it can modify its state etc.). First parameter: Just
    -- channel, or Nothing. The latter means a private message.
    | Notice (Maybe String) String String
    -- | Message (3rd parameter) referring to the bot sent by nick (2nd
    -- parameter) in a channel (1st parameter). The message begins with the
    -- bot's nick, followed by a colon or a comma. That part is however removed
    -- from the 3rd parameter. For example, if the message was
    -- \"funbot, hello!\" then the 3rd parameter will be \"hello!\".
    | BotMessage String String String
    -- | A bot command, which is a message with a special prefix, was sent to
    -- a channel. Parameters: Channel, sender nickname, prefix character,
    -- command name, command arguments.
    | BotCommand String String Char String [String]
    -- | A private message sent specifically to the bot, from a user with the
    -- given nickname (1st parameter) and with the given content (2nd
    -- parameter).
    | PersonalMessage String String
    -- | Channel, nickname, topic
    | TopicChange String String String
    -- | Unrecognized or unimplemented event. The parameter contains (possibly
    -- empty) input.
    | OtherEvent String
    -- | The server sent a list of nicknames present in a channel. Parameters:
    -- Channel privacy mode, channel name, list of users. Each list item is a
    -- pair of a user privilege level in the channel, and the user's nickname.
    | Names String ChannelPrivacy [(Privilege, String)]
    deriving Show

-- | Bot behavior definition.
data Behavior e s = Behavior
    { handleJoin        :: String -> String -> Session e s ()
    , handlePart        :: String -> String -> Maybe String -> Session e s ()
    , handleQuit        :: String -> Maybe String -> Session e s ()
    , handleMsg         :: String -> String -> String -> Bool -> Session e s ()
    , handleBotMsg      :: String -> String -> String -> Session e s ()
    , commandSets       :: [CommandSet e s]
    , handlePersonalMsg :: String -> String -> Session e s ()
    , handleTopicChange :: String -> String -> String -> Session e s ()
      -- | Handle a channel member list received. Parameters:
      --
      -- (1) Channel name
      -- (2) Channel privacy
      -- (3) List of channel members: their privilege level in the channel and
      --     their nicknames
    , handleNames       :: String
                        -> ChannelPrivacy
                        -> [(Privilege, String)]
                        -> Session e s ()
    }

-- | An 'IO' action, possibly running forever, which produces events for the
-- bot to process. These event sources are run by the bot in dedicated threads.
--
-- Type parameters:
--
-- * @e@ - custom bot environment type
-- * @s@ - custom bot state type
-- * @a@ - event type
type EventSource e s a
    =  Config
    -- ^ The bot configuration. The event source may find this useful.
    -> e
    -- ^ The bot's custom environment. The event source may find this useful.
    -> (a -> IO ())
    -- ^ A non-blocking 'IO' action which sends a given event to the
    -- processing queue.
    -> ([a] -> IO ())
    -- ^ A non-blocking 'IO' action which sends a given list of events to the
    -- processing queue.
    -> IO ()

-- | A bot session action which reacts to a single event which came from an
-- 'EventSource'.
--
-- Type parameters:
--
-- * @e@ - custom bot environment type
-- * @s@ - custom bot state type
-- * @a@ - event type
type EventHandler e s a = a -> Session e s ()

-- | Quote types for string formatting.
data Quotes
    -- | Single quote on each side of the formatted string. The parameter sets
    -- whether to use Unicode (otherwise use ASCII fallback).
    = SingleQuotes Bool
    -- | Double quote on each side of the formatted string. The parameter sets
    -- whether to use Unicode (otherwise use ASCII fallback).
    | DoubleQuotes Bool
    -- | Backtick on each side of the formatted string.
    | BackTicks
    deriving (Eq, Show)