src/Main.hs

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