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

Unbreak lateral joins by introducing a completely different ValidOnClause constraint

Browse Source
This commit is contained in:
belevy 2021-02-13 19:50:02 -06:00
parent 9bf34761a4
commit 096c1acfd6
1 changed files with 33 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
src/Database/Esqueleto/Experimental/From/Join.hs
View File

@ -1,32 +1,37 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Database.Esqueleto.Experimental.From.Join module Database.Esqueleto.Experimental.From.Join
where where
import Data.Bifunctor (first) import Data.Bifunctor (first)
import Data.Kind (Constraint) import Data.Kind (Constraint)
import Data.Proxy import Data.Proxy
import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.From import Database.Esqueleto.Experimental.From
import Database.Esqueleto.Experimental.From.SqlSetOperation import Database.Esqueleto.Experimental.From.SqlSetOperation
import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Experimental.ToMaybe import Database.Esqueleto.Experimental.ToMaybe
import Database.Esqueleto.Internal.Internal hiding import Database.Esqueleto.Internal.Internal hiding
(From(..), from, fromJoin, on) (From (..),
import Database.Esqueleto.Internal.PersistentImport from,
(Entity(..), EntityField, PersistEntity, PersistField) fromJoin,
import GHC.TypeLits on)
import Database.Esqueleto.Internal.PersistentImport (Entity (..),
EntityField,
PersistEntity,
PersistField)
import GHC.TypeLits
-- | A left-precedence pair. Pronounced \"and\". Used to represent expressions -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions
-- that have been joined together. -- that have been joined together.
@ -46,6 +51,9 @@ instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b) type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)
toMaybe (a :& b) = (toMaybe a :& toMaybe b) toMaybe (a :& b) = (toMaybe a :& toMaybe b)
class ValidOnClause a
instance {-# OVERLAPPABLE #-} ToFrom a a' => ValidOnClause a
instance ValidOnClause (a -> SqlQuery b)
-- | An @ON@ clause that describes how two tables are related. This should be -- | An @ON@ clause that describes how two tables are related. This should be
-- used as an infix operator after a 'JOIN'. For example, -- used as an infix operator after a 'JOIN'. For example,
@ -57,7 +65,7 @@ instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
-- \`on\` (\\(p :& bP) -> -- \`on\` (\\(p :& bP) ->
-- p ^. PersonId ==. bP ^. BlogPostAuthorId) -- p ^. PersonId ==. bP ^. BlogPostAuthorId)
-- @ -- @
on :: ToFrom a a' => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool)) on :: ValidOnClause a => a -> (b -> SqlExpr (Value Bool)) -> (a, b -> SqlExpr (Value Bool))
on = (,) on = (,)
infix 9 `on` infix 9 `on`