From ea17642f0836d917deaf8f4cea5c6540bb092e6c Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Thu, 9 Oct 2014 14:11:21 -0700 Subject: [PATCH 1/3] Better error for mkColumn --- src/PgStructure.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index 80b857b56..e36e1f3f4 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# LANGUAGE OverloadedStrings #-} module PgStructure where @@ -151,7 +150,6 @@ columns s t conn = do return cols where - --TODO: handle failed pattern match with an appropriate exception mkColumn [schema, table, name, pos, nullable, colT, updatable, maxlen, precision, defVal, enum] = Column (fromSql schema) (fromSql table) (fromSql name) @@ -163,6 +161,8 @@ columns s t conn = do (fromSql precision) (fromSql defVal) (splitOn "," <$> fromSql enum) + mkColumn _ = error $ "Incomplete column data received for table " ++ + t ++ " in schema " ++ s ++ "." printTables :: String -> Connection -> IO BL.ByteString printTables schema conn = JSON.encode <$> tables schema conn From ef6b38ea1e6c6e189331ec57f1d08a345e73d19f Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Thu, 9 Oct 2014 14:11:35 -0700 Subject: [PATCH 2/3] reformat raw sql for readability --- src/PgStructure.hs | 51 +++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/src/PgStructure.hs b/src/PgStructure.hs index e36e1f3f4..b4bdad305 100644 --- a/src/PgStructure.hs +++ b/src/PgStructure.hs @@ -117,31 +117,32 @@ tables s conn = do columns :: String -> String -> Connection -> IO [Column] columns s t conn = do r <- quickQuery conn - " 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) 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) \ + "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) 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" [toSql s, toSql t] fks <- foreignKeys s t conn let lookupFK (_:_:name:_) = Map.lookup (fromSql name) fks From e5db9bc58e785a5a4c7823227ec435a30090523c Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Thu, 9 Oct 2014 14:14:53 -0700 Subject: [PATCH 3/3] remove top level binding in test script --- test/Feature/StructureSpec.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 075c85833..42cffb610 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Feature.StructureSpec where @@ -13,12 +12,10 @@ import Codec.Binary.Base64.String (encode) import Data.Monoid ((<>)) import Data.String.Conversions (cs) -uName = "a user" -uPass = "nobody can ever know" -uRole = "dbapi_test" - spec :: Spec -spec = around withDatabaseConnection $ +spec = let {uName = "a user"; uPass = "nobody can ever know"; +uRole = "dbapi_test"} in + around withDatabaseConnection $ aroundWith (withUser uName uPass uRole) $ aroundWith withApp $ do describe "GET /" $ it "lists views in schema" $