{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import Data.Aeson
import Data.Aeson.Types
import Data.Foldable
import Data.Functor

import Data.ByteString (ByteString)

import Control.Monad.Trans

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as TIO

import Control.Monad.Reader
import Control.Monad.Trans.Maybe

import Network.HTTP.Req
import Text.URI (mkURI)

import System.Environment

import Discord
import Discord.Interactions
import qualified Discord.Requests as Request
import Discord.Types

import Deck.Diff
import Parser
import Repr.DiffRep

data AppConfig = AppConfig
    { botToken :: Text
    }

data SlashCommand = SlashCommand
    { name :: Text
    , register :: Maybe CreateApplicationCommand
    , handler ::
        Interaction
        -> Maybe OptionsData
        -> Maybe ResolvedData
        -> DiscordHandler ()
    }

defaultConfig :: AppConfig
defaultConfig =
    AppConfig
        { botToken = mempty
        }

getBotToken :: MaybeT IO Text
getBotToken = do
    token <- liftIO $ lookupEnv "DECKVINE_DISCORD_TOKEN"

    MaybeT . return $ fmap Text.pack token

getAppConfig :: MaybeT IO AppConfig
getAppConfig = do
    botToken <- getBotToken

    MaybeT . return $ Just defaultConfig {botToken}

runApp :: ReaderT AppConfig IO ()
runApp = do
    config <- ask
    userErr <-
        liftIO $
            runDiscord $
                def
                    { discordToken = botToken config
                    , discordOnEvent = eventHandler config
                    , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
                    }

    liftIO $ TIO.putStrLn userErr

fileRequest :: (MonadIO m) => Text -> m (Maybe ByteString)
fileRequest input = runReq defaultHttpConfig $ do
    uri <- mkURI $ Text.dropWhileEnd (== '&') input
    case useHttpsURI uri of
        Nothing -> return Nothing
        Just (url, options) -> do
            bs <- req GET url NoReqBody bsResponse options
            return . Just $ responseBody bs

handleDiff ::
    Interaction -> Maybe OptionsData -> Maybe ResolvedData -> DiscordHandler ()
handleDiff intr opts resolved = do
    let oldId = keyList >>= lookup "old"
        newId = keyList >>= lookup "new"
        atts = resolved >>= attachments
        oldUrl = atts >>= (\x -> oldId >>= \y -> lookup (showT y) x)
        newUrl = atts >>= (\x -> newId >>= \y -> lookup (showT y) x)

    case (oldUrl, newUrl) of
        (Just oldReq, Just newReq) -> do
            oldBytes <- fileRequest oldReq
            newBytes <- fileRequest newReq

            case (oldBytes, newBytes) of
                (Just oldContent, Just newContent) ->
                    let res =
                            ((,) <$> fromByteString oldContent <*> fromByteString newContent)
                                <&> view . eval . uncurry diff . uncurry evalDiffs
                     in case res of
                            Left _ ->
                                createResponse
                                    "Something went wrong, make sure the files are in the correct format"
                            Right report -> createResponse report
                _ -> createResponse "Unable to fetch the files"
        _ -> createResponse "Malformed URI's"
  where
    createResponse response =
        void $
            restCall $
                Request.CreateInteractionResponse
                    (interactionId intr)
                    (interactionToken intr)
                    (interactionResponseBasic response)
    keyList = values =<< opts
    values (OptionsDataValues vals) =
        mapM
            ( \case
                OptionDataValueAttachment {optionDataValueName, optionDataValueAttachment} -> Just (optionDataValueName, optionDataValueAttachment)
                _ -> Nothing
            )
            vals
    values _ = Nothing
    attachments :: ResolvedData -> Maybe [(Text, Text)]
    attachments (ResolvedData {resolvedDataAttachments = vals}) = case vals of
        Nothing -> Nothing
        Just val -> parseMaybe parseAttachments val
    parseAttachments = withObject "<attachment>" $ \obj ->
        let kvs = toList obj
            parsed = mapM parseUrl kvs
         in parsed
    parseUrl = withObject "<url>" $ \obj -> do
        attachmentId <- obj .: "id"
        attachmentUrl <- obj .: "url"

        return (attachmentId, attachmentUrl)

slashDiffCommand :: SlashCommand
slashDiffCommand = SlashCommand "diff" mkOptions handleDiff
  where
    mkOptions = options <$> createChatInput "diff" "Check the diff of two decklists"
    options command =
        command
            { createOptions =
                Just $
                    OptionsValues
                        [ OptionValueAttachment "old" Nothing "Old decklist" Nothing True
                        , OptionValueAttachment "new" Nothing "New decklist" Nothing True
                        ]
            }

slashCommands :: [SlashCommand]
slashCommands = [slashDiffCommand]

main :: IO ()
main = do
    config <- runMaybeT getAppConfig

    for_ config (runReaderT runApp)

eventHandler :: AppConfig -> Event -> DiscordHandler ()
eventHandler _config event = case event of
    Ready _ _ _ _ _ _ (PartialApplication appId _) -> onReady appId
    InteractionCreate intr -> case intr of
        cmd@InteractionApplicationCommand
            { applicationCommandData =
                ApplicationCommandDataChatInput
                    { applicationCommandDataName
                    , resolvedData
                    , optionsData
                    }
            } ->
                case find (\c -> applicationCommandDataName == name c) slashCommands of
                    Nothing -> echo "The command could not be found in the commands, out of sync"
                    Just found -> handler found cmd optionsData resolvedData
        _ -> pure ()
    _ -> pure ()

echo :: (MonadIO m) => Text -> m ()
echo = liftIO . TIO.putStrLn

showT :: (Show a) => a -> Text
showT = Text.pack . show

onReady :: ApplicationId -> DiscordHandler ()
onReady appId = do
    registerCommands <- mapM tryRegistering slashCommands

    case sequence registerCommands of
        Left err -> echo $ "[!] Unable to register some slash commands: " <> showT err
        Right cmds -> do
            echo $ "Registered " <> showT (length cmds) <> " command(s)"

            unregisterOutdatedCommands cmds
  where
    tryRegistering cmd =
        case register cmd of
            Nothing -> return . Left $ RestCallErrorCode 0 "" ""
            Just reg -> restCall $ Request.CreateGlobalApplicationCommand appId reg
    unregisterOutdatedCommands validCmds = do
        registered <- restCall $ Request.GetGlobalApplicationCommands appId

        case registered of
            Left err -> echo $ "Failed to get commands: " <> showT err
            Right cmds ->
                let validIds = map applicationCommandId validCmds
                    outdatedIds = filter (`notElem` validIds) . map applicationCommandId $ cmds
                 in forM_ outdatedIds $ restCall . Request.DeleteGlobalApplicationCommand appId