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

Create a FromRaw to replace FromSubquery and FromIdent in from clause. Modify Experimental to only use FromRaw.

Browse Source
This commit is contained in:
belevy 2021-02-08 15:10:36 -06:00
parent 9d1550b8b1
commit 7a579e921a
7 changed files with 143 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Database/Esqueleto.hs
View File

@ -1,4 +1,7 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, RankNTypes #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
-- | The @esqueleto@ EDSL (embedded domain specific language). -- | The @esqueleto@ EDSL (embedded domain specific language).
-- This module replaces @Database.Persist@, so instead of -- This module replaces @Database.Persist@, so instead of
-- importing that module you should just import this one: -- importing that module you should just import this one:
@ -125,8 +128,8 @@ import Control.Monad.Trans.Reader (ReaderT)
import Data.Int (Int64) import Data.Int (Int64)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Database.Esqueleto.Internal.Language import Database.Esqueleto.Internal.Language
import Database.Esqueleto.Internal.Sql
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.PersistentImport
import Database.Esqueleto.Internal.Sql
import qualified Database.Persist import qualified Database.Persist

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

@ -216,6 +216,7 @@ 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
-- $setup -- $setup
-- --
-- If you're already using "Database.Esqueleto", then you can get -- If you're already using "Database.Esqueleto", then you can get

69
src/Database/Esqueleto/Experimental/From.hs
View File

