Switch to HDBC

Fixes #2

Main.hs

@@ -4,7 +4,7 @@ module Main where
 
 import Control.Applicative
 
-import Database.PostgreSQL.Simple
+import Database.HDBC.PostgreSQL (connectPostgreSQL)
 
 import Network.Wai
 import Network.Wai.Handler.Warp hiding (Connection)
@@ -12,18 +12,13 @@ import Network.HTTP.Types.Status
 import Network.HTTP.Types.Header
 import Network.HTTP.Types.Method
 
-import Data.Aeson (encode)
-
 import Options.Applicative hiding (columns)
 
 import PgStructure (printTables, printColumns, selectAll)
 
-import Data.Text (unpack)
-import Web.Heroku.Postgres (parseDatabaseUrl)
-
 data AppConfig = AppConfig {
-    configDb   :: String
-  , configPort :: Int }
+    configDbUri :: String
+  , configPort  :: Int }
 
 argParser :: Parser AppConfig
 argParser = AppConfig
@@ -33,39 +28,25 @@ argParser = AppConfig
     <> help "port number on which to run HTTP server")
 
 main :: IO ()
-main = execParser (info (helper <*> argParser) describe) >>= exposeDb
-  where describe = progDesc "create a REST API to an existing Postgres database"
+main = do
+  conf <- execParser (info (helper <*> argParser) describe)
 
-exposeDb :: AppConfig -> IO ()
-exposeDb conf = do
-  Prelude.putStrLn $ "Listening on port " ++ show port
-  run port $ app conf
+  Prelude.putStrLn $ "Listening on port " ++ (show $ configPort conf :: String)
+  run (configPort conf) $ app conf
 
   where
-    port = configPort conf
-
-connInfo :: AppConfig -> ConnectInfo
-connInfo config = defaultConnectInfo {
-    connectHost = host,
-    connectUser = user,
-    connectPassword = pass,
-    connectDatabase = db
-  }
-  where
-    opts = parseDatabaseUrl $ configDb config
-    fromOpt (fn, key) = maybe (fn defaultConnectInfo) unpack $ lookup key opts
-    [host, user, pass, db] = map fromOpt [(connectHost, "host"), (connectUser, "user"), (connectPassword, "password"), (connectDatabase, "dbname")]
+    describe = progDesc "create a REST API to an existing Postgres database"
 
 app ::  AppConfig -> Application
 app config req respond =
   case path of
     []      -> respond =<< responseLBS status200 [json] <$> (printTables =<< conn)
-    [table] -> if verb == methodOptions
-              then respond =<< responseLBS status200 [json] <$> (printColumns table =<< conn)
-              else respond =<< responseLBS status200 [json] <$> encode <$> (selectAll table =<< conn)
+    [table] -> respond =<< if verb == methodOptions
+                              then responseLBS status200 [json] <$> (printColumns table =<< conn)
+                              else responseLBS status200 [json] <$> (selectAll table =<< conn)
     _       -> respond $ responseLBS status404 [] ""
   where
     path = pathInfo req
     verb = requestMethod req
     json = (hContentType, "application/json")
-    conn = connect $ connInfo config
+    conn = connectPostgreSQL $ configDbUri config