{-# LANGUAGE DoAndIfThenElse #-}

module Configuration (
  Cfg(..),
  cj_empty,
  get_cfg,
  use_account
  )
where

import Data.ConfigFile
import Data.Maybe (isJust)
import Data.Monoid (Monoid(..))
import Network.HTTP.Conduit (CookieJar, createCookieJar, destroyCookieJar)
import System.Directory (
  doesFileExist,
  getAppUserDataDirectory
  )
import System.Exit (ExitCode(..), exitWith)
import System.FilePath.Posix (joinPath)
import System.IO (hPutStrLn, stderr)

import qualified CommandLine as Cmd (
  Args(..),
  apply_args,
  program_name
  )
import ExitCodes

-- | Contains all of our configurable options.
data Cfg = Cfg {
  article      :: String,
  cookie_jar   :: CookieJar,
  full_stories :: Bool,
  output       :: FilePath,
  password     :: Maybe String,
  username     :: Maybe String }

-- An empty CookieJar. See cj_append for rationale.
cj_empty :: CookieJar
cj_empty = createCookieJar []


-- Defined for convenience; I would really like to use mappend but GHC
-- bitches about the orphan instance.
cj_append :: CookieJar -> CookieJar -> CookieJar
cj_append cj1 cj2 =
  createCookieJar (cookies1 ++ cookies2)
  where
    -- Decompose the cookie jars into lists.
    cookies1 = destroyCookieJar cj1
    cookies2 = destroyCookieJar cj2

instance Monoid Cfg where
  mempty = Cfg { article      = mempty,
                 cookie_jar   = cj_empty,
                 full_stories = False,
                 output       = mempty,
                 password     = Nothing,
                 username     = Nothing }

  mappend c1 c2 =
    let article'      = (if null article1 then article2 else article1)
        cookie_jar'   = cookie_jar1 `cj_append` cookie_jar2
        full_stories' = full_stories1 || full_stories2
        output'       = (if null output1 then output2 else output1)
        password'     = password1 `mappend` password2
        username'     = username1 `mappend` username2
    in
        Cfg { article      = article',
              cookie_jar   = cookie_jar',
              full_stories = full_stories',
              output       = output',
              password     = password',
              username     = username' }
    where
      article1      = article c1
      article2      = article c2
      cookie_jar1   = cookie_jar c1
      cookie_jar2   = cookie_jar c2
      full_stories1 = full_stories c1
      full_stories2 = full_stories c2
      output1       = output c1
      output2       = output c2
      password1     = password c1
      password2     = password c2
      username1     = username c1
      username2     = username c2


use_account :: Cfg -> Bool
use_account cfg =
  (isJust $ username cfg) && (isJust $ password cfg)

format_cpe :: CPError -> String
format_cpe (ParseError desc, _) = "Parse error: " ++ desc
format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc
format_cpe (NoSection desc, _) = "Missing section: " ++ desc
format_cpe (NoOption desc, _) = "Missing required option: " ++ desc
format_cpe (OtherProblem desc, _) = "Error: " ++ desc
format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc


-- | The config parsing functions return either the result or a
--   'CPError'. If there was an error, we represent it as 'Nothing'
--   (at least if we're forcing the value into a 'Maybe'
--   wrapper. Otherwise, we return 'Just' the result.
either_to_maybe :: Either CPError a -> Maybe a
either_to_maybe (Left  _) = Nothing
either_to_maybe (Right x) = Just x


config_filename :: String
config_filename = Cmd.program_name ++ ".conf"

config_path :: IO FilePath
config_path = do
  cfg_dir <- getAppUserDataDirectory Cmd.program_name
  let cfg_file = joinPath [cfg_dir, config_filename]
  return $ cfg_file

parse_config :: IO (Either String Cfg)
parse_config = do
  cfg_file <- config_path
  it_exists <- doesFileExist cfg_file
  if not it_exists then do
    return $ Right mempty
  else do
    parse_result <- readfile emptyCP cfg_file

    return $
      case parse_result of
        Left err -> Left (format_cpe err)
        Right cp ->
            let cp_full_stories = get cp "DEFAULT" "full_stories"
                cp_password = get cp "DEFAULT" "password"
                cp_username = get cp "DEFAULT" "username"

                cfg_password = either_to_maybe cp_password
                cfg_full_stories = case cp_full_stories of
                                     Left _  -> False -- default
                                     Right f -> f
                cfg_username = either_to_maybe cp_username
            in
                Right $ mempty { full_stories = cfg_full_stories,
                                 password = cfg_password,
                                 username = cfg_username }



get_cfg :: IO Cfg
get_cfg = do
  cmd_article <- Cmd.apply_args
  let arg_cfg = mempty { article      = Cmd.article cmd_article,
                         full_stories = Cmd.full_stories cmd_article,
                         output       = Cmd.output cmd_article }

  either_file_cfg <- parse_config
  case either_file_cfg of
    Left err -> do
      hPutStrLn stderr err
      exitWith $ ExitFailure exit_config_parse_failed
    Right file_cfg ->
      -- The left operand takes precedence when both are non-empty!
      return $ arg_cfg `mappend` file_cfg