-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
-- 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)