From 12f10aa2cbd7772e93885c5f1a583e2e238faf6c Mon Sep 17 00:00:00 2001
From: Oliver Charles <ollie@ocharles.org.uk>
Date: Thu, 18 Jun 2020 14:14:53 +0100
Subject: [PATCH] Introduce ExprTable

---
 src/Rel8/EqTable.hs      | 2 +-
 src/Rel8/Expr.hs         | 8 +++++++-
 src/Rel8/FromRow.hs      | 2 +-
 src/Rel8/FromRow.hs-boot | 3 +--
 src/Rel8/MaybeTable.hs   | 6 +++---
 src/Rel8/Query.hs        | 6 +++---
 6 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/src/Rel8/EqTable.hs b/src/Rel8/EqTable.hs
index 4a0e44d..2acabf4 100644
--- a/src/Rel8/EqTable.hs
+++ b/src/Rel8/EqTable.hs
@@ -15,7 +15,7 @@ import Rel8.Table
 
 -- | The class of database tables (containing one or more columns) that can be
 -- compared for equality as a whole.
-class (Table a, Context a ~ Expr) => EqTable a where
+class ExprTable a => EqTable a where
   -- | Compare two tables or expressions for equality.
   --
   -- This operator is overloaded (much like Haskell's 'Eq' type class) to allow
diff --git a/src/Rel8/Expr.hs b/src/Rel8/Expr.hs
index 855d4b4..174d065 100644
--- a/src/Rel8/Expr.hs
+++ b/src/Rel8/Expr.hs
@@ -11,6 +11,7 @@
 {-# language TypeApplications #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
+{-# language UndecidableSuperClasses #-}
 
 module Rel8.Expr
   ( DBType(..)
@@ -19,6 +20,7 @@ module Rel8.Expr
   , (&&.)
   , (||.)
   , Expr
+  , ExprTable
   , Function
   , and_
   , or_
@@ -332,7 +334,7 @@ null_ whenNull f a =
  ifThenElse_ ( isNull a ) whenNull ( f ( retype a ) )
 
 
-ifThenElse_ :: (Table a, Context a ~ Expr) => Expr Bool -> a -> a -> a
+ifThenElse_ :: ExprTable a => Expr Bool -> a -> a -> a
 ifThenElse_ bool whenTrue whenFalse =
   case_ [ ( bool, whenTrue ) ] whenFalse
 
@@ -371,3 +373,7 @@ and_ =
 or_ :: Foldable f => f ( Expr Bool ) -> Expr Bool
 or_ =
   foldl' (||.) ( lit False )
+
+
+class (Table a, Context a ~ Expr) => ExprTable a
+instance (Table a, Context a ~ Expr) => ExprTable a
diff --git a/src/Rel8/FromRow.hs b/src/Rel8/FromRow.hs
index 297e2d7..ca90867 100644
--- a/src/Rel8/FromRow.hs
+++ b/src/Rel8/FromRow.hs
@@ -25,7 +25,7 @@ import Data.Text ( Text )
 -- | @FromRow@ witnesses the one-to-one correspondence between the type @sql@,
 -- which contains SQL expressions, and the type @haskell@, which contains the
 -- Haskell decoding of rows containing @sql@ SQL expressions.
-class ( Context sql ~ Expr, Table sql ) => FromRow sql haskell | sql -> haskell, haskell -> sql where
+class ExprTable sql => FromRow sql haskell | sql -> haskell, haskell -> sql where
   rowParser :: sql -> RowParser haskell
 
 
diff --git a/src/Rel8/FromRow.hs-boot b/src/Rel8/FromRow.hs-boot
index e376e61..030425c 100644
--- a/src/Rel8/FromRow.hs-boot
+++ b/src/Rel8/FromRow.hs-boot
@@ -7,7 +7,6 @@ module Rel8.FromRow where
 
 import Database.PostgreSQL.Simple.FromRow
 import Rel8.Expr
-import Rel8.Table
 
-class ( Context sql ~ Expr, Table sql ) => FromRow sql haskell | sql -> haskell, haskell -> sql where
+class ExprTable sql => FromRow sql haskell | sql -> haskell, haskell -> sql where
   rowParser :: sql -> RowParser haskell
diff --git a/src/Rel8/MaybeTable.hs b/src/Rel8/MaybeTable.hs
index 7b74012..427db88 100644
--- a/src/Rel8/MaybeTable.hs
+++ b/src/Rel8/MaybeTable.hs
@@ -69,7 +69,7 @@ data MaybeTableField t a where
   MaybeTableField :: Field t a -> MaybeTableField t a
 
 
-instance (Table t, Context t ~ Expr) => Table (MaybeTable t) where
+instance ExprTable t => Table (MaybeTable t) where
   type Field (MaybeTable t) = MaybeTableField t
 
   type Context (MaybeTable t) = Context t
@@ -90,13 +90,13 @@ instance (Table t, Context t ~ Expr) => Table (MaybeTable t) where
 
 
 maybeTable
-  :: (Context b ~ Context a, Context a ~ Expr, Table b)
+  :: (ExprTable a, ExprTable b)
   => b -> (a -> b) -> MaybeTable a -> b
 maybeTable def f MaybeTable{ nullTag, table } =
   ifThenElse_ (null_ (lit False) id nullTag) (f table) def
 
 
-noTable :: (Table a, Context a ~ Expr, ConstrainTable a DBType) => MaybeTable a
+noTable :: (ExprTable a, ConstrainTable a DBType) => MaybeTable a
 noTable = MaybeTable tag t
   where
     tag = lit Nothing
diff --git a/src/Rel8/Query.hs b/src/Rel8/Query.hs
index ff7e1da..d25dd9a 100644
--- a/src/Rel8/Query.hs
+++ b/src/Rel8/Query.hs
@@ -457,7 +457,7 @@ optional =
 -- | Combine the results of two queries of the same type.
 --
 -- @union a b@ is the same as the SQL statement @x UNION b@.
-union :: (Table a, Context a ~ Expr) => Query a -> Query a -> Query a
+union :: ExprTable a => Query a -> Query a -> Query a
 union = union_forAll
 
 
@@ -489,7 +489,7 @@ union_forAll l r =
 -- | Select all distinct rows from a query, removing duplicates.
 --
 -- @distinct q@ is equivalent to the SQL statement @SELECT DISTINCT q@
-distinct :: (Table a, Context a ~ Expr) => Query a -> Query a
+distinct :: ExprTable a => Query a -> Query a
 distinct = distinct_forAll
 
 
@@ -550,7 +550,7 @@ catMaybeTable MaybeTable{ nullTag, table } = do
   return table
 
 
-values :: (Context expr ~ Expr, Table expr, Foldable f) => f expr -> Query expr
+values :: (ExprTable expr, Foldable f) => f expr -> Query expr
 values = liftOpaleye . Opaleye.valuesExplicit unpackspec valuesspec . toList
   where
     valuesspec =