haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplify ToFromT (#225)

Browse Source 
* Simplify ToFromT. Converted most closed type families to be associated type families with the exception of IsLateral, Nullable and the two new FromOnClause and FromCrossJoin type families that handle the overlaps instead of ToFromT
This commit is contained in:
Ben Levy 2020-11-04 11:15:17 -06:00 committed by GitHub
parent eb91208e94
commit eb034458de
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 274 additions and 300 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
changelog.md
View File

@ -3,6 +3,10 @@
- @arthurxavierx - @arthurxavierx
- [#221](https://github.com/bitemyapp/esqueleto/pull/221) - [#221](https://github.com/bitemyapp/esqueleto/pull/221)
- Deprecate `ToAliasT` and `ToAliasReferenceT` - Deprecate `ToAliasT` and `ToAliasReferenceT`
- @belevy
- [#225](https://github.com/bitemyapp/esqueleto/pull/225)
- Simplify `ToFromT` extracting the overlapping and type error instances
- Make `ToFromT` and associated type family of `ToFrom`
3.4.0.0 3.4.0.0
======= =======

570
src/Database/Esqueleto/Experimental.hs
View File

@ -52,11 +52,11 @@ module Database.Esqueleto.Experimental
-- * Internals -- * Internals
, ToFrom(..) , ToFrom(..)
, ToFromT
, ToMaybe(..) , ToMaybe(..)
, ToMaybeT
, ToAlias(..) , ToAlias(..)
, ToAliasT
, ToAliasReference(..) , ToAliasReference(..)
, ToAliasReferenceT
-- * The Normal Stuff -- * The Normal Stuff
, where_ , where_
@ -609,34 +609,27 @@ intersect_ :: a -> b -> Intersect a b
intersect_ = Intersect intersect_ = Intersect
class SetOperationT a ~ b => ToSetOperation a b | a -> b where class SetOperationT a ~ b => ToSetOperation a b | a -> b where
type SetOperationT a
toSetOperation :: a -> SqlSetOperation b toSetOperation :: a -> SqlSetOperation b
instance ToSetOperation (SqlSetOperation a) a where instance ToSetOperation (SqlSetOperation a) a where
type SetOperationT (SqlSetOperation a) = a
toSetOperation = id toSetOperation = id
instance ToSetOperation (SqlQuery a) a where instance ToSetOperation (SqlQuery a) a where
type SetOperationT (SqlQuery a) = a
toSetOperation = SelectQueryP Never toSetOperation = SelectQueryP Never
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Union a b) c where instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Union a b) c where
type SetOperationT (Union a b) = SetOperationT a
toSetOperation (Union a b) = SqlSetUnion (toSetOperation a) (toSetOperation b) toSetOperation (Union a b) = SqlSetUnion (toSetOperation a) (toSetOperation b)
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (UnionAll a b) c where instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (UnionAll a b) c where
type SetOperationT (UnionAll a b) = SetOperationT a
toSetOperation (UnionAll a b) = SqlSetUnionAll (toSetOperation a) (toSetOperation b) toSetOperation (UnionAll a b) = SqlSetUnionAll (toSetOperation a) (toSetOperation b)
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Except a b) c where instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Except a b) c where
type SetOperationT (Except a b) = SetOperationT a
toSetOperation (Except a b) = SqlSetExcept (toSetOperation a) (toSetOperation b) toSetOperation (Except a b) = SqlSetExcept (toSetOperation a) (toSetOperation b)
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Intersect a b) c where instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Intersect a b) c where
type SetOperationT (Intersect a b) = SetOperationT a
toSetOperation (Intersect a b) = SqlSetIntersect (toSetOperation a) (toSetOperation b) toSetOperation (Intersect a b) = SqlSetIntersect (toSetOperation a) (toSetOperation b)
type family SetOperationT a where
SetOperationT (Union a b) = SetOperationT a
SetOperationT (UnionAll a b) = SetOperationT a
SetOperationT (Except a b) = SetOperationT a
SetOperationT (Intersect a b) = SetOperationT a
SetOperationT (SqlQuery a) = a
SetOperationT (SqlSetOperation a) = a
{-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-} {-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-}
pattern SelectQuery :: SqlQuery a -> SqlSetOperation a pattern SelectQuery :: SqlQuery a -> SqlSetOperation a
pattern SelectQuery q = SelectQueryP Never q pattern SelectQuery q = SelectQueryP Never q
@ -648,75 +641,75 @@ pattern SelectQuery q = SelectQueryP Never q
-- select $ from $ Table \@People -- select $ from $ Table \@People
-- @ -- @
data From a where data From a where
Table Table
:: PersistEntity ent :: PersistEntity ent
=> From (SqlExpr (Entity ent)) => From (SqlExpr (Entity ent))
SubQuery SubQuery
:: ( SqlSelect a r :: ( SqlSelect a r
, ToAlias a , ToAlias a
, ToAliasReference a , ToAliasReference a
) )
=> SqlQuery a => SqlQuery a
-> From a -> From a
FromCte FromCte
:: Ident :: Ident
-> a -> a
-> From a -> From a
SqlSetOperation SqlSetOperation
:: ( SqlSelect a r :: ( SqlSelect a r
, ToAlias a , ToAlias a
, ToAliasReference a , ToAliasReference a
) )
=> SqlSetOperation a => SqlSetOperation a
-> From a -> From a
InnerJoinFrom InnerJoinFrom
:: From a :: From a
-> (From b, (a :& b) -> SqlExpr (Value Bool)) -> (From b, (a :& b) -> SqlExpr (Value Bool))
-> From (a :& b) -> From (a :& b)
InnerJoinFromLateral InnerJoinFromLateral
:: ( SqlSelect b r :: ( SqlSelect b r
, ToAlias b , ToAlias b
, ToAliasReference b , ToAliasReference b
) )
=> From a => From a
-> ((a -> SqlQuery b), (a :& b) -> SqlExpr (Value Bool)) -> ((a -> SqlQuery b), (a :& b) -> SqlExpr (Value Bool))
-> From (a :& b) -> From (a :& b)
CrossJoinFrom CrossJoinFrom
:: From a :: From a
-> From b -> From b
-> From (a :& b) -> From (a :& b)
CrossJoinFromLateral CrossJoinFromLateral
:: ( SqlSelect b r :: ( SqlSelect b r
, ToAlias b , ToAlias b
, ToAliasReference b , ToAliasReference b
) )
=> From a => From a
-> (a -> SqlQuery b) -> (a -> SqlQuery b)
-> From (a :& b) -> From (a :& b)
LeftJoinFrom LeftJoinFrom
:: ToMaybe b :: ToMaybe b
=> From a => From a
-> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> (From b, (a :& ToMaybeT b) -> SqlExpr (Value Bool))
-> From (a :& ToMaybeT b) -> From (a :& ToMaybeT b)
LeftJoinFromLateral LeftJoinFromLateral
:: ( SqlSelect b r :: ( SqlSelect b r
, ToAlias b , ToAlias b
, ToAliasReference b , ToAliasReference b
, ToMaybe b , ToMaybe b
) )
=> From a => From a
-> ((a -> SqlQuery b), (a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> ((a -> SqlQuery b), (a :& ToMaybeT b) -> SqlExpr (Value Bool))
-> From (a :& ToMaybeT b) -> From (a :& ToMaybeT b)
RightJoinFrom RightJoinFrom
:: ToMaybe a :: ToMaybe a
=> From a => From a
-> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool)) -> (From b, (ToMaybeT a :& b) -> SqlExpr (Value Bool))
-> From (ToMaybeT a :& b) -> From (ToMaybeT a :& b)
FullJoinFrom FullJoinFrom
:: (ToMaybe a, ToMaybe b ) :: (ToMaybe a, ToMaybe b )
=> From a => From a
-> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool)) -> (From b, (ToMaybeT a :& ToMaybeT b) -> SqlExpr (Value Bool))
-> From (ToMaybeT a :& ToMaybeT b) -> From (ToMaybeT a :& ToMaybeT b)
-- | Constraint for `on`. Ensures that only types that require an `on` can be used on -- | Constraint for `on`. Ensures that only types that require an `on` can be used on
-- the left hand side. This was previously reusing the ToFrom class which was actually -- the left hand side. This was previously reusing the ToFrom class which was actually
@ -744,28 +737,6 @@ on :: ValidOnClauseValue a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlEx
on = (,) on = (,)
infix 9 `on` infix 9 `on`
type JoinErrorMsg jk = 'Text "Missing on statement for " ':<>: 'Text jk
type family ToFromT a where
ToFromT (From a) = a
ToFromT (SqlQuery a) = a
ToFromT (Union a b) = SetOperationT a
ToFromT (UnionAll a b) = SetOperationT a
ToFromT (Except a b) = SetOperationT a
ToFromT (Intersect a b) = SetOperationT a
ToFromT (SqlSetOperation a) = a
ToFromT (InnerJoin a (b, c -> SqlExpr (Value Bool))) = c
ToFromT (LeftOuterJoin a (b, c -> SqlExpr (Value Bool))) = c
ToFromT (RightOuterJoin a (b, c -> SqlExpr (Value Bool))) = c
ToFromT (FullOuterJoin a (b, c -> SqlExpr (Value Bool))) = c
ToFromT (CrossJoin a (c -> SqlQuery b)) = ToFromT a :& b
ToFromT (CrossJoin a b) = ToFromT a :& ToFromT b
ToFromT (InnerJoin a b) = TypeError (JoinErrorMsg "InnerJoin")
ToFromT (LeftOuterJoin a b) = TypeError (JoinErrorMsg "LeftOuterJoin")
ToFromT (RightOuterJoin a b) = TypeError (JoinErrorMsg "RightOuterJoin")
ToFromT (FullOuterJoin a b) = TypeError (JoinErrorMsg "FullOuterJoin")
data Lateral data Lateral
data NotLateral data NotLateral
@ -779,53 +750,107 @@ type family ErrorOnLateral a :: Constraint where
{-- Type class magic to allow the use of the `InnerJoin` family of data constructors in from --} {-- Type class magic to allow the use of the `InnerJoin` family of data constructors in from --}
class ToFrom a where class ToFrom a where
type ToFromT a
toFrom :: a -> From (ToFromT a) toFrom :: a -> From (ToFromT a)
instance ToFrom (From a) where -- @since 3.4.0.1
toFrom = id type family FromOnClause a where
FromOnClause (a, b -> SqlExpr (Value Bool)) = b
FromOnClause a = TypeError ('Text "Missing ON clause")
instance {-# OVERLAPPABLE #-} ToFrom (InnerJoin a b) where instance {-# OVERLAPPABLE #-} ToFrom (InnerJoin a b) where
type ToFromT (InnerJoin a b) = FromOnClause b
toFrom = undefined toFrom = undefined
instance {-# OVERLAPPABLE #-} ToFrom (LeftOuterJoin a b) where instance {-# OVERLAPPABLE #-} ToFrom (LeftOuterJoin a b) where
type ToFromT (LeftOuterJoin a b) = FromOnClause b
toFrom = undefined
instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where
type ToFromT (FullOuterJoin a b) = FromOnClause b
toFrom = undefined toFrom = undefined
instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where
toFrom = undefined type ToFromT (RightOuterJoin a b) = FromOnClause b
instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where toFrom = undefined
toFrom = undefined instance ToFrom (From a) where
type ToFromT (From a) = a
toFrom = id
instance ( ToAlias a instance
, ToAliasReference a ( ToAlias a
, SqlSelect a r , ToAliasReference a
) => ToFrom (SqlQuery a) where , SqlSelect a r
toFrom = SubQuery )
=>
ToFrom (SqlQuery a)
where
type ToFromT (SqlQuery a) = a
toFrom = SubQuery
instance ( SqlSelect c r instance
, ToAlias c ( SqlSelect c r
, ToAliasReference c , ToAlias c
, ToSetOperation a c , ToAliasReference c
, ToSetOperation b c , ToSetOperation a c
, c ~ SetOperationT a , ToSetOperation b c
) => ToFrom (Union a b) where , c ~ SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u )
=>
ToFrom (Union a b)
where
type ToFromT (Union a b) = SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u
instance ( SqlSelect c r instance
, ToAlias c ( SqlSelect c r
, ToAliasReference c , ToAlias c
, ToSetOperation a c , ToAliasReference c
, ToSetOperation b c , ToSetOperation a c
, c ~ SetOperationT a , ToSetOperation b c
) => ToFrom (UnionAll a b) where , c ~ SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u )
=>
ToFrom (UnionAll a b)
where
type ToFromT (UnionAll a b) = SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u
instance
( SqlSelect c r
, ToAlias c
, ToAliasReference c
, ToSetOperation a c
, ToSetOperation b c
, c ~ SetOperationT a
)
=>
ToFrom (Intersect a b)
where
type ToFromT (Intersect a b) = SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u
instance
( SqlSelect c r
, ToAlias c
, ToAliasReference c
, ToSetOperation a c
, ToSetOperation b c
, c ~ SetOperationT a
)
=>
ToFrom (Except a b)
where
type ToFromT (Except a b) = SetOperationT a
toFrom u = SqlSetOperation $ toSetOperation u
instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlSetOperation a) where instance (SqlSelect a r, ToAlias a, ToAliasReference a) => ToFrom (SqlSetOperation a) where
-- If someone uses just a plain SelectQuery it should behave like a normal subquery type ToFromT (SqlSetOperation a) = a
toFrom (SelectQueryP _ q) = SubQuery q -- If someone uses just a plain SelectQuery it should behave like a normal subquery
-- Otherwise use the SqlSetOperation toFrom (SelectQueryP _ q) = SubQuery q
toFrom q = SqlSetOperation q -- Otherwise use the SqlSetOperation
toFrom q = SqlSetOperation q
class ToInnerJoin lateral lhs rhs res where class ToInnerJoin lateral lhs rhs res where
toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res
instance ( SqlSelect b r instance ( SqlSelect b r
, ToAlias b , ToAlias b
@ -833,49 +858,43 @@ instance ( SqlSelect b r
, ToFrom a , ToFrom a
, ToFromT a ~ a' , ToFromT a ~ a'
) => ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& b) where ) => ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& b) where
toInnerJoin _ lhs q on' = InnerJoinFromLateral (toFrom lhs) (q, on') toInnerJoin _ lhs q on' = InnerJoinFromLateral (toFrom lhs) (q, on')
instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b') instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b')
=> ToInnerJoin NotLateral a b (a' :& b') where => ToInnerJoin NotLateral a b (a' :& b') where
toInnerJoin _ lhs rhs on' = InnerJoinFrom (toFrom lhs) (toFrom rhs, on') toInnerJoin _ lhs rhs on' = InnerJoinFrom (toFrom lhs) (toFrom rhs, on')
instance instance (ToInnerJoin (IsLateral b) a b b') => ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where
( ToFrom a type ToFromT (InnerJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool))
, ToFromT a ~ a' toFrom (InnerJoin lhs (rhs, on')) = toInnerJoin (toProxy rhs) lhs rhs on'
, ToInnerJoin (IsLateral b) a b b' where
) toProxy :: b -> Proxy (IsLateral b)
=>
ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool)))
where
toFrom (InnerJoin lhs (rhs, on')) =
let toProxy :: b -> Proxy (IsLateral b)
toProxy _ = Proxy toProxy _ = Proxy
in
toInnerJoin (toProxy rhs) lhs rhs on'
instance -- @since 3.4.0.1
( ToFrom a type family FromCrossJoin a b where
, ToFrom b FromCrossJoin a (b -> SqlQuery c) = ToFromT a :& c
, ToFromT (CrossJoin a b) ~ (ToFromT a :& ToFromT b) FromCrossJoin a b = ToFromT a :& ToFromT b
)
=> instance ( ToFrom a
ToFrom (CrossJoin a b) , ToFrom b
where , ToFromT (CrossJoin a b) ~ (ToFromT a :& ToFromT b)
) => ToFrom (CrossJoin a b) where
type ToFromT (CrossJoin a b) = FromCrossJoin a b
toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs) toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs)
instance {-# OVERLAPPING #-} instance {-# OVERLAPPING #-}
( ToFrom a ( ToFrom a
, ToFromT a ~ a' , ToFromT a ~ a'
, SqlSelect b r , SqlSelect b r
, ToAlias b , ToAlias b
, ToAliasReference b , ToAliasReference b
) ) => ToFrom (CrossJoin a (a' -> SqlQuery b)) where
=> ToFrom (CrossJoin a (a' -> SqlQuery b)) where type ToFromT (CrossJoin a (a' -> SqlQuery b)) = FromCrossJoin a (a' -> SqlQuery b)
toFrom (CrossJoin lhs q) = CrossJoinFromLateral (toFrom lhs) q toFrom (CrossJoin lhs q) = CrossJoinFromLateral (toFrom lhs) q
class ToLeftJoin lateral lhs rhs res where class ToLeftJoin lateral lhs rhs res where
toLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res toLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res
instance ( ToFrom a instance ( ToFrom a
, ToFromT a ~ a' , ToFromT a ~ a'
@ -885,7 +904,7 @@ instance ( ToFrom a
, ToMaybe b , ToMaybe b
, mb ~ ToMaybeT b , mb ~ ToMaybeT b
) => ToLeftJoin Lateral a (a' -> SqlQuery b) (a' :& mb) where ) => ToLeftJoin Lateral a (a' -> SqlQuery b) (a' :& mb) where
toLeftJoin _ lhs q on' = LeftJoinFromLateral (toFrom lhs) (q, on') toLeftJoin _ lhs q on' = LeftJoinFromLateral (toFrom lhs) (q, on')
instance ( ToFrom a instance ( ToFrom a
, ToFromT a ~ a' , ToFromT a ~ a'
@ -894,161 +913,113 @@ instance ( ToFrom a
, ToMaybe b' , ToMaybe b'
, mb ~ ToMaybeT b' , mb ~ ToMaybeT b'
) => ToLeftJoin NotLateral a b (a' :& mb) where ) => ToLeftJoin NotLateral a b (a' :& mb) where
toLeftJoin _ lhs rhs on' = LeftJoinFrom (toFrom lhs) (toFrom rhs, on') toLeftJoin _ lhs rhs on' = LeftJoinFrom (toFrom lhs) (toFrom rhs, on')
instance instance ( ToLeftJoin (IsLateral b) a b b'
( ToLeftJoin (IsLateral b) a b b' ) => ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where
) type ToFromT (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool))
=> toFrom (LeftOuterJoin lhs (rhs, on')) =
ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) toLeftJoin (toProxy rhs) lhs rhs on'
where where
toFrom (LeftOuterJoin lhs (rhs, on')) = toProxy :: b -> Proxy (IsLateral b)
let toProxy :: b -> Proxy (IsLateral b) toProxy _ = Proxy
toProxy _ = Proxy
in
toLeftJoin (toProxy rhs) lhs rhs on'
instance instance ( ToFrom a
( ToFrom a , ToFromT a ~ a'
, ToFromT a ~ a' , ToFrom b
, ToFrom b , ToFromT b ~ b'
, ToFromT b ~ b' , ToMaybe a'
, ToMaybe a' , ma ~ ToMaybeT a'
, ma ~ ToMaybeT a' , ToMaybe b'
, ToMaybe b' , mb ~ ToMaybeT b'
, mb ~ ToMaybeT b' , ErrorOnLateral b
, ErrorOnLateral b ) => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where
) type ToFromT (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& mb) -> SqlExpr(Value Bool))
=> toFrom (FullOuterJoin lhs (rhs, on')) = FullJoinFrom (toFrom lhs) (toFrom rhs, on')
ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool)))
where
toFrom (FullOuterJoin lhs (rhs, on')) =
FullJoinFrom (toFrom lhs) (toFrom rhs, on')
instance instance ( ToFrom a
( ToFrom a , ToFromT a ~ a'
, ToFromT a ~ a' , ToMaybe a'
, ToMaybe a' , ma ~ ToMaybeT a'
, ma ~ ToMaybeT a' , ToFrom b
, ToFrom b , ToFromT b ~ b'
, ToFromT b ~ b' , ErrorOnLateral b
, ErrorOnLateral b ) => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where
) type ToFromT (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) = FromOnClause (b, (ma :& b') -> SqlExpr(Value Bool))
=> toFrom (RightOuterJoin lhs (rhs, on')) = RightJoinFrom (toFrom lhs) (toFrom rhs, on')
ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool)))
where
toFrom (RightOuterJoin lhs (rhs, on')) =
RightJoinFrom (toFrom lhs) (toFrom rhs, on')
type family Nullable a where type family Nullable a where
Nullable (Maybe a) = a Nullable (Maybe a) = a
Nullable a = a Nullable a = a
type family ToMaybeT a where
ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a)
ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))
ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b)
ToMaybeT (a, b, c) = (ToMaybeT a, ToMaybeT b, ToMaybeT c)
ToMaybeT (a, b, c, d) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d)
ToMaybeT (a, b, c, d, e) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e)
ToMaybeT (a, b, c, d, e, f) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f)
ToMaybeT (a, b, c, d, e, f, g) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g)
ToMaybeT (a, b, c, d, e, f, g, h) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g, ToMaybeT h)
class ToMaybe a where class ToMaybe a where
type ToMaybeT a
toMaybe :: a -> ToMaybeT a toMaybe :: a -> ToMaybeT a
instance ToMaybe (SqlExpr (Maybe a)) where instance ToMaybe (SqlExpr (Maybe a)) where
type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a)
toMaybe = id toMaybe = id
instance ToMaybe (SqlExpr (Entity a)) where instance ToMaybe (SqlExpr (Entity a)) where
type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a))
toMaybe = EMaybe toMaybe = EMaybe
instance ToMaybe (SqlExpr (Value a)) where instance ToMaybe (SqlExpr (Value a)) where
type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a)))
toMaybe = veryUnsafeCoerceSqlExprValue toMaybe = veryUnsafeCoerceSqlExprValue
instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
toMaybe (a :& b) = (toMaybe a :& toMaybe b) toMaybe (a :& b) = (toMaybe a :& toMaybe b)
instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where
type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b)
toMaybe (a, b) = (toMaybe a, toMaybe b) toMaybe (a, b) = (toMaybe a, toMaybe b)
instance instance ( ToMaybe a , ToMaybe b , ToMaybe c) => ToMaybe (a,b,c) where
( ToMaybe a type ToMaybeT (a, b, c) = (ToMaybeT a, ToMaybeT b, ToMaybeT c)
, ToMaybe b
, ToMaybe c
)
=>
ToMaybe (a,b,c)
where
toMaybe = to3 . toMaybe . from3 toMaybe = to3 . toMaybe . from3
instance instance ( ToMaybe a , ToMaybe b , ToMaybe c , ToMaybe d) => ToMaybe (a,b,c,d) where
( ToMaybe a type ToMaybeT (a, b, c, d) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d)
, ToMaybe b
, ToMaybe c
, ToMaybe d
)
=>
ToMaybe (a,b,c,d)
where
toMaybe = to4 . toMaybe . from4 toMaybe = to4 . toMaybe . from4
instance instance ( ToMaybe a , ToMaybe b , ToMaybe c , ToMaybe d , ToMaybe e) => ToMaybe (a,b,c,d,e) where
( ToMaybe a type ToMaybeT (a, b, c, d, e) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e)
, ToMaybe b
, ToMaybe c
, ToMaybe d
, ToMaybe e
)
=>
ToMaybe (a,b,c,d,e)
where
toMaybe = to5 . toMaybe . from5 toMaybe = to5 . toMaybe . from5
instance instance ( ToMaybe a
( ToMaybe a , ToMaybe b
, ToMaybe b , ToMaybe c
, ToMaybe c , ToMaybe d
, ToMaybe d , ToMaybe e
, ToMaybe e , ToMaybe f
, ToMaybe f ) => ToMaybe (a,b,c,d,e,f) where
) type ToMaybeT (a, b, c, d, e, f) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f)
=>
ToMaybe (a,b,c,d,e,f)
where
toMaybe = to6 . toMaybe . from6 toMaybe = to6 . toMaybe . from6
instance instance ( ToMaybe a
( ToMaybe a , ToMaybe b
, ToMaybe b , ToMaybe c
, ToMaybe c , ToMaybe d
, ToMaybe d , ToMaybe e
, ToMaybe e , ToMaybe f
, ToMaybe f , ToMaybe g
, ToMaybe g ) => ToMaybe (a,b,c,d,e,f,g) where
) type ToMaybeT (a, b, c, d, e, f, g) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g)
=>
ToMaybe (a,b,c,d,e,f,g)
where
toMaybe = to7 . toMaybe . from7 toMaybe = to7 . toMaybe . from7
instance instance ( ToMaybe a
( ToMaybe a , ToMaybe b
, ToMaybe b , ToMaybe c
, ToMaybe c , ToMaybe d
, ToMaybe d , ToMaybe e
, ToMaybe e , ToMaybe f
, ToMaybe f , ToMaybe g
, ToMaybe g , ToMaybe h
, ToMaybe h ) => ToMaybe (a,b,c,d,e,f,g,h) where
) type ToMaybeT (a, b, c, d, e, f, g, h) = (ToMaybeT a, ToMaybeT b, ToMaybeT c, ToMaybeT d, ToMaybeT e, ToMaybeT f, ToMaybeT g, ToMaybeT h)
=> toMaybe = to8 . toMaybe . from8
ToMaybe (a,b,c,d,e,f,g,h)
where
toMaybe = to8 . toMaybe . from8
-- | 'FROM' clause, used to bring entities into scope. -- | 'FROM' clause, used to bring entities into scope.
-- --
@ -1072,7 +1043,7 @@ from parts = do
let entity = EEntity ident let entity = EEntity ident
pure $ (entity, FromStart ident ed) pure $ (entity, FromStart ident ed)
where where
getVal :: PersistEntity ent => From (SqlExpr (Entity ent)) -> Proxy ent getVal :: From (SqlExpr (Entity ent)) -> Proxy ent
getVal = const Proxy getVal = const Proxy
runFrom (SubQuery subquery) = runFrom (SubQuery subquery) =
fromSubQuery NormalSubQuery subquery fromSubQuery NormalSubQuery subquery
@ -1320,14 +1291,14 @@ instance ( ToAlias a
, ToAlias b , ToAlias b
, ToAlias c , ToAlias c
) => ToAlias (a,b,c) where ) => ToAlias (a,b,c) where
toAlias x = to3 <$> (toAlias $ from3 x) toAlias x = to3 <$> (toAlias $ from3 x)
instance ( ToAlias a instance ( ToAlias a
, ToAlias b , ToAlias b
, ToAlias c , ToAlias c
, ToAlias d , ToAlias d
) => ToAlias (a,b,c,d) where ) => ToAlias (a,b,c,d) where
toAlias x = to4 <$> (toAlias $ from4 x) toAlias x = to4 <$> (toAlias $ from4 x)
instance ( ToAlias a instance ( ToAlias a
, ToAlias b , ToAlias b
@ -1335,7 +1306,7 @@ instance ( ToAlias a
, ToAlias d , ToAlias d
, ToAlias e , ToAlias e
) => ToAlias (a,b,c,d,e) where ) => ToAlias (a,b,c,d,e) where
toAlias x = to5 <$> (toAlias $ from5 x) toAlias x = to5 <$> (toAlias $ from5 x)
instance ( ToAlias a instance ( ToAlias a
, ToAlias b , ToAlias b
@ -1344,7 +1315,7 @@ instance ( ToAlias a
, ToAlias e , ToAlias e
, ToAlias f , ToAlias f
) => ToAlias (a,b,c,d,e,f) where ) => ToAlias (a,b,c,d,e,f) where
toAlias x = to6 <$> (toAlias $ from6 x) toAlias x = to6 <$> (toAlias $ from6 x)
instance ( ToAlias a instance ( ToAlias a
, ToAlias b , ToAlias b
@ -1354,7 +1325,7 @@ instance ( ToAlias a
, ToAlias f , ToAlias f
, ToAlias g , ToAlias g
) => ToAlias (a,b,c,d,e,f,g) where ) => ToAlias (a,b,c,d,e,f,g) where
toAlias x = to7 <$> (toAlias $ from7 x) toAlias x = to7 <$> (toAlias $ from7 x)
instance ( ToAlias a instance ( ToAlias a
, ToAlias b , ToAlias b
@ -1365,7 +1336,7 @@ instance ( ToAlias a
, ToAlias g , ToAlias g
, ToAlias h , ToAlias h
) => ToAlias (a,b,c,d,e,f,g,h) where ) => ToAlias (a,b,c,d,e,f,g,h) where
toAlias x = to8 <$> (toAlias $ from8 x) toAlias x = to8 <$> (toAlias $ from8 x)
{-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-} {-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
type ToAliasReferenceT a = a type ToAliasReferenceT a = a
@ -1396,14 +1367,14 @@ instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
, ToAliasReference c , ToAliasReference c
) => ToAliasReference (a,b,c) where ) => ToAliasReference (a,b,c) where
toAliasReference ident x = fmap to3 $ toAliasReference ident $ from3 x toAliasReference ident x = fmap to3 $ toAliasReference ident $ from3 x
instance ( ToAliasReference a instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
, ToAliasReference c , ToAliasReference c
, ToAliasReference d , ToAliasReference d
) => ToAliasReference (a,b,c,d) where ) => ToAliasReference (a,b,c,d) where
toAliasReference ident x = fmap to4 $ toAliasReference ident $ from4 x toAliasReference ident x = fmap to4 $ toAliasReference ident $ from4 x
instance ( ToAliasReference a instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
@ -1411,7 +1382,7 @@ instance ( ToAliasReference a
, ToAliasReference d , ToAliasReference d
, ToAliasReference e , ToAliasReference e
) => ToAliasReference (a,b,c,d,e) where ) => ToAliasReference (a,b,c,d,e) where
toAliasReference ident x = fmap to5 $ toAliasReference ident $ from5 x toAliasReference ident x = fmap to5 $ toAliasReference ident $ from5 x
instance ( ToAliasReference a instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
@ -1420,7 +1391,7 @@ instance ( ToAliasReference a
, ToAliasReference e , ToAliasReference e
, ToAliasReference f , ToAliasReference f
) => ToAliasReference (a,b,c,d,e,f) where ) => ToAliasReference (a,b,c,d,e,f) where
toAliasReference ident x = to6 <$> (toAliasReference ident $ from6 x) toAliasReference ident x = to6 <$> (toAliasReference ident $ from6 x)
instance ( ToAliasReference a instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
@ -1430,7 +1401,7 @@ instance ( ToAliasReference a
, ToAliasReference f , ToAliasReference f
, ToAliasReference g , ToAliasReference g
) => ToAliasReference (a,b,c,d,e,f,g) where ) => ToAliasReference (a,b,c,d,e,f,g) where
toAliasReference ident x = to7 <$> (toAliasReference ident $ from7 x) toAliasReference ident x = to7 <$> (toAliasReference ident $ from7 x)
instance ( ToAliasReference a instance ( ToAliasReference a
, ToAliasReference b , ToAliasReference b
@ -1441,8 +1412,7 @@ instance ( ToAliasReference a
, ToAliasReference g , ToAliasReference g
, ToAliasReference h , ToAliasReference h
) => ToAliasReference (a,b,c,d,e,f,g,h) where ) => ToAliasReference (a,b,c,d,e,f,g,h) where
toAliasReference ident x = to8 <$> (toAliasReference ident $ from8 x) toAliasReference ident x = to8 <$> (toAliasReference ident $ from8 x)
class RecursiveCteUnion a where class RecursiveCteUnion a where
unionKeyword :: a -> TLB.Builder unionKeyword :: a -> TLB.Builder