parse db url. Fixes #5.

This commit is contained in:
Adam C. Baker
2014-07-06 20:03:54 -07:00
parent 3f2e20a9a7
commit 91efcba6e9
2 changed files with 22 additions and 8 deletions
+19 -6
View File
@@ -18,6 +18,9 @@ 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 }
@@ -36,13 +39,25 @@ main = execParser (info (helper <*> argParser) describe) >>= exposeDb
exposeDb :: AppConfig -> IO ()
exposeDb conf = do
Prelude.putStrLn $ "Listening on port " ++ show port
run port app
run port $ app conf
where
port = configPort conf
app :: Application
app req respond =
connInfo :: AppConfig -> ConnectInfo
connInfo config = defaultConnectInfo {
connectHost = host,
connectUser = user,
connectPassword = pass,
connectDatabase = db
}
where
opts = parseDatabaseUrl $ configDb config
fromOpt key = maybe (connectHost defaultConnectInfo) unpack $ lookup key opts
[host, user, pass, db] = map fromOpt ["host", "user", "password", "dbname"]
app :: AppConfig -> Application
app config req respond =
case path of
[] -> respond =<< responseLBS status200 [json] <$> (printTables =<< conn)
[table] -> if verb == methodOptions
@@ -52,7 +67,5 @@ app req respond =
where
path = pathInfo req
verb = requestMethod req
conn = connect defaultConnectInfo {
connectDatabase = "dbapi_test"
}
json = (hContentType, "application/json")
conn = connect $ connInfo config
+3 -2
View File
@@ -7,7 +7,7 @@ author: Joe Nelson
maintainer: cred+github@begriffs.com
category: Web
build-type: Simple
-- extra-source-files:
-- extra-source-files:
cabal-version: >=1.10
executable dbapi
@@ -21,5 +21,6 @@ executable dbapi
, bytestring, aeson, network
, text, optparse-applicative
, unordered-containers
-- hs-source-dirs:
, heroku
-- hs-source-dirs:
default-language: Haskell2010