{-# 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 ) import String ( trim ) -- | 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 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 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. putStr r where show_sql_error :: SqlError -> IO () show_sql_error se = hPutStrLn stderr $ "SQL Error (" ++ show (seNativeError se) ++ "): " ++ (seErrorMsg se)