{- 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.Event
    ( matchPrefixedCommandC
    , matchPrefixedCommandP
    , matchPrefixedCommand
    , matchRefCommandC
    , matchRefCommandP
    , matchRefCommand
    , matchRefCommandFromSetC
    , matchRefCommandFromSetP
    , matchRefCommandFromSet
    , matchRefCommandFromNamesC
    , matchRefCommandFromNamesP
    , matchRefCommandFromNames
    , matchPlainPrivateCommand
    , matchNoticeC
    , matchNoticeP
    , matchNotice
    , matchRefC
    , matchRefP
    , matchRef
    , defaultMatch
    , matchEvent
    , handleEvent
    )
where

import           Control.Monad (when)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.RWS
import           Data.Char (isSpace)
import qualified Data.HashMap.Lazy as M
import           Data.Maybe (catMaybes, fromMaybe, maybeToList)
import           Data.List (stripPrefix)
import           Network.IRC.Fun.Bot.Internal.Chat (pong)
import           Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan)
import           Network.IRC.Fun.Bot.Internal.Nicks
import           Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS)
import           Network.IRC.Fun.Bot.Internal.Types hiding (Logger)
import           Network.IRC.Fun.Bot.Behavior (findCmd, findCmdInSet)
import           Network.IRC.Fun.Client.ChannelLogger hiding (LogEvent (..))
import qualified Network.IRC.Fun.Client.ChannelLogger as L
import qualified Network.IRC.Fun.Client.Events as C (Event (..))
import           Network.IRC.Fun.Client.IO (nick)
import           Network.IRC.Fun.Client.Util (mentions)

-------------------------------------------------------------------------------
-- Make Events
-------------------------------------------------------------------------------

detectRef :: Config -> String -> Maybe String
detectRef conf msg =
    let bnick = nick (connection conf)
        dw = Just . dropWhile isSpace
    in  case stripPrefix bnick msg of
            Nothing        -> Nothing
            Just (',' : s) -> dw s
            Just (':' : s) -> dw s
            Just (';' : s) -> dw s
            Just (c : s)   -> if isSpace c then dw s else Nothing
            Just s         -> dw s

mkCmd :: String -> (String, [String])
mkCmd message =
    let w = words message
        name = if null w then "" else head w
        args = if null w then [] else tail w
    in  (name, args)

makePrefixedCommand :: [CommandSet e s]
                    -> MessageSource
                    -> Char
                    -> String
                    -> Maybe Event
makePrefixedCommand csets src pref msg =
    if pref `elem` map prefix csets
        then
            let (name, args) = mkCmd msg
            in  Just $ BotCommand src (Just pref) name args
        else Nothing

makeRefCommand :: Config
               -> MessageSource
               -> String
               -> Maybe Event
makeRefCommand conf src msg =
    case detectRef conf msg of
        Just s ->
            let (name, args) = mkCmd s
            in  Just $ BotCommand src Nothing name args
        Nothing -> Nothing

makeRefCommandFromSet :: Config
                      -> CommandSet e s
                      -> MessageSource
                      -> String
                      -> Maybe Event
makeRefCommandFromSet conf cset =
    makeRefCommandFromNames conf (concatMap names $ commands cset)

makeRefCommandFromNames :: Config
                        -> [String]
                        -> MessageSource
                        -> String
                        -> Maybe Event
makeRefCommandFromNames conf names src msg =
    case detectRef conf msg of
        Just s ->
            let (name, args) = mkCmd s
            in  if name `elem` names
                    then Just $ BotCommand src Nothing name args
                    else Nothing
        Nothing -> Nothing

makePlainCommand :: MessageSource
                 -> String
                 -> Maybe Event
makePlainCommand src msg =
    let (name, args) = mkCmd msg
    in  Just $ BotCommand src Nothing name args

makeRefC :: Config -> String -> String -> String -> Maybe Event
makeRefC conf chan nick msg =
    case detectRef conf msg of
        Just s  -> Just $ BotMessage chan nick s
        Nothing -> Nothing

makeRefP :: Config -> String -> String -> Maybe Event
makeRefP conf nick msg =
    case detectRef conf msg of
        Just s  -> Just $ PersonalMessage nick s
        Nothing -> Nothing

-------------------------------------------------------------------------------
-- Match Events
-------------------------------------------------------------------------------

matchPrefixedCommandC :: EventMatcher e s
matchPrefixedCommandC event _conf csets =
    case event of
        C.ChannelMessage chan nick (c:cs) False ->
            makePrefixedCommand csets (Channel chan nick) c cs
        _ -> Nothing

matchPrefixedCommandP :: EventMatcher e s
matchPrefixedCommandP event _conf csets =
    case event of
        C.PrivateMessage nick (c:cs) False ->
            makePrefixedCommand csets (User nick) c cs
        _ -> Nothing

