From e28c8755025b5cab765474b12170131d5be1d807 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Sun, 22 Jun 2014 23:58:26 -0700
Subject: [PATCH] Show schema on OPTION and rows on GET

---
 Main.hs        | 12 +++++++++---
 PgStructure.hs | 23 ++++++++++++++++-------
 dbapi.cabal    |  1 +
 3 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/Main.hs b/Main.hs
index 07be2b341..f7bfd1e10 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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"
     }
diff --git a/PgStructure.hs b/PgStructure.hs
index 821e89241..990b388e1 100644
--- a/PgStructure.hs
+++ b/PgStructure.hs
@@ -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;"
diff --git a/dbapi.cabal b/dbapi.cabal
index 721b6bf86..8522f08cf 100644
--- a/dbapi.cabal
+++ b/dbapi.cabal
@@ -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