major formatting stuff
This commit is contained in:
parsonsmatt
parent
58575433ff
commit
ea032a9fc5
@ -1,16 +1,15 @@
|
||||
{-# LANGUAGE CPP
|
||||
, DataKinds
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
, FunctionalDependencies
|
||||
, GADTs
|
||||
, MultiParamTypeClasses
|
||||
, TypeOperators
|
||||
, TypeFamilies
|
||||
, UndecidableInstances
|
||||
, OverloadedStrings
|
||||
, PatternSynonyms
|
||||
#-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | This module contains a new way (introduced in 3.3.3.0) of using @FROM@ in
|
||||
-- Haskell. The old method was a bit finicky and could permit runtime errors,
|
||||
@ -61,22 +60,103 @@ module Database.Esqueleto.Experimental
|
||||
, ToAliasReference(..)
|
||||
, ToAliasReferenceT
|
||||
-- * The Normal Stuff
|
||||
, where_, groupBy, orderBy, rand, asc, desc, limit, offset
|
||||
, distinct, distinctOn, don, distinctOnOrderBy, having, locking
|
||||
, sub_select, (^.), (?.)
|
||||
, val, isNothing, just, nothing, joinV, withNonNull
|
||||
, countRows, count, countDistinct
|
||||
, not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
|
||||
, between, (+.), (-.), (/.), (*.)
|
||||
, random_, round_, ceiling_, floor_
|
||||
, min_, max_, sum_, avg_, castNum, castNumM
|
||||
, coalesce, coalesceDefault
|
||||
, lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_
|
||||
, like, ilike, (%), concat_, (++.), castString
|
||||
, subList_select, valList, justList
|
||||
, in_, notIn, exists, notExists
|
||||
, set, (=.), (+=.), (-=.), (*=.), (/=.)
|
||||
, case_, toBaseId
|
||||
|
||||
, where_
|
||||
, groupBy
|
||||
, orderBy
|
||||
, rand
|
||||
, asc
|
||||
, desc
|
||||
, limit
|
||||
, offset
|
||||
|
||||
, distinct
|
||||
, distinctOn
|
||||
, don
|
||||
, distinctOnOrderBy
|
||||
, having
|
||||
, locking
|
||||
|
||||
, sub_select
|
||||
, (^.)
|
||||
, (?.)
|
||||
|
||||
, val
|
||||
, isNothing
|
||||
, just
|
||||
, nothing
|
||||
, joinV
|
||||
, withNonNull
|
||||
|
||||
, countRows
|
||||
, count
|
||||
, countDistinct
|
||||
|
||||
, not_
|
||||
, (==.)
|
||||
, (>=.)
|
||||
, (>.)
|
||||
, (<=.)
|
||||
, (<.)
|
||||
, (!=.)
|
||||
, (&&.)
|
||||
, (||.)
|
||||
|
||||
, between
|
||||
, (+.)
|
||||
, (-.)
|
||||
, (/.)
|
||||
, (*.)
|
||||
|
||||
, random_
|
||||
, round_
|
||||
, ceiling_
|
||||
, floor_
|
||||
|
||||
, min_
|
||||
, max_
|
||||
, sum_
|
||||
, avg_
|
||||
, castNum
|
||||
, castNumM
|
||||
|
||||
, coalesce
|
||||
, coalesceDefault
|
||||
|
||||
, lower_
|
||||
, upper_
|
||||
, trim_
|
||||
, ltrim_
|
||||
, rtrim_
|
||||
, length_
|
||||
, left_
|
||||
, right_
|
||||
|
||||
, like
|
||||
, ilike
|
||||
, (%)
|
||||
, concat_
|
||||
, (++.)
|
||||
, castString
|
||||
|
||||
, subList_select
|
||||
, valList
|
||||
, justList
|
||||
|
||||
, in_
|
||||
, notIn
|
||||
, exists
|
||||
, notExists
|
||||
|
||||
, set
|
||||
, (=.)
|
||||
, (+=.)
|
||||
, (-=.)
|
||||
, (*=.)
|
||||
, (/=.)
|
||||
|
||||
, case_
|
||||
, toBaseId
|
||||
, subSelect
|
||||
, subSelectMaybe
|
||||
, subSelectCount
|
||||
@ -134,22 +214,20 @@ module Database.Esqueleto.Experimental
|
||||
-- $reexports
|
||||
, deleteKey
|
||||
, module Database.Esqueleto.Internal.PersistentImport
|
||||
)
|
||||
where
|
||||
) where
|
||||
|
||||
import qualified Control.Monad.Trans.Writer as W
|
||||
import qualified Control.Monad.Trans.State as S
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import qualified Control.Monad.Trans.State as S
|
||||
import qualified Control.Monad.Trans.Writer as W
|
||||
#if __GLASGOW_HASKELL__ < 804
|
||||
import Data.Semigroup
|
||||
#endif
|
||||
import Data.Proxy (Proxy(..))
|
||||
import qualified Data.Text.Lazy.Builder as TLB
|
||||
import Database.Esqueleto.Internal.Internal hiding (From, from, on)
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Internal.Internal hiding (from, on, From)
|
||||
import GHC.TypeLits
|
||||
|
||||
|
||||
-- $setup
|
||||
--
|
||||
-- If you're already using "Database.Esqueleto", then you can get
|
||||
@ -462,14 +540,13 @@ import GHC.TypeLits
|
||||
data (:&) a b = a :& b
|
||||
infixl 2 :&
|
||||
|
||||
data SqlSetOperation a =
|
||||
SqlSetUnion (SqlSetOperation a) (SqlSetOperation a)
|
||||
data SqlSetOperation a
|
||||
= SqlSetUnion (SqlSetOperation a) (SqlSetOperation a)
|
||||
| SqlSetUnionAll (SqlSetOperation a) (SqlSetOperation a)
|
||||
| SqlSetExcept (SqlSetOperation a) (SqlSetOperation a)
|
||||
| SqlSetIntersect (SqlSetOperation a) (SqlSetOperation a)
|
||||
| SelectQueryP NeedParens (SqlQuery a)
|
||||
|
||||
|
||||
-- $sql-set-operations
|
||||
--
|
||||
-- Data type that represents SQL set operations. This includes
|
||||
@ -504,32 +581,28 @@ data SqlSetOperation a =
|
||||
-- @
|
||||
--
|
||||
|
||||
{-# DEPRECATED Union "/Since: 3.4.0.0/ - \
|
||||
Use the 'union_' function instead of the 'Union' data constructor" #-}
|
||||
{-# DEPRECATED Union "/Since: 3.4.0.0/ - Use the 'union_' function instead of the 'Union' data constructor" #-}
|
||||
data Union a b = a `Union` b
|
||||
|
||||
-- | @UNION@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
|
||||
union_ :: a -> b -> Union a b
|
||||
union_ = Union
|
||||
|
||||
{-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - \
|
||||
Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}
|
||||
{-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}
|
||||
data UnionAll a b = a `UnionAll` b
|
||||
|
||||
-- | @UNION@ @ALL@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
|
||||
unionAll_ :: a -> b -> UnionAll a b
|
||||
unionAll_ = UnionAll
|
||||
|
||||
{-# DEPRECATED Except "/Since: 3.4.0.0/ - \
|
||||
Use the 'except_' function instead of the 'Except' data constructor" #-}
|
||||
{-# DEPRECATED Except "/Since: 3.4.0.0/ - Use the 'except_' function instead of the 'Except' data constructor" #-}
|
||||
data Except a b = a `Except` b
|
||||
|
||||
-- | @EXCEPT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
|
||||
except_ :: a -> b -> Except a b
|
||||
except_ = Except
|
||||
|
||||
{-# DEPRECATED Intersect "/Since: 3.4.0.0/ - \
|
||||
Use the 'intersect_' function instead of the 'Intersect' data constructor" #-}
|
||||
{-# DEPRECATED Intersect "/Since: 3.4.0.0/ - Use the 'intersect_' function instead of the 'Intersect' data constructor" #-}
|
||||
data Intersect a b = a `Intersect` b
|
||||
|
||||
-- | @INTERSECT@ SQL set operation. Can be used as an infix function between 'SqlQuery' values.
|
||||
@ -541,14 +614,19 @@ class SetOperationT a ~ b => ToSetOperation a b | a -> b where
|
||||
|
||||
instance ToSetOperation (SqlSetOperation a) a where
|
||||
toSetOperation = id
|
||||
|
||||
instance ToSetOperation (SqlQuery a) a where
|
||||
toSetOperation = SelectQueryP Never
|
||||
|
||||
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Union a b) c where
|
||||
toSetOperation (Union a b) = SqlSetUnion (toSetOperation a) (toSetOperation b)
|
||||
|
||||
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (UnionAll a b) c where
|
||||
toSetOperation (UnionAll a b) = SqlSetUnionAll (toSetOperation a) (toSetOperation b)
|
||||
|
||||
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Except a b) c where
|
||||
toSetOperation (Except a b) = SqlSetExcept (toSetOperation a) (toSetOperation b)
|
||||
|
||||
instance (ToSetOperation a c, ToSetOperation b c) => ToSetOperation (Intersect a b) c where
|
||||
toSetOperation (Intersect a b) = SqlSetIntersect (toSetOperation a) (toSetOperation b)
|
||||
|
||||
@ -560,12 +638,10 @@ type family SetOperationT a where
|
||||
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 q = SelectQueryP Never q
|
||||
|
||||
|
||||
-- | Data type that represents the syntax of a 'JOIN' tree. In practice,
|
||||
-- only the @Table@ constructor is used directly when writing queries. For example,
|
||||
--
|
||||
@ -731,16 +807,21 @@ instance {-# OVERLAPPABLE #-} ToFrom (RightOuterJoin a b) where
|
||||
instance {-# OVERLAPPABLE #-} ToFrom (FullOuterJoin a b) where
|
||||
toFrom = undefined
|
||||
|
||||
instance ( ToAlias a
|
||||
instance
|
||||
( ToAlias a
|
||||
, a' ~ ToAliasT a
|
||||
, ToAliasReference a'
|
||||
, a'' ~ ToAliasReferenceT a'
|
||||
, SqlSelect a' r'
|
||||
, SqlSelect a'' r'
|
||||
) => ToFrom (SqlQuery a) where
|
||||
)
|
||||
=>
|
||||
ToFrom (SqlQuery a)
|
||||
where
|
||||
toFrom = SubQuery
|
||||
|
||||
instance ( SqlSelect c' r
|
||||
instance
|
||||
( SqlSelect c' r
|
||||
, SqlSelect c'' r'
|
||||
, ToAlias c
|
||||
, c' ~ ToAliasT c
|
||||
@ -749,10 +830,14 @@ instance ( SqlSelect c' r
|
||||
, ToSetOperation a c
|
||||
, ToSetOperation b c
|
||||
, c ~ SetOperationT a
|
||||
) => ToFrom (Union a b) where
|
||||
)
|
||||
=>
|
||||
ToFrom (Union a b)
|
||||
where
|
||||
toFrom u = SqlSetOperation $ toSetOperation u
|
||||
|
||||
instance ( SqlSelect c' r
|
||||
instance
|
||||
( SqlSelect c' r
|
||||
, SqlSelect c'' r'
|
||||
, ToAlias c
|
||||
, c' ~ ToAliasT c
|
||||
@ -761,10 +846,23 @@ instance ( SqlSelect c' r
|
||||
, ToSetOperation a c
|
||||
, ToSetOperation b c
|
||||
, c ~ SetOperationT a
|
||||
) => ToFrom (UnionAll a b) where
|
||||
)
|
||||
=>
|
||||
ToFrom (UnionAll a b)
|
||||
where
|
||||
toFrom u = SqlSetOperation $ toSetOperation u
|
||||
|
||||
instance (SqlSelect a' r,SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasReference a', ToAliasReferenceT a' ~ a'') => ToFrom (SqlSetOperation a) where
|
||||
instance
|
||||
( SqlSelect a' r
|
||||
, SqlSelect a'' r'
|
||||
, ToAlias a
|
||||
, a' ~ ToAliasT a
|
||||
, ToAliasReference a'
|
||||
, ToAliasReferenceT a' ~ a''
|
||||
)
|
||||
=>
|
||||
ToFrom (SqlSetOperation a)
|
||||
where
|
||||
-- If someone uses just a plain SelectQuery it should behave like a normal subquery
|
||||
toFrom (SelectQueryP _ q) = SubQuery q
|
||||
-- Otherwise use the SqlSetOperation
|
||||
@ -773,7 +871,8 @@ instance (SqlSelect a' r,SqlSelect a'' r', ToAlias a, a' ~ ToAliasT a, ToAliasRe
|
||||
class ToInnerJoin lateral lhs rhs res where
|
||||
toInnerJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res
|
||||
|
||||
instance ( SqlSelect bAlias r
|
||||
instance
|
||||
( SqlSelect bAlias r
|
||||
, SqlSelect bAliasRef r'
|
||||
, ToAlias b
|
||||
, bAlias ~ ToAliasT b
|
||||
@ -781,27 +880,41 @@ instance ( SqlSelect bAlias r
|
||||
, bAliasRef ~ ToAliasReferenceT bAlias
|
||||
, ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
) => ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& bAliasRef) where
|
||||
)
|
||||
=>
|
||||
ToInnerJoin Lateral a (a' -> SqlQuery b) (a' :& bAliasRef)
|
||||
where
|
||||
toInnerJoin _ lhs q on' = InnerJoinFromLateral (toFrom lhs) (q, on')
|
||||
|
||||
instance (ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b')
|
||||
=> ToInnerJoin NotLateral a b (a' :& b') where
|
||||
instance
|
||||
(ToFrom a, ToFromT a ~ a', ToFrom b, ToFromT b ~ b')
|
||||
=>
|
||||
ToInnerJoin NotLateral a b (a' :& b')
|
||||
where
|
||||
toInnerJoin _ lhs rhs on' = InnerJoinFrom (toFrom lhs) (toFrom rhs, on')
|
||||
|
||||
instance ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
, ToInnerJoin (IsLateral b) a b b'
|
||||
) => ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool))) where
|
||||
)
|
||||
=>
|
||||
ToFrom (InnerJoin a (b, b' -> SqlExpr (Value Bool)))
|
||||
where
|
||||
toFrom (InnerJoin lhs (rhs, on')) =
|
||||
let
|
||||
toProxy :: b -> Proxy (IsLateral b)
|
||||
toProxy _ = Proxy
|
||||
in toInnerJoin (toProxy rhs) lhs rhs on'
|
||||
|
||||
instance ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFrom b
|
||||
, ToFromT (CrossJoin a b) ~ (ToFromT a :& ToFromT b)
|
||||
) => ToFrom (CrossJoin a b) where
|
||||
)
|
||||
=>
|
||||
ToFrom (CrossJoin a b)
|
||||
where
|
||||
toFrom (CrossJoin lhs rhs) = CrossJoinFrom (toFrom lhs) (toFrom rhs)
|
||||
|
||||
instance {-# OVERLAPPING #-}
|
||||
@ -814,13 +927,16 @@ instance {-# OVERLAPPING #-}
|
||||
, ToAliasReference bAlias
|
||||
, bAliasRef ~ ToAliasReferenceT bAlias
|
||||
)
|
||||
=> ToFrom (CrossJoin a (a' -> SqlQuery b)) where
|
||||
=>
|
||||
ToFrom (CrossJoin a (a' -> SqlQuery b))
|
||||
where
|
||||
toFrom (CrossJoin lhs q) = CrossJoinFromLateral (toFrom lhs) q
|
||||
|
||||
class ToLeftJoin lateral lhs rhs res where
|
||||
toLeftJoin :: Proxy lateral -> lhs -> rhs -> (res -> SqlExpr (Value Bool)) -> From res
|
||||
|
||||
instance ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
, SqlSelect bAlias r
|
||||
, SqlSelect bAliasRef r'
|
||||
@ -830,27 +946,38 @@ instance ( ToFrom a
|
||||
, bAliasRef ~ ToAliasReferenceT bAlias
|
||||
, ToMaybe bAliasRef
|
||||
, mb ~ ToMaybeT bAliasRef
|
||||
) => 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')
|
||||
|
||||
instance ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
, ToFrom b
|
||||
, ToFromT b ~ b'
|
||||
, ToMaybe 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')
|
||||
|
||||
instance ( ToLeftJoin (IsLateral b) a b b'
|
||||
) => ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where
|
||||
instance
|
||||
( ToLeftJoin (IsLateral b) a b b'
|
||||
)
|
||||
=>
|
||||
ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool)))
|
||||
where
|
||||
toFrom (LeftOuterJoin lhs (rhs, on')) =
|
||||
let
|
||||
toProxy :: b -> Proxy (IsLateral b)
|
||||
let toProxy :: b -> Proxy (IsLateral b)
|
||||
toProxy _ = Proxy
|
||||
in toLeftJoin (toProxy rhs) lhs rhs on'
|
||||
|
||||
instance ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
, ToFrom b
|
||||
, ToFromT b ~ b'
|
||||
@ -859,18 +986,27 @@ instance ( ToFrom a
|
||||
, ToMaybe b'
|
||||
, mb ~ ToMaybeT b'
|
||||
, ErrorOnLateral b
|
||||
) => ToFrom (FullOuterJoin a (b, (ma :& mb) -> SqlExpr (Value Bool))) where
|
||||
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 ( ToFrom a
|
||||
instance
|
||||
( ToFrom a
|
||||
, ToFromT a ~ a'
|
||||
, ToMaybe a'
|
||||
, ma ~ ToMaybeT a'
|
||||
, ToFrom b
|
||||
, ToFromT b ~ b'
|
||||
, ErrorOnLateral b
|
||||
) => ToFrom (RightOuterJoin a (b, (ma :& b') -> SqlExpr (Value Bool))) where
|
||||
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
|
||||
Nullable (Maybe a) = a
|
||||
@ -907,47 +1043,68 @@ instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where
|
||||
instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where
|
||||
toMaybe (a, b) = (toMaybe a, toMaybe b)
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
) => ToMaybe (a,b,c) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c)
|
||||
where
|
||||
toMaybe = to3 . toMaybe . from3
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
, ToMaybe d
|
||||
) => ToMaybe (a,b,c,d) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c,d)
|
||||
where
|
||||
toMaybe = to4 . toMaybe . from4
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
, ToMaybe d
|
||||
, ToMaybe e
|
||||
) => ToMaybe (a,b,c,d,e) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c,d,e)
|
||||
where
|
||||
toMaybe = to5 . toMaybe . from5
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
, ToMaybe d
|
||||
, ToMaybe e
|
||||
, ToMaybe f
|
||||
) => ToMaybe (a,b,c,d,e,f) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c,d,e,f)
|
||||
where
|
||||
toMaybe = to6 . toMaybe . from6
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
, ToMaybe d
|
||||
, ToMaybe e
|
||||
, ToMaybe f
|
||||
, ToMaybe g
|
||||
) => ToMaybe (a,b,c,d,e,f,g) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c,d,e,f,g)
|
||||
where
|
||||
toMaybe = to7 . toMaybe . from7
|
||||
|
||||
instance ( ToMaybe a
|
||||
instance
|
||||
( ToMaybe a
|
||||
, ToMaybe b
|
||||
, ToMaybe c
|
||||
, ToMaybe d
|
||||
@ -955,7 +1112,10 @@ instance ( ToMaybe a
|
||||
, ToMaybe f
|
||||
, ToMaybe g
|
||||
, ToMaybe h
|
||||
) => ToMaybe (a,b,c,d,e,f,g,h) where
|
||||
)
|
||||
=>
|
||||
ToMaybe (a,b,c,d,e,f,g,h)
|
||||
where
|
||||
toMaybe = to8 . toMaybe . from8
|
||||
|
||||
-- | 'FROM' clause, used to bring entities into scope.
|
||||
@ -1040,12 +1200,10 @@ from parts = do
|
||||
SqlSetIntersect o1 o2 -> doSetOperation "INTERSECT" info o1 o2
|
||||
|
||||
doSetOperation operationText info o1 o2 =
|
||||
let
|
||||
(q1, v1) = operationToSql o1 info
|
||||
let (q1, v1) = operationToSql o1 info
|
||||
(q2, v2) = operationToSql o2 info
|
||||
in (q1 <> " " <> operationText <> " " <> q2, v1 <> v2)
|
||||
|
||||
|
||||
runFrom (InnerJoinFrom leftPart (rightPart, on')) = do
|
||||
(leftVal, leftFrom) <- runFrom leftPart
|
||||
(rightVal, rightFrom) <- runFrom rightPart
|
||||
@ -1087,14 +1245,18 @@ from parts = do
|
||||
let ret = (toMaybe leftVal) :& (toMaybe rightVal)
|
||||
pure $ (ret, FromJoin leftFrom FullOuterJoinKind rightFrom (Just (on' ret)))
|
||||
|
||||
fromSubQuery :: ( SqlSelect a' r
|
||||
fromSubQuery
|
||||
::
|
||||
( SqlSelect a' r
|
||||
, SqlSelect a'' r'
|
||||
, ToAlias a
|
||||
, a' ~ ToAliasT a
|
||||
, ToAliasReference a'
|
||||
, ToAliasReferenceT a' ~ a''
|
||||
)
|
||||
=> SubQueryType -> SqlQuery a -> SqlQuery (ToAliasReferenceT (ToAliasT a), FromClause)
|
||||
=> SubQueryType
|
||||
-> SqlQuery a
|
||||
-> SqlQuery (ToAliasReferenceT (ToAliasT a), FromClause)
|
||||
fromSubQuery subqueryType subquery = do
|
||||
-- We want to update the IdentState without writing the query to side data
|
||||
(ret, sideData) <- Q $ W.censor (\_ -> mempty) $ W.listen $ unQ subquery
|
||||
@ -1109,8 +1271,6 @@ fromSubQuery subqueryType subquery = do
|
||||
ref <- toAliasReference subqueryAlias aliasedValue
|
||||
pure (ref , FromQuery subqueryAlias (\info -> toRawSql SELECT info aliasedQuery) subqueryType)
|
||||
|
||||
|
||||
|
||||
-- | @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
|
||||
-- in performance tuning. In Esqueleto, CTEs should be used as a
|
||||
@ -1321,6 +1481,7 @@ instance ToAliasReference (SqlExpr (Entity a)) where
|
||||
|
||||
instance ToAliasReference (SqlExpr (Maybe (Entity a))) where
|
||||
toAliasReference s (EMaybe e) = EMaybe <$> toAliasReference s e
|
||||
|
||||
instance (ToAliasReference a, ToAliasReference b) => ToAliasReference (a, b) where
|
||||
toAliasReference ident (a,b) = (,) <$> (toAliasReference ident a) <*> (toAliasReference ident b)
|
||||
|
||||
@ -1381,5 +1542,6 @@ class RecursiveCteUnion a where
|
||||
|
||||
instance RecursiveCteUnion (a -> b -> Union a b) where
|
||||
unionKeyword _ = "\nUNION\n"
|
||||
|
||||
instance RecursiveCteUnion (a -> b -> UnionAll a b) where
|
||||
unionKeyword _ = "\nUNION ALL\n"
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,17 +1,20 @@
|
||||
{-# LANGUAGE DeriveDataTypeable
|
||||
, EmptyDataDecls
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
, FunctionalDependencies
|
||||
, MultiParamTypeClasses
|
||||
, TypeFamilies
|
||||
, UndecidableInstances
|
||||
, GADTs
|
||||
#-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | This is an internal module, anything exported by this module
|
||||
-- may change without a major version bump. Please use only
|
||||
-- "Database.Esqueleto" if possible.
|
||||
--
|
||||
-- This module is deprecated as of 3.4.0.1, and will be removed in 3.5.0.0.
|
||||
module Database.Esqueleto.Internal.Language
|
||||
{-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-}
|
||||
( -- * The pretty face
|
||||
from
|
||||
, Value(..)
|
||||
@ -41,22 +44,90 @@ module Database.Esqueleto.Internal.Language
|
||||
, when_
|
||||
, then_
|
||||
, else_
|
||||
, where_, on, groupBy, orderBy, rand, asc, desc, limit, offset
|
||||
, distinct, distinctOn, don, distinctOnOrderBy, having, locking
|
||||
, sub_select, (^.), (?.)
|
||||
, val, isNothing, just, nothing, joinV, withNonNull
|
||||
, countRows, count, countDistinct
|
||||
, not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
|
||||
, between, (+.), (-.), (/.), (*.)
|
||||
, random_, round_, ceiling_, floor_
|
||||
, min_, max_, sum_, avg_, castNum, castNumM
|
||||
, coalesce, coalesceDefault
|
||||
, lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_
|
||||
, like, ilike, (%), concat_, (++.), castString
|
||||
, subList_select, valList, justList
|
||||
, in_, notIn, exists, notExists
|
||||
, set, (=.), (+=.), (-=.), (*=.), (/=.)
|
||||
, case_, toBaseId, (<#), (<&>)
|
||||
, where_
|
||||
, on
|
||||
, groupBy
|
||||
, orderBy
|
||||
, rand
|
||||
, asc
|
||||
, desc
|
||||
, limit
|
||||
, offset
|
||||
, distinct
|
||||
, distinctOn
|
||||
, don
|
||||
, distinctOnOrderBy
|
||||
, having
|
||||
, locking
|
||||
, sub_select
|
||||
, (^.)
|
||||
, (?.)
|
||||
, val
|
||||
, isNothing
|
||||
, just
|
||||
, nothing
|
||||
, joinV
|
||||
, withNonNull
|
||||
, countRows
|
||||
, count
|
||||
, countDistinct
|
||||
, not_
|
||||
, (==.)
|
||||
, (>=.)
|
||||
, (>.)
|
||||
, (<=.)
|
||||
, (<.)
|
||||
, (!=.)
|
||||
, (&&.)
|
||||
, (||.)
|
||||
, between
|
||||
, (+.)
|
||||
, (-.)
|
||||
, (/.)
|
||||
, (*.)
|
||||
, random_
|
||||
, round_
|
||||
, ceiling_
|
||||
, floor_
|
||||
, min_
|
||||
, max_
|
||||
, sum_
|
||||
, avg_
|
||||
, castNum
|
||||
, castNumM
|
||||
, coalesce
|
||||
, coalesceDefault
|
||||
, lower_
|
||||
, upper_
|
||||
, trim_
|
||||
, ltrim_
|
||||
, rtrim_
|
||||
, length_
|
||||
, left_
|
||||
, right_
|
||||
, like
|
||||
, ilike
|
||||
, (%)
|
||||
, concat_
|
||||
, (++.)
|
||||
, castString
|
||||
, subList_select
|
||||
, valList
|
||||
, justList
|
||||
, in_
|
||||
, notIn
|
||||
, exists
|
||||
, notExists
|
||||
, set
|
||||
, (=.)
|
||||
, (+=.)
|
||||
, (-=.)
|
||||
, (*=.)
|
||||
, (/=.)
|
||||
, case_
|
||||
, toBaseId
|
||||
, (<#)
|
||||
, (<&>)
|
||||
, subSelect
|
||||
, subSelectMaybe
|
||||
, subSelectCount
|
||||
@ -65,5 +136,5 @@ module Database.Esqueleto.Internal.Language
|
||||
, subSelectUnsafe
|
||||
) where
|
||||
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Internal.Internal
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
|
||||
@ -142,9 +142,36 @@ module Database.Esqueleto.Internal.PersistentImport
|
||||
) where
|
||||
|
||||
import Database.Persist.Sql hiding
|
||||
( BackendSpecificFilter, Filter(..), PersistQuery, SelectOpt(..)
|
||||
, Update(..), delete, deleteWhereCount, updateWhereCount, selectList
|
||||
, selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.)
|
||||
, (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.)
|
||||
, listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource
|
||||
, update , count )
|
||||
( BackendSpecificFilter
|
||||
, Filter(..)
|
||||
, PersistQuery
|
||||
, SelectOpt(..)
|
||||
, Update(..)
|
||||
, count
|
||||
, delete
|
||||
, deleteCascadeWhere
|
||||
, deleteWhereCount
|
||||
, getPersistMap
|
||||
, limitOffsetOrder
|
||||
, listToJSON
|
||||
, mapToJSON
|
||||
, selectKeysList
|
||||
, selectList
|
||||
, selectSource
|
||||
, update
|
||||
, updateWhereCount
|
||||
, (!=.)
|
||||
, (*=.)
|
||||
, (+=.)
|
||||
, (-=.)
|
||||
, (/<-.)
|
||||
, (/=.)
|
||||
, (<-.)
|
||||
, (<.)
|
||||
, (<=.)
|
||||
, (=.)
|
||||
, (==.)
|
||||
, (>.)
|
||||
, (>=.)
|
||||
, (||.)
|
||||
)
|
||||
|
||||
@ -1,31 +1,27 @@
|
||||
{-# LANGUAGE DeriveDataTypeable
|
||||
, EmptyDataDecls
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
, FunctionalDependencies
|
||||
, MultiParamTypeClasses
|
||||
, TypeFamilies
|
||||
, UndecidableInstances
|
||||
, GADTs
|
||||
#-}
|
||||
{-# LANGUAGE ConstraintKinds
|
||||
, EmptyDataDecls
|
||||
, FlexibleContexts
|
||||
, FlexibleInstances
|
||||
, FunctionalDependencies
|
||||
, GADTs
|
||||
, MultiParamTypeClasses
|
||||
, OverloadedStrings
|
||||
, UndecidableInstances
|
||||
, ScopedTypeVariables
|
||||
, InstanceSigs
|
||||
, Rank2Types
|
||||
, CPP
|
||||
#-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
|
||||
-- | This is an internal module, anything exported by this module
|
||||
-- may change without a major version bump. Please use only
|
||||
-- "Database.Esqueleto" if possible.
|
||||
--
|
||||
-- This module is deprecated as of 3.4.0.1, and will be removed in 3.5.0.0.
|
||||
module Database.Esqueleto.Internal.Sql
|
||||
{-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-}
|
||||
( -- * The pretty face
|
||||
SqlQuery
|
||||
, SqlExpr(..)
|
||||
|
||||
@ -1,7 +1,8 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module contain MySQL-specific functions.
|
||||
--
|
||||
-- /Since: 2.2.8/
|
||||
-- @since 2.2.8
|
||||
module Database.Esqueleto.MySQL
|
||||
( random_
|
||||
) where
|
||||
|
||||
@ -1,11 +1,13 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings
|
||||
, GADTs, CPP, Rank2Types
|
||||
, ScopedTypeVariables
|
||||
#-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
-- | This module contain PostgreSQL-specific functions.
|
||||
--
|
||||
-- /Since: 2.2.8/
|
||||
-- @since: 2.2.8
|
||||
module Database.Esqueleto.PostgreSQL
|
||||
( AggMode(..)
|
||||
, arrayAggDistinct
|
||||
@ -31,29 +33,38 @@ module Database.Esqueleto.PostgreSQL
|
||||
#if __GLASGOW_HASKELL__ < 804
|
||||
import Data.Semigroup
|
||||
#endif
|
||||
import Control.Arrow (first, (***))
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import qualified Control.Monad.Trans.Reader as R
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import Data.Proxy (Proxy(..))
|
||||
import qualified Data.Text.Internal.Builder as TLB
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Database.Esqueleto.Internal.Internal
|
||||
( CompositeKeyError(..)
|
||||
, EsqueletoError(..)
|
||||
, FinalResult(..)
|
||||
, Ident(..)
|
||||
, KnowResult
|
||||
, SetClause
|
||||
, UnexpectedCaseError(..)
|
||||
, UnexpectedValueError(..)
|
||||
, renderUpdates
|
||||
, toUniqueDef
|
||||
, uncommas
|
||||
)
|
||||
import Database.Esqueleto.Internal.Language hiding (random_)
|
||||
import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
|
||||
import Database.Esqueleto.Internal.Sql
|
||||
import Database.Esqueleto.Internal.Internal (EsqueletoError(..), CompositeKeyError(..),
|
||||
UnexpectedCaseError(..), SetClause, Ident(..),
|
||||
uncommas, FinalResult(..), toUniqueDef,
|
||||
KnowResult, renderUpdates, UnexpectedValueError(..))
|
||||
import Database.Persist.Class (OnlyOneUniqueKey)
|
||||
import Data.List.NonEmpty ( NonEmpty( (:|) ) )
|
||||
import Data.Int (Int64)
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Control.Arrow ((***), first)
|
||||
import Control.Exception (throw)
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (MonadIO (..))
|
||||
import qualified Control.Monad.Trans.Reader as R
|
||||
|
||||
-- | (@random()@) Split out into database specific modules
|
||||
-- because MySQL uses `rand()`.
|
||||
--
|
||||
-- /Since: 2.6.0/
|
||||
-- @since 2.6.0
|
||||
random_ :: (PersistField a, Num a) => SqlExpr (Value a)
|
||||
random_ = unsafeSqlValue "RANDOM()"
|
||||
|
||||
@ -69,7 +80,8 @@ maybeArray ::
|
||||
maybeArray x = coalesceDefault [x] (emptyArray)
|
||||
|
||||
-- | Aggregate mode
|
||||
data AggMode = AggModeAll -- ^ ALL
|
||||
data AggMode
|
||||
= AggModeAll -- ^ ALL
|
||||
| AggModeDistinct -- ^ DISTINCT
|
||||
deriving (Show)
|
||||
|
||||
@ -77,24 +89,26 @@ data AggMode = AggModeAll -- ^ ALL
|
||||
--
|
||||
-- /Do/ /not/ use this function directly, instead define a new function and give
|
||||
-- it a type (see `unsafeSqlBinOp`)
|
||||
unsafeSqlAggregateFunction ::
|
||||
UnsafeSqlFunctionArgument a
|
||||
unsafeSqlAggregateFunction
|
||||
:: UnsafeSqlFunctionArgument a
|
||||
=> TLB.Builder
|
||||
-> AggMode
|
||||
-> a
|
||||
-> [OrderByClause]
|
||||
-> SqlExpr (Value b)
|
||||
unsafeSqlAggregateFunction name mode args orderByClauses =
|
||||
ERaw Never $ \info ->
|
||||
unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
|
||||
let (orderTLB, orderVals) = makeOrderByNoNewline info orderByClauses
|
||||
-- Don't add a space if we don't have order by clauses
|
||||
orderTLBSpace = case orderByClauses of
|
||||
orderTLBSpace =
|
||||
case orderByClauses of
|
||||
[] -> ""
|
||||
(_:_) -> " "
|
||||
(argsTLB, argsVals) =
|
||||
uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList args
|
||||
aggMode = case mode of
|
||||
AggModeAll -> "" -- ALL is the default, so we don't need to
|
||||
aggMode =
|
||||
case mode of
|
||||
AggModeAll -> ""
|
||||
-- ALL is the default, so we don't need to
|
||||
-- specify it
|
||||
AggModeDistinct -> "DISTINCT "
|
||||
in ( name <> parens (aggMode <> argsTLB <> orderTLBSpace <> orderTLB)
|
||||
@ -103,8 +117,8 @@ unsafeSqlAggregateFunction name mode args orderByClauses =
|
||||
|
||||
--- | (@array_agg@) Concatenate input values, including @NULL@s,
|
||||
--- into an array.
|
||||
arrayAggWith ::
|
||||
AggMode
|
||||
arrayAggWith
|
||||
:: AggMode
|
||||
-> SqlExpr (Value a)
|
||||
-> [OrderByClause]
|
||||
-> SqlExpr (Value (Maybe [a]))
|
||||
@ -118,18 +132,17 @@ arrayAgg x = arrayAggWith AggModeAll x []
|
||||
-- | (@array_agg@) Concatenate distinct input values, including @NULL@s, into
|
||||
-- an array.
|
||||
--
|
||||
-- /Since: 2.5.3/
|
||||
arrayAggDistinct ::
|
||||
(PersistField a, PersistField [a])
|
||||
-- @since 2.5.3
|
||||
arrayAggDistinct
|
||||
:: (PersistField a, PersistField [a])
|
||||
=> SqlExpr (Value a)
|
||||
-> SqlExpr (Value (Maybe [a]))
|
||||
arrayAggDistinct x = arrayAggWith AggModeDistinct x []
|
||||
|
||||
|
||||
-- | (@array_remove@) Remove all elements equal to the given value from the
|
||||
-- array.
|
||||
--
|
||||
-- /Since: 2.5.3/
|
||||
-- @since 2.5.3
|
||||
arrayRemove :: SqlExpr (Value [a]) -> SqlExpr (Value a) -> SqlExpr (Value [a])
|
||||
arrayRemove arr elem' = unsafeSqlFunction "array_remove" (arr, elem')
|
||||
|
||||
@ -154,7 +167,7 @@ stringAggWith mode expr delim os =
|
||||
-- | (@string_agg@) Concatenate input values separated by a
|
||||
-- delimiter.
|
||||
--
|
||||
-- /Since: 2.2.8/
|
||||
-- @since 2.2.8
|
||||
stringAgg ::
|
||||
SqlString s
|
||||
=> SqlExpr (Value s) -- ^ Input values.
|
||||
@ -165,18 +178,21 @@ stringAgg expr delim = stringAggWith AggModeAll expr delim []
|
||||
-- | (@chr@) Translate the given integer to a character. (Note the result will
|
||||
-- depend on the character set of your database.)
|
||||
--
|
||||
-- /Since: 2.2.11/
|
||||
-- @since 2.2.11
|
||||
chr :: SqlString s => SqlExpr (Value Int) -> SqlExpr (Value s)
|
||||
chr = unsafeSqlFunction "chr"
|
||||
|
||||
now_ :: SqlExpr (Value UTCTime)
|
||||
now_ = unsafeSqlFunction "NOW" ()
|
||||
|
||||
upsert :: (MonadIO m,
|
||||
PersistEntity record,
|
||||
OnlyOneUniqueKey record,
|
||||
PersistRecordBackend record SqlBackend,
|
||||
IsPersistBackend (PersistEntityBackend record))
|
||||
upsert
|
||||
::
|
||||
( MonadIO m
|
||||
, PersistEntity record
|
||||
, OnlyOneUniqueKey record
|
||||
, PersistRecordBackend record SqlBackend
|
||||
, IsPersistBackend (PersistEntityBackend record)
|
||||
)
|
||||
=> record
|
||||
-- ^ new record to insert
|
||||
-> [SqlExpr (Update record)]
|
||||
@ -187,9 +203,12 @@ upsert record updates = do
|
||||
uniqueKey <- onlyUnique record
|
||||
upsertBy uniqueKey record updates
|
||||
|
||||
upsertBy :: (MonadIO m,
|
||||
PersistEntity record,
|
||||
IsPersistBackend (PersistEntityBackend record))
|
||||
upsertBy
|
||||
::
|
||||
(MonadIO m
|
||||
, PersistEntity record
|
||||
, IsPersistBackend (PersistEntityBackend record)
|
||||
)
|
||||
=> Unique record
|
||||
-- ^ uniqueness constraint to find by
|
||||
-> record
|
||||
@ -245,29 +264,30 @@ upsertBy uniqueKey record updates = do
|
||||
-- the conflicting value is updated to the current plus the excluded.
|
||||
--
|
||||
-- @since 3.1.3
|
||||
insertSelectWithConflict :: forall a m val. (
|
||||
FinalResult a,
|
||||
KnowResult a ~ (Unique val),
|
||||
MonadIO m,
|
||||
PersistEntity val) =>
|
||||
a
|
||||
-- ^ Unique constructor or a unique, this is used just to get the name of the postgres constraint, the value(s) is(are) never used, so if you have a unique "MyUnique 0", "MyUnique undefined" would work as well.
|
||||
insertSelectWithConflict
|
||||
:: forall a m val
|
||||
. (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
|
||||
=> a
|
||||
-- ^ Unique constructor or a unique, this is used just to get the name of
|
||||
-- the postgres constraint, the value(s) is(are) never used, so if you have
|
||||
-- a unique "MyUnique 0", "MyUnique undefined" would work as well.
|
||||
-> SqlQuery (SqlExpr (Insertion val))
|
||||
-- ^ Insert query.
|
||||
-> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
|
||||
-- ^ A list of updates to be applied in case of the constraint being violated. The expression takes the current and excluded value to produce the updates.
|
||||
-- ^ A list of updates to be applied in case of the constraint being
|
||||
-- violated. The expression takes the current and excluded value to produce
|
||||
-- the updates.
|
||||
-> SqlWriteT m ()
|
||||
insertSelectWithConflict unique query = void . insertSelectWithConflictCount unique query
|
||||
insertSelectWithConflict unique query =
|
||||
void . insertSelectWithConflictCount unique query
|
||||
|
||||
-- | Same as 'insertSelectWithConflict' but returns the number of rows affected.
|
||||
--
|
||||
-- @since 3.1.3
|
||||
insertSelectWithConflictCount :: forall a val m. (
|
||||
FinalResult a,
|
||||
KnowResult a ~ (Unique val),
|
||||
MonadIO m,
|
||||
PersistEntity val) =>
|
||||
a
|
||||
insertSelectWithConflictCount
|
||||
:: forall a val m
|
||||
. (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
|
||||
=> a
|
||||
-> SqlQuery (SqlExpr (Insertion val))
|
||||
-> (SqlExpr (Entity val) -> SqlExpr (Entity val) -> [SqlExpr (Update val)])
|
||||
-> SqlWriteT m Int64
|
||||
@ -289,7 +309,7 @@ insertSelectWithConflictCount unique query conflictQuery = do
|
||||
constraint = TLB.fromText . unDBName . uniqueDBName $ uniqueDef
|
||||
renderedUpdates :: (BackendCompatible SqlBackend backend) => backend -> (TLB.Builder, [PersistValue])
|
||||
renderedUpdates conn = renderUpdates conn updates
|
||||
conflict conn = (foldr1 mappend ([
|
||||
conflict conn = (mconcat ([
|
||||
TLB.fromText "ON CONFLICT ON CONSTRAINT \"",
|
||||
constraint,
|
||||
TLB.fromText "\" DO "
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
{-|
|
||||
This module contains PostgreSQL-specific JSON functions.
|
||||
|
||||
@ -135,17 +136,15 @@ module Database.Esqueleto.PostgreSQL.JSON
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Database.Esqueleto.Internal.Language hiding ((?.), (-.), (||.))
|
||||
import Database.Esqueleto.Internal.Language hiding ((-.), (?.), (||.))
|
||||
import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Internal.Sql
|
||||
import Database.Esqueleto.PostgreSQL.JSON.Instances
|
||||
|
||||
|
||||
infixl 6 ->., ->>., #>., #>>.
|
||||
infixl 6 @>., <@., ?., ?|., ?&.
|
||||
infixl 6 ||., -., --., #-.
|
||||
|
||||
|
||||
-- | /Requires PostgreSQL version >= 9.3/
|
||||
--
|
||||
-- This function extracts the jsonb value from a JSON array or object,
|
||||
|
||||
@ -4,6 +4,8 @@
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# language DerivingStrategies #-}
|
||||
|
||||
module Database.Esqueleto.PostgreSQL.JSON.Instances where
|
||||
|
||||
import Data.Aeson (FromJSON(..), ToJSON(..), encode, eitherDecodeStrict)
|
||||
@ -18,15 +20,12 @@ import Database.Esqueleto.Internal.PersistentImport
|
||||
import Database.Esqueleto.Internal.Sql (SqlExpr)
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
|
||||
-- | Newtype wrapper around any type with a JSON representation.
|
||||
--
|
||||
-- @since 3.1.0
|
||||
newtype JSONB a = JSONB { unJSONB :: a }
|
||||
deriving
|
||||
deriving stock
|
||||
( Generic
|
||||
, FromJSON
|
||||
, ToJSON
|
||||
, Eq
|
||||
, Foldable
|
||||
, Functor
|
||||
@ -35,6 +34,10 @@ newtype JSONB a = JSONB { unJSONB :: a }
|
||||
, Show
|
||||
, Traversable
|
||||
)
|
||||
deriving newtype
|
||||
( FromJSON
|
||||
, ToJSON
|
||||
)
|
||||
|
||||
-- | 'SqlExpr' of a NULL-able 'JSONB' value. Hence the 'Maybe'.
|
||||
--
|
||||
@ -60,7 +63,8 @@ jsonbVal = just . val . JSONB
|
||||
-- JSONKey "name"
|
||||
--
|
||||
-- NOTE: DO NOT USE ANY OF THE 'Num' METHODS ON THIS TYPE!
|
||||
data JSONAccessor = JSONIndex Int
|
||||
data JSONAccessor
|
||||
= JSONIndex Int
|
||||
| JSONKey Text
|
||||
deriving (Generic, Eq, Show)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user