Configure server port with command line arguments
This commit is contained in:
@@ -5,8 +5,6 @@ module Main where
|
|||||||
import Data.ByteString.Lazy
|
import Data.ByteString.Lazy
|
||||||
|
|
||||||
import Data.Text
|
import Data.Text
|
||||||
import Data.Text.Encoding (encodeUtf8)
|
|
||||||
import Text.Read
|
|
||||||
|
|
||||||
import Database.PostgreSQL.Simple
|
import Database.PostgreSQL.Simple
|
||||||
import Database.PostgreSQL.Simple.FromRow
|
import Database.PostgreSQL.Simple.FromRow
|
||||||
@@ -19,10 +17,12 @@ import Network.HTTP.Types.Status
|
|||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
|
|
||||||
|
import Options.Applicative hiding (columns)
|
||||||
|
|
||||||
data Table = Table {
|
data Table = Table {
|
||||||
viewSchema :: String
|
tableSchema :: String
|
||||||
, viewName :: String
|
, tableName :: String
|
||||||
, viewInsertable :: Bool
|
, tableInsertable :: Bool
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
instance FromRow Table where
|
instance FromRow Table where
|
||||||
@@ -30,9 +30,9 @@ instance FromRow Table where
|
|||||||
|
|
||||||
instance JSON.ToJSON Table where
|
instance JSON.ToJSON Table where
|
||||||
toJSON v = JSON.object [
|
toJSON v = JSON.object [
|
||||||
"schema" .= viewSchema v
|
"schema" .= tableSchema v
|
||||||
, "name" .= viewName v
|
, "name" .= tableName v
|
||||||
, "insertable" .= viewInsertable v ]
|
, "insertable" .= tableInsertable v ]
|
||||||
|
|
||||||
toBool :: String -> Bool
|
toBool :: String -> Bool
|
||||||
toBool = (== "YES")
|
toBool = (== "YES")
|
||||||
@@ -81,24 +81,40 @@ columns t conn = query conn q $ Only t
|
|||||||
\ from information_schema.columns\
|
\ from information_schema.columns\
|
||||||
\ where table_name = ?"
|
\ where table_name = ?"
|
||||||
|
|
||||||
main :: IO ()
|
data AppConfig = AppConfig {
|
||||||
main = do
|
configDb :: String
|
||||||
let port = 3000
|
, configPort :: Int }
|
||||||
|
|
||||||
|
argParser :: Parser AppConfig
|
||||||
|
argParser = AppConfig
|
||||||
|
<$> strOption (long "db" <> short 'd' <> metavar "URI"
|
||||||
|
<> help "database uri to expose, e.g. postgres://user:pass@host:port/database")
|
||||||
|
<*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
|
||||||
|
<> help "port number on which to run HTTP server")
|
||||||
|
|
||||||
|
exposeDb :: AppConfig -> IO ()
|
||||||
|
exposeDb conf = do
|
||||||
Prelude.putStrLn $ "Listening on port " ++ show port
|
Prelude.putStrLn $ "Listening on port " ++ show port
|
||||||
run port app
|
run port app
|
||||||
|
where
|
||||||
|
port = configPort conf
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = execParser (info (helper <*> argParser) describe) >>= exposeDb
|
||||||
|
where describe = progDesc "create a REST API to an existing Postgres database"
|
||||||
|
|
||||||
printTables :: Connection -> IO ByteString
|
printTables :: Connection -> IO ByteString
|
||||||
printTables conn = JSON.encode <$> tables "base" conn
|
printTables conn = JSON.encode <$> tables "base" conn
|
||||||
|
|
||||||
printColumns :: Text -> Connection -> IO ByteString
|
printColumns :: Text -> Connection -> IO ByteString
|
||||||
printColumns tableName conn = JSON.encode <$> columns tableName conn
|
printColumns table conn = JSON.encode <$> columns table conn
|
||||||
|
|
||||||
app :: Application
|
app :: Application
|
||||||
app req respond =
|
app req respond =
|
||||||
case path of
|
case path of
|
||||||
[] -> respond =<< responseLBS status200 [] <$> (printTables =<< conn)
|
[] -> respond =<< responseLBS status200 [] <$> (printTables =<< conn)
|
||||||
[table] -> respond =<< responseLBS status200 [] <$> (printColumns table =<< conn)
|
[table] -> respond =<< responseLBS status200 [] <$> (printColumns table =<< conn)
|
||||||
_ -> respond $ responseLBS status404 [] ""
|
_ -> respond $ responseLBS status404 [] ""
|
||||||
where
|
where
|
||||||
path = pathInfo req
|
path = pathInfo req
|
||||||
conn = connect defaultConnectInfo {
|
conn = connect defaultConnectInfo {
|
||||||
|
|||||||
+2
-2
@@ -17,7 +17,7 @@ executable dbapi
|
|||||||
build-depends: base >=4.6 && <5
|
build-depends: base >=4.6 && <5
|
||||||
, postgresql-simple
|
, postgresql-simple
|
||||||
, warp, wai, http-types
|
, warp, wai, http-types
|
||||||
, bytestring, aeson
|
, bytestring, aeson, network
|
||||||
, text
|
, text, optparse-applicative
|
||||||
-- hs-source-dirs:
|
-- hs-source-dirs:
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
Reference in New Issue
Block a user