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