matchPrefixedCommand :: EventMatcher e s
matchPrefixedCommand event _conf csets =
    case event of
        C.ChannelMessage chan nick (c:cs) False ->
            makePrefixedCommand csets (Channel chan nick) c cs
        C.PrivateMessage nick (c:cs) False ->
            makePrefixedCommand csets (User nick) c cs
        _ -> Nothing

matchRefCommandC :: EventMatcher e s
matchRefCommandC event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommand conf (Channel chan nick) msg
        _ -> Nothing

matchRefCommandP :: EventMatcher e s
matchRefCommandP event conf _csets =
    case event of
        C.PrivateMessage nick msg False ->
            makeRefCommand conf (User nick) msg
        _ -> Nothing

matchRefCommand :: EventMatcher e s
matchRefCommand event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommand conf (Channel chan nick) msg
        C.PrivateMessage nick msg False ->
            makeRefCommand conf (User nick) msg
        _ -> Nothing

matchRefCommandFromSetC :: EventMatcher e s
matchRefCommandFromSetC _     _    []       = Nothing
matchRefCommandFromSetC event conf (cset:_) =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommandFromSet conf cset (Channel chan nick) msg
        _ -> Nothing

matchRefCommandFromSetP :: EventMatcher e s
matchRefCommandFromSetP _     _    []       = Nothing
matchRefCommandFromSetP event conf (cset:_) =
    case event of
        C.PrivateMessage nick msg False ->
            makeRefCommandFromSet conf cset (User nick) msg
        _ -> Nothing

matchRefCommandFromSet :: EventMatcher e s
matchRefCommandFromSet _     _    []       = Nothing
matchRefCommandFromSet event conf (cset:_) =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommandFromSet conf cset (Channel chan nick) msg
        C.PrivateMessage nick msg False ->
            makeRefCommandFromSet conf cset (User nick) msg
        _ -> Nothing

matchRefCommandFromNamesC :: [String] -> EventMatcher e s
matchRefCommandFromNamesC names event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommandFromNames conf names (Channel chan nick) msg
        _ -> Nothing

matchRefCommandFromNamesP :: [String] -> EventMatcher e s
matchRefCommandFromNamesP names event conf _csets =
    case event of
        C.PrivateMessage nick msg False ->
            makeRefCommandFromNames conf names (User nick) msg
        _ -> Nothing

matchRefCommandFromNames :: [String] -> EventMatcher e s
matchRefCommandFromNames names event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False ->
            makeRefCommandFromNames conf names (Channel chan nick) msg
        C.PrivateMessage nick msg False ->
            makeRefCommandFromNames conf names (User nick) msg
        _ -> Nothing

matchPlainPrivateCommand :: EventMatcher e s
matchPlainPrivateCommand event _conf _csets =
    case event of
        C.PrivateMessage nick msg False ->
            makePlainCommand (User nick) msg
        _ -> Nothing

matchNoticeC :: EventMatcher e s
matchNoticeC event _conf _csets =
    case event of
        C.ChannelMessage chan nick msg True ->
            Just $ Notice (Just chan) nick msg
        _ -> Nothing

matchNoticeP :: EventMatcher e s
matchNoticeP event _conf _csets =
    case event of
        C.PrivateMessage nick msg True ->
            Just $ Notice Nothing nick msg
        _ -> Nothing

matchNotice :: EventMatcher e s
matchNotice event _conf _csets =
    case event of
        C.ChannelMessage chan nick msg True ->
            Just $ Notice (Just chan) nick msg
        C.PrivateMessage nick msg True ->
            Just $ Notice Nothing nick msg
        _ -> Nothing

matchRefC :: EventMatcher e s
matchRefC event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg
        _ -> Nothing

matchRefP :: EventMatcher e s
matchRefP event conf _csets =
    case event of
        C.PrivateMessage nick msg False -> makeRefP conf nick msg
        _ -> Nothing

matchRef :: EventMatcher e s
matchRef event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg
        C.PrivateMessage nick msg False -> makeRefP conf nick msg
        _ -> Nothing

defaultMatch :: EventMatcher e s
defaultMatch event conf csets =
    case event of
        C.Ping server1 server2      -> Just $ Ping server1 server2
        C.Kick channel nicks reason -> Just $ Kick channel nicks reason
        C.Join channel nick         -> Just $ Join channel nick
        C.Part channel nick reason  -> Just $ Part channel nick reason
        C.Quit nick reason          -> Just $ Quit nick reason
        C.ChannelMessage channel nick msg False ->
            Just $ Message channel nick msg $ msg `mentions` bnick
        C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg
        C.Topic channel nick topic -> Just $ TopicChange channel nick topic
        C.Names priv chan pnicks -> Just $ Names chan priv pnicks
        _ -> Nothing
    where
    bnick = nick (connection conf)

