Split db functions into separate module

This commit is contained in:
Joe Nelson
2014-06-22 16:04:28 -07:00
parent a3b2d8a9ba
commit 884f06b8cf
3 changed files with 91 additions and 81 deletions
+8 -80
View File
@@ -2,84 +2,17 @@
module Main where module Main where
import Data.ByteString.Lazy import Control.Applicative
import Data.Text
import Database.PostgreSQL.Simple import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Control.Applicative
import Network.Wai import Network.Wai
import Network.Wai.Handler.Warp hiding (Connection) import Network.Wai.Handler.Warp hiding (Connection)
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import qualified Data.Aeson as JSON
import Data.Aeson ((.=))
import Options.Applicative hiding (columns) import Options.Applicative hiding (columns)
data Table = Table { import PgStructure (printTables, printColumns)
tableSchema :: String
, tableName :: String
, tableInsertable :: Bool
} deriving (Show)
instance FromRow Table where
fromRow = Table <$> field <*> field <*> fmap toBool field
instance JSON.ToJSON Table where
toJSON v = JSON.object [
"schema" .= tableSchema v
, "name" .= tableName v
, "insertable" .= tableInsertable v ]
toBool :: String -> Bool
toBool = (== "YES")
data Column = Column {
colSchema :: String
, colTable :: String
, colName :: String
, colPosition :: Int
, colNullable :: Bool
, colType :: String
, colUpdatable :: Bool
, colMaxLen :: Maybe Int
, colPrecision :: Maybe Int
} deriving (Show)
instance FromRow Column where
fromRow = Column <$> field <*> field <*> field <*> field <*>
fmap toBool field <*> field <*>
fmap toBool field <*>
field <*> field
instance JSON.ToJSON Column where
toJSON c = JSON.object [
"schema" .= colSchema c
, "name" .= colName c
, "position" .= colPosition c
, "nullable" .= colNullable c
, "type" .= colType c
, "updatable" .= colUpdatable c
, "maxLen" .= colMaxLen c
, "precision" .= colPrecision c ]
tables :: String -> Connection -> IO [Table]
tables s conn = query conn q $ Only s
where q = "select table_schema, table_name,\
\ is_insertable_into \
\ from information_schema.tables\
\ where table_schema = ?"
columns :: 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,\
\ character_maximum_length, numeric_precision\
\ from information_schema.columns\
\ where table_name = ?"
data AppConfig = AppConfig { data AppConfig = AppConfig {
configDb :: String configDb :: String
@@ -92,22 +25,17 @@ argParser = AppConfig
<*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000 <*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000
<> help "port number on which to run HTTP server") <> help "port number on which to run HTTP server")
exposeDb :: AppConfig -> IO ()
exposeDb conf = do
Prelude.putStrLn $ "Listening on port " ++ show port
run port app
where
port = configPort conf
main :: IO () main :: IO ()
main = execParser (info (helper <*> argParser) describe) >>= exposeDb main = execParser (info (helper <*> argParser) describe) >>= exposeDb
where describe = progDesc "create a REST API to an existing Postgres database" where describe = progDesc "create a REST API to an existing Postgres database"
printTables :: Connection -> IO ByteString exposeDb :: AppConfig -> IO ()
printTables conn = JSON.encode <$> tables "base" conn exposeDb conf = do
Prelude.putStrLn $ "Listening on port " ++ show port
run port app
printColumns :: Text -> Connection -> IO ByteString where
printColumns table conn = JSON.encode <$> columns table conn port = configPort conf
app :: Application app :: Application
app req respond = app req respond =
+82
View File
@@ -0,0 +1,82 @@
{-# LANGUAGE OverloadedStrings #-}
module PgStructure where
import Control.Applicative
import Data.Text
import Data.ByteString.Lazy
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import qualified Data.Aeson as JSON
import Data.Aeson ((.=))
data Table = Table {
tableSchema :: String
, tableName :: String
, tableInsertable :: Bool
} deriving (Show)
instance FromRow Table where
fromRow = Table <$> field <*> field <*> fmap toBool field
instance JSON.ToJSON Table where
toJSON v = JSON.object [
"schema" .= tableSchema v
, "name" .= tableName v
, "insertable" .= tableInsertable v ]
toBool :: String -> Bool
toBool = (== "YES")
data Column = Column {
colSchema :: String
, colTable :: String
, colName :: String
, colPosition :: Int
, colNullable :: Bool
, colType :: String
, colUpdatable :: Bool
, colMaxLen :: Maybe Int
, colPrecision :: Maybe Int
} deriving (Show)
instance FromRow Column where
fromRow = Column <$> field <*> field <*> field <*> field <*>
fmap toBool field <*> field <*>
fmap toBool field <*>
field <*> field
instance JSON.ToJSON Column where
toJSON c = JSON.object [
"schema" .= colSchema c
, "name" .= colName c
, "position" .= colPosition c
, "nullable" .= colNullable c
, "type" .= colType c
, "updatable" .= colUpdatable c
, "maxLen" .= colMaxLen c
, "precision" .= colPrecision c ]
tables :: String -> Connection -> IO [Table]
tables s conn = query conn q $ Only s
where q = "select table_schema, table_name,\
\ is_insertable_into \
\ from information_schema.tables\
\ where table_schema = ?"
columns :: 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,\
\ character_maximum_length, numeric_precision\
\ from information_schema.columns\
\ where table_name = ?"
printTables :: Connection -> IO ByteString
printTables conn = JSON.encode <$> tables "base" conn
printColumns :: Text -> Connection -> IO ByteString
printColumns table conn = JSON.encode <$> columns table conn
+1 -1
View File
@@ -12,7 +12,7 @@ cabal-version: >=1.10
executable dbapi executable dbapi
main-is: Main.hs main-is: Main.hs
-- other-modules: other-modules: PgStructure
other-extensions: OverloadedStrings other-extensions: OverloadedStrings
build-depends: base >=4.6 && <5 build-depends: base >=4.6 && <5
, postgresql-simple , postgresql-simple