From 884f06b8cf7ac4ace21ae28d71b90d7db1b1d632 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 22 Jun 2014 16:04:28 -0700 Subject: [PATCH] Split db functions into separate module --- Main.hs | 88 +++++--------------------------------------------- PgStructure.hs | 82 ++++++++++++++++++++++++++++++++++++++++++++++ dbapi.cabal | 2 +- 3 files changed, 91 insertions(+), 81 deletions(-) create mode 100644 PgStructure.hs diff --git a/Main.hs b/Main.hs index d18a86833..07be2b341 100644 --- a/Main.hs +++ b/Main.hs @@ -2,84 +2,17 @@ module Main where -import Data.ByteString.Lazy - -import Data.Text +import Control.Applicative 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 -import Data.Aeson ((.=)) - import Options.Applicative hiding (columns) -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 = ?" +import PgStructure (printTables, printColumns) data AppConfig = AppConfig { configDb :: String @@ -92,22 +25,17 @@ argParser = AppConfig <*> option (long "port" <> short 'p' <> metavar "NUMBER" <> value 3000 <> 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 = execParser (info (helper <*> argParser) describe) >>= exposeDb where describe = progDesc "create a REST API to an existing Postgres database" -printTables :: Connection -> IO ByteString -printTables conn = JSON.encode <$> tables "base" conn +exposeDb :: AppConfig -> IO () +exposeDb conf = do + Prelude.putStrLn $ "Listening on port " ++ show port + run port app -printColumns :: Text -> Connection -> IO ByteString -printColumns table conn = JSON.encode <$> columns table conn + where + port = configPort conf app :: Application app req respond = diff --git a/PgStructure.hs b/PgStructure.hs new file mode 100644 index 000000000..91071ab28 --- /dev/null +++ b/PgStructure.hs @@ -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 diff --git a/dbapi.cabal b/dbapi.cabal index 8ee9acf0a..d796ac721 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -12,7 +12,7 @@ cabal-version: >=1.10 executable dbapi main-is: Main.hs - -- other-modules: + other-modules: PgStructure other-extensions: OverloadedStrings build-depends: base >=4.6 && <5 , postgresql-simple