diff --git a/Main.hs b/Main.hs index 981abc7e5..7fa975def 100644 --- a/Main.hs +++ b/Main.hs @@ -1,22 +1,33 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} module Main where +import GHC.Generics +import Data.ByteString.Lazy + import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple.FromRow import Control.Applicative +import Network.Wai +import Network.Wai.Handler.Warp hiding (Connection) +import Network.HTTP.Types.Status + +import qualified Data.Aeson as JSON + data View = View { viewSchema :: String , viewName :: String , viewUpdatable :: Bool , viewInsertable :: Bool -} deriving (Show) +} deriving (Show, Generic) instance FromRow View where fromRow = View <$> field <*> field <*> fmap toBool field <*> fmap toBool field +instance JSON.ToJSON View + toBool :: String -> Bool toBool = (== "YES") @@ -32,8 +43,8 @@ data Column = Column { , colPrecision :: Maybe Int } deriving (Show) -views :: Connection -> String -> IO [View] -views conn s = query conn q $ Only s +views :: String -> Connection -> IO [View] +views s conn = query conn q $ Only s where q = "select table_schema, table_name,\ \ is_updatable, is_insertable_into \ \ from information_schema.views\ @@ -41,7 +52,17 @@ views conn s = query conn q $ Only s main :: IO () main = do - conn <- connect defaultConnectInfo { - connectDatabase = "dbapi_test" - } - mapM_ print =<< views conn "base" + let port = 3000 + Prelude.putStrLn $ "Listening on port " ++ show port + run port app + +payload :: Connection -> IO ByteString +payload conn = JSON.encode <$> views "base" conn + +app :: Application +app req respond = + respond =<< responseLBS status200 [] <$> (payload =<< conn) + where + conn = connect defaultConnectInfo { + connectDatabase = "dbapi_test" + } diff --git a/dbapi.cabal b/dbapi.cabal index 48add8935..95e65b3c6 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -16,5 +16,7 @@ executable dbapi other-extensions: OverloadedStrings build-depends: base >=4.7 && <4.8 , postgresql-simple + , warp, wai, http-types + , bytestring, aeson -- hs-source-dirs: default-language: Haskell2010