Add config file parsing.
[dead/lwn-epub.git] / src / Configuration.hs
1 module Configuration (
2 Cfg(..),
3 get_cfg
4 )
5 where
6
7 import Control.Monad (mplus)
8 import Data.ConfigFile
9 import Data.Maybe (isJust)
10 import Data.Monoid (Monoid(..))
11 import System.Directory (
12 getAppUserDataDirectory
13 )
14 import System.Exit (ExitCode(..), exitWith)
15 import System.FilePath.Posix (joinPath)
16 import System.IO (hPutStrLn, stderr)
17
18 import qualified CommandLine as Cmd (
19 Args(..),
20 apply_args,
21 program_name
22 )
23 import ExitCodes
24
25 -- | Contains all of our configurable options.
26 data Cfg = Cfg {
27 article :: String,
28 output :: FilePath,
29 password :: Maybe String,
30 username :: Maybe String }
31
32
33 instance Monoid Cfg where
34 mempty = Cfg { article = "",
35 output = "",
36 password = Nothing,
37 username = Nothing }
38
39 mappend c1 c2 =
40 let article' = (if null article1 then article2 else article1)
41 output' = (if null output1 then output2 else output1)
42 password' = password1 `mplus` password2
43 username' = username1 `mplus` username2
44 in
45 Cfg { article = article',
46 output = output',
47 password = password',
48 username = username' }
49 where
50 article1 = article c1
51 article2 = article c2
52 output1 = output c1
53 output2 = output c2
54 password1 = password c1
55 password2 = password c2
56 username1 = username c1
57 username2 = username c2
58
59
60 use_account :: Cfg -> Bool
61 use_account cfg =
62 (isJust $ username cfg) && (isJust $ password cfg)
63
64 format_cpe :: CPError -> String
65 format_cpe (ParseError desc, _) = "Parse error: " ++ desc
66 format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc
67 format_cpe (NoSection desc, _) = "Missing section: " ++ desc
68 format_cpe (NoOption desc, _) = "Missing required option: " ++ desc
69 format_cpe (OtherProblem desc, _) = "Error: " ++ desc
70 format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc
71
72
73 -- | The config parsing functions return either the result or a
74 -- 'CPError'. If there was an error, we represent it as 'Nothing'
75 -- (at least if we're forcing the value into a 'Maybe'
76 -- wrapper. Otherwise, we return 'Just' the result.
77 either_to_maybe :: Either CPError a -> Maybe a
78 either_to_maybe (Left _) = Nothing
79 either_to_maybe (Right x) = Just x
80
81
82 config_filename :: String
83 config_filename = Cmd.program_name ++ ".conf"
84
85 config_path :: IO FilePath
86 config_path = do
87 cfg_dir <- getAppUserDataDirectory Cmd.program_name
88 return $ joinPath [cfg_dir, config_filename]
89
90 parse_config :: IO (Either String Cfg)
91 parse_config = do
92 cfg_file <- config_path
93 parse_result <- readfile emptyCP cfg_file
94
95 return $
96 case parse_result of
97 Left err -> Left (format_cpe err)
98 Right cp ->
99 let cp_username = get cp "DEFAULT" "username"
100 cp_password = get cp "DEFAULT" "password"
101
102 cfg_username = either_to_maybe cp_username
103 cfg_password = either_to_maybe cp_password
104 in
105 Right $ mempty { username = cfg_username,
106 password = cfg_password }
107
108
109
110 get_cfg :: IO Cfg
111 get_cfg = do
112 cmd_article <- Cmd.apply_args
113 let arg_cfg = mempty { article = Cmd.article cmd_article,
114 output = Cmd.output cmd_article }
115
116 either_file_cfg <- parse_config
117 case either_file_cfg of
118 Left err -> do
119 hPutStrLn stderr err
120 exitWith $ ExitFailure exit_config_parse_failed
121 Right file_cfg ->
122 -- The left operand takes precedence when both are non-empty!
123 return $ arg_cfg `mappend` file_cfg