src/Main.hs

   1 module Main
   2 where
   3
   4 import Data.Maybe ( fromMaybe )
   5 import Data.Monoid ( (<>) )
   6 import Data.String.Utils ( join )
   7 import Database.HDBC.PostgreSQL ( connectPostgreSQL )
   8 import System.Console.CmdArgs ( def )
   9
  10 import CommandLine ( get_args )
  11 import Configuration ( Configuration(..), merge_optional )
  12 import qualified OptionalConfiguration as OC ( from_rc )
  13 import Report ( report )
  14
  15 -- | Construct a connection string (postgres-only, for now) from a
  16 --   'Configuration'. All of these are optional, at least for
  17 --   Postgres, and so we want to avoid appending e.g. \"host=\" to the
  18 --   connection string if @(host cfg)@ is 'Nothing'.
  19 --
  20 --   Examples:
  21 --
  22 --   >>> let default_cfg = def :: Configuration
  23 --   >>> let cfg = default_cfg { host = Just "localhost" }
  24 --   >>> connection_string cfg
  25 --   "host=localhost"
  26 --   >>> let cfg2 = cfg { username = Just "postgres" }
  27 --   >>> connection_string cfg2
  28 --   "host=localhost user=postgres"
  29 --
  30 connection_string :: Configuration -> String
  31 connection_string cfg =
  32   trim $ join " " [host_part, port_part, user_part, pw_part, db_part]
  33   where
  34     -- | Strip leading/trailing whitespace, and collapse multiple
  35     --   consecutive spaces into one.
  36     trim :: String -> String
  37     trim = unwords . words
  38
  39     host_part = let h = fmap ("host=" ++) (host cfg) in  fromMaybe "" h
  40     port_part = let p = fmap (("port=" ++) . show) (port cfg) in fromMaybe "" p
  41     user_part = let u = fmap ("user=" ++) (username cfg) in fromMaybe "" u
  42     pw_part = let pw = fmap ("password=" ++) (password cfg) in fromMaybe "" pw
  43     db_part = let db = fmap ("dbname=" ++) (database cfg) in fromMaybe "" db
  44
  45
  46 main :: IO ()
  47 main = do
  48   rc_cfg <- OC.from_rc
  49   cmd_cfg <- get_args
  50
  51     -- Merge the config file options with the command-line ones,
  52   -- prefering the command-line ones.
  53   let opt_config = rc_cfg <> cmd_cfg
  54
  55   -- Update a default config with any options that have been set in
  56   -- either the config file or on the command-line.  We initialize
  57   -- logging before the missing parameter checks below so that we can
  58   -- log the errors.
  59   let cfg = (def :: Configuration) `merge_optional` opt_config
  60
  61   -- Check the optional config for missing required options.
  62   --when (isNothing (OC.password opt_config)) $ do
  63   --  report_error "No password supplied."
  64   --  exitWith (ExitFailure exit_no_password)
  65
  66   --when (isNothing (OC.username opt_config)) $ do
  67   --  report_error "No username supplied."
  68   --exitWith (ExitFailure exit_no_username)
  69
  70   conn <- connectPostgreSQL (connection_string cfg)
  71   r <- report conn (detail cfg)
  72   putStrLn r
  73 --  disconnect conn