@ -1,25 +1,28 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Database.Esqueleto.Experimental.From module Database.Esqueleto.Experimental.From
where where
import qualified Control.Monad.Trans.Writer as W import qualified Control.Monad.Trans.Writer as W
import Data.Proxy import Data.Proxy
import Database.Esqueleto.Experimental.ToAlias import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.Internal hiding
(From (..),
from, on)
import Database.Esqueleto.Internal.PersistentImport
-- | 'FROM' clause, used to bring entities into scope. -- | 'FROM' clause, used to bring entities into scope.
-- --
@ -33,12 +36,13 @@ import Database.Esqueleto.Internal.PersistentImport
from :: From a => a -> SqlQuery (FromT a) from :: From a => a -> SqlQuery (FromT a)
from parts = do from parts = do
(a, clause) <- runFrom parts (a, clause) <- runFrom parts
Q $ W.tell mempty{sdFromClause=[clause]} Q $ W.tell mempty{sdFromClause=[FromRaw clause]}
pure a pure a
type RawFn = NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])
class From a where class From a where
type FromT a type FromT a
runFrom :: a -> SqlQuery (FromT a, FromClause) runFrom :: a -> SqlQuery (FromT a, RawFn)
-- | Data type for bringing a Table into scope in a JOIN tree -- | Data type for bringing a Table into scope in a JOIN tree
-- --
@ -53,11 +57,20 @@ instance PersistEntity a => From (Table a) where
let ed = entityDef $ getVal e let ed = entityDef $ getVal e
ident <- newIdentFor (entityDB ed) ident <- newIdentFor (entityDB ed)
let entity = unsafeSqlEntity ident let entity = unsafeSqlEntity ident
pure $ (entity, FromStart ident ed) pure $ ( entity, \p -> base p ident ed )
where where
getVal :: Table ent -> Proxy ent getVal :: Table ent -> Proxy ent
getVal = const Proxy getVal = const Proxy
base _ ident@(I identText) def info =
let db@(DBName dbText) = entityDB def
in ( fromDBName info db <>
if dbText == identText
then mempty
else " AS " <> useIdent info ident
, mempty
)
{-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-} {-# DEPRECATED SubQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SubQuery@" #-}
newtype SubQuery a = SubQuery a newtype SubQuery a = SubQuery a
@ -92,7 +105,7 @@ fromSubQuery
, ToAlias a , ToAlias a
, ToAliasReference a , ToAliasReference a
) )
=> SubQueryType -> SqlQuery a -> SqlQuery (a, FromClause) => SubQueryType -> SqlQuery a -> SqlQuery (a, RawFn)
fromSubQuery subqueryType subquery = do fromSubQuery subqueryType subquery = do
-- We want to update the IdentState without writing the query to side data -- We want to update the IdentState without writing the query to side data
(ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery (ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
@ -105,4 +118,16 @@ fromSubQuery subqueryType subquery = do
-- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`), -- create aliased references from the outer query results (e.g value from subquery will be `subquery`.`value`),
-- this is probably overkill as the aliases should already be unique but seems to be good practice. -- this is probably overkill as the aliases should already be unique but seems to be good practice.
ref <- toAliasReference subqueryAlias aliasedValue ref <- toAliasReference subqueryAlias aliasedValue
pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery) subqueryType)
pure (ref, \_ info ->
let (queryText,queryVals) = toRawSql SELECT info aliasedQuery
lateralKeyword =
case subqueryType of
NormalSubQuery -> ""
LateralSubQuery -> "LATERAL "
in
( lateralKeyword <> (parens queryText) <> " AS " <> useIdent info subqueryAlias
, queryVals
)
)

22
src/Database/Esqueleto/Experimental/From/CommonTableExpression.hs
View File

@ -1,24 +1,26 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Database.Esqueleto.Experimental.From.CommonTableExpression module Database.Esqueleto.Experimental.From.CommonTableExpression
where where
import qualified Control.Monad.Trans.Writer as W import qualified Control.Monad.Trans.Writer as W
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.Internal.Internal hiding (From(..), from, on) import Database.Esqueleto.Internal.Internal hiding
import Database.Esqueleto.Internal.PersistentImport (DBName(..)) (From (..),
from, on)
import Database.Esqueleto.Internal.PersistentImport (DBName (..))
data CommonTableExpression ref = CommonTableExpression Ident ref data CommonTableExpression ref = CommonTableExpression Ident ref
instance From (CommonTableExpression ref) where instance From (CommonTableExpression ref) where
type FromT (CommonTableExpression ref) = ref type FromT (CommonTableExpression ref) = ref
runFrom (CommonTableExpression ident ref) = runFrom (CommonTableExpression ident ref) =
pure (ref, FromIdent ident) pure (ref, (\_ info -> (useIdent info ident, mempty)))
-- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression). -- | @WITH@ clause used to introduce a [Common Table Expression (CTE)](https://en.wikipedia.org/wiki/Hierarchical_and_recursive_queries_in_SQL#Common_table_expression).
-- CTEs are supported in most modern SQL engines and can be useful -- CTEs are supported in most modern SQL engines and can be useful

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

@ -1,6 +1,7 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
@ -8,6 +9,7 @@
module Database.Esqueleto.Experimental.From.Join module Database.Esqueleto.Experimental.From.Join
where where
import Data.Bifunctor (first)
import Data.Kind (Constraint) import Data.Kind (Constraint)
import Data.Proxy import Data.Proxy
import Database.Esqueleto.Experimental.From import Database.Esqueleto.Experimental.From
@ -90,7 +92,25 @@ instance {-# OVERLAPPABLE #-} From (FullOuterJoin a b) where
runFrom = undefined runFrom = undefined
class FromInnerJoin lateral lhs rhs res where class FromInnerJoin lateral lhs rhs res where
runFromInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, FromClause) runFromInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, RawFn)
fromJoin_ :: RawFn -> JoinKind -> RawFn -> Maybe (SqlExpr (Value Bool)) -> RawFn
fromJoin_ lhs kind rhs monClause =
\paren info ->
first (parensM paren) $
mconcat [ lhs Never info
, (fromKind kind, mempty)
, rhs Parens info
, maybe mempty (makeOnClause info) monClause
]
where
fromKind InnerJoinKind = " INNER JOIN "
fromKind CrossJoinKind = " CROSS JOIN "
fromKind LeftOuterJoinKind = " LEFT OUTER JOIN "
fromKind RightOuterJoinKind = " RIGHT OUTER JOIN "
fromKind FullOuterJoinKind = " FULL OUTER JOIN "
makeOnClause info (ERaw _ f) = first (" ON " <>) (f Never info)
instance ( SqlSelect b r instance ( SqlSelect b r
, ToAlias b , ToAlias b
@ -102,7 +122,7 @@ instance ( SqlSelect b r
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)
let ret = leftVal :& rightVal let ret = leftVal :& rightVal
pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom InnerJoinKind rightFrom (Just (on' ret)))
instance (From a, FromT a ~ a', From b, FromT b ~ b') instance (From a, FromT a ~ a', From b, FromT b ~ b')
=> FromInnerJoin NotLateral a b (a' :& b') where => FromInnerJoin NotLateral a b (a' :& b') where
@ -110,7 +130,7 @@ instance (From a, FromT a ~ a', From b, FromT b ~ b')
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- runFrom rightPart (rightVal, rightFrom) <- runFrom rightPart
let ret = leftVal :& rightVal let ret = leftVal :& rightVal
pure $ (ret, FromJoin leftFrom InnerJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom InnerJoinKind rightFrom (Just (on' ret)))
instance (FromInnerJoin (IsLateral b) a b b') => From (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where instance (FromInnerJoin (IsLateral b) a b b') => From (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where
type FromT (InnerJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool)) type FromT (InnerJoin a (b, b' -> SqlExpr (Value Bool))) = FromOnClause (b, b' -> SqlExpr(Value Bool))
@ -132,7 +152,7 @@ instance ( From a
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- runFrom rightPart (rightVal, rightFrom) <- runFrom rightPart
let ret = leftVal :& rightVal let ret = leftVal :& rightVal
pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing) pure $ (ret, fromJoin_ leftFrom CrossJoinKind rightFrom Nothing)
instance {-# OVERLAPPING #-} instance {-# OVERLAPPING #-}
( From a ( From a
@ -146,10 +166,10 @@ instance {-# OVERLAPPING #-}
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)
let ret = leftVal :& rightVal let ret = leftVal :& rightVal
pure $ (ret, FromJoin leftFrom CrossJoinKind rightFrom Nothing) pure $ (ret, fromJoin_ leftFrom CrossJoinKind rightFrom Nothing)
class FromLeftJoin lateral lhs rhs res where class FromLeftJoin lateral lhs rhs res where
runFromLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, FromClause) runFromLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> SqlQuery (res, RawFn)
instance ( From a instance ( From a
, FromT a ~ a' , FromT a ~ a'
@ -163,7 +183,7 @@ instance ( From a
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal) (rightVal, rightFrom) <- fromSubQuery LateralSubQuery (q leftVal)
let ret = leftVal :& (toMaybe rightVal) let ret = leftVal :& (toMaybe rightVal)
pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom LeftOuterJoinKind rightFrom (Just (on' ret)))
instance ( From a instance ( From a
, FromT a ~ a' , FromT a ~ a'
@ -176,7 +196,7 @@ instance ( From a
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- runFrom rightPart (rightVal, rightFrom) <- runFrom rightPart
let ret = leftVal :& (toMaybe rightVal) let ret = leftVal :& (toMaybe rightVal)
pure $ (ret, FromJoin leftFrom LeftOuterJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom LeftOuterJoinKind rightFrom (Just (on' ret)))
instance ( FromLeftJoin (IsLateral b) a b b' instance ( FromLeftJoin (IsLateral b) a b b'
) => From (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where ) => From (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where
@ -202,7 +222,7 @@ instance ( From a
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- runFrom rightPart (rightVal, rightFrom) <- runFrom rightPart
let ret = (toMaybe leftVal) :& (toMaybe rightVal) let ret = (toMaybe leftVal) :& (toMaybe rightVal)
pure $ (ret, FromJoin leftFrom FullOuterJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom FullOuterJoinKind rightFrom (Just (on' ret)))
instance ( From a instance ( From a
, FromT a ~ a' , FromT a ~ a'
@ -217,7 +237,7 @@ instance ( From a
(leftVal, leftFrom) <- runFrom leftPart (leftVal, leftFrom) <- runFrom leftPart
(rightVal, rightFrom) <- runFrom rightPart (rightVal, rightFrom) <- runFrom rightPart
let ret = (toMaybe leftVal) :& rightVal let ret = (toMaybe leftVal) :& rightVal
pure $ (ret, FromJoin leftFrom RightOuterJoinKind rightFrom (Just (on' ret))) pure $ (ret, fromJoin_ leftFrom RightOuterJoinKind rightFrom (Just (on' ret)))
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) type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b)

44
src/Database/Esqueleto/Experimental/From/SqlSetOperation.hs
View File

@ -1,23 +1,27 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
module Database.Esqueleto.Experimental.From.SqlSetOperation module Database.Esqueleto.Experimental.From.SqlSetOperation
where where
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.State as S
import qualified Control.Monad.Trans.Writer as W import qualified Control.Monad.Trans.Writer as W
import Database.Esqueleto.Experimental.From import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.From
import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Internal.PersistentImport (DBName(..)) import Database.Esqueleto.Internal.Internal hiding
(From (..),
from, on)
import Database.Esqueleto.Internal.PersistentImport (DBName (..),
PersistValue)
data SqlSetOperation a data SqlSetOperation a
= SqlSetUnion (SqlSetOperation a) (SqlSetOperation a) = SqlSetUnion (SqlSetOperation a) (SqlSetOperation a)
@ -27,12 +31,16 @@ data SqlSetOperation a
| SelectQueryP NeedParens (SqlQuery a) | SelectQueryP NeedParens (SqlQuery a)
runSetOperation :: (SqlSelect a r, ToAlias a, ToAliasReference a) runSetOperation :: (SqlSelect a r, ToAlias a, ToAliasReference a)
=> SqlSetOperation a -> SqlQuery (a, FromClause) => SqlSetOperation a -> SqlQuery (a, NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]))
runSetOperation operation = do runSetOperation operation = do
(aliasedOperation, ret) <- aliasQueries operation (aliasedOperation, ret) <- aliasQueries operation
ident <- newIdentFor (DBName "u") ident <- newIdentFor (DBName "u")
ref <- toAliasReference ident ret ref <- toAliasReference ident ret
pure (ref, FromQuery ident (operationToSql aliasedOperation) NormalSubQuery) pure ( ref
, \_ info ->
let (queryText, queryVals) = operationToSql aliasedOperation info
in (parens queryText <> " AS " <> useIdent info ident, queryVals)
)
where where
aliasQueries o = aliasQueries o =
@ -200,4 +208,4 @@ instance (SqlSelect a r, ToAlias a, ToAliasReference a) => From (SqlSetOperation
-- If someone uses just a plain SelectQuery it should behave like a normal subquery -- If someone uses just a plain SelectQuery it should behave like a normal subquery
runFrom (SelectQueryP _ subquery) = fromSubQuery NormalSubQuery subquery runFrom (SelectQueryP _ subquery) = fromSubQuery NormalSubQuery subquery
-- Otherwise use the SqlSetOperation -- Otherwise use the SqlSetOperation
runFrom u = runSetOperation $ toSetOperation u runFrom u = runSetOperation $ toSetOperation u

58
src/Database/Esqueleto/Internal/Internal.hs
View File

@ -24,7 +24,7 @@
module Database.Esqueleto.Internal.Internal where module Database.Esqueleto.Internal.Internal where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Coerce (coerce) import Data.Coerce (Coercible, coerce)
import Control.Arrow (first, (***)) import Control.Arrow (first, (***))
import Control.Exception (Exception, throw, throwIO) import Control.Exception (Exception, throw, throwIO)
import Control.Monad (MonadPlus(..), guard, void) import Control.Monad (MonadPlus(..), guard, void)
@ -533,8 +533,7 @@ subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Va
subSelectUnsafe = sub SELECT subSelectUnsafe = sub SELECT
-- | Project a field of an entity. -- | Project a field of an entity.
(^.) (^.) :: forall typ val . (PersistEntity val, PersistField typ)
:: forall typ val. (PersistEntity val, PersistField typ)
=> SqlExpr (Entity val) => SqlExpr (Entity val)
-> EntityField val typ -> EntityField val typ
-> SqlExpr (Value typ) -> SqlExpr (Value typ)
@ -584,9 +583,20 @@ withNonNull field f = do
where_ $ not_ $ isNothing field where_ $ not_ $ isNothing field
f $ veryUnsafeCoerceSqlExprValue field f $ veryUnsafeCoerceSqlExprValue field
class (PersistEntity ent, PersistField val)
=> MaybeHasSqlField entity ent value val
| entity val -> value
, entity value -> val
, entity -> ent
, value ent val -> entity where
instance (PersistEntity ent, PersistField val)
=> MaybeHasSqlField (Maybe (Entity ent)) ent (Maybe val) val
class WithMaybe noMaybe withMaybe | withMaybe -> noMaybe
instance WithMaybe a (Maybe a)
-- | Project a field of an entity that may be null. -- | Project a field of an entity that may be null.
(?.) (?.) :: ( PersistEntity val , PersistField typ)
:: (PersistEntity val, PersistField typ)
=> SqlExpr (Maybe (Entity val)) => SqlExpr (Maybe (Entity val))
-> EntityField val typ -> EntityField val typ
-> SqlExpr (Value (Maybe typ)) -> SqlExpr (Value (Maybe typ))
@ -1738,8 +1748,7 @@ data FromClause
= FromStart Ident EntityDef = FromStart Ident EntityDef
| FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool))) | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool)))
| OnClause (SqlExpr (Value Bool)) | OnClause (SqlExpr (Value Bool))
| FromQuery Ident (IdentInfo -> (TLB.Builder, [PersistValue])) SubQueryType | FromRaw (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]))
| FromIdent Ident
data CommonTableExpressionKind data CommonTableExpressionKind
= RecursiveCommonTableExpression = RecursiveCommonTableExpression
@ -1759,8 +1768,7 @@ collectIdents fc = case fc of
FromStart i _ -> Set.singleton i FromStart i _ -> Set.singleton i
FromJoin lhs _ rhs _ -> collectIdents lhs <> collectIdents rhs FromJoin lhs _ rhs _ -> collectIdents lhs <> collectIdents rhs
OnClause _ -> mempty OnClause _ -> mempty
FromQuery _ _ _ -> mempty FromRaw _ -> mempty
FromIdent _ -> mempty
instance Show FromClause where instance Show FromClause where
show fc = case fc of show fc = case fc of
@ -1782,10 +1790,8 @@ instance Show FromClause where
] ]
OnClause expr -> OnClause expr ->
"(OnClause " <> render' expr <> ")" "(OnClause " <> render' expr <> ")"
FromQuery ident _ subQueryType -> FromRaw _ ->
"(FromQuery " <> show ident <> " " <> show subQueryType <> ")" "(FromRaw _)"
FromIdent ident ->
"(FromIdent " <> show ident <> ")"
where where
dummy = SqlBackend dummy = SqlBackend
@ -1839,14 +1845,12 @@ collectOnClauses sqlBackend = go Set.empty []
findRightmostIdent (FromStart i _) = Just i findRightmostIdent (FromStart i _) = Just i
findRightmostIdent (FromJoin _ _ r _) = findRightmostIdent r findRightmostIdent (FromJoin _ _ r _) = findRightmostIdent r
findRightmostIdent (OnClause {}) = Nothing findRightmostIdent (OnClause {}) = Nothing
findRightmostIdent (FromQuery _ _ _) = Nothing findRightmostIdent (FromRaw _) = Nothing
findRightmostIdent (FromIdent _) = Nothing
findLeftmostIdent (FromStart i _) = Just i findLeftmostIdent (FromStart i _) = Just i
findLeftmostIdent (FromJoin l _ _ _) = findLeftmostIdent l findLeftmostIdent (FromJoin l _ _ _) = findLeftmostIdent l
findLeftmostIdent (OnClause {}) = Nothing findLeftmostIdent (OnClause {}) = Nothing
findLeftmostIdent (FromQuery _ _ _) = Nothing findLeftmostIdent (FromRaw _) = Nothing
findLeftmostIdent (FromIdent _) = Nothing
tryMatch tryMatch
:: Set Ident :: Set Ident
@ -2819,18 +2823,7 @@ makeFrom info mode fs = ret
, maybe mempty makeOnClause monClause , maybe mempty makeOnClause monClause
] ]
mk _ (OnClause _) = throw (UnexpectedCaseErr MakeFromError) mk _ (OnClause _) = throw (UnexpectedCaseErr MakeFromError)
mk _ (FromQuery ident f subqueryType) = mk paren (FromRaw f) = f paren info
let (queryText, queryVals) = f info
lateralKeyword =
case subqueryType of
NormalSubQuery -> ""
LateralSubQuery -> "LATERAL "
in
( lateralKeyword <> (parens queryText) <> " AS " <> useIdent info ident
, queryVals
)
mk _ (FromIdent ident) =
(useIdent info ident, mempty)
base ident@(I identText) def = base ident@(I identText) def =
let db@(DBName dbText) = entityDB def let db@(DBName dbText) = entityDB def
@ -2914,13 +2907,6 @@ makeLocking = flip (,) [] . maybe mempty toTLB . Monoid.getLast
parens :: TLB.Builder -> TLB.Builder parens :: TLB.Builder -> TLB.Builder
parens b = "(" <> (b <> ")") parens b = "(" <> (b <> ")")
aliasedValueIdentToRawSql :: Ident -> IdentInfo -> (TLB.Builder, [PersistValue])
aliasedValueIdentToRawSql i info = (useIdent info i, mempty)
valueReferenceToRawSql :: Ident -> (IdentInfo -> Ident) -> IdentInfo -> (TLB.Builder, [PersistValue])
valueReferenceToRawSql sourceIdent columnIdentF info =
(useIdent info sourceIdent <> "." <> useIdent info (columnIdentF info), mempty)
aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident aliasedEntityColumnIdent :: Ident -> FieldDef -> Ident
aliasedEntityColumnIdent (I baseIdent) field = aliasedEntityColumnIdent (I baseIdent) field =
I (baseIdent <> "_" <> (unDBName $ fieldDB field)) I (baseIdent <> "_" <> (unDBName $ fieldDB field))