Handle SQL errors gracefully.

[mailbox-count.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index d6f7c8fdbf0d3656a49d09c59abc7c2886d0289f..d1d1ea81fa43516bd44b01b294326451b9fbafaf 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,6 +1,85 @@
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 module Main
 where
 
+import Data.Maybe ( fromMaybe )
+import Data.Monoid ( (<>) )
+import Data.String.Utils ( join )
+import Database.HDBC ( SqlError(..), handleSql )
+import Database.HDBC.PostgreSQL ( connectPostgreSQL )
+import Database.HDBC.Sqlite3 ( connectSqlite3 )
+import System.Console.CmdArgs ( def )
+import System.Directory ( doesFileExist )
+import System.IO ( hPutStrLn, stderr )
+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
+
+  -- If a database name was specified, and that name exists as a file
+  -- on the system, assume that the user wanted to use SQLite.
+  handleSql show_sql_error $ do
+    r <- case (database cfg) of
+        Nothing -> connectPostgreSQL (connection_string cfg) >>= report cfg
+
+        Just dbname -> do
+          exists <- doesFileExist dbname
+          if exists
+          then connectSqlite3 dbname >>= report cfg
+          else connectPostgreSQL (connection_string cfg) >>= report cfg
+
+    -- The DB connection is implicitly closed when it gets garbage collected.
+    putStrLn r
+
+  where
+    show_sql_error :: SqlError -> IO ()
+    show_sql_error se = hPutStrLn stderr $
+      "SQL Error (" ++ (show $ seNativeError se) ++ "): " ++ (seErrorMsg se)