From: Michael Orlitzky <michael@orlitzky.com>
Date: Tue, 22 Apr 2014 23:23:33 +0000 (-0400)
Subject: Make all connection string parameters optional.
X-Git-Tag: 0.0.3~21
X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=7a6ba612bdec5ba940dc6f74143ca64a9163fff2;p=mailbox-count.git

Make all connection string parameters optional.
---

diff --git a/src/Configuration.hs b/src/Configuration.hs
index 2fbc397..e383abc 100644
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -9,19 +9,22 @@ where
 
 import System.Console.CmdArgs.Default ( Default(..) )
 
-import qualified OptionalConfiguration as OC ( OptionalConfiguration(..) )
+import qualified OptionalConfiguration as OC (
+  OptionalConfiguration(..),
+  merge_maybes )
 
 -- | The main configuration data type. This will be passed to most of
 --   the important functions once it has been created.
+--
 data Configuration =
   Configuration {
     both   :: Bool,
-    database :: String,
+    database :: Maybe String,
     detail  :: Bool,
-    host :: String,
-    password :: String,
-    port :: Int,
-    username :: String }
+    host :: Maybe String,
+    password :: Maybe String,
+    port :: Maybe Int,
+    username :: Maybe String }
   deriving (Show)
 
 -- | A Configuration with all of its fields set to their default
@@ -29,12 +32,12 @@ data Configuration =
 instance Default Configuration where
   def = Configuration {
           both   = def,
-          database = "postfixadmin",
+          database = def,
           detail = def,
-          host = "localhost",
+          host = def,
           password = def,
-          port = 5432,
-          username = "postgres" }
+          port = def,
+          username = def }
 
 -- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is
 --   more or less the Monoid instance for 'OptionalConfiguration', but
@@ -45,12 +48,12 @@ merge_optional :: Configuration
 merge_optional cfg opt_cfg =
   Configuration
     (merge (both cfg) (OC.both opt_cfg))
-    (merge (database cfg) (OC.database opt_cfg))
+    (OC.merge_maybes (database cfg) (OC.database opt_cfg))
     (merge (detail cfg) (OC.detail opt_cfg))
-    (merge (host cfg) (OC.host opt_cfg))
-    (merge (password cfg) (OC.password opt_cfg))
-    (merge (port cfg) (OC.port opt_cfg))
-    (merge (username cfg) (OC.username opt_cfg))
+    (OC.merge_maybes (host cfg) (OC.host opt_cfg))
+    (OC.merge_maybes (password cfg) (OC.password opt_cfg))
+    (OC.merge_maybes (port cfg) (OC.port opt_cfg))
+    (OC.merge_maybes (username cfg) (OC.username opt_cfg))
   where
     -- | If the thing on the right is Just something, return that
     --   something, otherwise return the thing on the left.
diff --git a/src/Main.hs b/src/Main.hs
index b52bf50..633e969 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,7 +1,9 @@
 module Main
 where
 
+import Data.Maybe ( fromMaybe )
 import Data.Monoid ( (<>) )
+import Data.String.Utils ( join )
 import Database.HDBC.PostgreSQL ( connectPostgreSQL )
 import System.Console.CmdArgs ( def )
 
@@ -10,13 +12,36 @@ import Configuration ( Configuration(..), 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
+--   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 =
-  "host=" ++ (host cfg) ++ " " ++
-  "port=" ++ (show $ port cfg) ++ " " ++
-  "user=" ++ (username cfg) ++ " " ++
-  "password=" ++ (password cfg) ++ " " ++
-  "dbname=" ++ (database cfg)
+  trim $ join " " [host_part, port_part, user_part, pw_part, db_part]
+  where
+    -- | Strip leading/trailing whitespace, and collapse multiple
+    --   consecutive spaces into one.
+    trim :: String -> String
+    trim = unwords . words
+
+    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
diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs
index d2b6a05..6bf4f9b 100644
--- a/src/OptionalConfiguration.hs
+++ b/src/OptionalConfiguration.hs
@@ -10,7 +10,8 @@
 
 module OptionalConfiguration (
   OptionalConfiguration(..),
-  from_rc )
+  from_rc,
+  merge_maybes )
 where
 
 import qualified Data.Configurator as DC (