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.Handler.Warp hiding (Connection)
import Network.HTTP.Types.Status
import Network.HTTP.Types.Method
import Data.Aeson (encode)
import Options.Applicative hiding (columns)
import PgStructure (printTables, printColumns)
import PgStructure (printTables, printColumns, selectAll)
data AppConfig = AppConfig {
configDb :: String
@@ -41,10 +44,13 @@ app :: Application
app req respond =
case path of
[] -> respond =<< responseLBS status200 [] <$> (printTables =<< conn)
[table] -> respond =<< responseLBS status200 [] <$> (printColumns table =<< conn)
_ -> respond $ responseLBS status404 [] ""
[table] -> if verb == methodOptions
then respond =<< responseLBS status200 [] <$> (printColumns table =<< conn)
else respond =<< responseLBS status200 [] <$> encode <$> (selectAll table =<< conn)
_ -> respond $ responseLBS status404 [] ""
where
path = pathInfo req
verb = requestMethod req
conn = connect defaultConnectInfo {
connectDatabase = "dbapi_test"
}
+16 -7
View File
@@ -4,14 +4,18 @@ module PgStructure where
import Control.Applicative
import Data.Text
import Data.HashMap.Strict
import Data.ByteString.Lazy
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as BL
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 ((.=))
data Table = Table {
@@ -68,7 +72,7 @@ tables s conn = query conn q $ Only s
\ from information_schema.tables\
\ where table_schema = ?"
columns :: Text -> Connection -> IO [Column]
columns :: T.Text -> Connection -> IO [Column]
columns t conn = query conn q $ Only t
where q = "select table_schema, table_name, column_name, ordinal_position,\
\ is_nullable, data_type, is_updatable,\
@@ -79,8 +83,13 @@ columns t conn = query conn q $ Only t
namedColumnHash :: [Column] -> HashMap String Column
namedColumnHash = fromList . (Prelude.zip =<< Prelude.map colName)
printTables :: Connection -> IO ByteString
printTables :: Connection -> IO BL.ByteString
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
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
main-is: Main.hs
ghc-options: -Wall
other-modules: PgStructure
other-extensions: OverloadedStrings
build-depends: base >=4.6 && <5