module Configuration ( Cfg(..), get_cfg ) where import Control.Monad (mplus) import Data.ConfigFile import Data.Maybe (isJust) import Data.Monoid (Monoid(..)) import System.Directory ( getAppUserDataDirectory ) import System.Exit (ExitCode(..), exitWith) import System.FilePath.Posix (joinPath) import System.IO (hPutStrLn, stderr) import qualified CommandLine as Cmd ( Args(..), apply_args, program_name ) import ExitCodes -- | Contains all of our configurable options. data Cfg = Cfg { article :: String, output :: FilePath, password :: Maybe String, username :: Maybe String } instance Monoid Cfg where mempty = Cfg { article = "", output = "", 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 in Cfg { article = article', 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 use_account :: Cfg -> Bool use_account cfg = (isJust $ username cfg) && (isJust $ password cfg) format_cpe :: CPError -> String format_cpe (ParseError desc, _) = "Parse error: " ++ desc format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc format_cpe (NoSection desc, _) = "Missing section: " ++ desc format_cpe (NoOption desc, _) = "Missing required option: " ++ desc format_cpe (OtherProblem desc, _) = "Error: " ++ desc format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc -- | The config parsing functions return either the result or a -- 'CPError'. If there was an error, we represent it as 'Nothing' -- (at least if we're forcing the value into a 'Maybe' -- wrapper. Otherwise, we return 'Just' the result. either_to_maybe :: Either CPError a -> Maybe a either_to_maybe (Left _) = Nothing either_to_maybe (Right x) = Just x config_filename :: String config_filename = Cmd.program_name ++ ".conf" config_path :: IO FilePath config_path = do cfg_dir <- getAppUserDataDirectory Cmd.program_name return $ joinPath [cfg_dir, config_filename] 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 } 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 } either_file_cfg <- parse_config case either_file_cfg of Left err -> do hPutStrLn stderr err exitWith $ ExitFailure exit_config_parse_failed Right file_cfg -> -- The left operand takes precedence when both are non-empty! return $ arg_cfg `mappend` file_cfg