Real deal haskell!

This commit is contained in:
Joe Nelson
2014-06-17 01:51:27 -07:00
parent a73ed2c5fd
commit ce8392bf66
2 changed files with 31 additions and 8 deletions
+29 -8
View File
@@ -1,22 +1,33 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module Main where module Main where
import GHC.Generics
import Data.ByteString.Lazy
import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow import Database.PostgreSQL.Simple.FromRow
import Control.Applicative 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 { data View = View {
viewSchema :: String viewSchema :: String
, viewName :: String , viewName :: String
, viewUpdatable :: Bool , viewUpdatable :: Bool
, viewInsertable :: Bool , viewInsertable :: Bool
} deriving (Show) } deriving (Show, Generic)
instance FromRow View where instance FromRow View where
fromRow = View <$> field <*> field <*> fromRow = View <$> field <*> field <*>
fmap toBool field <*> fmap toBool field fmap toBool field <*> fmap toBool field
instance JSON.ToJSON View
toBool :: String -> Bool toBool :: String -> Bool
toBool = (== "YES") toBool = (== "YES")
@@ -32,8 +43,8 @@ data Column = Column {
, colPrecision :: Maybe Int , colPrecision :: Maybe Int
} deriving (Show) } deriving (Show)
views :: Connection -> String -> IO [View] views :: String -> Connection -> IO [View]
views conn s = 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_updatable, is_insertable_into \
\ from information_schema.views\ \ from information_schema.views\
@@ -41,7 +52,17 @@ views conn s = query conn q $ Only s
main :: IO () main :: IO ()
main = do main = do
conn <- connect defaultConnectInfo { let port = 3000
connectDatabase = "dbapi_test" Prelude.putStrLn $ "Listening on port " ++ show port
} run port app
mapM_ print =<< views conn "base"
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"
}
+2
View File
@@ -16,5 +16,7 @@ executable dbapi
other-extensions: OverloadedStrings other-extensions: OverloadedStrings
build-depends: base >=4.7 && <4.8 build-depends: base >=4.7 && <4.8
, postgresql-simple , postgresql-simple
, warp, wai, http-types
, bytestring, aeson
-- hs-source-dirs: -- hs-source-dirs:
default-language: Haskell2010 default-language: Haskell2010