X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=633e969fcef69849fd07ed602990e52a0f49d80f;hb=7a6ba612bdec5ba940dc6f74143ca64a9163fff2;hp=d6f7c8fdbf0d3656a49d09c59abc7c2886d0289f;hpb=65ec33ab24068e50612e72e69d893ecac9079cdc;p=mailbox-count.git diff --git a/src/Main.hs b/src/Main.hs index d6f7c8f..633e969 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,73 @@ module Main where +import Data.Maybe ( fromMaybe ) +import Data.Monoid ( (<>) ) +import Data.String.Utils ( join ) +import Database.HDBC.PostgreSQL ( connectPostgreSQL ) +import System.Console.CmdArgs ( def ) + +import CommandLine ( get_args ) +import Configuration ( Configuration(..), merge_optional ) +import qualified OptionalConfiguration as OC ( from_rc ) +import Report ( report ) + +-- | Construct a connection string (postgres-only, for now) from a +-- 'Configuration'. All of these are optional, at least for +-- Postgres, and so we want to avoid appending e.g. \"host=\" to the +-- connection string if @(host cfg)@ is 'Nothing'. +-- +-- Examples: +-- +-- >>> let default_cfg = def :: Configuration +-- >>> let cfg = default_cfg { host = Just "localhost" } +-- >>> connection_string cfg +-- "host=localhost" +-- >>> let cfg2 = cfg { username = Just "postgres" } +-- >>> connection_string cfg2 +-- "host=localhost user=postgres" +-- +connection_string :: Configuration -> String +connection_string cfg = + trim $ join " " [host_part, port_part, user_part, pw_part, db_part] + where + -- | Strip leading/trailing whitespace, and collapse multiple + -- consecutive spaces into one. + trim :: String -> String + trim = unwords . words + + host_part = let h = fmap ("host=" ++) (host cfg) in fromMaybe "" h + port_part = let p = fmap (("port=" ++) . show) (port cfg) in fromMaybe "" p + user_part = let u = fmap ("user=" ++) (username cfg) in fromMaybe "" u + pw_part = let pw = fmap ("password=" ++) (password cfg) in fromMaybe "" pw + db_part = let db = fmap ("dbname=" ++) (database cfg) in fromMaybe "" db + + main :: IO () main = do - putStrLn "Hello, world!" + rc_cfg <- OC.from_rc + cmd_cfg <- get_args + + -- Merge the config file options with the command-line ones, + -- prefering the command-line ones. + let opt_config = rc_cfg <> cmd_cfg + + -- Update a default config with any options that have been set in + -- either the config file or on the command-line. We initialize + -- logging before the missing parameter checks below so that we can + -- log the errors. + let cfg = (def :: Configuration) `merge_optional` opt_config + + -- Check the optional config for missing required options. + --when (isNothing (OC.password opt_config)) $ do + -- report_error "No password supplied." + -- exitWith (ExitFailure exit_no_password) + + --when (isNothing (OC.username opt_config)) $ do + -- report_error "No username supplied." + --exitWith (ExitFailure exit_no_username) + + conn <- connectPostgreSQL (connection_string cfg) + r <- report conn (both cfg) (detail cfg) + putStrLn r +-- disconnect conn