Show all tables, not just views

This commit is contained in:
Joe Nelson
2014-06-21 15:51:36 -07:00
parent f5bda4bb96
commit c1da42ea3f
2 changed files with 15 additions and 10 deletions
+14 -10
View File
@@ -5,6 +5,8 @@ module Main where
import GHC.Generics import GHC.Generics
import Data.ByteString.Lazy import Data.ByteString.Lazy
import Data.Text.Encoding (encodeUtf8)
import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow import Database.PostgreSQL.Simple.FromRow
import Control.Applicative import Control.Applicative
@@ -15,18 +17,16 @@ import Network.HTTP.Types.Status
import qualified Data.Aeson as JSON import qualified Data.Aeson as JSON
data View = View { data Table = Table {
viewSchema :: String viewSchema :: String
, viewName :: String , viewName :: String
, viewUpdatable :: Bool
, viewInsertable :: Bool , viewInsertable :: Bool
} deriving (Show, Generic) } deriving (Show, Generic)
instance FromRow View where instance FromRow Table where
fromRow = View <$> field <*> field <*> fromRow = Table <$> field <*> field <*> fmap toBool field
fmap toBool field <*> fmap toBool field
instance JSON.ToJSON View instance JSON.ToJSON Table
toBool :: String -> Bool toBool :: String -> Bool
toBool = (== "YES") toBool = (== "YES")
@@ -43,11 +43,11 @@ data Column = Column {
, colPrecision :: Maybe Int , colPrecision :: Maybe Int
} deriving (Show) } deriving (Show)
views :: String -> Connection -> IO [View] views :: String -> Connection -> IO [Table]
views s conn = query conn q $ Only s views s conn = query conn q $ Only s
where q = "select table_schema, table_name,\ where q = "select table_schema, table_name,\
\ is_updatable, is_insertable_into \ \ is_insertable_into \
\ from information_schema.views\ \ from information_schema.tables\
\ where table_schema = ?" \ where table_schema = ?"
main :: IO () main :: IO ()
@@ -61,8 +61,12 @@ payload conn = JSON.encode <$> views "base" conn
app :: Application app :: Application
app req respond = app req respond =
respond =<< responseLBS status200 [] <$> (payload =<< conn) case path of
[] -> respond =<< responseLBS status200 [] <$> (payload =<< conn)
-- [table] -> respond $ responseLBS status200 [] $ encodeUtf8 table
_ -> respond $ responseLBS status404 [] ""
where where
path = pathInfo req
conn = connect defaultConnectInfo { conn = connect defaultConnectInfo {
connectDatabase = "dbapi_test" connectDatabase = "dbapi_test"
} }
+1
View File
@@ -18,5 +18,6 @@ executable dbapi
, postgresql-simple , postgresql-simple
, warp, wai, http-types , warp, wai, http-types
, bytestring, aeson , bytestring, aeson
, text
-- hs-source-dirs: -- hs-source-dirs:
default-language: Haskell2010 default-language: Haskell2010