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

-- | This module allows you to define bot event handlers and commands, and then
-- just run event source and sink threads in your @main@ function and let them
-- handle all the details.
module Network.IRC.Fun.Bot
    ( runBot
    )
where

import Control.Concurrent (threadDelay, forkIO)
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Monad (liftM, forever, void, when)
import Control.Monad.IO.Class (liftIO)
import Data.List (transpose)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Data.Time.Interval
import Network.IRC.Fun.Bot.Internal.Chat (sendIO)
import Network.IRC.Fun.Bot.Internal.Event
import Network.IRC.Fun.Bot.Internal.History
import Network.IRC.Fun.Bot.Internal.Logger
import Network.IRC.Fun.Bot.Internal.Monad (ask)
import Network.IRC.Fun.Bot.Internal.MsgCount
import Network.IRC.Fun.Bot.Internal.Types
import Network.IRC.Fun.Bot.Chat (login, joinConfig, run)
import Network.IRC.Fun.Bot.State (askConfigS)
import Network.IRC.Fun.Client.ChannelLogger (fromClientEvent)
import Network.IRC.Fun.Client.Events (hGetIrcEvents)
import Network.IRC.Fun.Client.IO (connServer, hPutIrc)
import Network.IRC.Fun.Types (Message (PingMessage))
import System.Clock
import System.IO.Error (tryIOError)

import qualified Network.IRC.Fun.Client.Events as C (Event (Pong))

-- Get the bot ready for listening to IRC messages.
startBot :: Session e s ()
startBot = do
    liftIO $ putStrLn "Bot: Logging in as IRC user with nickname"
    login
    liftIO $ putStrLn "Bot: Joining IRC channels"
    joinConfig

-- Wait for an event, then handle it according to bot behavior definition.
-- Return whether listening should continue.
listenToEvent
    :: (Text -> Session e s ()) -- Log error
    -> (Text -> Session e s ()) -- Log event
    -> Chan (Msg a)             -- Chan from which to read events
    -> EventHandler e s a       -- Handler for external events
    -> Session e s Bool
listenToEvent elog dlog q handler = do
    m <- liftIO $ readChan q
    case m of
        MsgLogEvent event -> do
            handleEvent $ Left event
            return True
        MsgHistoryEvent nick chan msg action -> do
            rememberMsg chan nick msg action
            return True
        MsgCountLogMsg chan -> do
            recordMsg chan
            return True
        MsgCountLogJoin nick chan -> do
            recordJoin nick chan
            return True
        MsgCountLogPart nick chan -> do
            recordPart nick chan
            return True
        MsgCountLogQuit nick -> do
            recordQuit nick
            return True
        MsgBotEvent event -> do
            handleEvent $ Right event
            return True
        MsgExtEvent event -> do
            handler elog dlog event
            return True
        MsgQuit -> return False

-- Get time since epoch.
getNow :: IO TimeSpec
getNow = getTime Realtime

-- Collect IRC events from the server and push into a 'Chan' for the main
-- thread to handle.
listenToIrc
    :: [EventMatcher e s]
    -> BotEnv e s
    -> Chan (Msg a)
    -> MVar TimeSpec
    -> IO ()
listenToIrc ms bot chan pongvar = do
    let mlogger getfile =
            case getfile $ beConfig bot of
                Just path ->
                    fmap Just $ newLogger (fmap snd $ beGetTime bot) path
                Nothing -> return Nothing
    dlogger <- mlogger cfgIrcEventLogFile
    elogger <- mlogger cfgIrcErrorLogFile
    putStrLn "Bot: IRC event source listening to IRC events"
    let match e = matchEvent ms e (beConfig bot) (commandSets $ beBehavior bot)
        loop = do
            r <- tryIOError $ hGetIrcEvents $ beConn bot
            case r of
                Left e -> do
                    putStrLn "Bot: IRC event listener hGetIrcEvents IO error"
                    print e
                    writeChan chan MsgQuit
                Right (errs, ircEvents) -> do
                    let botEvents = map match ircEvents
                        logEvents = mapMaybe fromClientEvent ircEvents
                        hisEvents = mapMaybe checkEvent ircEvents
                        cntEvents = mapMaybe countEvent ircEvents
                        interleaved = concat $ transpose
                            [ map MsgLogEvent logEvents
                            , hisEvents
                            , cntEvents
                            , map MsgBotEvent botEvents
                            ]
                        isPong (C.Pong _ _) = True
                        isPong _            = False
                    when (any isPong ircEvents) $ do
                        now <- getNow
                        void $ tryTakeMVar pongvar
                        putMVar pongvar now
                    case dlogger of
                        Nothing -> return ()
                        Just lg -> mapM_ (logLine lg . show) botEvents
                    case elogger of
                        Nothing -> return ()
                        Just lg -> mapM_ (logLine lg . show) errs
                    writeList2Chan chan interleaved
                    loop
    loop

