X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FMain.hs;h=2c225aebfa1bd8b4e4af120ca235e7aa63dff4ce;hb=HEAD;hp=633e969fcef69849fd07ed602990e52a0f49d80f;hpb=7a6ba612bdec5ba940dc6f74143ca64a9163fff2;p=mailbox-count.git diff --git a/src/Main.hs b/src/Main.hs index 633e969..d777973 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,17 +1,24 @@ -module Main +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +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 ) + -- | 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 @@ -58,16 +65,22 @@ main = do -- 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) + -- 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 - --when (isNothing (OC.username opt_config)) $ do - -- report_error "No username supplied." - --exitWith (ExitFailure exit_no_username) + Just dbname -> do + exists <- doesFileExist dbname + if exists + then connectSqlite3 dbname >>= report cfg + else connectPostgreSQL (connection_string cfg) >>= report cfg - conn <- connectPostgreSQL (connection_string cfg) - r <- report conn (both cfg) (detail cfg) - putStrLn r --- disconnect conn + -- 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)