parse db url. Fixes #5.
This commit is contained in:
@@ -18,6 +18,9 @@ import Options.Applicative hiding (columns)
|
|||||||
|
|
||||||
import PgStructure (printTables, printColumns, selectAll)
|
import PgStructure (printTables, printColumns, selectAll)
|
||||||
|
|
||||||
|
import Data.Text (unpack)
|
||||||
|
import Web.Heroku.Postgres (parseDatabaseUrl)
|
||||||
|
|
||||||
data AppConfig = AppConfig {
|
data AppConfig = AppConfig {
|
||||||
configDb :: String
|
configDb :: String
|
||||||
, configPort :: Int }
|
, configPort :: Int }
|
||||||
@@ -36,13 +39,25 @@ main = execParser (info (helper <*> argParser) describe) >>= exposeDb
|
|||||||
exposeDb :: AppConfig -> IO ()
|
exposeDb :: AppConfig -> IO ()
|
||||||
exposeDb conf = do
|
exposeDb conf = do
|
||||||
Prelude.putStrLn $ "Listening on port " ++ show port
|
Prelude.putStrLn $ "Listening on port " ++ show port
|
||||||
run port app
|
run port $ app conf
|
||||||
|
|
||||||
where
|
where
|
||||||
port = configPort conf
|
port = configPort conf
|
||||||
|
|
||||||
app :: Application
|
connInfo :: AppConfig -> ConnectInfo
|
||||||
app req respond =
|
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
|
case path of
|
||||||
[] -> respond =<< responseLBS status200 [json] <$> (printTables =<< conn)
|
[] -> respond =<< responseLBS status200 [json] <$> (printTables =<< conn)
|
||||||
[table] -> if verb == methodOptions
|
[table] -> if verb == methodOptions
|
||||||
@@ -52,7 +67,5 @@ app req respond =
|
|||||||
where
|
where
|
||||||
path = pathInfo req
|
path = pathInfo req
|
||||||
verb = requestMethod req
|
verb = requestMethod req
|
||||||
conn = connect defaultConnectInfo {
|
|
||||||
connectDatabase = "dbapi_test"
|
|
||||||
}
|
|
||||||
json = (hContentType, "application/json")
|
json = (hContentType, "application/json")
|
||||||
|
conn = connect $ connInfo config
|
||||||
|
|||||||
+3
-2
@@ -7,7 +7,7 @@ author: Joe Nelson
|
|||||||
maintainer: cred+github@begriffs.com
|
maintainer: cred+github@begriffs.com
|
||||||
category: Web
|
category: Web
|
||||||
build-type: Simple
|
build-type: Simple
|
||||||
-- extra-source-files:
|
-- extra-source-files:
|
||||||
cabal-version: >=1.10
|
cabal-version: >=1.10
|
||||||
|
|
||||||
executable dbapi
|
executable dbapi
|
||||||
@@ -21,5 +21,6 @@ executable dbapi
|
|||||||
, bytestring, aeson, network
|
, bytestring, aeson, network
|
||||||
, text, optparse-applicative
|
, text, optparse-applicative
|
||||||
, unordered-containers
|
, unordered-containers
|
||||||
-- hs-source-dirs:
|
, heroku
|
||||||
|
-- hs-source-dirs:
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
Reference in New Issue
Block a user