From a7da74578b50e592cac263ff6532998c2cd0d2b9 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Sat, 27 Feb 2021 19:06:31 +0000 Subject: [PATCH] Yet another version --- Another.hs | 211 +++++++++++++++++ shell.nix | 2 +- src/Rel8.hs | 8 +- src/Rel8/Core.hs | 435 +++++++++++++++------------------- src/Rel8/EqTable.hs | 5 +- src/Rel8/Expr.hs | 1 - src/Rel8/Query.hs | 113 +++++---- src/Rel8/SimpleConstraints.hs | 43 ++-- 8 files changed, 477 insertions(+), 341 deletions(-) create mode 100644 Another.hs diff --git a/Another.hs b/Another.hs new file mode 100644 index 0000000..51c06dc --- /dev/null +++ b/Another.hs @@ -0,0 +1,211 @@ +{-# language BlockArguments #-} +{-# language ConstraintKinds #-} +{-# language DataKinds #-} +{-# language DerivingVia #-} +{-# language FlexibleContexts #-} +{-# language FlexibleInstances #-} +{-# language FunctionalDependencies #-} +{-# language GADTs #-} +{-# language InstanceSigs #-} +{-# language KindSignatures #-} +{-# language LambdaCase #-} +{-# language NamedFieldPuns #-} +{-# language RankNTypes #-} +{-# language ScopedTypeVariables #-} +{-# language StandaloneDeriving #-} +{-# language TypeApplications #-} +{-# language TypeFamilies #-} +{-# language TypeFamilyDependencies #-} +{-# language UndecidableInstances #-} +{-# language UndecidableSuperClasses #-} + +{-# options -Wno-implicit-prelude -Wno-missing-export-lists -Wno-missing-import-lists #-} + +module Another where + +import Prelude hiding (null) +import Control.Applicative (liftA2) +import Data.Functor.Identity (Identity) +import Data.Kind (Constraint, Type) +import Database.PostgreSQL.Simple.FromField (FieldParser) +import Database.PostgreSQL.Simple.FromRow (RowParser, fieldWith, field) +import qualified Opaleye.Internal.Column as O +import qualified Opaleye.Internal.HaskellDB.PrimQuery as O +import qualified Opaleye.Internal.RunQuery as O +import qualified Opaleye as O +import Data.Profunctor.Product.Default (Default) +import Data.Proxy ( Proxy( Proxy ) ) + +type family Column (f :: Type -> Type) (a :: Type) :: Type where + Column Identity a = a + Column f a = f a + +newtype C f a = C { toColumn :: Column f a } + +data Witness (c :: Type -> Constraint) (a :: Type) where + Witness :: c a => Witness c a + +class DBType (a :: Type) where + typeInformation :: TypeInformation a + +data TypeInformation a = TypeInformation + { encode :: a -> O.PrimExpr + , decode :: FieldParser a + } + +mapTypeInformation :: (a -> b) -> (b -> a) -> TypeInformation a -> TypeInformation b +mapTypeInformation f g TypeInformation{ encode, decode } = TypeInformation + { encode = encode . g + , decode = \x y -> f <$> decode x y + } + +newtype OpaleyeDBType sql a = OpaleyeDBType a + +instance (O.DefaultFromField sql a, Default O.ToFields a (O.Column sql)) => DBType (OpaleyeDBType sql a) where + typeInformation = TypeInformation + { encode = \(OpaleyeDBType x) -> + case O.toFields @a @(O.Column sql) x of + O.Column primExpr -> primExpr + , decode = \x y -> + case O.defaultFromField @sql @a of + O.QueryRunnerColumn _ fieldParser -> OpaleyeDBType <$> fieldParser x y + } + +deriving via OpaleyeDBType O.SqlBool Bool instance DBType Bool +deriving via OpaleyeDBType O.SqlInt4 Int instance DBType Int + +instance DBType () where + typeInformation = TypeInformation + { encode = \_ -> O.ConstExpr O.NullLit + , decode = \_ _ -> return () + } + +instance DBType a => DBType (Maybe a) where + typeInformation = TypeInformation + { encode = maybe null (encode typeInformation) + , decode = \x y -> + case y of + Nothing -> return Nothing + Just _ -> decode typeInformation x y + } + +class AllFields t DBType => HigherKindedTable (t :: (Type -> Type) -> Type) where + type HField t = (i :: Type -> Type) | i -> t + type AllFields t (c :: Type -> Constraint) :: Constraint + + hindex :: t f -> HField t a -> C f a + htabulate :: (forall x. HField t x -> C f x) -> t f + htraverse :: Applicative m => (forall x. C f x -> m (C g x)) -> t f -> m (t g) + hdicts :: forall (c :: Type -> Constraint). AllFields t c => t (Witness c) + +class HigherKindedTable (Schema t) => Table (t :: Type) where + type Schema t :: ((Type -> Type) -> Type) + type Context t :: Type -> Type + + fromColumns :: Schema t (Context t) -> t + toColumns :: t -> Schema t (Context t) + +instance HigherKindedTable f => Table (f g) where + type Schema (f g) = f + type Context (f g) = g + toColumns = id + fromColumns = id + +newtype Expr a = Expr { toPrimExpr :: O.PrimExpr } + +unsafeCoerceExpr :: Expr a -> Expr b +unsafeCoerceExpr (Expr a) = Expr a + +data MaybeTable t = MaybeTable (Expr (Maybe ())) t + +class SerializationMethod expr haskell => Serializable expr haskell | expr -> haskell, haskell -> expr where + +instance SerializationMethod expr haskell => Serializable expr haskell + +type family ResultType (expr :: Type) :: Type where + ResultType (MaybeTable t) = Maybe (ResultType t) + ResultType (t Expr) = t Identity + ResultType (a, b) = (ResultType a, ResultType b) + ResultType (Expr a) = a + +type family ExprType (haskell :: Type) :: Type where + ExprType (Maybe (t Identity)) = MaybeTable (t Expr) + ExprType (Maybe a) = Expr (Maybe a) + ExprType (t Identity) = t Expr + ExprType (a, b) = (ExprType a, ExprType b) + ExprType a = Expr a + +class (haskell ~ ResultType expr, expr ~ ExprType haskell) => SerializationMethod (expr :: Type) (haskell :: Type) where + rowParser :: RowParser haskell + lit :: haskell -> expr + +instance (DBType a, a ~ b, ExprType b ~ Expr a) => SerializationMethod (Expr (a :: Type)) (b :: Type) where + rowParser = fieldWith (decode (typeInformation @a)) + lit = Expr . encode (typeInformation @a) + +instance (HigherKindedTable s, s ~ t) => SerializationMethod (s Expr) (t Identity) where + rowParser = htraverse f $ htabulate @s \i -> g (hindex hdicts i) + where + f :: C RowParser x -> RowParser (C Identity x) + f (C x) = C <$> x + + g :: forall a. C (Witness DBType) a -> C RowParser a + g (C Witness) = C $ fieldWith $ decode $ typeInformation @a + + lit t = htabulate \i -> f (hindex hdicts i) (hindex t i) + where + f :: forall x. C (Witness DBType) x -> C Identity x -> C Expr x + f (C Witness) (C a) = C $ Expr $ encode (typeInformation @x) a + +instance (SerializationMethod a1 b1, SerializationMethod a2 b2, a1 ~ ExprType b1, a2 ~ ExprType b2, b1 ~ ResultType a1, b2 ~ ResultType a2) => SerializationMethod (a1, a2) (b1, b2) where + rowParser = liftA2 (,) rowParser rowParser + lit (a, b) = (lit a, lit b) + +instance (Serializable s t, Table s, Context s ~ Expr, MaybeTable s ~ ExprType (Maybe t), ResultType s ~ t) => SerializationMethod (MaybeTable s) (Maybe t) where + rowParser = do + nullTag <- field + case nullTag of + Just () -> Just <$> rowParser + Nothing -> Nothing <$ htraverse @(Schema s) (\x -> x <$ fieldWith (\_ _ -> pure ())) (htabulate @_ @Proxy \_ -> C Proxy) + + lit Nothing = MaybeTable nullUnit $ fromColumns $ htabulate \_ -> C $ unsafeCoerceExpr nullUnit + where + nullUnit :: Expr (Maybe ()) + nullUnit = lit Nothing + + lit (Just a) = MaybeTable (lit (Just ())) (lit a) + +null :: O.PrimExpr +null = O.ConstExpr O.NullLit + +-- + +data One f = One { oneA :: Column f Int } + +data OneField :: Type -> Type where + OneA :: OneField Int + +instance HigherKindedTable One where + type HField One = OneField + type AllFields One c = (c Int) + + hindex One{ oneA } = \case + OneA -> C oneA + + htabulate f = One { oneA = toColumn $ f OneA } + + hdicts = One Witness + + htraverse :: forall m f g. Applicative m => (forall x. C f x -> m (C g x)) -> One f -> m (One g) + htraverse f One{ oneA } = fmap (\(C oneA') -> One oneA') $ f (C oneA :: C f Int) + + +-- TODO Get this to infer! +-- thing :: _ +-- thing = lit (Just $ (One 42)) + +thing :: MaybeTable (One Expr) +thing = lit (Just $ (One 42 :: One Identity)) + +-- thing2 :: MaybeTable (One Expr) +-- thing2 = lit (Just _) diff --git a/shell.nix b/shell.nix index 1501765..b5dc890 100644 --- a/shell.nix +++ b/shell.nix @@ -1,5 +1,5 @@ let - hsPkgs = import ./default.nix {}; + hsPkgs = import ./default.nix; in hsPkgs.shellFor { withHoogle = true; diff --git a/src/Rel8.hs b/src/Rel8.hs index fb11fe9..5df3674 100644 --- a/src/Rel8.hs +++ b/src/Rel8.hs @@ -39,7 +39,6 @@ module Rel8 -- ** Expressions , Expr - , Context , coerceExpr , unsafeCoerceExpr @@ -86,11 +85,7 @@ module Rel8 , update , Update(..) - -- * Common Table Subtypes - , IsTableIn - , Selects - - -- TODO + -- * TOOD , ExprType -- * Next Steps @@ -107,7 +102,6 @@ import Rel8.DBEq import Rel8.EqTable import Rel8.Expr import Rel8.Query -import Rel8.SimpleConstraints import Rel8.TableSchema {- $nextSteps diff --git a/src/Rel8/Core.hs b/src/Rel8/Core.hs index 360895a..5ee36a3 100644 --- a/src/Rel8/Core.hs +++ b/src/Rel8/Core.hs @@ -48,6 +48,7 @@ import Data.Typeable ( Typeable ) import Data.UUID ( UUID ) import Database.PostgreSQL.Simple.FromField ( FromField, FieldParser, fromField, optionalField, returnError, ResultError( Incompatible ) ) import Database.PostgreSQL.Simple.FromRow ( RowParser, fieldWith ) +import Data.Functor.Compose ( Compose(..) ) import GHC.Generics hiding ( C ) import qualified Opaleye.Internal.Column as Opaleye import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye @@ -102,19 +103,21 @@ data MyType f = MyType { fieldA :: Column f T } @ -} -class HigherKindedTable ( t :: ( Type -> Type ) -> Type ) where +class HigherKindedTable (t :: (Type -> Type) -> Type) where -- | Like 'Field', but for higher-kinded tables. - type HField t = ( field :: Type -> Type ) | field -> t - type HField t = - GenericField t + type HField t = (field :: Type -> Type) | field -> t + type HField t = GenericField t -- | Like 'Constraintable', but for higher-kinded tables. - type HConstrainTable t ( f :: Type -> Type ) ( c :: Type -> Constraint ) :: Constraint - type HConstrainTable t f c = - GHConstrainTable ( Rep ( t f ) ) ( Rep ( t SPINE ) ) c + type HConstrainTable t (f :: Type -> Type) (c :: Type -> Constraint) :: Constraint + type HConstrainTable t f c = GHConstrainTable (Rep (t f)) (Rep (t SPINE)) c + + hfield :: t f -> HField t x -> C f x + htabulate :: ( forall x. c x => HField t x -> C f x ) -> t f + htraverse :: Applicative m => (forall x. C f x -> m (C g x)) -> t f -> m (t g) + hdicts :: forall f c. HConstrainTable t f c => t (Dict c) -- | Like 'field', but for higher-kinded tables. - hfield :: t f -> HField t x -> C f x default hfield :: forall f x . ( Generic ( t f ) @@ -126,50 +129,49 @@ class HigherKindedTable ( t :: ( Type -> Type ) -> Type ) where ghfield @( Rep ( t f ) ) @t @f @( Rep ( t SPINE ) ) ( from x ) i -- | Like 'tabulateMCP', but for higher-kinded tables. - htabulate - :: ( Applicative m, HConstrainTable t f c ) - => proxy c -> ( forall x. c x => HField t x -> m ( C f x ) ) -> m ( t f ) - default htabulate - :: forall f m c proxy - . ( Applicative m, GHConstrainTable ( Rep ( t f ) ) ( Rep ( t SPINE ) ) c, Generic ( t f ) - , GHigherKindedTable ( Rep ( t f ) ) t f ( Rep ( t SPINE ) ) - , HField t ~ GenericField t - ) - => proxy c -> ( forall x. c x => HField t x -> m ( C f x ) ) -> m ( t f ) - htabulate proxy f = - fmap to ( ghtabulate @( Rep ( t f ) ) @t @f @( Rep ( t SPINE ) ) proxy ( f . GenericField ) ) + -- default htabulate + -- :: forall f + -- . ( Applicative m, GHConstrainTable ( Rep ( t f ) ) ( Rep ( t SPINE ) ) c, Generic ( t f ) + -- , GHigherKindedTable ( Rep ( t f ) ) t f ( Rep ( t SPINE ) ) + -- , HField t ~ GenericField t + -- ) + -- => ( forall x. c x => HField t x -> C f x ) -> t f + -- htabulate proxy f = + -- fmap to ( ghtabulate @( Rep ( t f ) ) @t @f @( Rep ( t SPINE ) ) proxy ( f . GenericField ) ) +data Dict c a where + Dict :: c a => Dict c a + data TableHField t ( f :: Type -> Type ) x where F :: HField t x -> TableHField t f x -- | Any 'HigherKindedTable' is also a 'Table'. -instance HigherKindedTable t => Table (t f) where - type Structure (t f) = t - type Context (t f) = f - toStructure = id - fromStructure = id +instance (HigherKindedTable t, f ~ g) => Table f (t g) where + type Columns (t g) = t + toColumns = id + fromColumns = id data GenericField t a where - GenericField :: GHField t ( Rep ( t SPINE ) ) a -> GenericField t a + GenericField :: GHField t (Rep (t SPINE)) a -> GenericField t a -class GHigherKindedTable ( rep :: Type -> Type ) ( t :: ( Type -> Type ) -> Type ) ( f :: Type -> Type ) ( repIdentity :: Type -> Type ) where +class GHigherKindedTable (rep :: Type -> Type) (t :: (Type -> Type) -> Type) (f :: Type -> Type) (repIdentity :: Type -> Type) where data GHField t repIdentity :: Type -> Type type GHConstrainTable rep repIdentity ( c :: Type -> Constraint ) :: Constraint ghfield :: rep a -> GHField t repIdentity x -> C f x - ghtabulate - :: ( Applicative m, GHConstrainTable rep repIdentity c ) - => proxy c - -> ( forall x. c x => GHField t repIdentity x -> m ( C f x ) ) - -> m ( rep a ) + -- ghtabulate + -- :: ( Applicative m, GHConstrainTable rep repIdentity c ) + -- => proxy c + -- -> ( forall x. c x => GHField t repIdentity x -> m ( C f x ) ) + -- -> m ( rep a ) instance GHigherKindedTable x t f x' => GHigherKindedTable ( M1 i c x ) t f ( M1 i' c' x' ) where @@ -182,8 +184,8 @@ instance GHigherKindedTable x t f x' => GHigherKindedTable ( M1 i c x ) t f ( M1 ghfield ( M1 a ) ( M1Field i ) = ghfield a i - ghtabulate proxy f = - M1 <$> ghtabulate @x @t @f @x' proxy ( f . M1Field ) +-- ghtabulate proxy f = +-- M1 <$> ghtabulate @x @t @f @x' proxy ( f . M1Field ) instance ( GHigherKindedTable x t f x', GHigherKindedTable y t f y' ) => GHigherKindedTable ( x :*: y ) t f ( x' :*: y' ) where @@ -198,9 +200,9 @@ instance ( GHigherKindedTable x t f x', GHigherKindedTable y t f y' ) => GHigher FieldL i -> ghfield x i FieldR i -> ghfield y i - ghtabulate proxy f = - (:*:) <$> ghtabulate @x @t @f @x' proxy ( f . FieldL ) - <*> ghtabulate @y @t @f @y' proxy ( f . FieldR ) +-- ghtabulate proxy f = +-- (:*:) <$> ghtabulate @x @t @f @x' proxy ( f . FieldL ) +-- <*> ghtabulate @y @t @f @y' proxy ( f . FieldR ) type family IsColumnApplication ( a :: Type ) :: Bool where @@ -219,8 +221,8 @@ instance DispatchK1 ( IsColumnApplication c' ) f c c' => GHigherKindedTable ( K1 ghfield ( K1 a ) ( K1Field i ) = k1field @( IsColumnApplication c' ) @f @c @c' a i - ghtabulate proxy f = - K1 <$> k1tabulate @( IsColumnApplication c' ) @f @c @c' proxy ( f . K1Field ) +-- ghtabulate proxy f = +-- K1 <$> k1tabulate @( IsColumnApplication c' ) @f @c @c' proxy ( f . K1Field ) class DispatchK1 ( isSPINE :: Bool ) f a a' where @@ -230,9 +232,9 @@ class DispatchK1 ( isSPINE :: Bool ) f a a' where k1field :: a -> K1Field isSPINE a' x -> C f x - k1tabulate - :: ( ConstrainK1 isSPINE a a' c, Applicative m ) - => proxy c -> ( forall x. c x => K1Field isSPINE a' x -> m ( C f x ) ) -> m a +-- k1tabulate +-- :: ( ConstrainK1 isSPINE a a' c, Applicative m ) +-- => proxy c -> ( forall x. c x => K1Field isSPINE a' x -> m ( C f x ) ) -> m a instance (a ~ Column f b) => DispatchK1 'True f a ( SPINE b ) where @@ -245,8 +247,8 @@ instance (a ~ Column f b) => DispatchK1 'True f a ( SPINE b ) where k1field a K1True = MkC a - k1tabulate _ f = - toColumn <$> f @b K1True +-- k1tabulate _ f = +-- toColumn <$> f @b K1True data SPINE a @@ -259,25 +261,11 @@ writing higher-kinded data types is usually more convenient. See also: 'HigherKindedTable'. -} -class HigherKindedTable (Structure t) => Table (t :: Type) where - type Structure t :: (Type -> Type) -> Type - type Context t :: Type -> Type +class HigherKindedTable (Columns t) => Table (context :: Type -> Type) (t :: Type) | t -> context where + type Columns t :: (Type -> Type) -> Type - toStructure :: t -> Structure t (Context t) - fromStructure :: Structure t (Context t) -> t - - - --- | Effectfully map a table from one context to another. -traverseTableWithIndexC - :: forall c t t' m - . (Applicative m, Table t, Table t', HConstrainTable (Structure t') (Context t') c, Structure t ~ Structure t') - => (forall x. c x => HField (Structure t) x -> C (Context t) x -> m (C (Context t') x)) - -> t - -> m t' -traverseTableWithIndexC f t = - fmap fromStructure $ - htabulate (Proxy @c) \index -> f index (hfield (toStructure t) index) + toColumns :: t -> Columns t context + fromColumns :: Columns t context -> t data HPair x y (f :: Type -> Type) = HPair { hfst :: x f, hsnd :: y f } @@ -287,107 +275,38 @@ data HPair x y (f :: Type -> Type) = HPair { hfst :: x f, hsnd :: y f } deriving instance (HigherKindedTable x, HigherKindedTable y) => HigherKindedTable (HPair x y) -instance (Table a, Table b, Context a ~ Context b) => Table (a, b) where - type Structure (a, b) = HPair (Structure a) (Structure b) - type Context (a, b) = Context a - toStructure (a, b) = HPair (toStructure a) (toStructure b) - fromStructure (HPair x y) = (fromStructure x, fromStructure y) +instance (Table f a, Table f b) => Table f (a, b) where + type Columns (a, b) = HPair (Columns a) (Columns b) + toColumns (a, b) = HPair (toColumns a) (toColumns b) + fromColumns (HPair x y) = (fromColumns x, fromColumns y) --- | Map a 'Table' from one type to another. The table types must be compatible, --- see 'Compatible' for what that means. -mapTable - :: forall t' t - . (Table t, Table t', Structure t ~ Structure t', HConstrainTable (Structure t) (Context t') Unconstrained) - => (forall x. C (Context t) x -> C (Context t') x) -> t -> t' -mapTable f = runIdentity . traverseTable (Identity . f) - - --- | Map a 'Table' from one type to another, where all columns in the table are --- subject to a constraint. -mapTableC - :: forall c t' t - . (Table t, Table t', Structure t ~ Structure t', HConstrainTable (Structure t) (Context t') c) - => (forall x. c x => C (Context t) x -> C (Context t') x) - -> t -> t' -mapTableC f = - runIdentity . traverseTableC @c ( Identity . f ) - - --- | Effectfully traverse all fields in a 'Table', potentially producing another --- @Table@. -traverseTable - :: forall t' t m - . (Applicative m, Table t, Table t', Structure t ~ Structure t', HConstrainTable (Structure t) (Context t') Unconstrained) - => (forall x. C (Context t) x -> m (C (Context t') x)) - -> t - -> m t' -traverseTable f = - traverseTableWithIndexC @Unconstrained (const f) - - --- | Effectfully traverse all fields in a 'Table', provided that all fields --- satisfy a given constraint. For example, if all fields in a table have an --- instance for 'Read', we can apply 'readMaybe' to all fields in the table, --- failing if any read fails: --- --- >>> traverseTableC @Read ( traverseC readMaybe ) MyTable{ fieldA = "True" } --- Just MyTable{ fieldA = True } -traverseTableC - :: forall c m t t' - . (Table t, Table t', Applicative m, Structure t ~ Structure t', HConstrainTable (Structure t) (Context t') c) - => (forall x. c x => C (Context t) x -> m (C (Context t') x)) - -> t - -> m t' -traverseTableC f = - traverseTableWithIndexC @c (const f) - - -zipTablesWithM - :: forall t m - . ( Applicative m - , Table t - , HConstrainTable (Structure t) (Context t) Unconstrained - ) - => ( forall x. C ( Context t ) x -> C ( Context t ) x -> m ( C ( Context t ) x ) ) - -> t -> t -> m t -zipTablesWithM f t t' = - fmap fromStructure $ - htabulate (Proxy @Unconstrained) \index -> - f (hfield (toStructure t) index) (hfield (toStructure t') index) - - -instance (Context a ~ f, Table a, Structure a ~ Structure a') => DispatchK1 'False f a a' where +instance (Table f a, Columns a ~ Columns a') => DispatchK1 'False f a a' where data K1Field 'False a' x where - K1False :: HField (Structure a') x -> K1Field 'False a' x + K1False :: HField (Columns a') x -> K1Field 'False a' x - type ConstrainK1 'False a a' c = - HConstrainTable (Structure a) (Context a) c + -- type ConstrainK1 'False a a' c = + -- HConstrainTable (Columns a) (Context a) c k1field a (K1False i) = - hfield (toStructure a) i + hfield (toColumns a) i - k1tabulate proxy f = - fromStructure <$> htabulate proxy (f . K1False) +-- -- k1tabulate proxy f = +-- -- fromColumns <$> htabulate proxy (f . K1False) newtype HIdentity a f = HIdentity { unHIdentity :: Column f a } deriving ( Generic, HigherKindedTable ) --- | Any 'Identity' can be seen as a 'Table' with only one column. -instance Table (Identity a) where - type Context (Identity a) = Identity - type Structure (Identity a) = HIdentity a - toStructure = HIdentity . runIdentity - fromStructure = Identity . unHIdentity - - -- | @Serializable@ 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 (ExprTable sql, SerializableChoice sql haskell) => Serializable sql haskell | sql -> haskell, haskell -> sql where -instance (ExprTable a, SerializableChoice a b) => Serializable a b where +class SerializationMethod sql haskell => Serializable sql haskell | sql -> haskell, haskell -> sql where + lit2 :: haskell -> sql + +instance SerializationMethod a b => Serializable a b where + lit2 = lit type family ExprType (a :: Type) :: Type where @@ -405,58 +324,63 @@ type family ResultType (a :: Type) :: Type where ResultType (MaybeTable a) = Maybe (ResultType a) -class (ExprTable a, a ~ ExprType b, b ~ ResultType a) => SerializableChoice (a :: Type) (b :: Type) where - rowParser :: a -> RowParser b - lit :: b -> a +class (Table Expr expr, expr ~ ExprType haskell, haskell ~ ResultType expr) => SerializationMethod (expr :: Type) (haskell :: Type) where + rowParser :: RowParser haskell + lit :: haskell -> expr -- | Any higher-kinded records can be @SELECT@ed, as long as we know how to -- decode all of the records constituent part's. -instance (expr ~ Expr, identity ~ Identity, ExprTable (t expr), Table (t identity), HConstrainTable t Identity DBType) => SerializableChoice ( t expr ) ( t identity ) where - rowParser = - traverseTableC @DBType ( traverseCC @DBType \_ -> fieldWith ( decode typeInformation ) ) +instance (s ~ t, expr ~ Expr, identity ~ Identity, HigherKindedTable t, HConstrainTable t Identity DBType) => SerializationMethod (s expr) (t identity) where +-- rowParser _ = htraverse f $ htabulate @t \i -> g (hfield hdicts i) +-- where +-- f :: C RowParser x -> RowParser (C Identity x) +-- f (MkC x) = MkC <$> x - lit = - runIdentity . mapContext (Proxy @Lit) (Proxy @DBType) (Identity . mapCC @DBType lit) +-- g :: forall a. C (Dict DBType) a -> C RowParser a +-- g (MkC Dict) = MkC $ fieldWith $ decode $ typeInformation @a + lit t = + fromColumns $ htabulate \i -> + case (hfield (hdicts @t @Identity @DBType) i, hfield t i) of + (MkC Dict, MkC x) -> MkC $ lit2 x -- mapCC @DBType lit x -instance DBType a => SerializableChoice (Expr a) a where - rowParser _ = fieldWith (decode typeInformation) +instance (DBType a, a ~ b) => SerializationMethod (Expr a) b where + rowParser = fieldWith (decode typeInformation) lit = Expr . Opaleye.CastExpr typeName . encode where DatabaseType{ encode, typeName } = typeInformation -instance (Serializable a1 b1, Serializable a2 b2) => SerializableChoice (a1, a2) (b1, b2) where - rowParser (a, b) = - liftA2 (,) (rowParser a) (rowParser b) +instance (Serializable a1 b1, Serializable a2 b2) => SerializationMethod (a1, a2) (b1, b2) where + rowParser = liftA2 (,) rowParser rowParser lit (a, b) = (lit a, lit b) -instance - ( Context a ~ Expr - , Table a - , HConstrainTable (Structure a) Expr Unconstrained - , HConstrainTable (Structure a) Expr DBType - , Serializable a b - , ExprType (Maybe b) ~ MaybeTable a - ) => SerializableChoice (MaybeTable a) (Maybe b) where +-- instance +-- ( Context a ~ Expr +-- , Table a +-- , HConstrainTable (Structure a) Expr Unconstrained +-- , HConstrainTable (Structure a) Expr DBType +-- , Serializable a b +-- , ExprType (Maybe b) ~ MaybeTable a +-- ) => SerializationMethod (MaybeTable a) (Maybe b) where - rowParser ( MaybeTable _ t ) = do - rowExists <- fieldWith ( decode typeInformation ) +-- rowParser ( MaybeTable _ t ) = do +-- rowExists <- fieldWith ( decode typeInformation ) - case rowExists of - Just True -> - Just <$> rowParser t +-- case rowExists of +-- Just True -> +-- Just <$> rowParser t - _ -> - Nothing <$ traverseTableC @DBType @RowParser @_ @a nullField t +-- _ -> +-- Nothing <$ traverseTableC @DBType @RowParser @_ @a nullField t - lit = \case - Nothing -> noTable - Just x -> pure (lit x) +-- lit = \case +-- Nothing -> noTable +-- Just x -> pure (lit x) nullField :: forall x f. C f x -> RowParser ( C f x ) @@ -464,8 +388,7 @@ nullField x = x <$ fieldWith (\_ _ -> pure ()) -- | Typed SQL expressions -newtype Expr ( a :: Type ) = - Expr { toPrimExpr :: Opaleye.PrimExpr } +newtype Expr (a :: Type) = Expr { toPrimExpr :: Opaleye.PrimExpr } type role Expr representational @@ -476,8 +399,8 @@ instance ( IsString a, DBType a ) => IsString ( Expr a ) where lit . fromString -class (HConstrainTable (Structure a) Expr Unconstrained, Table a, Context a ~ Expr, HConstrainTable (Structure a) Expr DBType) => ExprTable a -instance (HConstrainTable (Structure a) Expr Unconstrained, Table a, Context a ~ Expr, HConstrainTable (Structure a) Expr DBType) => ExprTable a +-- class (HConstrainTable (Structure a) Expr Unconstrained, Table a, Context a ~ Expr, HConstrainTable (Structure a) Expr DBType) => Table Expr a +-- instance (HConstrainTable (Structure a) Expr Unconstrained, Table a, Context a ~ Expr, HConstrainTable (Structure a) Expr DBType) => Table Expr a {-| @MaybeTable t@ is the table @t@, but as the result of an outer join. If the @@ -518,51 +441,51 @@ instance Monad MaybeTable where null_ (lit False) (\x' -> null_ (lit False) (\y' -> x' ||. y') y) x -data HMaybeTable g f = - HMaybeTable - { hnullTag :: Column f (Maybe Bool) - , hcontents :: g f - } - deriving - (Generic) +-- data HMaybeTable g f = +-- HMaybeTable +-- { hnullTag :: Column f (Maybe Bool) +-- , hcontents :: g f +-- } +-- deriving +-- (Generic) -deriving instance (forall f. Table (g f)) => HigherKindedTable (HMaybeTable g) +-- deriving instance (forall f. Table (g f)) => HigherKindedTable (HMaybeTable g) -instance (ExprTable a, HigherKindedTable (Structure a)) => Table (MaybeTable a) where - type Structure (MaybeTable a) = HMaybeTable (Structure a) - type Context (MaybeTable a) = Expr +-- instance (Table Expr a, HigherKindedTable (Structure a)) => Table (MaybeTable a) where +-- type Structure (MaybeTable a) = HMaybeTable (Structure a) +-- type Context (MaybeTable a) = Expr - toStructure (MaybeTable x y) = HMaybeTable x (toStructure y) - fromStructure (HMaybeTable x y) = MaybeTable x (fromStructure y) +-- toStructure (MaybeTable x y) = HMaybeTable x (toStructure y) +-- fromColumns (HMaybeTable x y) = MaybeTable x (fromColumns y) maybeTable - :: ExprTable b + :: Table Expr b => b -> (a -> b) -> MaybeTable a -> b maybeTable def f MaybeTable{ nullTag, table } = ifThenElse_ (null_ (lit False) id nullTag) (f table) def -noTable :: forall a. ExprTable a => MaybeTable a -noTable = MaybeTable tag t - where - tag :: Expr (Maybe Bool) - tag = lit (Nothing :: Maybe Bool) +noTable :: forall a. Table Expr a => MaybeTable a +noTable = undefined +-- noTable = MaybeTable tag t +-- where +-- tag :: Expr (Maybe Bool) +-- tag = lit (Nothing :: Maybe Bool) - t :: a - t = fromStructure $ runIdentity $ htabulate (Proxy @DBType) f - where - f :: forall x i. DBType x => i x -> Identity (C Expr x) - f _ = pure $ MkC $ unsafeCoerceExpr (lit (Nothing :: Maybe x) :: Expr (Maybe x)) +-- t :: a +-- t = fromColumns $ runIdentity $ htabulate (Proxy @DBType) f +-- where +-- f :: forall x i. DBType x => i x -> Identity (C Expr x) +-- f _ = pure $ MkC $ unsafeCoerceExpr (lit (Nothing :: Maybe x) :: Expr (Maybe x)) -instance Table (Expr a) where - type Context (Expr a) = Expr - type Structure (Expr a) = HIdentity a - toStructure = HIdentity - fromStructure = unHIdentity +instance expr ~ Expr => Table expr (Expr a) where + type Columns (Expr a) = HIdentity a + toColumns = HIdentity + fromColumns = unHIdentity {-| Haskell types that can be represented as expressiosn in a database. There @@ -588,7 +511,7 @@ just used integers (the type distinction does not impact query generation). -} -class (ExprType a ~ Expr a, ResultType (Expr a) ~ a, ExprType (Maybe a) ~ Expr (Maybe a)) => DBType ( a :: Type ) where +class (ExprType a ~ Expr a, ResultType (Expr a) ~ a, ExprType (Maybe a) ~ Expr (Maybe a), Serializable (Expr a) a) => DBType (a :: Type) where typeInformation :: DatabaseType a a @@ -746,71 +669,67 @@ infixr 2 ||. Expr ( Opaleye.BinExpr Opaleye.OpOr a b ) -ifThenElse_ :: ExprTable a => Expr Bool -> a -> a -> a +ifThenElse_ :: Table Expr a => Expr Bool -> a -> a -> a ifThenElse_ bool whenTrue whenFalse = case_ [ ( bool, whenTrue ) ] whenFalse -case_ :: forall a. ExprTable a => [ ( Expr Bool, a ) ] -> a -> a +case_ :: forall a. Table Expr a => [ ( Expr Bool, a ) ] -> a -> a case_ alts def = - fromStructure $ runIdentity $ htabulate @(Structure a) (Proxy @Unconstrained) \x -> - pure $ MkC $ fromPrimExpr $ + fromColumns $ htabulate @(Columns a) \x -> MkC $ fromPrimExpr $ Opaleye.CaseExpr - [ ( toPrimExpr bool, toPrimExpr $ toColumn $ hfield (toStructure alt) x ) | ( bool, alt ) <- alts ] - ( toPrimExpr $ toColumn $ hfield (toStructure def) x ) + [ ( toPrimExpr bool, toPrimExpr $ toColumn $ hfield (toColumns alt) x ) | ( bool, alt ) <- alts ] + ( toPrimExpr $ toColumn $ hfield (toColumns def) x ) unsafeCoerceExpr :: Expr a -> Expr b -unsafeCoerceExpr ( Expr x ) = Expr x +unsafeCoerceExpr (Expr x) = Expr x retype :: Expr a -> Expr b -retype = - fromPrimExpr . toPrimExpr +retype = fromPrimExpr . toPrimExpr -isNull :: Expr ( Maybe a ) -> Expr Bool -isNull = - fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNull . toPrimExpr +isNull :: Expr (Maybe a) -> Expr Bool +isNull = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNull . toPrimExpr fromPrimExpr :: Opaleye.PrimExpr -> Expr a -fromPrimExpr = - Expr +fromPrimExpr = Expr -type family Apply (g :: (Type -> Type) -> Type -> Type) (f :: Type -> Type) :: Type -> Type where - Apply Lit Identity = Expr - Apply g f = g f +-- type family Apply (g :: (Type -> Type) -> Type -> Type) (f :: Type -> Type) :: Type -> Type where +-- Apply Lit Identity = Expr +-- Apply g f = g f -data Lit (f :: Type -> Type) a +-- data Lit (f :: Type -> Type) a -class - ( Table a - , Table b - , MapContext g a ~ b - , Structure a ~ Structure b - , Apply g (Context a) ~ Context b - ) => - Recontextualise g a b - where +-- class +-- ( Table a +-- , Table b +-- , MapContext g a ~ b +-- , Structure a ~ Structure b +-- , Apply g (Context a) ~ Context b +-- ) => +-- Recontextualise g a b +-- where - type MapContext (g :: (Type -> Type) -> Type -> Type) a :: Type +-- type MapContext (g :: (Type -> Type) -> Type -> Type) a :: Type - mapContext :: (Applicative m, HConstrainTable (Structure a) (Context b) c) - => proxy g - -> proxy' c - -> (forall x. c x => C (Context a) x -> m (C (Context b) x)) - -> a - -> m b +-- mapContext :: (Applicative m, HConstrainTable (Structure a) (Context b) c) +-- => proxy g +-- -> proxy' c +-- -> (forall x. c x => C (Context a) x -> m (C (Context b) x)) +-- -> a +-- -> m b -instance (HigherKindedTable t, f' ~ Apply g f) => Recontextualise g (t f) (t f') where - type MapContext g (t f) = t (Apply g f) +-- instance (HigherKindedTable t, f' ~ Apply g f) => Recontextualise g (t f) (t f') where +-- type MapContext g (t f) = t (Apply g f) - mapContext _ c f as = htabulate c (\field -> f (hfield as field)) +-- mapContext _ c f as = htabulate c (\field -> f (hfield as field)) -- | A deriving-via helper type for column types that store a Haskell value @@ -834,3 +753,21 @@ instance (Read a, Show a, Typeable a) => DBType (ReadShow a) where typeInformation = parseDatabaseType (fmap ReadShow . readEither) $ lmap (show . fromReadShow) typeInformation + + +mapTable + :: (Columns s ~ Columns t, Table f s, Table g t) + => (forall x. C f x -> C g x) -> s -> t +mapTable f = fromColumns . runIdentity . htraverse (pure . f) . toColumns + + +zipTablesWithM + :: (Columns x ~ Columns y, Columns y ~ Columns z, Table f x, Table g y, Table h z) + => (forall x. C f x -> C g y -> m (C h z)) -> x -> y -> m z +zipTablesWithM f x y = undefined + + +traverseTable + :: (Columns x ~ Columns y, Table f x, Table g y) + => (forall x. C f x -> m (C g y)) -> x -> m y +traverseTable f = undefined diff --git a/src/Rel8/EqTable.hs b/src/Rel8/EqTable.hs index bb65829..cc8f120 100644 --- a/src/Rel8/EqTable.hs +++ b/src/Rel8/EqTable.hs @@ -1,4 +1,5 @@ {-# language BlockArguments #-} +{-# language FlexibleContexts #-} {-# language FlexibleInstances #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} @@ -15,7 +16,7 @@ import Rel8.Core -- | The class of database tables (containing one or more columns) that can be -- compared for equality as a whole. -class ExprTable a => EqTable a where +class Table Expr a => EqTable a where -- | Compare two tables or expressions for equality. -- -- This operator is overloaded (much like Haskell's 'Eq' type class) to allow @@ -31,7 +32,7 @@ class ExprTable a => EqTable a where -- -- >>> :t ( exprA, exprA ) ==. ( exprA, exprA ) -- Expr m Bool - (==.) :: a -> a -> Context a Bool + (==.) :: a -> a -> Expr Bool -- | Any @Expr@s can be compared for equality as long as the underlying diff --git a/src/Rel8/Expr.hs b/src/Rel8/Expr.hs index 31fbb32..fbfb744 100644 --- a/src/Rel8/Expr.hs +++ b/src/Rel8/Expr.hs @@ -22,7 +22,6 @@ module Rel8.Expr , (&&.) , (||.) , Expr - , ExprTable , Function , and_ , or_ diff --git a/src/Rel8/Query.hs b/src/Rel8/Query.hs index 27c13fa..08e9f30 100644 --- a/src/Rel8/Query.hs +++ b/src/Rel8/Query.hs @@ -130,15 +130,13 @@ queryRunner . Serializable row haskell => Opaleye.FromFields row haskell queryRunner = - Opaleye.QueryRunner ( void unpackspec ) rowParser ( const 1 ) + Opaleye.QueryRunner ( void unpackspec ) (const rowParser) ( const 1 ) -unpackspec - :: (ExprTable row) - => Opaleye.Unpackspec row row +unpackspec :: Table Expr row => Opaleye.Unpackspec row row unpackspec = - Opaleye.Unpackspec $ Opaleye.PackMap \f -> - traverseTable (traverseC (traversePrimExpr f)) + Opaleye.Unpackspec $ Opaleye.PackMap \f -> + fmap fromColumns . htraverse (traverseC (traversePrimExpr f)) . toColumns -- | Run an @INSERT@ statement @@ -154,10 +152,9 @@ insert connection Insert{ into, rows, onConflict, returning } = toOpaleyeInsert :: forall schema result value - . ( ExprTable value - , Context schema ~ ColumnSchema - , Structure value ~ Structure schema - , Table schema + . ( Table Expr value + , Table ColumnSchema schema + , Columns value ~ Columns schema ) => TableSchema schema -> [ value ] @@ -185,9 +182,8 @@ insert connection Insert{ into, rows, onConflict, returning } = writer :: forall value schema - . ( Context value ~ Expr - , Context schema ~ ColumnSchema - , Selects schema value + . ( Table Expr value + , Table ColumnSchema schema ) => TableSchema schema -> Opaleye.Writer value schema writer into_ = @@ -197,23 +193,23 @@ writer into_ = . ( Functor list, Applicative f ) => ( ( list Opaleye.PrimExpr, String ) -> f () ) -> list value - -> f () - go f xs = - void - ( traverseTableWithIndexC - @Unconstrained - @schema - @value - ( \i -> - traverseC \ColumnSchema{ columnName } -> do - f ( toPrimExpr . toColumn . flip hfield i . toStructure <$> xs - , columnName - ) + -> f () + go f xs = undefined + -- void + -- ( traverseTableWithIndexC + -- @Unconstrained + -- @schema + -- @value + -- ( \i -> + -- traverseC \ColumnSchema{ columnName } -> do + -- f ( toPrimExpr . toColumn . flip hfield i . toStructure <$> xs + -- , columnName + -- ) - return ( column columnName ) - ) - ( tableColumns into_ ) - ) + -- return ( column columnName ) + -- ) + -- ( tableColumns into_ ) + -- ) in Opaleye.Writer ( Opaleye.PackMap go ) @@ -239,7 +235,7 @@ ddlTable schema writer_ = -- | The constituent parts of a SQL @INSERT@ statement. data Insert :: * -> * where Insert - :: Selects schema value + :: (Columns value ~ Columns schema, Table Expr value, Table ColumnSchema schema) => { into :: TableSchema schema -- ^ Which table to insert into. , rows :: [ value ] @@ -265,9 +261,10 @@ data Returning schema a where -- >>> :t insert Insert{ returning = Projection fooId } -- IO [ FooId ] Projection - :: ( Selects schema row - , Table projection - , Context row ~ Context projection + :: ( Table Expr projection + , Table ColumnSchema schema + , Table Expr row + , Columns schema ~ Columns row , Serializable projection a ) => ( row -> projection ) @@ -279,7 +276,7 @@ data OnConflict | DoNothing -selectQuery :: forall a . ExprTable a => Query a -> Maybe String +selectQuery :: forall a . Table Expr a => Query a -> Maybe String selectQuery ( Query opaleye ) = showSqlForPostgresExplicit @@ -303,10 +300,9 @@ delete c Delete{ from, deleteWhere, returning } = go :: forall schema r row - . ( Context schema ~ ColumnSchema - , ExprTable row - , Structure schema ~ Structure row - , Table schema + . ( Table Expr row + , Table ColumnSchema schema + , Columns schema ~ Columns row ) => TableSchema schema -> ( row -> Expr Bool ) @@ -326,7 +322,7 @@ delete c Delete{ from, deleteWhere, returning } = data Delete from return where Delete - :: Selects from row + :: ( Columns from ~ Columns row, Table Expr row, Table ColumnSchema from ) => { from :: TableSchema from , deleteWhere :: row -> Expr Bool , returning :: Returning from return @@ -342,10 +338,9 @@ update connection Update{ target, set, updateWhere, returning } = go :: forall returning target row - . ( Context target ~ ColumnSchema - , ExprTable row - , Structure target ~ Structure row - , Table target + . ( Table Expr row + , Columns target ~ Columns row + , Table ColumnSchema target ) => TableSchema target -> ( row -> row ) @@ -373,7 +368,7 @@ update connection Update{ target, set, updateWhere, returning } = data Update target returning where Update - :: Selects target row + :: ( Columns target ~ Columns row, Table Expr row, Table ColumnSchema target ) => { target :: TableSchema target , set :: row -> row , updateWhere :: row -> Expr Bool @@ -393,13 +388,13 @@ exists query = -- | Select each row from a table definition. -- -- This is equivalent to @FROM table@. -each :: Selects schema row => TableSchema schema -> Query row +each :: (Columns schema ~ Columns row, Table Expr row, Table ColumnSchema schema) => TableSchema schema -> Query row each = each_forAll each_forAll :: forall schema row - . Selects schema row + . ( Columns schema ~ Columns row, Table Expr row, Table ColumnSchema schema ) => TableSchema schema -> Query row each_forAll schema = liftOpaleye @@ -453,13 +448,13 @@ 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 :: ExprTable a => Query a -> Query a -> Query a +union :: Table Expr a => Query a -> Query a -> Query a union = union_forAll union_forAll :: forall a - . ExprTable a + . Table Expr a => Query a -> Query a -> Query a union_forAll l r = liftOpaleye @@ -483,11 +478,11 @@ 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 :: ExprTable a => Query a -> Query a +distinct :: Table Expr a => Query a -> Query a distinct = distinct_forAll -distinct_forAll :: forall a. ExprTable a => Query a -> Query a +distinct_forAll :: forall a. Table Expr a => Query a -> Query a distinct_forAll query = liftOpaleye ( Opaleye.distinctExplicit distinctspec ( toOpaleye query ) ) @@ -543,20 +538,20 @@ catMaybe e = catMaybeTable $ MaybeTable (ifThenElse_ (isNull e) (lit Nothing) (lit (Just False))) (unsafeCoerceExpr e) -values :: forall expr f. (ExprTable expr, Foldable f) => f expr -> Query expr +values :: forall expr f. (Table Expr expr, Foldable f) => f expr -> Query expr values = liftOpaleye . Opaleye.valuesExplicit valuesspec . toList where valuesspec = Opaleye.ValuesspecSafe packmap unpackspec where packmap :: Opaleye.PackMap Opaleye.PrimExpr Opaleye.PrimExpr () expr - packmap = Opaleye.PackMap \f () -> - fmap fromStructure $ - htabulate (Proxy @DBType) \i -> MkC . fromPrimExpr <$> f (nullExpr i) - where - nullExpr :: forall a w. DBType a => HField w a -> Opaleye.PrimExpr - nullExpr _ = Opaleye.CastExpr typeName (Opaleye.ConstExpr Opaleye.NullLit) - where - DatabaseType{ typeName } = typeInformation @a + packmap = Opaleye.PackMap \f () -> undefined + -- fmap fromColumns $ + -- htabulate (Proxy @DBType) \i -> MkC . fromPrimExpr <$> f (nullExpr i) + -- where + -- nullExpr :: forall a w. DBType a => HField w a -> Opaleye.PrimExpr + -- nullExpr _ = Opaleye.CastExpr typeName (Opaleye.ConstExpr Opaleye.NullLit) + -- where + -- DatabaseType{ typeName } = typeInformation @a filter :: (a -> Expr Bool) -> a -> Query a diff --git a/src/Rel8/SimpleConstraints.hs b/src/Rel8/SimpleConstraints.hs index 10df194..fa6115b 100644 --- a/src/Rel8/SimpleConstraints.hs +++ b/src/Rel8/SimpleConstraints.hs @@ -10,35 +10,34 @@ {-# language UndecidableInstances #-} {-# language UndecidableSuperClasses #-} -module Rel8.SimpleConstraints ( Selects, IsTableIn ) where +module Rel8.SimpleConstraints where -- ( Selects, IsTableIn ) where import Rel8.ColumnSchema import Rel8.Expr import Rel8.Core --- | @Selects m schema row@ says that in the monad @m@, the schema definition --- @schema@ can be @SELECT@ed into the Haskell type @row@. -class - ( ExprTable row - , Context schema ~ ColumnSchema - , Table schema - , Structure row ~ Structure schema - ) => Selects schema row +-- -- | @Selects m schema row@ says that in the monad @m@, the schema definition +-- -- @schema@ can be @SELECT@ed into the Haskell type @row@. +-- class +-- ( Context schema ~ ColumnSchema +-- , Table schema +-- , Structure row ~ Structure schema +-- ) => Selects schema row -instance - {-# overlapping #-} - ( ExprTable row - , Context schema ~ ColumnSchema - , Table schema - , Structure row ~ Structure schema - ) => Selects schema row +-- instance +-- {-# overlapping #-} +-- ( ExprTable row +-- , Context schema ~ ColumnSchema +-- , Table schema +-- , Structure row ~ Structure schema +-- ) => Selects schema row --- | Makes sure that a given table (@a@) contains expressions compatible with --- the monad @m@. This type class is essentially a scoping check. -class - ( Table a - , Context a ~ Expr - ) => a `IsTableIn` m +-- -- | Makes sure that a given table (@a@) contains expressions compatible with +-- -- the monad @m@. This type class is essentially a scoping check. +-- class +-- ( Table a +-- , Context a ~ Expr +-- ) => a `IsTableIn` m