--------------------------------------------------------------------------------

module Codeforces.App.Config
    ( loadConfig
    , setupConfig
    ) where

import           Codeforces.Config
import           Codeforces.Types

import           Data.Aeson
import qualified Data.ByteString.Lazy          as BL
import           Data.Maybe
import qualified Data.Text.IO                  as T

import           System.Directory
import           System.IO

--------------------------------------------------------------------------------

-- | 'loadConfig' returns the user configuration instance from the config file.
loadConfig :: IO UserConfig
loadConfig :: IO UserConfig
loadConfig = do
    FilePath
path      <- IO FilePath
configPath
    Bool
hasConfig <- FilePath -> IO Bool
doesPathExist FilePath
path
    Maybe UserConfig
mConfig   <- if Bool
hasConfig then ByteString -> Maybe UserConfig
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe UserConfig)
-> IO ByteString -> IO (Maybe UserConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BL.readFile FilePath
path else Maybe UserConfig -> IO (Maybe UserConfig)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe UserConfig
forall a. Maybe a
Nothing
    UserConfig -> IO UserConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserConfig -> IO UserConfig) -> UserConfig -> IO UserConfig
forall a b. (a -> b) -> a -> b
$ UserConfig -> Maybe UserConfig -> UserConfig
forall a. a -> Maybe a -> a
fromMaybe UserConfig
emptyConfig Maybe UserConfig
mConfig

-- | The user configuration file path is
-- @configPath/codeforces-cli/config.json@ where @configPath@ is the user's
-- 'XdgConfig' directory.
configPath :: IO FilePath
configPath :: IO FilePath
configPath = XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgConfig FilePath
"codeforces-cli/config.json"

emptyConfig :: UserConfig
emptyConfig :: UserConfig
emptyConfig = UserConfig :: Handle -> Text -> Text -> UserConfig
UserConfig { cfgHandle :: Handle
cfgHandle = Text -> Handle
Handle Text
"", cfgKey :: Text
cfgKey = Text
"", cfgSecret :: Text
cfgSecret = Text
"" }

--------------------------------------------------------------------------------

-- | Creates a configuration file with user prompts.
--
-- The user must decide whether to overwrite their configuration file if one
-- already exists.
--
setupConfig :: IO ()
setupConfig :: IO ()
setupConfig = do
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin  BufferMode
LineBuffering
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering

    FilePath
path     <- IO FilePath
configPath
    Bool
exists   <- FilePath -> IO Bool
doesPathExist FilePath
path

    Bool
continue <- if Bool
exists
        then do
            FilePath -> IO ()
putStrLn
                (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$  FilePath
"Warning: A configuration file already exists in "
                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path
            FilePath -> IO ()
putStr FilePath
"Do you want to continue? [Y/n]: "
            FilePath
resp <- IO FilePath
getLine
            Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
resp FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Y"
        else Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

    if Bool -> Bool
not Bool
continue then () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else FilePath -> IO ()
createConfig FilePath
path

-- | 'createConfig' is an interactive prompt tool to help users create
-- configuration files easily.
createConfig :: FilePath -> IO ()
createConfig :: FilePath -> IO ()
createConfig FilePath
path = do
    FilePath -> IO ()
putStrLn FilePath
""
    FilePath -> IO ()
putStrLn
        FilePath
"You'll need to generate an API key via \
        \<https://codeforces.com/settings/api>\n"
    FilePath -> IO ()
putStrLn FilePath
"Then, complete the following details:\n"

    FilePath -> IO ()
putStr FilePath
"Codeforces handle: "
    Text
handle <- IO Text
T.getLine

    FilePath -> IO ()
putStr FilePath
"API key: "
    Text
key <- IO Text
T.getLine

    FilePath -> IO ()
putStr FilePath
"API secret: "
    Text
secret <- IO Text
T.getLine

    FilePath -> ByteString -> IO ()
BL.writeFile FilePath
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ UserConfig -> ByteString
forall a. ToJSON a => a -> ByteString
encode UserConfig :: Handle -> Text -> Text -> UserConfig
UserConfig { cfgHandle :: Handle
cfgHandle = Text -> Handle
Handle Text
handle
                                          , cfgKey :: Text
cfgKey    = Text
key
                                          , cfgSecret :: Text
cfgSecret = Text
secret
                                          }
    FilePath -> IO ()
putStrLn FilePath
""
    FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Successfully created a configuration file in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path

--------------------------------------------------------------------------------