Make postgrest usable as a library

2015-05-19 23:40:39 -07:00
parent 035acebf59
commit c3ad87ffaf
14 changed files with 79 additions and 106 deletions
@@ -0,0 +1,175 @@
+{-# LANGUAGE QuasiQuotes, OverloadedStrings, TypeSynonymInstances,
+             MultiParamTypeClasses, ScopedTypeVariables,
+             FlexibleContexts #-}
+module PostgREST.PgStructure where
+
+import PostgREST.PgQuery (QualifiedTable(..))
+import Data.Text hiding (foldl, map, zipWith, concat)
+import Data.Aeson
+import Data.Functor.Identity
+import Data.String.Conversions (cs)
+import Data.Maybe (fromMaybe)
+import Control.Applicative
+
+import qualified Data.Map as Map
+
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+
+import Prelude
+
+foreignKeys :: QualifiedTable -> H.Tx P.Postgres s (Map.Map Text ForeignKey)
+foreignKeys table = do
+  r <- H.listEx $ [H.stmt|
+      select kcu.column_name, ccu.table_name AS foreign_table_name,
+        ccu.column_name AS foreign_column_name
+      from information_schema.table_constraints AS tc
+        join information_schema.key_column_usage AS kcu
+          on tc.constraint_name = kcu.constraint_name
+        join information_schema.constraint_column_usage AS ccu
+          on ccu.constraint_name = tc.constraint_name
+      where constraint_type = 'FOREIGN KEY'
+        and tc.table_name=? and tc.table_schema = ?
+        order by kcu.column_name
+    |] (qtName table) (qtSchema table)
+
+  return $ foldl addKey Map.empty r
+  where
+    addKey :: Map.Map Text ForeignKey -> (Text, Text, Text) -> Map.Map Text ForeignKey
+    addKey m (col, ftab, fcol) = Map.insert col (ForeignKey ftab fcol) m
+
+
+tables :: Text -> H.Tx P.Postgres s [Table]
+tables schema = do
+  rows <- H.listEx $
+    [H.stmt|
+      select table_schema, table_name,
+             is_insertable_into
+        from information_schema.tables
+       where table_schema = ?
+       order by table_name
+    |] schema
+  return $ map tableFromRow rows
+
+
+columns :: QualifiedTable -> H.Tx P.Postgres s [Column]
+columns table = do
+  cols <- H.listEx $ [H.stmt|
+      select info.table_schema as schema, info.table_name as table_name,
+             info.column_name as name, info.ordinal_position as position,
+             info.is_nullable as nullable, info.data_type as col_type,
+             info.is_updatable as updatable,
+             info.character_maximum_length as max_len,
+             info.numeric_precision as precision,
+             info.column_default as default_value,
+             array_to_string(enum_info.vals, ',') as enum
+         from (
+           select table_schema, table_name, column_name, ordinal_position,
+                  is_nullable, data_type, is_updatable,
+                  character_maximum_length, numeric_precision,
+                  column_default, udt_name
+             from information_schema.columns
+            where table_schema = ? and table_name = ?
+         ) as info
+         left outer join (
+           select n.nspname as s,
+                  t.typname as n,
+                  array_agg(e.enumlabel ORDER BY e.enumsortorder) as vals
+           from pg_type t
+              join pg_enum e on t.oid = e.enumtypid
+              join pg_catalog.pg_namespace n ON n.oid = t.typnamespace
+           group by s, n
+         ) as enum_info
+         on (info.udt_name = enum_info.n)
+      order by position |]
+    (qtSchema table) (qtName table)
+
+  fks <- foreignKeys table
+  return $ map (addFK fks . columnFromRow) cols
+
+  where
+    addFK fks col = col { colFK = Map.lookup (cs . colName $ col) fks }
+
+
+primaryKeyColumns :: QualifiedTable -> H.Tx P.Postgres s [Text]
+primaryKeyColumns table = do
+  r <- H.listEx $ [H.stmt|
+    select kc.column_name
+      from
+        information_schema.table_constraints tc,
+        information_schema.key_column_usage kc
+    where
+      tc.constraint_type = 'PRIMARY KEY'
+      and kc.table_name = tc.table_name and kc.table_schema = tc.table_schema
+      and kc.constraint_name = tc.constraint_name
+      and kc.table_schema = ?
+      and kc.table_name  = ? |] (qtSchema table) (qtName table)
+  return $ map runIdentity r
+
+
+toBool :: Text -> Bool
+toBool = (== "YES")
+
+data Table = Table {
+  tableSchema :: Text
+, tableName :: Text
+, tableInsertable :: Bool
+} deriving (Show)
+
+data ForeignKey = ForeignKey {
+  fkTable::Text, fkCol::Text
+} deriving (Eq, Show)
+
+data Column = Column {
+  colSchema :: Text
+, colTable :: Text
+, colName :: Text
+, colPosition :: Int
+, colNullable :: Bool
+, colType :: Text
+, colUpdatable :: Bool
+, colMaxLen :: Maybe Int
+, colPrecision :: Maybe Int
+, colDefault :: Maybe Text
+, colEnum :: [Text]
+, colFK :: Maybe ForeignKey
+} deriving (Show)
+
+tableFromRow :: (Text, Text, Text) -> Table
+tableFromRow (s, n, i) = Table s n (toBool i)
+
+columnFromRow :: (Text,       Text,      Text,
+                  Int,        Text,      Text,
+                  Text,       Maybe Int, Maybe Int,
+                  Maybe Text, Maybe Text)
+              -> Column
+columnFromRow (s, t, n, pos, nul, typ, u, l, p, d, e) =
+  Column s t n pos (toBool nul) typ (toBool u) l p d (parseEnum e) Nothing
+
+  where
+    parseEnum :: Maybe Text -> [Text]
+    parseEnum str = fromMaybe [] $ split (==',') <$> str
+
+
+instance ToJSON Column where
+  toJSON c = 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
+    , "references".= colFK c
+    , "default"   .= colDefault c
+    , "enum"      .= colEnum c ]
+
+instance ToJSON ForeignKey where
+  toJSON fk = object ["table".=fkTable fk, "column".=fkCol fk]
+
+instance ToJSON Table where
+  toJSON v = object [
+      "schema"     .= tableSchema v
+    , "name"       .= tableName v
+    , "insertable" .= tableInsertable v ]