]> gitweb.michael.orlitzky.com - mailbox-count.git/blob - src/Main.hs
mailbox-count.cabal: update to v0.0.6.
[mailbox-count.git] / src / Main.hs
1 {-# LANGUAGE DoAndIfThenElse #-}
2 {-# LANGUAGE NoMonomorphismRestriction #-}
3 module Main ( main )
4 where
5
6 import Data.Maybe ( fromMaybe )
7 import Data.String.Utils ( join )
8 import Database.HDBC ( SqlError( seNativeError, seErrorMsg ), handleSql )
9 import Database.HDBC.PostgreSQL ( connectPostgreSQL )
10 import Database.HDBC.Sqlite3 ( connectSqlite3 )
11 import System.Console.CmdArgs ( def )
12 import System.Directory ( doesFileExist )
13 import System.IO ( hPutStrLn, stderr )
14 import CommandLine ( get_args )
15 import Configuration (
16 Configuration( host, port, username, password, database ),
17 merge_optional )
18 import qualified OptionalConfiguration as OC ( from_rc )
19 import Report ( report )
20
21
22 -- | Construct a connection string (postgres-only, for now) from a
23 -- 'Configuration'. All of these are optional, at least for
24 -- Postgres, and so we want to avoid appending e.g. \"host=\" to the
25 -- connection string if @(host cfg)@ is 'Nothing'.
26 --
27 -- Examples:
28 --
29 -- >>> let default_cfg = def :: Configuration
30 -- >>> let cfg = default_cfg { host = Just "localhost" }
31 -- >>> connection_string cfg
32 -- "host=localhost"
33 -- >>> let cfg2 = cfg { username = Just "postgres" }
34 -- >>> connection_string cfg2
35 -- "host=localhost user=postgres"
36 --
37 connection_string :: Configuration -> String
38 connection_string cfg =
39 trim $ join " " [host_part, port_part, user_part, pw_part, db_part]
40 where
41 -- | Strip leading/trailing whitespace, and collapse multiple
42 -- consecutive spaces into one.
43 trim :: String -> String
44 trim = unwords . words
45
46 host_part = let h = fmap ("host=" ++) (host cfg) in fromMaybe "" h
47 port_part = let p = fmap (("port=" ++) . show) (port cfg) in fromMaybe "" p
48 user_part = let u = fmap ("user=" ++) (username cfg) in fromMaybe "" u
49 pw_part = let pw = fmap ("password=" ++) (password cfg) in fromMaybe "" pw
50 db_part = let db = fmap ("dbname=" ++) (database cfg) in fromMaybe "" db
51
52
53 main :: IO ()
54 main = do
55 rc_cfg <- OC.from_rc
56 cmd_cfg <- get_args
57
58 -- Merge the config file options with the command-line ones,
59 -- prefering the command-line ones.
60 let opt_config = rc_cfg <> cmd_cfg
61
62 -- Update a default config with any options that have been set in
63 -- either the config file or on the command-line. We initialize
64 -- logging before the missing parameter checks below so that we can
65 -- log the errors.
66 let cfg = (def :: Configuration) `merge_optional` opt_config
67
68 -- If a database name was specified, and that name exists as a file
69 -- on the system, assume that the user wanted to use SQLite.
70 handleSql show_sql_error $ do
71 r <- case (database cfg) of
72 Nothing -> connectPostgreSQL (connection_string cfg) >>= report cfg
73
74 Just dbname -> do
75 exists <- doesFileExist dbname
76 if exists
77 then connectSqlite3 dbname >>= report cfg
78 else connectPostgreSQL (connection_string cfg) >>= report cfg
79
80 -- The DB connection is implicitly closed when it gets garbage collected.
81 putStrLn r
82
83 where
84 show_sql_error :: SqlError -> IO ()
85 show_sql_error se = hPutStrLn stderr $
86 "SQL Error (" ++ (show $ seNativeError se) ++ "): " ++ (seErrorMsg se)