From 8aff51b4d80a6911116eef0c559157c8132648b7 Mon Sep 17 00:00:00 2001 From: belevy Date: Sat, 13 Feb 2021 19:47:15 -0600 Subject: [PATCH] Modify SqlSelect to remove the backwards FunDep. Remove the need for the Value newtype --- src/Database/Esqueleto.hs | 23 +- src/Database/Esqueleto/Experimental.hs | 22 +- .../Esqueleto/Experimental/ToAlias.hs | 9 +- .../Experimental/ToAliasReference.hs | 11 +- .../Esqueleto/Experimental/ToMaybe.hs | 21 +- src/Database/Esqueleto/Internal/Internal.hs | 392 +++++++++--------- src/Database/Esqueleto/Internal/Language.hs | 25 +- test/Common/Test.hs | 125 +++--- test/PostgreSQL/Test.hs | 106 ++--- 9 files changed, 371 insertions(+), 363 deletions(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 2b7a50d..fadeb24 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} -- | The @esqueleto@ EDSL (embedded domain specific language). -- This module replaces @Database.Persist@, so instead of -- importing that module you should just import this one: @@ -74,6 +75,8 @@ module Database.Esqueleto , else_ , from , Value(..) + , pattern Value + , unValue , ValueList(..) , OrderBy , DistinctOn @@ -123,13 +126,13 @@ module Database.Esqueleto , module Database.Esqueleto.Internal.PersistentImport ) where -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Reader (ReaderT) -import Data.Int (Int64) -import qualified Data.Map.Strict as Map -import Database.Esqueleto.Internal.Language -import Database.Esqueleto.Internal.PersistentImport -import Database.Esqueleto.Internal.Sql +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Reader (ReaderT) +import Data.Int (Int64) +import qualified Data.Map.Strict as Map +import Database.Esqueleto.Internal.Language +import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Sql import qualified Database.Persist diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index 316cfe9..ce3303f 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -170,6 +170,7 @@ module Database.Esqueleto.Experimental , then_ , else_ , Value(..) + , pattern Value , ValueList(..) , OrderBy , DistinctOn @@ -218,16 +219,19 @@ module Database.Esqueleto.Experimental , module Database.Esqueleto.Internal.PersistentImport ) where -import Database.Esqueleto.Internal.Internal hiding (From, from, on) -import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Internal hiding + (From, + from, + on) +import Database.Esqueleto.Internal.PersistentImport -import Database.Esqueleto.Experimental.From -import Database.Esqueleto.Experimental.From.CommonTableExpression -import Database.Esqueleto.Experimental.From.Join -import Database.Esqueleto.Experimental.From.SqlSetOperation -import Database.Esqueleto.Experimental.ToAlias -import Database.Esqueleto.Experimental.ToAliasReference -import Database.Esqueleto.Experimental.ToMaybe +import Database.Esqueleto.Experimental.From +import Database.Esqueleto.Experimental.From.CommonTableExpression +import Database.Esqueleto.Experimental.From.Join +import Database.Esqueleto.Experimental.From.SqlSetOperation +import Database.Esqueleto.Experimental.ToAlias +import Database.Esqueleto.Experimental.ToAliasReference +import Database.Esqueleto.Experimental.ToMaybe -- $setup -- diff --git a/src/Database/Esqueleto/Experimental/ToAlias.hs b/src/Database/Esqueleto/Experimental/ToAlias.hs index 4a85143..7c2c4e6 100644 --- a/src/Database/Esqueleto/Experimental/ToAlias.hs +++ b/src/Database/Esqueleto/Experimental/ToAlias.hs @@ -1,12 +1,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies #-} module Database.Esqueleto.Experimental.ToAlias where -import Database.Esqueleto.Internal.Internal hiding (From, from, on) -import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Internal hiding (From, + from, on) +import Database.Esqueleto.Internal.PersistentImport {-# DEPRECATED ToAliasT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-} type ToAliasT a = a @@ -15,7 +16,7 @@ type ToAliasT a = a class ToAlias a where toAlias :: a -> SqlQuery a -instance ToAlias (SqlExpr (Value a)) where +instance {-# OVERLAPPABLE #-} ToAlias (SqlExpr a) where toAlias e@(ERaw m f) | Just _ <- sqlExprMetaAlias m, not (sqlExprMetaIsReference m) = pure e | otherwise = do diff --git a/src/Database/Esqueleto/Experimental/ToAliasReference.hs b/src/Database/Esqueleto/Experimental/ToAliasReference.hs index 72ac475..dfe3b1c 100644 --- a/src/Database/Esqueleto/Experimental/ToAliasReference.hs +++ b/src/Database/Esqueleto/Experimental/ToAliasReference.hs @@ -1,13 +1,14 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies #-} module Database.Esqueleto.Experimental.ToAliasReference where -import Data.Coerce -import Database.Esqueleto.Internal.Internal hiding (From, from, on) -import Database.Esqueleto.Internal.PersistentImport +import Data.Coerce +import Database.Esqueleto.Internal.Internal hiding (From, + from, on) +import Database.Esqueleto.Internal.PersistentImport {-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-} type ToAliasReferenceT a = a @@ -16,7 +17,7 @@ type ToAliasReferenceT a = a class ToAliasReference a where toAliasReference :: Ident -> a -> SqlQuery a -instance ToAliasReference (SqlExpr (Value a)) where +instance {-# OVERLAPPABLE #-} ToAliasReference (SqlExpr a) where toAliasReference aliasSource (ERaw m _) | Just alias <- sqlExprMetaAlias m = pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info -> (useIdent info aliasSource <> "." <> useIdent info alias, []) diff --git a/src/Database/Esqueleto/Experimental/ToMaybe.hs b/src/Database/Esqueleto/Experimental/ToMaybe.hs index 0677bfb..66b2b80 100644 --- a/src/Database/Esqueleto/Experimental/ToMaybe.hs +++ b/src/Database/Esqueleto/Experimental/ToMaybe.hs @@ -1,11 +1,12 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilies #-} module Database.Esqueleto.Experimental.ToMaybe where -import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) -import Database.Esqueleto.Internal.PersistentImport (Entity(..)) +import Database.Esqueleto.Internal.Internal hiding (From (..), + from, on) +import Database.Esqueleto.Internal.PersistentImport (Entity (..)) type family Nullable a where Nullable (Maybe a) = a @@ -15,18 +16,10 @@ class ToMaybe a where type ToMaybeT a toMaybe :: a -> ToMaybeT a -instance ToMaybe (SqlExpr (Maybe a)) where - type ToMaybeT (SqlExpr (Maybe a)) = SqlExpr (Maybe a) - toMaybe = id - -instance ToMaybe (SqlExpr (Entity a)) where - type ToMaybeT (SqlExpr (Entity a)) = SqlExpr (Maybe (Entity a)) - toMaybe (ERaw f m) = (ERaw f m) - -instance ToMaybe (SqlExpr (Value a)) where - type ToMaybeT (SqlExpr (Value a)) = SqlExpr (Value (Maybe (Nullable a))) - toMaybe = veryUnsafeCoerceSqlExprValue +instance ToMaybe (SqlExpr a) where + type ToMaybeT (SqlExpr a) = SqlExpr (Maybe (Nullable a)) + toMaybe = veryUnsafeCoerceSqlExpr instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b) diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 5903bc4..dbd14c2 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -14,6 +14,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE PatternSynonyms #-} -- | This is an internal module, anything exported by this module -- may change without a major version bump. Please use only @@ -131,7 +132,7 @@ fromFinish (PreprocessedFrom ret f') = Q $ do return ret -- | @WHERE@ clause: restrict the query's result. -where_ :: SqlExpr (Value Bool) -> SqlQuery () +where_ :: SqlExpr (Bool) -> SqlQuery () where_ expr = Q $ W.tell mempty { sdWhereClause = Where expr } -- | An @ON@ clause, useful to describe how two tables are related. Cross joins @@ -190,7 +191,7 @@ where_ expr = Q $ W.tell mempty { sdWhereClause = Where expr } -- 'on' (baz '^.' BazId '==.' bar '^.' BarBazId) -- ... -- @ -on :: SqlExpr (Value Bool) -> SqlQuery () +on :: SqlExpr (Bool) -> SqlQuery () on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] } -- | @GROUP BY@ clause. You can enclose multiple columns @@ -205,7 +206,7 @@ on expr = Q $ W.tell mempty { sdFromClause = [OnClause expr] } -- -- With groupBy you can sort by aggregate functions, like so -- (we used @let@ to restrict the more general 'countRows' to --- @SqlSqlExpr (Value Int)@ to avoid ambiguity---the second use of +-- @SqlSqlExpr (Int)@ to avoid ambiguity---the second use of -- 'countRows' has its type restricted by the @:: Int@ below): -- -- @ @@ -249,14 +250,14 @@ orderBy :: [SqlExpr OrderBy] -> SqlQuery () orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs } -- | Ascending order of this field or SqlExpression. -asc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy +asc :: PersistField a => SqlExpr a -> SqlExpr OrderBy asc = orderByExpr " ASC" -- | Descending order of this field or SqlExpression. -desc :: PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy +desc :: PersistField a => SqlExpr a -> SqlExpr OrderBy desc = orderByExpr " DESC" -orderByExpr :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr OrderBy +orderByExpr :: TLB.Builder -> SqlExpr a -> SqlExpr OrderBy orderByExpr orderByType (ERaw m f) | Just fields <- sqlExprMetaCompositeFields m = ERaw noMeta $ \_ info -> @@ -336,7 +337,7 @@ distinctOn exprs act = Q (W.tell mempty { sdDistinctClause = DistinctOn exprs }) -- be used by 'distinctOn'. -- -- @since 2.2.4 -don :: SqlExpr (Value a) -> SqlExpr DistinctOn +don :: SqlExpr a -> SqlExpr DistinctOn don = coerce -- | A convenience function that calls both 'distinctOn' and @@ -376,7 +377,7 @@ rand = ERaw noMeta $ \_ _ -> ("RANDOM()", []) -- | @HAVING@. -- -- @since 1.2.2 -having :: SqlExpr (Value Bool) -> SqlQuery () +having :: SqlExpr (Bool) -> SqlQuery () having expr = Q $ W.tell mempty { sdHavingClause = Where expr } -- | Add a locking clause to the query. Please read @@ -409,7 +410,7 @@ SQL error.\n\n Instead, consider using one of the following alternatives: \n \ -- is guaranteed to return just one row. -- -- Deprecated in 3.2.0. -sub_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) +sub_select :: (SqlSelect (SqlExpr a) a, PersistField a) => SqlQuery (SqlExpr a) -> SqlExpr a sub_select = sub SELECT -- | Execute a subquery @SELECT@ in a 'SqlExpr'. The query passed to this @@ -429,9 +430,9 @@ sub_select = sub SELECT -- -- @since 3.2.0 subSelect - :: PersistField a - => SqlQuery (SqlExpr (Value a)) - -> SqlExpr (Value (Maybe a)) + :: (PersistField a, SqlSelect (SqlExpr a) a) + => SqlQuery (SqlExpr a) + -> SqlExpr (Maybe a) subSelect query = just (subSelectUnsafe (query <* limit 1)) -- | Execute a subquery @SELECT@ in a 'SqlExpr'. This function is a shorthand @@ -443,9 +444,9 @@ subSelect query = just (subSelectUnsafe (query <* limit 1)) -- -- @since 3.2.0 subSelectMaybe - :: PersistField a - => SqlQuery (SqlExpr (Value (Maybe a))) - -> SqlExpr (Value (Maybe a)) + :: (PersistField a, SqlSelect (SqlExpr (Maybe a)) (Maybe a)) + => SqlQuery (SqlExpr (Maybe a)) + -> SqlExpr (Maybe a) subSelectMaybe = joinV . subSelect -- | Performs a @COUNT@ of the given query in a @subSelect@ manner. This is @@ -453,9 +454,9 @@ subSelectMaybe = joinV . subSelect -- -- @since 3.2.0 subSelectCount - :: (Num a, PersistField a) + :: (Num a, PersistField a, SqlSelect (SqlExpr a) a) => SqlQuery ignored - -> SqlExpr (Value a) + -> SqlExpr a subSelectCount query = subSelectUnsafe $ do _ <- query @@ -467,8 +468,8 @@ subSelectCount query = -- -- @since 3.2.0 subSelectList - :: PersistField a - => SqlQuery (SqlExpr (Value a)) + :: (SqlSelect (SqlExpr a) a, PersistField a) + => SqlQuery (SqlExpr a) -> SqlExpr (ValueList a) subSelectList = subList_select @@ -499,14 +500,15 @@ subSelectForeign :: ( BackendCompatible SqlBackend (PersistEntityBackend val1) , PersistEntity val1, PersistEntity val2, PersistField a + , SqlSelect (SqlExpr a) a ) => SqlExpr (Entity val2) -- ^ An expression representing the table you have access to now. -> EntityField val2 (Key val1) -- ^ The foreign key field on the table. - -> (SqlExpr (Entity val1) -> SqlExpr (Value a)) + -> (SqlExpr (Entity val1) -> SqlExpr a) -- ^ A function to extract a value from the foreign reference table. - -> SqlExpr (Value a) + -> SqlExpr a subSelectForeign expr foreignKey k = subSelectUnsafe $ from $ \table -> do @@ -529,14 +531,14 @@ subSelectForeign expr foreignKey k = -- 'subSelectMaybe'. For the most common safe use of this, see 'subSelectCount'. -- -- @since 3.2.0 -subSelectUnsafe :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) +subSelectUnsafe :: (SqlSelect (SqlExpr a) a, PersistField a) => SqlQuery (SqlExpr a) -> SqlExpr a subSelectUnsafe = sub SELECT -- | Project a field of an entity. (^.) :: forall typ val . (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ - -> SqlExpr (Value typ) + -> SqlExpr typ ERaw m f ^. field | isIdField field = idFieldValue | Just alias <- sqlExprMetaAlias m = @@ -576,22 +578,22 @@ ERaw m f ^. field -- | Project an SqlExpression that may be null, guarding against null cases. withNonNull :: PersistField typ - => SqlExpr (Value (Maybe typ)) - -> (SqlExpr (Value typ) -> SqlQuery a) + => SqlExpr (Maybe typ) + -> (SqlExpr typ -> SqlQuery a) -> SqlQuery a withNonNull field f = do where_ $ not_ $ isNothing field - f $ veryUnsafeCoerceSqlExprValue field + f $ veryUnsafeCoerceSqlExpr field -- | Project a field of an entity that may be null. (?.) :: ( PersistEntity val , PersistField typ) => SqlExpr (Maybe (Entity val)) -> EntityField val typ - -> SqlExpr (Value (Maybe typ)) + -> SqlExpr (Maybe typ) ERaw m f ?. field = just (ERaw m f ^. field) -- | Lift a constant value from Haskell-land to the query. -val :: PersistField typ => typ -> SqlExpr (Value typ) +val :: PersistField typ => typ -> SqlExpr typ val v = ERaw noMeta $ \_ _ -> ("?", [toPersistValue v]) -- | @IS NULL@ comparison. @@ -615,7 +617,7 @@ val v = ERaw noMeta $ \_ _ -> ("?", [toPersistValue v]) -- > - error: {lhs: v ==. val Nothing, rhs: Database.Esqueleto.isNothing v, name: Use Esqueleto's isNothing} -- > - error: {lhs: v !=. nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing} -- > - error: {lhs: v !=. val Nothing, rhs: not_ (Database.Esqueleto.isNothing v), name: Use Esqueleto's not isNothing} -isNothing :: PersistField typ => SqlExpr (Value (Maybe typ)) -> SqlExpr (Value Bool) +isNothing :: PersistField typ => SqlExpr ((Maybe typ)) -> SqlExpr (Bool) isNothing v = case v of ERaw m f -> @@ -627,25 +629,25 @@ isNothing v = ERaw noMeta $ \p info -> first (parensM p) . isNullExpr $ f Never info where - isNullExpr = first ((<> " IS NULL")) + isNullExpr = first (<> " IS NULL") -- | Analogous to 'Just', promotes a value of type @typ@ into -- one of type @Maybe typ@. It should hold that @'val' . Just -- === just . 'val'@. -just :: SqlExpr (Value typ) -> SqlExpr (Value (Maybe typ)) -just = veryUnsafeCoerceSqlExprValue +just :: SqlExpr typ -> SqlExpr (Maybe typ) +just = veryUnsafeCoerceSqlExpr -- | @NULL@ value. -nothing :: SqlExpr (Value (Maybe typ)) +nothing :: SqlExpr (Maybe typ) nothing = unsafeSqlValue "NULL" -- | Join nested 'Maybe's in a 'Value' into one. This is useful when -- calling aggregate functions on nullable fields. -joinV :: SqlExpr (Value (Maybe (Maybe typ))) -> SqlExpr (Value (Maybe typ)) -joinV = veryUnsafeCoerceSqlExprValue +joinV :: SqlExpr (Maybe (Maybe typ)) -> SqlExpr (Maybe typ) +joinV = veryUnsafeCoerceSqlExpr -countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr (Value typ) -> SqlExpr (Value a) +countHelper :: Num a => TLB.Builder -> TLB.Builder -> SqlExpr typ -> SqlExpr a countHelper open close v = case v of ERaw meta f -> @@ -654,24 +656,24 @@ countHelper open close v = else countRawSql (f Never) where - countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Value a) + countRawSql :: (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr a countRawSql x = ERaw noMeta $ \_ -> first (\b -> "COUNT" <> open <> parens b <> close) . x -- | @COUNT(*)@ value. -countRows :: Num a => SqlExpr (Value a) +countRows :: Num a => SqlExpr a countRows = unsafeSqlValue "COUNT(*)" -- | @COUNT@. -count :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a) +count :: Num a => SqlExpr typ -> SqlExpr a count = countHelper "" "" -- | @COUNT(DISTINCT x)@. -- -- @since 2.4.1 -countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a) +countDistinct :: Num a => SqlExpr typ -> SqlExpr a countDistinct = countHelper "(DISTINCT " ")" -not_ :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) +not_ :: SqlExpr (Bool) -> SqlExpr (Bool) not_ v = ERaw noMeta $ \p info -> first ("NOT " <>) $ x p info where x p info = @@ -683,66 +685,66 @@ not_ v = ERaw noMeta $ \p info -> first ("NOT " <>) $ x p info let (b, vals) = f Never info in (parensM p b, vals) -(==.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(==.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (==.) = unsafeSqlBinOpComposite " = " " AND " -(>=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(>=.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (>=.) = unsafeSqlBinOp " >= " -(>.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(>.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (>.) = unsafeSqlBinOp " > " -(<=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(<=.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (<=.) = unsafeSqlBinOp " <= " -(<.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(<.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (<.) = unsafeSqlBinOp " < " -(!=.) :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool) +(!=.) :: PersistField typ => SqlExpr typ -> SqlExpr typ -> SqlExpr (Bool) (!=.) = unsafeSqlBinOpComposite " != " " OR " -(&&.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) +(&&.) :: SqlExpr (Bool) -> SqlExpr (Bool) -> SqlExpr (Bool) (&&.) = unsafeSqlBinOp " AND " -(||.) :: SqlExpr (Value Bool) -> SqlExpr (Value Bool) -> SqlExpr (Value Bool) +(||.) :: SqlExpr (Bool) -> SqlExpr (Bool) -> SqlExpr (Bool) (||.) = unsafeSqlBinOp " OR " -(+.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) +(+.) :: PersistField a => SqlExpr a -> SqlExpr a -> SqlExpr a (+.) = unsafeSqlBinOp " + " -(-.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) +(-.) :: PersistField a => SqlExpr a -> SqlExpr a -> SqlExpr a (-.) = unsafeSqlBinOp " - " -(/.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) +(/.) :: PersistField a => SqlExpr a -> SqlExpr a -> SqlExpr a (/.) = unsafeSqlBinOp " / " -(*.) :: PersistField a => SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value a) +(*.) :: PersistField a => SqlExpr a -> SqlExpr a -> SqlExpr a (*.) = unsafeSqlBinOp " * " -- | @BETWEEN@. -- -- @since: 3.1.0 -between :: PersistField a => SqlExpr (Value a) -> (SqlExpr (Value a), SqlExpr (Value a)) -> SqlExpr (Value Bool) +between :: PersistField a => SqlExpr a -> (SqlExpr a, SqlExpr a) -> SqlExpr (Bool) a `between` (b, c) = a >=. b &&. a <=. c -random_ :: (PersistField a, Num a) => SqlExpr (Value a) +random_ :: (PersistField a, Num a) => SqlExpr a random_ = unsafeSqlValue "RANDOM()" -round_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) +round_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr a -> SqlExpr b round_ = unsafeSqlFunction "ROUND" -ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) +ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr a -> SqlExpr b ceiling_ = unsafeSqlFunction "CEILING" -floor_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) +floor_ :: (PersistField a, Num a, PersistField b, Num b) => SqlExpr a -> SqlExpr b floor_ = unsafeSqlFunction "FLOOR" -sum_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b)) +sum_ :: (PersistField a, PersistField b) => SqlExpr a -> SqlExpr (Maybe b) sum_ = unsafeSqlFunction "SUM" -min_ :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe a)) +min_ :: (PersistField a) => SqlExpr a -> SqlExpr (Maybe a) min_ = unsafeSqlFunction "MIN" -max_ :: (PersistField a) => SqlExpr (Value a) -> SqlExpr (Value (Maybe a)) +max_ :: (PersistField a) => SqlExpr a -> SqlExpr (Maybe a) max_ = unsafeSqlFunction "MAX" -avg_ :: (PersistField a, PersistField b) => SqlExpr (Value a) -> SqlExpr (Value (Maybe b)) +avg_ :: (PersistField a, PersistField b) => SqlExpr a -> SqlExpr (Maybe b) avg_ = unsafeSqlFunction "AVG" -- | Allow a number of one type to be used as one of another @@ -762,14 +764,14 @@ avg_ = unsafeSqlFunction "AVG" -- not being able to parse it. -- -- @since 2.2.9 -castNum :: (Num a, Num b) => SqlExpr (Value a) -> SqlExpr (Value b) -castNum = veryUnsafeCoerceSqlExprValue +castNum :: (Num a, Num b) => SqlExpr a -> SqlExpr b +castNum = veryUnsafeCoerceSqlExpr -- | Same as 'castNum', but for nullable values. -- -- @since 2.2.9 -castNumM :: (Num a, Num b) => SqlExpr (Value (Maybe a)) -> SqlExpr (Value (Maybe b)) -castNumM = veryUnsafeCoerceSqlExprValue +castNumM :: (Num a, Num b) => SqlExpr (Maybe a) -> SqlExpr (Maybe b) +castNumM = veryUnsafeCoerceSqlExpr -- | @COALESCE@ function. Evaluates the arguments in order and -- returns the value of the first non-NULL SqlExpression, or NULL @@ -778,7 +780,7 @@ castNumM = veryUnsafeCoerceSqlExprValue -- documentation. -- -- @since 1.4.3 -coalesce :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value (Maybe a)) +coalesce :: PersistField a => [SqlExpr (Maybe a)] -> SqlExpr (Maybe a) coalesce = unsafeSqlFunctionParens "COALESCE" -- | Like @coalesce@, but takes a non-nullable SqlExpression @@ -786,50 +788,50 @@ coalesce = unsafeSqlFunctionParens "COALESCE" -- a non-NULL result. -- -- @since 1.4.3 -coalesceDefault :: PersistField a => [SqlExpr (Value (Maybe a))] -> SqlExpr (Value a) -> SqlExpr (Value a) +coalesceDefault :: PersistField a => [SqlExpr (Maybe a)] -> SqlExpr a -> SqlExpr a coalesceDefault exprs = unsafeSqlFunctionParens "COALESCE" . (exprs ++) . return . just -- | @LOWER@ function. -lower_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) +lower_ :: SqlString s => SqlExpr s -> SqlExpr s lower_ = unsafeSqlFunction "LOWER" -- | @UPPER@ function. -- @since 3.3.0 -upper_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) +upper_ :: SqlString s => SqlExpr s -> SqlExpr s upper_ = unsafeSqlFunction "UPPER" -- | @TRIM@ function. -- @since 3.3.0 -trim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) +trim_ :: SqlString s => SqlExpr s -> SqlExpr s trim_ = unsafeSqlFunction "TRIM" -- | @RTRIM@ function. -- @since 3.3.0 -rtrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) +rtrim_ :: SqlString s => SqlExpr s -> SqlExpr s rtrim_ = unsafeSqlFunction "RTRIM" -- | @LTRIM@ function. -- @since 3.3.0 -ltrim_ :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) +ltrim_ :: SqlString s => SqlExpr s -> SqlExpr s ltrim_ = unsafeSqlFunction "LTRIM" -- | @LENGTH@ function. -- @since 3.3.0 -length_ :: (SqlString s, Num a) => SqlExpr (Value s) -> SqlExpr (Value a) +length_ :: (SqlString s, Num a) => SqlExpr s -> SqlExpr a length_ = unsafeSqlFunction "LENGTH" -- | @LEFT@ function. -- @since 3.3.0 -left_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s) +left_ :: (SqlString s, Num a) => (SqlExpr s, SqlExpr a) -> SqlExpr s left_ = unsafeSqlFunction "LEFT" -- | @RIGHT@ function. -- @since 3.3.0 -right_ :: (SqlString s, Num a) => (SqlExpr (Value s), SqlExpr (Value a)) -> SqlExpr (Value s) +right_ :: (SqlString s, Num a) => (SqlExpr s, SqlExpr a) -> SqlExpr s right_ = unsafeSqlFunction "RIGHT" -- | @LIKE@ operator. -like :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool) +like :: SqlString s => SqlExpr s -> SqlExpr s -> SqlExpr (Bool) like = unsafeSqlBinOp " LIKE " -- | @ILIKE@ operator (case-insensitive @LIKE@). @@ -837,7 +839,7 @@ like = unsafeSqlBinOp " LIKE " -- Supported by PostgreSQL only. -- -- @since 2.2.3 -ilike :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value Bool) +ilike :: SqlString s => SqlExpr s -> SqlExpr s -> SqlExpr (Bool) ilike = unsafeSqlBinOp " ILIKE " -- | The string @'%'@. May be useful while using 'like' and @@ -848,18 +850,18 @@ ilike = unsafeSqlBinOp " ILIKE " -- @ -- name `'like`` (%) ++. 'val' \"John\" ++. (%) -- @ -(%) :: SqlString s => SqlExpr (Value s) -(%) = unsafeSqlValue "'%'" +(%) :: SqlString s => SqlExpr s +(%) = unsafeSqlValue "'%'" -- | The @CONCAT@ function with a variable number of -- parameters. Supported by MySQL and PostgreSQL. -concat_ :: SqlString s => [SqlExpr (Value s)] -> SqlExpr (Value s) +concat_ :: SqlString s => [SqlExpr s] -> SqlExpr s concat_ = unsafeSqlFunction "CONCAT" -- | The @||@ string concatenation operator (named after -- Haskell's '++' in order to avoid naming clash with '||.'). -- Supported by SQLite and PostgreSQL. -(++.) :: SqlString s => SqlExpr (Value s) -> SqlExpr (Value s) -> SqlExpr (Value s) +(++.) :: SqlString s => SqlExpr s -> SqlExpr s -> SqlExpr s (++.) = unsafeSqlBinOp " || " -- | Cast a string type into 'Text'. This function @@ -872,12 +874,12 @@ concat_ = unsafeSqlFunction "CONCAT" -- since 'Maybe' is an instance of 'SqlString', it's possible -- to turn a nullable value into a non-nullable one. Avoid -- using this function if possible. -castString :: (SqlString s, SqlString r) => SqlExpr (Value s) -> SqlExpr (Value r) -castString = veryUnsafeCoerceSqlExprValue +castString :: (SqlString s, SqlString r) => SqlExpr s -> SqlExpr r +castString = veryUnsafeCoerceSqlExpr -- | Execute a subquery @SELECT@ in an SqlExpression. Returns a -- list of values. -subList_select :: PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (ValueList a) +subList_select :: (SqlSelect (SqlExpr a) a, PersistField a) => SqlQuery (SqlExpr a) -> SqlExpr (ValueList a) subList_select query = ERaw noMeta $ \_ info -> first parens $ toRawSql SELECT info query @@ -913,7 +915,7 @@ justList (ERaw m f) = ERaw m f -- @ -- -- Where @personIds@ is of type @[Key Person]@. -in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) +in_ :: PersistField typ => SqlExpr typ -> SqlExpr (ValueList typ) -> SqlExpr (Bool) (ERaw _ v) `in_` (ERaw _ list) = ERaw noMeta $ \p info -> let (b1, vals1) = v Parens info @@ -925,7 +927,7 @@ in_ :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> Sql (b1 <> " IN " <> b2, vals1 <> vals2) -- | @NOT IN@ operator. -notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> SqlExpr (Value Bool) +notIn :: PersistField typ => SqlExpr typ -> SqlExpr (ValueList typ) -> SqlExpr (Bool) (ERaw _ v) `notIn` (ERaw _ list) = ERaw noMeta $ \p info -> let (b1, vals1) = v Parens info @@ -942,14 +944,14 @@ notIn :: PersistField typ => SqlExpr (Value typ) -> SqlExpr (ValueList typ) -> S -- 'where_' (post '^.' BlogPostAuthorId '==.' person '^.' PersonId) -- return person -- @ -exists :: SqlQuery () -> SqlExpr (Value Bool) +exists :: SqlQuery () -> SqlExpr (Bool) exists q = ERaw noMeta $ \p info -> let ERaw _ f = existsHelper q (b, vals) = f Never info in ( parensM p $ "EXISTS " <> b, vals) -- | @NOT EXISTS@ operator. -notExists :: SqlQuery () -> SqlExpr (Value Bool) +notExists :: SqlQuery () -> SqlExpr (Bool) notExists q = ERaw noMeta $ \p info -> let ERaw _ f = existsHelper q (b, vals) = f Never info @@ -963,27 +965,27 @@ set ent upds = Q $ W.tell mempty { sdSetClause = map apply upds } where apply f = SetClause (f ent) -(=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr (Value typ) -> (SqlExpr (Entity val) -> SqlExpr Update ) +(=.) :: (PersistEntity val, PersistField typ) => EntityField val typ -> SqlExpr typ -> (SqlExpr (Entity val) -> SqlExpr Update ) field =. expr = setAux field (const expr) -(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update) +(+=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr a -> (SqlExpr (Entity val) -> SqlExpr Update) field +=. expr = setAux field (\ent -> ent ^. field +. expr) -(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update) +(-=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr a -> (SqlExpr (Entity val) -> SqlExpr Update) field -=. expr = setAux field (\ent -> ent ^. field -. expr) -(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update) +(*=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr a -> (SqlExpr (Entity val) -> SqlExpr Update) field *=. expr = setAux field (\ent -> ent ^. field *. expr) -(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr (Value a) -> (SqlExpr (Entity val) -> SqlExpr Update) +(/=.) :: (PersistEntity val, PersistField a) => EntityField val a -> SqlExpr a -> (SqlExpr (Entity val) -> SqlExpr Update) field /=. expr = setAux field (\ent -> ent ^. field /. expr) -- | Apply a 'PersistField' constructor to @SqlExpr Value@ arguments. -(<#) :: (a -> b) -> SqlExpr (Value a) -> SqlExpr (Insertion b) +(<#) :: (a -> b) -> SqlExpr a -> SqlExpr (Insertion b) (<#) _ (ERaw _ f) = ERaw noMeta f -- | Apply extra @SqlExpr Value@ arguments to a 'PersistField' constructor -(<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr (Value a) -> SqlExpr (Insertion b) +(<&>) :: SqlExpr (Insertion (a -> b)) -> SqlExpr a -> SqlExpr (Insertion b) (ERaw _ f) <&> (ERaw _ g) = ERaw noMeta $ \_ info -> let (fb, fv) = f Never info @@ -1031,7 +1033,7 @@ field /=. expr = setAux field (\ent -> ent ^. field /. expr) -- reproduce this via 'nothing'. -- -- @since 2.1.2 -case_ :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a) +case_ :: PersistField a => [(SqlExpr (Bool), SqlExpr a)] -> SqlExpr a -> SqlExpr a case_ = unsafeSqlCase -- | Convert an entity's key into another entity's. @@ -1070,8 +1072,8 @@ case_ = unsafeSqlCase -- one of the example above. -- -- @since 2.4.3 -toBaseId :: ToBaseId ent => SqlExpr (Value (Key ent)) -> SqlExpr (Value (Key (BaseEnt ent))) -toBaseId = veryUnsafeCoerceSqlExprValue +toBaseId :: ToBaseId ent => SqlExpr (Key ent) -> SqlExpr (Key (BaseEnt ent)) +toBaseId = veryUnsafeCoerceSqlExpr {-# DEPRECATED random_ "Since 2.6.0: `random_` is not uniform across all databases! Please use a specific one such as 'Database.Esqueleto.PostgreSQL.random_', 'Database.Esqueleto.MySQL.random_', or 'Database.Esqueleto.SQLite.random_'" #-} @@ -1090,7 +1092,7 @@ infixl 2 `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuter -- | Syntax sugar for 'case_'. -- -- @since 2.1.2 -when_ :: expr (Value Bool) -> () -> expr a -> (expr (Value Bool), expr a) +when_ :: expr (Bool) -> () -> expr a -> (expr (Bool), expr a) when_ cond _ expr = (cond, expr) -- | Syntax sugar for 'case_'. @@ -1107,28 +1109,25 @@ else_ = id -- | A single value (as opposed to a whole entity). You may use -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. -newtype Value a = Value { unValue :: a } deriving (Eq, Ord, Show, Typeable) +type Value a = a --- | @since 1.4.4 -instance Functor Value where - fmap f (Value a) = Value (f a) +pattern Value :: a -> a +pattern Value a = a -instance Applicative Value where - (<*>) (Value f) (Value a) = Value (f a) - pure = Value +unValue :: Value a -> a +unValue = id -instance Monad Value where - (>>=) x f = valueJoin $ fmap f x - where valueJoin (Value v) = v +veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) +veryUnsafeCoerceSqlExprValue = coerce -- | A list of single values. There's a limited set of functions -- able to work with this data type (such as 'subList_select', -- 'valList', 'in_' and 'exists'). newtype ValueList a = ValueList a deriving (Eq, Ord, Show, Typeable) --- | A wrapper type for for any @expr (Value a)@ for all a. +-- | A wrapper type for for any @expr a@ for all a. data SomeValue where - SomeValue :: SqlExpr (Value a) -> SomeValue + SomeValue :: SqlExpr a -> SomeValue -- | A class of things that can be converted into a list of SomeValue. It has -- instances for tuples and is the reason why 'groupBy' can take tuples, like @@ -1734,8 +1733,8 @@ instance Monoid DistinctClause where -- | A part of a @FROM@ clause. data FromClause = FromStart Ident EntityDef - | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Value Bool))) - | OnClause (SqlExpr (Value Bool)) + | FromJoin FromClause JoinKind FromClause (Maybe (SqlExpr (Bool))) + | OnClause (SqlExpr (Bool)) | FromRaw (NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue])) data CommonTableExpressionKind @@ -1796,7 +1795,7 @@ newtype SetClause = SetClause (SqlExpr Update) collectOnClauses :: SqlBackend -> [FromClause] - -> Either (SqlExpr (Value Bool)) [FromClause] + -> Either (SqlExpr (Bool)) [FromClause] collectOnClauses sqlBackend = go Set.empty [] where go is [] (f@(FromStart i _) : fs) = @@ -1812,8 +1811,8 @@ collectOnClauses sqlBackend = go Set.empty [] findMatching :: Set Ident -> [FromClause] - -> SqlExpr (Value Bool) - -> Either (SqlExpr (Value Bool)) (Set Ident, [FromClause]) + -> SqlExpr (Bool) + -> Either (SqlExpr (Bool)) (Set Ident, [FromClause]) findMatching idents fromClauses expr = case fromClauses of f : acc -> @@ -1842,7 +1841,7 @@ collectOnClauses sqlBackend = go Set.empty [] tryMatch :: Set Ident - -> SqlExpr (Value Bool) + -> SqlExpr (Bool) -> FromClause -> Maybe (Set Ident, FromClause) tryMatch idents expr fromClause = @@ -1907,7 +1906,7 @@ collectOnClauses sqlBackend = go Set.empty [] $ renderedExpr -- | A complete @WHERE@ clause. -data WhereClause = Where (SqlExpr (Value Bool)) +data WhereClause = Where (SqlExpr (Bool)) | NoWhere instance Semigroup WhereClause where @@ -2074,7 +2073,7 @@ parensM Parens = parens data OrderByType = ASC | DESC -instance ToSomeValues (SqlExpr (Value a)) where +instance ToSomeValues (SqlExpr a) where toSomeValues a = [SomeValue a] fieldName @@ -2086,29 +2085,29 @@ fieldName info = fromDBName info . fieldDB . persistFieldDef setAux :: (PersistEntity val, PersistField typ) => EntityField val typ - -> (SqlExpr (Entity val) -> SqlExpr (Value typ)) + -> (SqlExpr (Entity val) -> SqlExpr typ) -> (SqlExpr (Entity val) -> SqlExpr Update) setAux field value = \ent -> ERaw noMeta $ \_ info -> let ERaw _ valueF = value ent (valueToSet, valueVals) = valueF Parens info in (fieldName info field <> " = " <> valueToSet, valueVals) -sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) +sub :: (SqlSelect (SqlExpr a) r, PersistField a) => Mode -> SqlQuery (SqlExpr a) -> SqlExpr a sub mode query = ERaw noMeta $ \_ info -> first parens $ toRawSql mode info query fromDBName :: IdentInfo -> DBName -> TLB.Builder fromDBName (conn, _) = TLB.fromText . connEscapeName conn -existsHelper :: SqlQuery () -> SqlExpr (Value Bool) +existsHelper :: SqlQuery () -> SqlExpr (Bool) existsHelper = sub SELECT . (>> return true) where - true :: SqlExpr (Value Bool) + true :: SqlExpr (Bool) true = val True -- | (Internal) Create a case statement. -- -- Since: 2.1.1 -unsafeSqlCase :: PersistField a => [(SqlExpr (Value Bool), SqlExpr (Value a))] -> SqlExpr (Value a) -> SqlExpr (Value a) +unsafeSqlCase :: PersistField a => [(SqlExpr (Bool), SqlExpr a)] -> SqlExpr a -> SqlExpr a unsafeSqlCase when v = ERaw noMeta buildCase where buildCase :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) @@ -2117,17 +2116,17 @@ unsafeSqlCase when v = ERaw noMeta buildCase (whenText, whenVals) = mapWhen when Parens info in ( "CASE" <> whenText <> " ELSE " <> elseText <> " END", whenVals <> elseVals) - mapWhen :: [(SqlExpr (Value Bool), SqlExpr (Value a))] -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) + mapWhen :: [(SqlExpr (Bool), SqlExpr a)] -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) mapWhen [] _ _ = throw (UnexpectedCaseErr UnsafeSqlCaseError) mapWhen when' p info = foldl (foldHelp p info) (mempty, mempty) when' - foldHelp :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Value Bool), SqlExpr (Value a)) -> (TLB.Builder, [PersistValue]) + foldHelp :: NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) -> (SqlExpr (Bool), SqlExpr a) -> (TLB.Builder, [PersistValue]) foldHelp p info (b0, vals0) (v1, v2) = let (b1, vals1) = valueToSql v1 p info (b2, vals2) = valueToSql v2 p info in ( b0 <> " WHEN " <> b1 <> " THEN " <> b2, vals0 <> vals1 <> vals2 ) - valueToSql :: SqlExpr (Value a) -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) + valueToSql :: SqlExpr a -> NeedParens -> IdentInfo -> (TLB.Builder, [PersistValue]) valueToSql (ERaw _ f) p = f p -- | (Internal) Create a custom binary operator. You /should/ @@ -2136,13 +2135,13 @@ unsafeSqlCase when v = ERaw noMeta buildCase -- signature. For example: -- -- @ --- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool) +-- (==.) :: SqlExpr a -> SqlExpr a -> SqlExpr (Bool) -- (==.) = unsafeSqlBinOp " = " -- @ -- -- In the example above, we constraint the arguments to be of the -- same type and constraint the result to be a boolean value. -unsafeSqlBinOp :: TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) +unsafeSqlBinOp :: TLB.Builder -> SqlExpr a -> SqlExpr b -> SqlExpr c unsafeSqlBinOp op (ERaw m1 f1) (ERaw m2 f2) | not (hasCompositeKeyMeta m1 || hasCompositeKeyMeta m2) = ERaw noMeta f where @@ -2155,7 +2154,7 @@ unsafeSqlBinOp op (ERaw m1 f1) (ERaw m2 f2) ) unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b) where - construct :: SqlExpr (Value a) -> SqlExpr (Value a) + construct :: SqlExpr a -> SqlExpr a construct (ERaw m f) = case sqlExprMetaCompositeFields m of Just fields -> @@ -2177,7 +2176,7 @@ unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b) -- Usage example: -- -- @ --- (==.) :: SqlExpr (Value a) -> SqlExpr (Value a) -> SqlExpr (Value Bool) +-- (==.) :: SqlExpr a -> SqlExpr a -> SqlExpr (Bool) -- (==.) = unsafeSqlBinOpComposite " = " " AND " -- @ -- @@ -2193,15 +2192,15 @@ unsafeSqlBinOp op a b = unsafeSqlBinOp op (construct a) (construct b) -- - If it is not a single placeholder, then it's assumed to be -- a foreign (composite or not) key, so we enforce that it has -- no placeholders and split it on the commas. -unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr (Value a) -> SqlExpr (Value b) -> SqlExpr (Value c) +unsafeSqlBinOpComposite :: TLB.Builder -> TLB.Builder -> SqlExpr a -> SqlExpr b -> SqlExpr c unsafeSqlBinOpComposite op sep a b | isCompositeKey a || isCompositeKey b = ERaw noMeta $ const $ compose (listify a) (listify b) | otherwise = unsafeSqlBinOp op a b where - isCompositeKey :: SqlExpr (Value x) -> Bool + isCompositeKey :: SqlExpr x -> Bool isCompositeKey (ERaw m _) = hasCompositeKeyMeta m - listify :: SqlExpr (Value x) -> IdentInfo -> ([TLB.Builder], [PersistValue]) + listify :: SqlExpr x -> IdentInfo -> ([TLB.Builder], [PersistValue]) listify (ERaw m f) | Just f <- sqlExprMetaCompositeFields m = flip (,) [] . f | otherwise = deconstruct . f Parens @@ -2224,7 +2223,7 @@ unsafeSqlBinOpComposite op sep a b -- | (Internal) A raw SQL value. The same warning from -- 'unsafeSqlBinOp' applies to this function as well. -unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a) +unsafeSqlValue :: TLB.Builder -> SqlExpr a unsafeSqlValue v = ERaw noMeta $ \_ _ -> (v, mempty) {-# INLINE unsafeSqlValue #-} @@ -2232,14 +2231,14 @@ unsafeSqlEntity :: PersistEntity ent => Ident -> SqlExpr (Entity ent) unsafeSqlEntity ident = ERaw noMeta $ \_ info -> (useIdent info ident, []) -valueToFunctionArg :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) +valueToFunctionArg :: IdentInfo -> SqlExpr a -> (TLB.Builder, [PersistValue]) valueToFunctionArg info (ERaw _ f) = f Never info -- | (Internal) A raw SQL function. Once again, the same warning -- from 'unsafeSqlBinOp' applies to this function as well. unsafeSqlFunction :: UnsafeSqlFunctionArgument a - => TLB.Builder -> a -> SqlExpr (Value b) + => TLB.Builder -> a -> SqlExpr b unsafeSqlFunction name arg = ERaw noMeta $ \p info -> let (argsTLB, argsVals) = @@ -2253,7 +2252,7 @@ unsafeSqlFunction name arg = -- Since: 1.3.6. unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a - => TLB.Builder -> a -> SqlExpr (Value b) + => TLB.Builder -> a -> SqlExpr b unsafeSqlExtractSubField subField arg = ERaw noMeta $ \_ info -> let (argsTLB, argsVals) = @@ -2265,7 +2264,7 @@ unsafeSqlExtractSubField subField arg = -- See 'unsafeSqlBinOp' for warnings. unsafeSqlFunctionParens :: UnsafeSqlFunctionArgument a - => TLB.Builder -> a -> SqlExpr (Value b) + => TLB.Builder -> a -> SqlExpr b unsafeSqlFunctionParens name arg = ERaw noMeta $ \p info -> let valueToFunctionArgParens (ERaw _ f) = f Never info @@ -2276,18 +2275,18 @@ unsafeSqlFunctionParens name arg = -- | (Internal) An explicit SQL type cast using CAST(value as type). -- See 'unsafeSqlBinOp' for warnings. -unsafeSqlCastAs :: T.Text -> SqlExpr (Value a) -> SqlExpr (Value b) +unsafeSqlCastAs :: T.Text -> SqlExpr a -> SqlExpr b unsafeSqlCastAs t (ERaw _ f) = ERaw noMeta $ \_ -> ((first (\value -> "CAST" <> parens (value <> " AS " <> TLB.fromText t))) . f Never) -- | (Internal) This class allows 'unsafeSqlFunction' to work with different -- numbers of arguments; specifically it allows providing arguments to a sql --- function via an n-tuple of @SqlExpr (Value _)@ values, which are not all +-- function via an n-tuple of @SqlExpr _@ values, which are not all -- necessarily required to be the same type. There are instances for up to -- 10-tuples, but for sql functions which take more than 10 arguments, you can -- also nest tuples, as e.g. @toArgList ((a,b),(c,d))@ is the same as -- @toArgList (a,b,c,d)@. class UnsafeSqlFunctionArgument a where - toArgList :: a -> [SqlExpr (Value ())] + toArgList :: a -> [SqlExpr (())] -- | Useful for 0-argument functions, like @now@ in Postgresql. -- @@ -2295,8 +2294,8 @@ class UnsafeSqlFunctionArgument a where instance UnsafeSqlFunctionArgument () where toArgList _ = [] -instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where - toArgList = (:[]) . veryUnsafeCoerceSqlExprValue +instance UnsafeSqlFunctionArgument (SqlExpr a) where + toArgList = (:[]) . veryUnsafeCoerceSqlExpr instance UnsafeSqlFunctionArgument a => UnsafeSqlFunctionArgument [a] where toArgList = concatMap toArgList @@ -2404,16 +2403,16 @@ instance ( UnsafeSqlFunctionArgument a toArgList = toArgList . from10 --- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to --- 'SqlExpr (Value b)'. You should /not/ use this function +-- | (Internal) Coerce a value's type from 'SqlExpr a' to +-- 'SqlExpr b'. You should /not/ use this function -- unless you know what you're doing! -veryUnsafeCoerceSqlExprValue :: SqlExpr (Value a) -> SqlExpr (Value b) -veryUnsafeCoerceSqlExprValue = coerce +veryUnsafeCoerceSqlExpr :: SqlExpr a -> SqlExpr b +veryUnsafeCoerceSqlExpr = coerce -- | (Internal) Coerce a value's type from 'SqlExpr (ValueList --- a)' to 'SqlExpr (Value a)'. Does not work with empty lists. -veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr (Value a) +-- a)' to 'SqlExpr a'. Does not work with empty lists. +veryUnsafeCoerceSqlExprValueList :: SqlExpr (ValueList a) -> SqlExpr a veryUnsafeCoerceSqlExprValueList = coerce @@ -2422,7 +2421,7 @@ veryUnsafeCoerceSqlExprValueList = coerce -- | (Internal) Execute an @esqueleto@ @SELECT@ 'SqlQuery' inside -- @persistent@'s 'SqlPersistT' monad. rawSelectSource - :: + :: forall a r m1 m2. ( SqlSelect a r , MonadIO m1 , MonadIO m2 @@ -2443,7 +2442,7 @@ rawSelectSource mode query = do massage = do mrow <- C.await - case sqlSelectProcessRow <$> mrow of + case sqlSelectProcessRow (Proxy :: Proxy a) <$> mrow of Just (Right r) -> C.yield r >> massage Just (Left err) -> liftIO $ throwIO $ PersistMarshalError err Nothing -> return () @@ -2486,7 +2485,7 @@ selectSource query = do -- * You may return a @SqlExpr ('Value' t)@ for a value @t@ -- (i.e., a single column), where @t@ is any instance of -- 'PersistField', which is then returned to Haskell-land as --- @Value t@. You may use @Value@ to return projections of an +-- @t@. You may use @Value@ to return projections of an -- @Entity@ (see @('^.')@ and @('?.')@) or to return any other -- value calculated on the query (e.g., 'countRows' or -- 'subSelect'). @@ -2784,7 +2783,7 @@ makeSelect info mode_ distinctClause ret = process mode_ first (("SELECT DISTINCT ON (" <>) . (<> ") ")) $ uncommas' (processExpr <$> exprs) where - processExpr e = materializeExpr info (coerce e :: SqlExpr (Value a)) + processExpr e = materializeExpr info (coerce e :: SqlExpr a) withCols v = v <> sqlSelectCols info ret plain v = (v, []) @@ -2833,7 +2832,7 @@ makeFrom info mode fs = ret makeOnClause (ERaw _ f) = first (" ON " <>) (f Never info) - mkExc :: SqlExpr (Value Bool) -> OnClauseWithoutMatchingJoinException + mkExc :: SqlExpr (Bool) -> OnClauseWithoutMatchingJoinException mkExc (ERaw _ f) = OnClauseWithoutMatchingJoinException $ TL.unpack $ TLB.toLazyText $ fst (f Never info) @@ -2912,7 +2911,7 @@ aliasedColumnName (I baseIdent) info columnName = -- This looks very similar to @RawSql@, and it is! However, -- there are some crucial differences and ultimately they're -- different classes. -class SqlSelect a r | a -> r, r -> a where +class SqlSelect a r | a -> r where -- | Creates the variable part of the @SELECT@ query and -- returns the list of 'PersistValue's that will be given to -- 'rawQuery'. @@ -2922,7 +2921,7 @@ class SqlSelect a r | a -> r, r -> a where sqlSelectColCount :: Proxy a -> Int -- | Transform a row of the result into the data type. - sqlSelectProcessRow :: [PersistValue] -> Either T.Text r + sqlSelectProcessRow :: Proxy a -> [PersistValue] -> Either T.Text r -- | Create @INSERT INTO@ clause instead. sqlInsertInto :: IdentInfo -> a -> (TLB.Builder, [PersistValue]) @@ -2945,14 +2944,14 @@ instance PersistEntity e => SqlSelect (SqlExpr (Insertion e)) (Insertion e) wher ("INSERT INTO " <> table e <> parens fields <> "\n", []) sqlSelectCols info (ERaw _ f) = f Never info sqlSelectColCount = const 0 - sqlSelectProcessRow = + sqlSelectProcessRow _ = const (Right (throw (UnexpectedCaseErr InsertionFinalError))) -- | Not useful for 'select', but used for 'update' and 'delete'. instance SqlSelect () () where sqlSelectCols _ _ = ("1", []) sqlSelectColCount _ = 1 - sqlSelectProcessRow _ = Right () + sqlSelectProcessRow _ _ = Right () unescapedColumnNames :: EntityDef -> [DBName] unescapedColumnNames ent = @@ -2992,7 +2991,7 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where in (process ed, mempty) sqlSelectColCount = entityColumnCount . entityDef . getEntityVal - sqlSelectProcessRow = parseEntityValues ed + sqlSelectProcessRow _ = parseEntityValues ed where ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity a))) @@ -3002,25 +3001,24 @@ getEntityVal = const Proxy -- | You may return a possibly-@NULL@ 'Entity' from a 'select' query. instance PersistEntity a => SqlSelect (SqlExpr (Maybe (Entity a))) (Maybe (Entity a)) where sqlSelectCols info e = sqlSelectCols info (coerce e :: SqlExpr (Entity a)) - sqlSelectColCount = sqlSelectColCount . fromEMaybe - where - fromEMaybe :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e) - fromEMaybe = const Proxy - sqlSelectProcessRow cols + sqlSelectColCount = sqlSelectColCount . fromMaybeP + sqlSelectProcessRow proxy cols | all (== PersistNull) cols = return Nothing - | otherwise = Just <$> sqlSelectProcessRow cols + | otherwise = Just <$> sqlSelectProcessRow (fromMaybeP proxy) cols +fromMaybeP :: Proxy (SqlExpr (Maybe e)) -> Proxy (SqlExpr e) +fromMaybeP = const Proxy -- | You may return any single value (i.e. a single column) from -- a 'select' query. -instance PersistField a => SqlSelect (SqlExpr (Value a)) (Value a) where +instance {-# OVERLAPPABLE #-} PersistField a => SqlSelect (SqlExpr a) a where sqlSelectCols = materializeExpr sqlSelectColCount = const 1 - sqlSelectProcessRow [pv] = Value <$> fromPersistValue pv - sqlSelectProcessRow pvs = Value <$> fromPersistValue (PersistList pvs) + sqlSelectProcessRow _ [pv] = fromPersistValue pv + sqlSelectProcessRow _ pvs = fromPersistValue (PersistList pvs) --- | Materialize a @SqlExpr (Value a)@. -materializeExpr :: IdentInfo -> SqlExpr (Value a) -> (TLB.Builder, [PersistValue]) +-- | Materialize a @SqlExpr a@. +materializeExpr :: IdentInfo -> SqlExpr a -> (TLB.Builder, [PersistValue]) materializeExpr info (ERaw m f) | Just fields <- sqlExprMetaCompositeFields m = (uncommas $ fmap parens $ fields info, []) | Just alias <- sqlExprMetaAlias m @@ -3028,6 +3026,8 @@ materializeExpr info (ERaw m f) | otherwise = f Parens info +fromTupleP :: Proxy (a,b) -> (Proxy a, Proxy b) +fromTupleP = const (Proxy, Proxy) -- | You may return tuples (up to 16-tuples) and tuples of tuples -- from a 'select' query. instance (SqlSelect a ra, SqlSelect b rb) => SqlSelect (a, b) (ra, rb) where @@ -3036,21 +3036,19 @@ instance (SqlSelect a ra, SqlSelect b rb) => SqlSelect (a, b) (ra, rb) where [ sqlSelectCols esc a , sqlSelectCols esc b ] - sqlSelectColCount = uncurry (+) . (sqlSelectColCount *** sqlSelectColCount) . fromTuple - where - fromTuple :: Proxy (a,b) -> (Proxy a, Proxy b) - fromTuple = const (Proxy, Proxy) - sqlSelectProcessRow = + sqlSelectColCount = uncurry (+) . (sqlSelectColCount *** sqlSelectColCount) . fromTupleP + sqlSelectProcessRow p = let x = getType processRow getType :: SqlSelect a r => (z -> Either y (r,x)) -> Proxy a getType = const Proxy colCountFst = sqlSelectColCount x + (fstP, sndP) = fromTupleP p processRow row = let (rowFst, rowSnd) = splitAt colCountFst row - in (,) <$> sqlSelectProcessRow rowFst - <*> sqlSelectProcessRow rowSnd + in (,) <$> sqlSelectProcessRow fstP rowFst + <*> sqlSelectProcessRow sndP rowSnd in colCountFst `seq` processRow -- Avoids recalculating 'colCountFst'. @@ -3066,7 +3064,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc c ] sqlSelectColCount = sqlSelectColCount . from3P - sqlSelectProcessRow = fmap to3 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to3 . sqlSelectProcessRow (from3P p) from3P :: Proxy (a,b,c) -> Proxy ((a,b),c) from3P = const Proxy @@ -3090,7 +3088,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc d ] sqlSelectColCount = sqlSelectColCount . from4P - sqlSelectProcessRow = fmap to4 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to4 . sqlSelectProcessRow (from4P p) from4P :: Proxy (a,b,c,d) -> Proxy ((a,b),(c,d)) from4P = const Proxy @@ -3116,7 +3114,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc e ] sqlSelectColCount = sqlSelectColCount . from5P - sqlSelectProcessRow = fmap to5 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to5 . sqlSelectProcessRow (from5P p) from5P :: Proxy (a,b,c,d,e) -> Proxy ((a,b),(c,d),e) from5P = const Proxy @@ -3144,7 +3142,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc f ] sqlSelectColCount = sqlSelectColCount . from6P - sqlSelectProcessRow = fmap to6 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to6 . sqlSelectProcessRow (from6P p) from6P :: Proxy (a,b,c,d,e,f) -> Proxy ((a,b),(c,d),(e,f)) from6P = const Proxy @@ -3174,7 +3172,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc g ] sqlSelectColCount = sqlSelectColCount . from7P - sqlSelectProcessRow = fmap to7 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to7 . sqlSelectProcessRow (from7P p) from7P :: Proxy (a,b,c,d,e,f,g) -> Proxy ((a,b),(c,d),(e,f),g) from7P = const Proxy @@ -3206,7 +3204,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc h ] sqlSelectColCount = sqlSelectColCount . from8P - sqlSelectProcessRow = fmap to8 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to8 . sqlSelectProcessRow (from8P p) from8P :: Proxy (a,b,c,d,e,f,g,h) -> Proxy ((a,b),(c,d),(e,f),(g,h)) from8P = const Proxy @@ -3240,7 +3238,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc i ] sqlSelectColCount = sqlSelectColCount . from9P - sqlSelectProcessRow = fmap to9 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to9 . sqlSelectProcessRow (from9P p) from9P :: Proxy (a,b,c,d,e,f,g,h,i) -> Proxy ((a,b),(c,d),(e,f),(g,h),i) from9P = const Proxy @@ -3276,7 +3274,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc j ] sqlSelectColCount = sqlSelectColCount . from10P - sqlSelectProcessRow = fmap to10 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to10 . sqlSelectProcessRow (from10P p) from10P :: Proxy (a,b,c,d,e,f,g,h,i,j) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j)) from10P = const Proxy @@ -3314,7 +3312,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc k ] sqlSelectColCount = sqlSelectColCount . from11P - sqlSelectProcessRow = fmap to11 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to11 . sqlSelectProcessRow (from11P p) from11P :: Proxy (a,b,c,d,e,f,g,h,i,j,k) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),k) from11P = const Proxy @@ -3351,7 +3349,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc l ] sqlSelectColCount = sqlSelectColCount . from12P - sqlSelectProcessRow = fmap to12 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to12 . sqlSelectProcessRow (from12P p) from12P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l)) from12P = const Proxy @@ -3390,7 +3388,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc m ] sqlSelectColCount = sqlSelectColCount . from13P - sqlSelectProcessRow = fmap to13 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to13 . sqlSelectProcessRow (from13P p) from13P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),m) from13P = const Proxy @@ -3431,7 +3429,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc n ] sqlSelectColCount = sqlSelectColCount . from14P - sqlSelectProcessRow = fmap to14 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to14 . sqlSelectProcessRow (from14P p) from14P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n)) from14P = const Proxy @@ -3474,7 +3472,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc o ] sqlSelectColCount = sqlSelectColCount . from15P - sqlSelectProcessRow = fmap to15 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to15 . sqlSelectProcessRow (from15P p) from15P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n, o) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),o) from15P = const Proxy @@ -3519,7 +3517,7 @@ instance ( SqlSelect a ra , sqlSelectCols esc p ] sqlSelectColCount = sqlSelectColCount . from16P - sqlSelectProcessRow = fmap to16 . sqlSelectProcessRow + sqlSelectProcessRow p = fmap to16 . sqlSelectProcessRow (from16P p) from16P :: Proxy (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> Proxy ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) from16P = const Proxy @@ -3547,7 +3545,7 @@ insertSelectCount = rawEsqueleto INSERT_INTO -- representation of the clauses passed to an "On" clause. -- -- @since 3.2.0 -renderExpr :: SqlBackend -> SqlExpr (Value Bool) -> T.Text +renderExpr :: SqlBackend -> SqlExpr (Bool) -> T.Text renderExpr sqlBackend e = case e of ERaw _ mkBuilderValues -> let (builder, _) = mkBuilderValues Never (sqlBackend, initialIdentState) @@ -3569,7 +3567,7 @@ instance Exception RenderExprException -- (). valkey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) - => Int64 -> SqlExpr (Value (Key entity)) + => Int64 -> SqlExpr (Key entity) valkey = val . toSqlKey -- | @valJ@ is like @val@ but for something that is already a @Value@. The use @@ -3584,8 +3582,8 @@ valkey = val . toSqlKey -- @since 1.4.2 valJ :: (PersistField (Key entity)) - => Value (Key entity) - -> SqlExpr (Value (Key entity)) + => (Key entity) + -> SqlExpr (Key entity) valJ = val . unValue diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 382cba3..289a39c 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -1,12 +1,13 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} -- | This is an internal module, anything exported by this module -- may change without a major version bump. Please use only @@ -17,7 +18,9 @@ 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(..) + , Value + , pattern Value + , unValue , ValueList(..) , SomeValue(..) , ToSomeValues(..) @@ -136,5 +139,5 @@ module Database.Esqueleto.Internal.Language , subSelectUnsafe ) where -import Database.Esqueleto.Internal.Internal -import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.Internal +import Database.Esqueleto.Internal.PersistentImport diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 8eb157b..d36c5c0 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -1,25 +1,25 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} @@ -62,37 +62,41 @@ module Common.Test , Key(..) ) where -import Control.Monad (forM_, replicateM, replicateM_, void) -import Control.Monad.Catch (MonadCatch) -import Control.Monad.Reader (ask) -import Data.Either -import Data.Time +import Control.Monad (forM_, replicateM, + replicateM_, void) +import Control.Monad.Catch (MonadCatch) +import Control.Monad.Reader (ask) +import Data.Either +import Data.Time #if __GLASGOW_HASKELL__ >= 806 -import Control.Monad.Fail (MonadFail) +import Control.Monad.Fail (MonadFail) #endif -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT) -import Control.Monad.Trans.Reader (ReaderT) -import qualified Data.Attoparsec.Text as AP -import Data.Char (toLower, toUpper) -import Data.Monoid ((<>)) -import Database.Esqueleto -import Database.Esqueleto.Experimental hiding (from, on) -import qualified Database.Esqueleto.Experimental as Experimental -import Database.Persist.TH -import Test.Hspec -import UnliftIO +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Logger (MonadLogger (..), + NoLoggingT, + runNoLoggingT) +import Control.Monad.Trans.Reader (ReaderT) +import qualified Data.Attoparsec.Text as AP +import Data.Char (toLower, toUpper) +import Data.Monoid ((<>)) +import Database.Esqueleto +import Database.Esqueleto.Experimental hiding (from, on) +import qualified Database.Esqueleto.Experimental as Experimental +import Database.Persist.TH +import Test.Hspec +import UnliftIO -import Data.Conduit (ConduitT, runConduit, (.|)) -import qualified Data.Conduit.List as CL -import qualified Data.List as L -import qualified Data.Set as S -import qualified Data.Text as Text -import qualified Data.Text.Internal.Lazy as TL -import qualified Data.Text.Lazy.Builder as TLB +import Data.Conduit (ConduitT, runConduit, + (.|)) +import qualified Data.Conduit.List as CL +import qualified Data.List as L +import qualified Data.Set as S +import qualified Data.Text as Text +import qualified Data.Text.Internal.Lazy as TL +import qualified Data.Text.Lazy.Builder as TLB import qualified Database.Esqueleto.Internal.ExprParser as P -import qualified Database.Esqueleto.Internal.Sql as EI -import qualified UnliftIO.Resource as R +import qualified Database.Esqueleto.Internal.Sql as EI +import qualified UnliftIO.Resource as R -- Test schema share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| @@ -497,16 +501,14 @@ testSelectSource run = do describe "selectSource" $ do it "works for a simple example" $ run $ do let query = selectSource $ - from $ \person -> - return person + Experimental.from $ Table @Person p1e <- insert' p1 ret <- runConduit $ query .| CL.consume liftIO $ ret `shouldBe` [ p1e ] it "can run a query many times" $ run $ do let query = selectSource $ - from $ \person -> - return person + Experimental.from $ Table @Person p1e <- insert' p1 ret0 <- runConduit $ query .| CL.consume ret1 <- runConduit $ query .| CL.consume @@ -535,17 +537,16 @@ testSelectFrom run = do describe "select/from" $ do it "works for a simple example" $ run $ do p1e <- insert' p1 - ret <- - select $ - from $ \person -> - return person + ret <- select $ Experimental.from $ Table @Person liftIO $ ret `shouldBe` [ p1e ] it "works for a simple self-join (one entity)" $ run $ do p1e <- insert' p1 ret <- - select $ - from $ \(person1, person2) -> + select $ do + person1 :& person2 <- + Experimental.from $ Table @Person + `crossJoin` Table @Person return (person1, person2) liftIO $ ret `shouldBe` [ (p1e, p1e) ] @@ -553,8 +554,10 @@ testSelectFrom run = do p1e <- insert' p1 p2e <- insert' p2 ret <- - select $ - from $ \(person1, person2) -> + select $ do + person1 :& person2 <- + Experimental.from $ Table @Person + `crossJoin` Table @Person return (person1, person2) liftIO $ ret @@ -669,7 +672,7 @@ testSelectFrom run = do number = 101 Right thePk = keyFromValues [toPersistValue number] fcPk <- insert fc - [Entity _ ret] <- select $ from return + [Entity _ ret] <- select $ Experimental.from $ Table @Frontcover liftIO $ do ret `shouldBe` fc fcPk `shouldBe` thePk diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index b1b3a10..249a828 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -1,53 +1,55 @@ {-# OPTIONS_GHC -fno-warn-unused-binds #-} -{-# LANGUAGE FlexibleContexts - , LambdaCase - , NamedFieldPuns - , OverloadedStrings - , RankNTypes - , ScopedTypeVariables - , TypeApplications - , TypeFamilies - , PartialTypeSignatures - #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Main (main) where -import Data.Coerce -import Data.Foldable -import qualified Data.Map.Strict as Map -import Data.Map (Map) -import Data.Time -import Control.Arrow ((&&&)) -import Control.Monad (void, when) -import Control.Monad.Catch (MonadCatch, catch) -import Control.Monad.IO.Class (MonadIO(liftIO)) -import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT) -import Control.Monad.Trans.Reader (ReaderT, ask) -import qualified Control.Monad.Trans.Resource as R -import Data.Aeson hiding (Value) -import qualified Data.Aeson as A (Value) -import Data.ByteString (ByteString) -import qualified Data.Char as Char -import qualified Data.List as L -import Data.Ord (comparing) -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime) -import Database.Esqueleto hiding (random_) -import Database.Esqueleto.Experimental hiding (random_, from, on) -import qualified Database.Esqueleto.Experimental as Experimental -import qualified Database.Esqueleto.Internal.Sql as ES -import Database.Esqueleto.PostgreSQL (random_) -import qualified Database.Esqueleto.PostgreSQL as EP -import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.)) +import Control.Arrow ((&&&)) +import Control.Monad (void, when) +import Control.Monad.Catch (MonadCatch, catch) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Logger (runNoLoggingT, + runStderrLoggingT) +import Control.Monad.Trans.Reader (ReaderT, ask) +import qualified Control.Monad.Trans.Resource as R +import Data.Aeson hiding (Value) +import qualified Data.Aeson as A (Value) +import Data.ByteString (ByteString) +import qualified Data.Char as Char +import Data.Coerce +import Data.Foldable +import qualified Data.List as L +import Data.Map (Map) +import qualified Data.Map.Strict as Map +import Data.Ord (comparing) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Data.Time +import Data.Time.Clock (UTCTime, diffUTCTime, + getCurrentTime) +import Database.Esqueleto hiding (random_) +import Database.Esqueleto.Experimental hiding (from, on, random_) +import qualified Database.Esqueleto.Experimental as Experimental +import qualified Database.Esqueleto.Internal.Sql as ES +import Database.Esqueleto.PostgreSQL (random_) +import qualified Database.Esqueleto.PostgreSQL as EP +import Database.Esqueleto.PostgreSQL.JSON hiding ((-.), (?.), (||.)) import qualified Database.Esqueleto.PostgreSQL.JSON as JSON -import Database.Persist.Postgresql (withPostgresqlConn) -import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..)) -import System.Environment -import Test.Hspec -import Test.Hspec.QuickCheck +import Database.Persist.Postgresql (withPostgresqlConn) +import Database.PostgreSQL.Simple (ExecStatus (..), + SqlError (..)) +import System.Environment +import Test.Hspec +import Test.Hspec.QuickCheck -import Common.Test -import PostgreSQL.MigrateJSON +import Common.Test +import PostgreSQL.MigrateJSON @@ -1076,7 +1078,7 @@ testInsertSelectWithConflict = from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum) ) (\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)]) - uniques2 <- select $ from $ \u -> return u + uniques2 <- select $ Experimental.from $ table @OneUnique liftIO $ n1 `shouldBe` 3 liftIO $ n2 `shouldBe` 3 let test = map (OneUnique "test" . personFavNum) [p1,p2,p3] @@ -1226,7 +1228,7 @@ testLateralQuery = do select $ do l :& c <- Experimental.from $ Table @Lord - `CrossJoin` \lord -> do + `crossJoinLateral` \lord -> do deed <- Experimental.from $ Table @Deed where_ $ lord ^. LordId ==. deed ^. DeedOwnerId pure $ countRows @Int @@ -1241,7 +1243,7 @@ testLateralQuery = do pure $ countRows @Int res <- select $ do l :& c <- Experimental.from $ Table @Lord - `InnerJoin` subquery + `innerJoinLateral` subquery `Experimental.on` (const $ val True) pure (l, c) @@ -1252,9 +1254,9 @@ testLateralQuery = do it "supports LEFT JOIN LATERAL" $ do run $ do res <- select $ do - l :& c <- Experimental.from $ Table @Lord - `LeftOuterJoin` (\lord -> do - deed <- Experimental.from $ Table @Deed + l :& c <- Experimental.from $ table @Lord + `leftJoinLateral` (\lord -> do + deed <- Experimental.from $ table @Deed where_ $ lord ^. LordId ==. deed ^. DeedOwnerId pure $ countRows @Int) `Experimental.on` (const $ val True) @@ -1295,7 +1297,7 @@ testLateralQuery = do type JSONValue = Maybe (JSONB A.Value) -createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO () +createSaneSQL :: (ES.SqlSelect (SqlExpr a) a, PersistField a) => SqlExpr a -> T.Text -> [PersistValue] -> IO () createSaneSQL act q vals = run $ do (query, args) <- showQuery ES.SELECT $ fromValue act liftIO $ query `shouldBe` q