{- 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
    ( modId
    , modPrefix
    , modPrefixes
    , modPrefixCI
    , modPrefixesCI
    , modPleasePrefix
    , modPleasePrefix'
    , matchPrefixedCommand
    , matchPrefixedCommandFromSet
    , matchPrefixedCommandFromNames
    , matchRefCommand
    , matchRefCommandFromSet
    , matchRefCommandFromNames
    , matchPlainPrivateCommand
    , matchNotice
    , matchRef
    , defaultMatch
    , matchEvent
    , handleEvent
    )
where

import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS
import Data.Char (isSpace, toLower)
import Data.Maybe
import Data.List (find, stripPrefix)
import Network.IRC.Fun.Bot.Internal.Chat (pong, sendBack)
import Network.IRC.Fun.Bot.Internal.Failure
import Network.IRC.Fun.Bot.Internal.Nicks
import Network.IRC.Fun.Bot.Internal.State
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 Network.IRC.Fun.Client.IO (connNick)
import Network.IRC.Fun.Client.Util (mentions)

import qualified Data.HashMap.Lazy as M
import qualified Network.IRC.Fun.Client.ChannelLogger as L
import qualified Network.IRC.Fun.Client.Events as C (Event (..))

-------------------------------------------------------------------------------
-- Modifiers
-------------------------------------------------------------------------------

modId :: String -> String
modId = id

modPrefix :: String -> Bool -> String -> String
modPrefix p d s =
    case stripPrefix p s of
        Just s' -> if d then dropWhile isSpace s' else s'
        Nothing -> s

modPrefixes :: [String] -> Bool -> String -> String
modPrefixes ps d s =
    case listToMaybe $ mapMaybe (flip stripPrefix s) ps of
        Just s' -> if d then dropWhile isSpace s' else s'
        Nothing -> s

stripPrefixCI :: String -> String -> Maybe String
stripPrefixCI []     ys       = Just ys
stripPrefixCI (_:_)  []       = Nothing
stripPrefixCI (x:xs) (y:ys)   =
    if toLower x == toLower y
        then stripPrefixCI xs ys
        else Nothing

modPrefixCI :: String -> Bool -> String -> String
modPrefixCI p d s =
    case stripPrefixCI p s of
        Just s' -> if d then dropWhile isSpace s' else s'
        Nothing -> s

modPrefixesCI :: [String] -> Bool -> String -> String
modPrefixesCI ps d s =
    case listToMaybe $ mapMaybe (flip stripPrefixCI s) ps of
        Just s' -> if d then dropWhile isSpace s' else s'
        Nothing -> s

modPleasePrefix :: String -> String
modPleasePrefix = modPrefixCI "please" True

modPleasePrefix' :: String -> String
modPleasePrefix' = modPrefixesCI ["please", "plz", "pls"] True

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

detectRef :: Config -> String -> Maybe String
detectRef conf msg =
    let bnick = connNick (cfgConnection 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)

expand :: [String] -> Maybe (CommandSet e s) -> [String]
expand ns Nothing     = ns
expand ns (Just cset) =
    let ls = map cmdNames $ csetCommands cset
    in  concat $ mapMaybe (\ n -> find (n `elem`) ls) ns

makePrefixedCommand :: Maybe Config
                    -> [CommandSet e s]
                    -> MessageSource
                    -> Char
                    -> String
                    -> Maybe Event
makePrefixedCommand mconf csets src pref msg =
    let (pref', msg') =
            case mconf >>= flip detectRef (pref:msg) of
                Just (p:m) -> (p, m)
                _          -> (pref, msg)
    in  if pref' `elem` map csetPrefix csets && not (null msg')
            then
                let (name, args) = mkCmd msg'
                in  Just $ BotCommand src (Just pref') name args
            else Nothing

makePrefixedCommandFromSet :: Maybe Config
                           -> CommandSet e s
                           -> MessageSource
                           -> Char
                           -> String
                           -> Maybe Event
makePrefixedCommandFromSet mconf cset =
    let names = concatMap cmdNames $ csetCommands cset
    in  makePrefixedCommandFromNames mconf (Left $ csetPrefix cset) names

makePrefixedCommandFromNames :: Maybe Config
                             -> Either Char (CommandSet e s)
                             -> [String]
                             -> MessageSource
                             -> Char
                             -> String
                             -> Maybe Event
makePrefixedCommandFromNames mconf eith names src pref msg =
    let (pref', msg') =
            case mconf >>= flip detectRef (pref:msg) of
                Just (p:m) -> (p, m)
                _          -> (pref, msg)
    in  if pref' == either id csetPrefix eith && not (null msg')
            then
                let (name, args) = mkCmd msg'
                    cset = either (const Nothing) Just eith
                in  if name `elem` expand names cset
                        then Just $ BotCommand src (Just pref') name args
                        else Nothing
            else Nothing

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

makeRefCommandFromSet :: Config
                      -> CommandSet e s
                      -> MessageSource
                      -> (String -> String)
                      -> String
                      -> Maybe Event
makeRefCommandFromSet conf cset =
    let names = concatMap cmdNames $ csetCommands cset
    in  makeRefCommandFromNames conf Nothing names

makeRefCommandFromNames :: Config
                        -> Maybe (CommandSet e s)
                        -> [String]
                        -> MessageSource
                        -> (String -> String)
                        -> String
                        -> Maybe Event
makeRefCommandFromNames conf cset names src f msg =
    case detectRef conf msg of
        Just s ->
            let (name, args) = mkCmd $ f s
            in  if name `elem` expand names cset
                    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 msg
        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
-------------------------------------------------------------------------------

ifPriv :: EventMatchSpace -> Maybe Event -> Maybe Event
ifPriv MatchInChannel _ = Nothing
ifPriv _              e = e

ifChan :: EventMatchSpace -> Maybe Event -> Maybe Event
ifChan MatchInPrivate _ = Nothing
ifChan _              e = e

matchPrefixedCommand :: EventMatchSpace
                     -> Bool
                     -> EventMatcher e s
matchPrefixedCommand space ref event conf csets =
    case event of
        C.ChannelMessage chan nick (c:cs) False ->
            ifChan space $
            makePrefixedCommand mconf csets (Channel chan nick) c cs
        C.PrivateMessage nick (c:cs) False ->
            ifPriv space $
            makePrefixedCommand mconf csets (User nick) c cs
        _ -> Nothing
    where
    mconf = if ref then Just conf else Nothing

matchPrefixedCommandFromSet :: EventMatchSpace
                            -> Bool
                            -> Maybe (CommandSet e s)
                            -> EventMatcher e s
matchPrefixedCommandFromSet space ref mcset event conf csets =
    case maybe (listToMaybe csets) Just mcset of
        Nothing   -> Nothing
        Just cset ->
            case event of
                C.ChannelMessage chan nick (c:cs) False ->
                    ifChan space $
                    makePrefixedCommandFromSet
                        mconf cset (Channel chan nick) c cs
                C.PrivateMessage nick (c:cs) False ->
                    ifPriv space $
                    makePrefixedCommandFromSet
                        mconf cset (User nick) c cs
                _ -> Nothing
    where
    mconf = if ref then Just conf else Nothing

matchPrefixedCommandFromNames :: EventMatchSpace
                              -> Bool
                              -> Either Char (CommandSet e s)
                              -> [String]
                              -> EventMatcher e s
matchPrefixedCommandFromNames space ref eith names event conf csets =
    case event of
        C.ChannelMessage chan nick (c:cs) False ->
            ifChan space $
            makePrefixedCommandFromNames
                mconf eith names (Channel chan nick) c cs
        C.PrivateMessage nick (c:cs) False ->
            ifPriv space $
            makePrefixedCommandFromNames
                mconf eith names (User nick) c cs
        _ -> Nothing
    where
    mconf = if ref then Just conf else Nothing

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

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

matchRefCommandFromNames :: EventMatchSpace
                         -> (String -> String)
                         -> Bool
                         -> [String]
                         -> EventMatcher e s
matchRefCommandFromNames space f ex names event conf csets =
    case event of
        C.ChannelMessage chan nick msg False -> ifChan space $
            makeRefCommandFromNames conf cset names (Channel chan nick) f msg
        C.PrivateMessage nick msg False -> ifPriv space $
            makeRefCommandFromNames conf cset names (User nick) f msg
        _ -> Nothing
    where
    cset = if ex then listToMaybe csets else Nothing

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

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

matchRef :: EventMatchSpace -> EventMatcher e s
matchRef space event conf _csets =
    case event of
        C.ChannelMessage chan nick msg False ->
            ifChan space $ makeRefC conf chan nick msg
        C.PrivateMessage nick msg False ->
            ifPriv space $ 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.ChannelAction channel nick msg ->
            Just $ Action channel nick msg $ msg `mentions` bnick
        C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg
        C.PrivateAction nick msg -> Just $ PersonalAction nick msg
        C.NickChange oldnick newnick -> Just $ NickChange oldnick newnick
        C.Topic channel nick topic -> Just $ TopicChange channel nick topic
        C.Names priv chan pnicks -> Just $ Names chan priv pnicks
        _ -> Nothing
    where
    bnick = connNick (cfgConnection 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
           -> Maybe String -- Channel in which the command was triggered
           -> String       -- Nickname of user who triggered the command
           -> Session e s ()
runCommand cpref cname cparams mchan sender = do
    csets <- askBehaviorS commandSets
    case findCommand cpref cname csets of
        Nothing          ->
            case mchan of
                Just chan -> defaultRespondToChan chan cpref cname Nothing
                Nothing -> defaultRespondToUser sender cpref cname Nothing
        Just (Left cset) ->
            case mchan of
                Just chan ->
                    defaultRespondToChan
                        chan (Just $ csetPrefix cset) cname (Just cset)
                Nothing ->
                    defaultRespondToUser
                        sender (Just $ csetPrefix cset) cname (Just cset)
        Just (Right cmd) ->
            cmdRespond cmd mchan sender cparams (sendBack mchan sender)

-- 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 user -> do
            tracked <- channelIsTracked chan
            when tracked $ addMember chan user
            self <- askConfigS $ connNick . cfgConnection
            when (user == self) $ addCurrChan chan
            handleJoin b chan user
        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
        Action chan sender msg mentioned ->
            handleAction b chan sender msg mentioned
        Notice mchan sender msg -> return ()
        BotMessage chan sender msg full -> handleBotMsg b chan sender msg full
        BotCommand (Channel chan sender) cpref cname cargs ->
            runCommand cpref cname cargs (Just chan) sender
        BotCommand (User sender) cpref cname cargs ->
            runCommand cpref cname cargs Nothing sender
        PersonalMessage sender msg -> handlePersonalMsg b sender msg
        PersonalAction sender msg -> handlePersonalAction b sender msg
        NickChange oldnick newnick -> do
            changeNick oldnick newnick
            handleNickChange b oldnick newnick
        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)) $ csLogger cstate
        detectOne chan event = do
            cstates <- gets bsChannels
            return $ maybeToList $ M.lookup chan cstates >>= detect event
        detectMany nick event = do
            chans <- presence nick
            cstates <- gets bsChannels
            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.Action nick chan msg  -> detectOne chan $ ActInChan 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