Show schema on OPTION and rows on GET

This commit is contained in:
Joe Nelson
2014-06-22 23:58:26 -07:00
parent dd06232369
commit e28c875502
3 changed files with 26 additions and 10 deletions
+9 -3
View File
@@ -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
View File
@@ -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;"
+1
View File
@@ -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