From d16ecdc28fd42b6800b5abef63d40c46767ed4f1 Mon Sep 17 00:00:00 2001
From: "Adam C. Baker" <adam.durandal@gmail.com>
Date: Tue, 7 Oct 2014 17:48:03 -0700
Subject: [PATCH] data/procedure for foreign key

---
 src/PgStructure.hs           | 20 ++++++++++++++++++++
 test/Unit/PgStructureSpec.hs | 13 +++++++++++--
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/src/PgStructure.hs b/src/PgStructure.hs
index 8ffdbdcc7..a6c25f157 100644
--- a/src/PgStructure.hs
+++ b/src/PgStructure.hs
@@ -36,6 +36,26 @@ instance JSON.ToJSON Table where
 toBool :: String -> Bool
 toBool = (== "YES")
 
+data ForeignKey = ForeignKey {
+  fkCol::String, fkTableReferred::String, fkColReferred::String
+} deriving (Eq, Show)
+
+foreignKeys :: String -> String -> Connection -> IO [ForeignKey]
+foreignKeys schema table conn = do
+  r <- quickQuery conn
+    "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" (map toSql [table, schema])
+  return [ForeignKey col reftab refcol | [col, reftab, refcol] <-
+    map (map fromSql) r]
+
 data Column = Column {
   colSchema :: String
 , colTable :: String
diff --git a/test/Unit/PgStructureSpec.hs b/test/Unit/PgStructureSpec.hs
index 059283c69..bf9480b4d 100644
--- a/test/Unit/PgStructureSpec.hs
+++ b/test/Unit/PgStructureSpec.hs
@@ -1,7 +1,8 @@
 module Unit.PgStructureSpec where
 
 import Test.Hspec
-import PgStructure (Table(..), tables, Column(..), columns)
+import PgStructure (Table(..), tables, Column(..), columns, ForeignKey(..),
+  foreignKeys)
 
 import Database.HDBC (quickQuery)
 import SpecHelper(dbWithSchema)
@@ -20,4 +21,12 @@ spec = around dbWithSchema $ beforeWith setRole $ do
       map colName cs `shouldBe` ["id","nullable_string","non_nullable_string",
         "inserted_at"]
 
-  where setRole = \conn -> quickQuery conn "set role dbapi_test" [] >> return conn
+  describe "foreignKeys" $
+    it "has a description of the foreign key columns" $ \conn ->
+      foreignKeys "1" "has_fk" conn `shouldReturn` [
+        ForeignKey { fkCol="auto_inc_fk",
+                   fkTableReferred="auto_incrementing_pk", fkColReferred="id"},
+        ForeignKey { fkCol="simple_fk", fkTableReferred="simple_pk",
+                   fkColReferred="k"}
+        ]
+  where setRole conn = quickQuery conn "set role dbapi_test" [] >> return conn