{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE OverloadedStrings #-}
module Lambdabot.Plugin.Telegram.Callback where

import Control.Exception.Lifted ( SomeException (..) )
import Control.Exception.Lifted as E (catch)
import Control.Monad.State (gets, lift)
import Data.List
import Data.List.Split
import qualified Data.Text as Text
import qualified Data.Map.Strict as Map
import Text.EditDistance
import Text.Regex.TDFA

import Lambdabot.Bot
import Lambdabot.Command
import Lambdabot.Config
import Lambdabot.IRC
import Lambdabot.Logging
import Lambdabot.Message
import Lambdabot.Monad
import Lambdabot.Nick
import Lambdabot.Plugin.Core
import Lambdabot.Util

import Lambdabot.Plugin.Telegram.Shared
import Lambdabot.Plugin.Telegram.Message


-- | In order to read messages from a different plugin, it is necessary
-- to set a callback with a known label. This function is a main entry point
-- as a plugin callback.
--
-- Since we needed an extended functionality from @eval@ plugin,
-- we used these non-exported functions from corresponding @lambdabot-haskell-plugins@ module.
doTGMSG :: IrcMessage -> Telegram ()
doTGMSG msg = do
  ignored     <- lift $ checkIgnore msg
  commands    <- getConfig commandPrefixes
  if ignored
    then doIGNORE msg
    else mapM_ (doTGMSG' commands (lambdabotName msg) msg) targets
  where
    alltargets = head (ircMsgParams msg)
    targets = map (parseNick (ircMsgServer msg)) $ splitOn "," alltargets

doIGNORE :: IrcMessage -> Telegram ()
doIGNORE = debugM . show

doTGMSG'
  :: [String] -- ^ Commands.
  -> Nick -- ^ My name.
  -> IrcMessage -- ^ IRC Message.
  -> Nick -- ^ Target name.
  -> Telegram ()
doTGMSG' commands myname msg target
    | myname == target
    = let (cmd, params) = splitFirstWord text
      in doPersonalMsg commands msg cmd params
    
    | flip any (":," :: String)
        $ \c -> (fmtNick (ircMsgServer msg) myname ++ [c]) `isPrefixOf` text
    = let Just wholeCmd = maybeCommand (fmtNick (ircMsgServer msg) myname) text
          (cmd, params) = splitFirstWord wholeCmd
      in doPublicMsg commands msg target cmd params
    
    | (commands `arePrefixesOf` text)
    && length text > 1
    && (text !! 1 /= ' ') -- elem of prefixes
    && (not (commands `arePrefixesOf` [text !! 1]) ||
      (length text > 2 && text !! 2 == ' ')) -- ignore @@ prefix, but not the @@ command itself
    = let (cmd, params) = splitFirstWord (dropWhile (==' ') text)
      in doPublicMsg commands msg target cmd params
    
    | otherwise = return () -- contextual messages are not allowed here
    
    where
        text = tail (head (tail (ircMsgParams msg)))

doPersonalMsg
  :: [String]
  -> IrcMessage
  -> String
  -> String
  -> Telegram ()
doPersonalMsg commands msg s r
  | commands `arePrefixesOf` s = doMsg msg (tail s) r who
  | otherwise                  = return () -- contextual messages are not allowed here
  where
    who = nick msg

doPublicMsg
  :: [String] -> IrcMessage -> Nick -> String -> String -> Telegram ()
doPublicMsg commands msg target s r
    | commands `arePrefixesOf` s  = doMsg msg (tail s) r target
    | otherwise                   = doIGNORE msg

-- | normal commands.
--
-- check privledges, do any spell correction, dispatch, handling
-- possible timeouts.
--
doMsg :: IrcMessage -> String -> String -> Nick -> Telegram ()
doMsg msg cmd rest towhere = do
    ldebug $ "doMsg : nick : " <> fmtNick "" towhere <> " : cmd : " <> cmd
    let ircmsg = tgIrcPrivMsg (getTgChatId msg) (getTgMsgId msg) . Text.pack
    allcmds <- lift (gets (Map.keys . ircCommands))
    let ms      = filter (isPrefixOf cmd) allcmds
    e <- getConfig editDistanceLimit
    case ms of
        [s] -> docmd msg towhere rest s                  -- a unique prefix
        _ | cmd `elem` ms -> docmd msg towhere rest cmd  -- correct command (usual case)
        _ | otherwise     -> case closests cmd allcmds of
          (n,[s]) | n < e ,  ms == [] -> docmd msg towhere rest s -- unique edit match
          (n,ss)  | n < e || ms /= []            -- some possibilities
              -> lift . ircmsg $ "Maybe you meant: "++showClean(nub(ms++ss))
          _   -> docmd msg towhere rest cmd         -- no prefix, edit distance too far

docmd :: IrcMessage -> Nick -> [Char] -> String -> Telegram ()
docmd msg towhere rest cmd' = lb $ 
    withCommand cmd'   -- Important.
        (tgIrcPrivMsg (getTgChatId msg) (getTgMsgId msg)  "Unknown command, try @list")
        (\theCmd -> do
            hasPrivs <- lb (checkPrivs msg)
            -- TODO: handle disabled commands earlier
            -- users should probably see no difference between a
            -- command that is disabled and one that doesn't exist.
            disabled <- elem cmd' <$> getConfig disabledCommands
            let ok = not disabled && (not (privileged theCmd) || hasPrivs)

            -- unfortunately we have to pre-process command here to add some context,
            -- since the 'process' accepts a 'String' but we want more info specified
            -- (e.g. 'ChatId') to create multiple sandboxes
            debugM $ "docmd : nick : " <> fmtNick "" towhere <> " : cmd : " <> cmd' <> " : input : " <> rest
            let new = if cmd' `elem` ["@run", "@define", "@undefine", "@let", "run", "define", "undefine", "let"]
                  then Text.unpack (getTgChatId msg) <> "|" <> rest
                  else rest

            response <- if not ok
                then return ["Not enough privileges"]
                else runCommand theCmd msg towhere cmd' new
                    `E.catch` \exc@SomeException{} ->
                        return ["Plugin `Telegram` failed with: " ++ show exc]
            
            lift $ mapM_ (tgIrcPrivMsg (getTgChatId msg) (getTgMsgId msg) . Text.pack . expandTab 8) response
        )


closests :: String -> [String] -> (Int,[String])
closests pat ss = Map.findMin m
  where
    m = Map.fromListWith (++) ls
    ls = [ (levenshteinDistance defaultEditCosts pat s, [s]) | s <- ss ]

maybeCommand :: String -> String -> Maybe String
maybeCommand nm text = mrAfter <$> matchM re text
  where
    re :: Regex
    re = makeRegex (nm ++ "[.:,]*[[:space:]]*")