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