1 {-# LANGUAGE DoAndIfThenElse #-}
10 import Control.Monad (mplus)
11 import Data.ConfigFile
12 import Data.Maybe (isJust)
13 import Data.Monoid (Monoid(..))
14 import System.Directory (
16 getAppUserDataDirectory
18 import System.Exit (ExitCode(..), exitWith)
19 import System.FilePath.Posix (joinPath)
20 import System.IO (hPutStrLn, stderr)
22 import qualified CommandLine as Cmd (
29 -- | Contains all of our configurable options.
32 cookie_jar :: Maybe FilePath,
34 password :: Maybe String,
35 username :: Maybe String }
38 instance Monoid Cfg where
39 mempty = Cfg { article = "",
46 let article' = (if null article1 then article2 else article1)
47 cookie_jar' = cookie_jar1 `mplus` cookie_jar2
48 output' = (if null output1 then output2 else output1)
49 password' = password1 `mplus` password2
50 username' = username1 `mplus` username2
52 Cfg { article = article',
53 cookie_jar = cookie_jar',
56 username = username' }
60 cookie_jar1 = cookie_jar c1
61 cookie_jar2 = cookie_jar c2
64 password1 = password c1
65 password2 = password c2
66 username1 = username c1
67 username2 = username c2
70 use_account :: Cfg -> Bool
72 (isJust $ username cfg) && (isJust $ password cfg)
74 format_cpe :: CPError -> String
75 format_cpe (ParseError desc, _) = "Parse error: " ++ desc
76 format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc
77 format_cpe (NoSection desc, _) = "Missing section: " ++ desc
78 format_cpe (NoOption desc, _) = "Missing required option: " ++ desc
79 format_cpe (OtherProblem desc, _) = "Error: " ++ desc
80 format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc
83 -- | The config parsing functions return either the result or a
84 -- 'CPError'. If there was an error, we represent it as 'Nothing'
85 -- (at least if we're forcing the value into a 'Maybe'
86 -- wrapper. Otherwise, we return 'Just' the result.
87 either_to_maybe :: Either CPError a -> Maybe a
88 either_to_maybe (Left _) = Nothing
89 either_to_maybe (Right x) = Just x
92 config_filename :: String
93 config_filename = Cmd.program_name ++ ".conf"
95 config_path :: IO FilePath
97 cfg_dir <- getAppUserDataDirectory Cmd.program_name
98 let cfg_file = joinPath [cfg_dir, config_filename]
101 parse_config :: IO (Either String Cfg)
103 cfg_file <- config_path
104 it_exists <- doesFileExist cfg_file
105 if not it_exists then do
106 return $ Right mempty
108 parse_result <- readfile emptyCP cfg_file
112 Left err -> Left (format_cpe err)
114 let cp_username = get cp "DEFAULT" "username"
115 cp_password = get cp "DEFAULT" "password"
117 cfg_username = either_to_maybe cp_username
118 cfg_password = either_to_maybe cp_password
120 Right $ mempty { username = cfg_username,
121 password = cfg_password }
127 cmd_article <- Cmd.apply_args
128 let arg_cfg = mempty { article = Cmd.article cmd_article,
129 output = Cmd.output cmd_article }
131 either_file_cfg <- parse_config
132 case either_file_cfg of
135 exitWith $ ExitFailure exit_config_parse_failed
137 -- The left operand takes precedence when both are non-empty!
138 return $ arg_cfg `mappend` file_cfg