+{-# LANGUAGE DoAndIfThenElse #-}
+
module Configuration (
Cfg(..),
- get_cfg
+ cj_empty,
+ get_cfg,
+ use_account
)
where
-import Control.Monad (mplus)
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)
-- | Contains all of our configurable options.
data Cfg = Cfg {
- article :: String,
- output :: FilePath,
- password :: Maybe String,
- username :: Maybe String }
-
+ 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 = "",
- output = "",
- password = Nothing,
- username = Nothing }
+ 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)
- output' = (if null output1 then output2 else output1)
- password' = password1 `mplus` password2
- username' = username1 `mplus` username2
+ 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',
- output = output',
- password = password',
- username = username' }
+ Cfg { article = article',
+ cookie_jar = cookie_jar',
+ full_stories = full_stories',
+ output = output',
+ password = password',
+ username = username' }
where
- article1 = article c1
- article2 = article c2
- output1 = output c1
- output2 = output c2
- password1 = password c1
- password2 = password c2
- username1 = username c1
- username2 = username c2
+ 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
config_path :: IO FilePath
config_path = do
cfg_dir <- getAppUserDataDirectory Cmd.program_name
- return $ joinPath [cfg_dir, config_filename]
+ let cfg_file = joinPath [cfg_dir, config_filename]
+ return $ cfg_file
parse_config :: IO (Either String Cfg)
parse_config = do
cfg_file <- config_path
- parse_result <- readfile emptyCP cfg_file
-
- return $
- case parse_result of
- Left err -> Left (format_cpe err)
- Right cp ->
- let cp_username = get cp "DEFAULT" "username"
- cp_password = get cp "DEFAULT" "password"
-
- cfg_username = either_to_maybe cp_username
- cfg_password = either_to_maybe cp_password
- in
- Right $ mempty { username = cfg_username,
- password = cfg_password }
+ 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,
- output = Cmd.output cmd_article }
+ 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