X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=2c225aebfa1bd8b4e4af120ca235e7aa63dff4ce;hb=HEAD;hp=f00ebb39dd2eb6b258d39261ca4f2a807da67d93;hpb=39e047ccd8422207e01247c63f514c40e7eac31e;p=mailbox-count.git

diff --git a/src/Main.hs b/src/Main.hs
index f00ebb3..d777973 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,18 +1,20 @@
 {-# LANGUAGE DoAndIfThenElse #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
-module Main
+module Main ( main )
 where
 
 import Data.Maybe ( fromMaybe )
-import Data.Monoid ( (<>) )
 import Data.String.Utils ( join )
+import Database.HDBC ( SqlError( seNativeError, seErrorMsg ), 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 Configuration (
+  Configuration( host, port, username, password, database ),
+  merge_optional )
 import qualified OptionalConfiguration as OC ( from_rc )
 import Report ( report )
 
@@ -65,14 +67,20 @@ main = do
 
   -- If a database name was specified, and that name exists as a file
   -- on the system, assume that the user wanted to use SQLite.
-  r <- case (database cfg) of
-      Nothing -> connectPostgreSQL (connection_string cfg) >>= report cfg
+  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
 
-      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
 
-  -- 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)