intervalToSpec :: TimeInterval -> TimeSpec
intervalToSpec ti =
    let t = microseconds ti
        (s, us) = t `divMod` (1000 * 1000)
    in  TimeSpec
            { sec  = fromInteger s
            , nsec = 1000 * fromInteger us
            }

-- Send pings periodically to the server, and track the latest PONGs received,
-- as reported by the receiver thread. If it has been long enough since the
-- last PONG, tell the main thread to shut down.
manageLag :: BotEnv e s
          -> Chan (Msg a)
          -> MVar TimeSpec
          -> IO ()
manageLag bot chan pongvar =
    case cfgLagCheck $ beConfig bot of
        Nothing -> return ()
        Just iv -> do
            putStrLn "Bot: IRC lag manager thread running"
            let maxdiff = intervalToSpec $ cfgLagMax $ beConfig bot
                loop prev = do
                    mpong <- tryTakeMVar pongvar
                    let pong = fromMaybe prev mpong
                    now <- getNow
                    if now - pong > maxdiff
                        then do
                            putStrLn "Bot: IRC max lag reached"
                            writeChan chan MsgQuit
                        else do
                            let serv =
                                    connServer $ cfgConnection $ beConfig bot
                            hPutIrc (beConn bot) $ PingMessage serv Nothing
                            threadDelay $ fromInteger $ microseconds iv
                            loop pong
            loop =<< getNow

-- Wait for requests to send IRC messages, and send them while maintaining a
-- delay to avoid flood.
sendMessages :: BotEnv e s -> IO ()
sendMessages bot = do
    putStrLn "Bot: IRC message sending scheduler thread running"
    let q = beMsgQueue bot
        c = beConn bot
        delay = fromInteger $ microseconds $ cfgMsgDelay $ beConfig bot
    forever $ do
        msg <- readChan q
        sendIO c msg
        threadDelay delay

-- Create a logging function from an optional log file path.
mkLog :: (Config -> Maybe FilePath) -> Session e s (Text -> Session e s ())
mkLog getfile = do
    mfile <- askConfigS getfile
    case mfile of
        Nothing   -> return $ const $ return ()
        Just file -> do
            logger <- newLogger' file
            return $ liftIO . logLine logger

-- Connect, login, join. Then listen to events and handle them, forever.
botSession :: [EventMatcher e s]
           -> [EventSource e s a]
           -> EventHandler e s a
           -> Session e s ()
           -> Session e s ()
botSession matchers sources handler actInit = do
    actInit
    chan <- liftIO newChan
    bot <- ask
    pongvar <- liftIO newEmptyMVar
    elog <- mkLog cfgExtErrorLogFile
    dlog <- mkLog cfgExtEventLogFile
    liftIO $ void $ forkIO $ sendMessages bot
    liftIO $ void $ forkIO $ listenToIrc matchers bot chan pongvar
    liftIO $ void $ forkIO $ manageLag bot chan pongvar
    let launch s = forkIO $ s (beConfig bot)
                              (beCustom bot)
                              (writeChan chan . MsgExtEvent)
                              (writeList2Chan chan . map MsgExtEvent)
                              (newLogger $ liftM snd $ beGetTime bot)
    liftIO $ mapM_ launch sources
    startBot
    liftIO $ putStrLn "Bot: Event sink listening to events"
    let listen = listenToEvent elog dlog
        loop = do
            proceed <- listen chan handler
            if proceed
                then loop
                else liftIO $ putStrLn "Bot: Event sink asked to stop"
    loop

-- | Start the bot and run its event loop. The bot will listen to messages from
-- the IRC server and other provided sources, and will respond according to the
-- behavior definitions.
runBot :: Config              -- ^ IRC connection configuration
       -> [EventMatcher e s]  -- ^ Event detection (high-to-low priority)
       -> Behavior e s        -- ^ Behavior definition for IRC events
       -> [EventSource e s a] -- ^ Additional event source threads to run
       -> EventHandler e s a  -- ^ Handler for events coming from those sources
       -> e                   -- ^ Custom bot environment (read-only state)
       -> s                   -- ^ Initial state to hold in the background
       -> Session e s ()      -- ^ Initialization action to run at the very
                              --   beginning of the session
       -> IO ()
runBot conf matchers behav sources handler env state actInit = do
    putStrLn "Bot: Starting"
    run conf behav env state $ botSession matchers sources handler actInit
    putStrLn "Bot: Disconnected"