{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeApplications           #-}

module Main where

import           Options.Applicative

import qualified Data.ByteString                as ByteString
import           Data.ByteString.Lazy           (ByteString)
import qualified Data.ByteString.Lazy           as ByteStringLazy
import           Data.Either.Extra
import qualified Data.Text.IO                   as TextIO
import qualified Data.Text.Lazy                 as Text

import           Control.Exception
import           Control.Monad
import           Control.Monad.Except           (ExceptT, MonadError, liftEither,
                                                 runExceptT, throwError)
import           Control.Monad.IO.Class
import           Control.Monad.Reader           (MonadReader, ReaderT, ask, runReaderT)
import           Control.Monad.Trans            (MonadTrans, lift)
import           GHC.IO.Exception               (IOErrorType (UserError),
                                                 IOException (..))

import           System.Directory
import           System.Environment.XDG.BaseDir
import           System.IO

import           AlBhed
import           AlBhed.Index                   (AlBhedIndex, addLocation, getPrimer, oneline,
                                                 toDoc)
import           Data.JSON                      
import           Data.Maybe
import           Options                        (Build, Command, Config, Run)
import qualified Options
import qualified Options.Primer                 as Primer

newtype App a = App { runApp :: ReaderT (Config Run) (ExceptT AppError IO) a }
    deriving stock (Functor)
    deriving newtype (MonadReader (Config Run), Applicative, Monad, MonadIO, MonadError AppError, MonadFail)

applicationName :: String
applicationName = "ffxwt"

main :: IO ()
main = do
    (configBuild, command) <- execParser opts
    datadir <- getUserDataDir applicationName
    let config = Options.configBuild datadir configBuild
    result <- runExceptT . flip runReaderT config . runApp $ dispatch command
    either handleError return result
    where
        opts = info (Options.mainOpts <**> helper)
            (fullDesc
            <> progDesc "Track your progress in Final Fantasy X"
            <> header "ffxwt - Final Fantasy X WalkThrough")
        handleError = putStrLn . ("error: " ++)

dispatch :: Command -> App ()
dispatch (Options.Primer x) = primerDispatch x

primerDispatch :: Primer.PrimerCommand -> App ()
primerDispatch command = do
    config <- ask
    primers <- loadIndex
    case command of
        (Primer.Add vol loc) ->
            case getPrimer vol primers of
                Nothing -> throwError "Primer not found"
                Just x  -> saveIndex $ addLocation x loc primers
        (Primer.New vol from to loc) ->
            let newPrimer = Primer vol from to
                index = case getPrimer vol primers of
                    Nothing -> Right $ addLocation newPrimer loc primers
                    Just x ->
                        if x == newPrimer
                        then Right $ addLocation newPrimer loc primers
                        else Left "The primer already exists and they differ in some fields"
                in liftEither index >>= saveIndex
        Primer.List opts ->
            let doc = case opts of
                    Primer.OneLine   -> toDoc oneline
                    Primer.MultiLine -> toDoc id
                in liftIO . print . doc $ primers

type AppError = String

saveIndex :: AlBhedIndex -> App ()
saveIndex index = do
    config <- ask
    let filename = Options.fromRun $  Options.dataFile config

    liftIO $ withFile filename WriteMode
        (\handle -> let json = toJson index in TextIO.hPutStr handle $ Text.toStrict json)

loadIndex :: App AlBhedIndex
loadIndex = do
    config <- ask

    let filename = Options.fromRun $ Options.dataFile config
    fileExists <- liftIO $ doesFileExist filename

    if fileExists
        then liftIO (withFile filename ReadMode (ByteStringLazy.hGetContents >=> tryJust catchError . loadContent))
                >>= liftEither
        else
                loadContent "[]"
    where
        catchError e = case ioe_type e of
            UserError -> Just $ ioe_description e
            _         -> Nothing
        loadContent :: (MonadFail m) => ByteString -> m AlBhedIndex
        loadContent = either fail pure . fromJson' @AlBhedIndex