Show schema on OPTION and rows on GET
This commit is contained in:
@@ -9,10 +9,13 @@ import Database.PostgreSQL.Simple
|
|||||||
import Network.Wai
|
import Network.Wai
|
||||||
import Network.Wai.Handler.Warp hiding (Connection)
|
import Network.Wai.Handler.Warp hiding (Connection)
|
||||||
import Network.HTTP.Types.Status
|
import Network.HTTP.Types.Status
|
||||||
|
import Network.HTTP.Types.Method
|
||||||
|
|
||||||
|
import Data.Aeson (encode)
|
||||||
|
|
||||||
import Options.Applicative hiding (columns)
|
import Options.Applicative hiding (columns)
|
||||||
|
|
||||||
import PgStructure (printTables, printColumns)
|
import PgStructure (printTables, printColumns, selectAll)
|
||||||
|
|
||||||
data AppConfig = AppConfig {
|
data AppConfig = AppConfig {
|
||||||
configDb :: String
|
configDb :: String
|
||||||
@@ -41,10 +44,13 @@ 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] -> if verb == methodOptions
|
||||||
_ -> respond $ responseLBS status404 [] ""
|
then respond =<< responseLBS status200 [] <$> (printColumns table =<< conn)
|
||||||
|
else respond =<< responseLBS status200 [] <$> encode <$> (selectAll table =<< conn)
|
||||||
|
_ -> respond $ responseLBS status404 [] ""
|
||||||
where
|
where
|
||||||
path = pathInfo req
|
path = pathInfo req
|
||||||
|
verb = requestMethod req
|
||||||
conn = connect defaultConnectInfo {
|
conn = connect defaultConnectInfo {
|
||||||
connectDatabase = "dbapi_test"
|
connectDatabase = "dbapi_test"
|
||||||
}
|
}
|
||||||
|
|||||||
+16
-7
@@ -4,14 +4,18 @@ module PgStructure where
|
|||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
|
||||||
import Data.Text
|
|
||||||
import Data.HashMap.Strict
|
import Data.HashMap.Strict
|
||||||
import Data.ByteString.Lazy
|
|
||||||
|
|
||||||
import Database.PostgreSQL.Simple
|
import qualified Data.Text as T
|
||||||
import Database.PostgreSQL.Simple.FromRow
|
import qualified Data.ByteString.Lazy as BL
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Database.PostgreSQL.Simple.Types
|
||||||
|
import Database.PostgreSQL.Simple.FromRow
|
||||||
|
--import Database.PostgreSQL.Simple.Arrays (esc)
|
||||||
|
|
||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
|
|
||||||
data Table = Table {
|
data Table = Table {
|
||||||
@@ -68,7 +72,7 @@ tables s conn = query conn q $ Only s
|
|||||||
\ from information_schema.tables\
|
\ from information_schema.tables\
|
||||||
\ where table_schema = ?"
|
\ where table_schema = ?"
|
||||||
|
|
||||||
columns :: Text -> Connection -> IO [Column]
|
columns :: T.Text -> Connection -> IO [Column]
|
||||||
columns t conn = query conn q $ Only t
|
columns t conn = query conn q $ Only t
|
||||||
where q = "select table_schema, table_name, column_name, ordinal_position,\
|
where q = "select table_schema, table_name, column_name, ordinal_position,\
|
||||||
\ is_nullable, data_type, is_updatable,\
|
\ is_nullable, data_type, is_updatable,\
|
||||||
@@ -79,8 +83,13 @@ columns t conn = query conn q $ Only t
|
|||||||
namedColumnHash :: [Column] -> HashMap String Column
|
namedColumnHash :: [Column] -> HashMap String Column
|
||||||
namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
|
namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
|
||||||
|
|
||||||
printTables :: Connection -> IO ByteString
|
printTables :: Connection -> IO BL.ByteString
|
||||||
printTables conn = JSON.encode <$> tables "base" conn
|
printTables conn = JSON.encode <$> tables "base" conn
|
||||||
|
|
||||||
printColumns :: Text -> Connection -> IO ByteString
|
printColumns :: T.Text -> Connection -> IO BL.ByteString
|
||||||
printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn
|
printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn
|
||||||
|
|
||||||
|
selectAll :: T.Text -> Connection -> IO JSON.Value
|
||||||
|
selectAll table conn = fromOnly <$> Prelude.head <$> query conn sql (Only $ QualifiedIdentifier (Just "base") table)
|
||||||
|
where sql = "select array_to_json(array_agg(row_to_json(t)))\
|
||||||
|
\ from (select * from ?) t;"
|
||||||
|
|||||||
@@ -12,6 +12,7 @@ cabal-version: >=1.10
|
|||||||
|
|
||||||
executable dbapi
|
executable dbapi
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
|
ghc-options: -Wall
|
||||||
other-modules: PgStructure
|
other-modules: PgStructure
|
||||||
other-extensions: OverloadedStrings
|
other-extensions: OverloadedStrings
|
||||||
build-depends: base >=4.6 && <5
|
build-depends: base >=4.6 && <5
|
||||||
|
|||||||
Reference in New Issue
Block a user