combineMatchers :: [EventMatcher e s] -> EventMatcher e s
combineMatchers []     _event _conf _csets = Nothing
combineMatchers (m:ms) event  conf  csets  =
    case m event conf csets of
       ev@(Just _) -> ev
       Nothing     -> combineMatchers ms event conf csets

applyMatchers :: [EventMatcher e s]
              -> C.Event
              -> Config
              -> [CommandSet e s]
              -> Event
applyMatchers ms event conf csets =
    fromMaybe (OtherEvent $ show event) $ combineMatchers ms event conf csets

matchEvent :: [EventMatcher e s]
           -> C.Event
           -> Config
           -> [CommandSet e s]
           -> Event
matchEvent = applyMatchers

findCommand :: Maybe Char
            -> String
            -> [CommandSet e s]
            -> Maybe (Either (CommandSet e s) (Command e s))
findCommand (Just cpref) cname csets    = findCmd cpref cname csets
findCommand Nothing      _     []       = Nothing
findCommand Nothing      cname (cset:_) =
    Just $ maybe (Left cset) Right $ findCmdInSet cname cset

-- Run the command with the given prefix character, command name and list of
-- parameters. If a command with the given prefix and name isn't found, the bot
-- sends a default friendly response.
runCommand :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix
           -> String     -- Command name
           -> [String]   -- List of parameters
           -> String     -- Channel in which the command was triggered
           -> String     -- Nickname of user who triggered the command
           -> Session e s ()
runCommand cpref cname cparams channel sender = do
    csets <- askBehaviorS commandSets
    case findCommand cpref cname csets of
        Nothing          ->
            defaultRespondToChan channel cpref cname Nothing
        Just (Left cset) ->
            defaultRespondToChan channel (Just $ prefix cset) cname (Just cset)
        Just (Right cmd) ->
            respond cmd channel sender cparams

-- React to a bot event.
handleBotEvent :: Event -> Session e s ()
handleBotEvent event = do
    b <- askBehavior
    case event of
        Ping s1 s2 -> pong s1 s2
        Kick chan users why -> return ()
        Join chan nick -> do
            tracked <- channelIsTracked chan
            when tracked $ addMember chan nick
            handleJoin b chan nick
        Part chan nick why -> do
            tracked <- channelIsTracked chan
            when tracked $ removeMemberOnce chan nick
            handlePart b chan nick why
        Quit nick why -> do
            removeMember nick
            handleQuit b nick why
        Message chan sender msg mentioned ->
            handleMsg b chan sender msg mentioned
        Notice mchan sender msg -> return ()
        BotMessage chan sender msg -> handleBotMsg b chan sender msg
        BotCommand (Channel chan sender) cpref cname cargs ->
            runCommand cpref cname cargs chan sender
        BotCommand _ _ _ _ -> return ()
        PersonalMessage sender msg -> handlePersonalMsg b sender msg
        TopicChange chan nick topic -> handleTopicChange b chan nick topic
        Names chan priv pnicks -> do
            tracked <- channelIsTracked chan
            let nicks = map snd pnicks
            when tracked $ addChannel chan nicks
            handleNames b chan priv pnicks
        OtherEvent s -> return ()

-- Using nick tracking and logging state, determine from a general log event a
-- set of channel loggers and channel-specific log events to write into them.
detectLogEvents :: L.LogEvent -> Session e s [(Logger, ChanLogEvent)]
detectLogEvents e =
    let detect event cstate = fmap (\ cl -> (cl, event)) $ chanLogger cstate
        detectOne chan event = do
            cstates <- gets chanstate
            return $ maybeToList $ M.lookup chan cstates >>= detect event
        detectMany nick event = do
            chans <- presence nick
            cstates <- gets chanstate
            let cstatesP =
                    cstates `M.difference` M.fromList (zip chans (repeat ()))
            return $ catMaybes $ map (detect event) $ M.elems cstatesP
    in  case e of
            L.Enter nick chan       -> detectOne chan $ EnterChan nick
            L.Leave nick chan       -> detectOne chan $ LeaveChan nick
            L.LeaveAll nick         -> detectMany nick $ LeaveChan nick
            L.Message nick chan msg -> detectOne chan $ MessageChan nick msg
            L.Rename oldN newN      -> detectMany oldN $ RenameInChan oldN newN

-- Possibly write a log event into the right file(s), according to logging
-- settings.
handleLogEvent :: L.LogEvent -> Session e s ()
handleLogEvent e = do
    l <- detectLogEvents e
    liftIO $ mapM_ (\ (logger, event) -> logEvent logger event) l

-- | Handle a bot event, or log a log event into a file.
handleEvent :: Either L.LogEvent Event -> Session e s ()
handleEvent = either handleLogEvent handleBotEvent