major formatting stuff

src/Database/Esqueleto/Experimental.hs

@@ -1,16 +1,15 @@
-{-# LANGUAGE CPP
+{-# LANGUAGE CPP #-}
-           , DataKinds
+{-# LANGUAGE DataKinds #-}
-           , FlexibleContexts
+{-# LANGUAGE FlexibleContexts #-}
-           , FlexibleInstances
+{-# LANGUAGE FlexibleInstances #-}
-           , FunctionalDependencies
+{-# LANGUAGE FunctionalDependencies #-}
-           , GADTs
+{-# LANGUAGE GADTs #-}
-           , MultiParamTypeClasses
+{-# LANGUAGE MultiParamTypeClasses #-}
-           , TypeOperators
+{-# LANGUAGE OverloadedStrings #-}
-           , TypeFamilies
+{-# LANGUAGE PatternSynonyms #-}
-           , UndecidableInstances
+{-# LANGUAGE TypeFamilies #-}
-           , OverloadedStrings
+{-# LANGUAGE TypeOperators #-}
-           , PatternSynonyms
+{-# 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
+    , where_
-             , sub_select, (^.), (?.)
+    , groupBy
-             , val, isNothing, just, nothing, joinV, withNonNull
+    , orderBy
-             , countRows, count, countDistinct
+    , rand
-             , not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
+    , asc
-             , between, (+.), (-.), (/.), (*.)
+    , desc
-             , random_, round_, ceiling_, floor_
+    , limit
-             , min_, max_, sum_, avg_, castNum, castNumM
+    , offset
-             , coalesce, coalesceDefault
+
-             , lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_
+    , distinct
-             , like, ilike, (%), concat_, (++.), castString
+    , distinctOn
-             , subList_select, valList, justList
+    , don
-             , in_, notIn, exists, notExists
+    , distinctOnOrderBy
-             , set, (=.), (+=.), (-=.), (*=.), (/=.)
+    , having
-             , case_, toBaseId
+    , 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 =
+data SqlSetOperation a
-    SqlSetUnion (SqlSetOperation a) (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/ - \
+{-# DEPRECATED Union "/Since: 3.4.0.0/ - Use the 'union_' function instead of the 'Union' data constructor" #-}
-    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/ - \
+{-# DEPRECATED UnionAll "/Since: 3.4.0.0/ - Use the 'unionAll_' function instead of the 'UnionAll' data constructor" #-}
-    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/ - \
+{-# DEPRECATED Except "/Since: 3.4.0.0/ - Use the 'except_' function instead of the 'Except' data constructor" #-}
-    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/ - \
+{-# DEPRECATED Intersect "/Since: 3.4.0.0/ - Use the 'intersect_' function instead of the 'Intersect' data constructor" #-}
-    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/ - \
+{-# DEPRECATED SelectQuery "/Since: 3.4.0.0/ - It is no longer necessary to tag 'SqlQuery' values with @SelectQuery@" #-}
-    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')
+instance
-        => ToInnerJoin NotLateral a b (a' :& b') where
+    (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'
+instance
-         ) => ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool))) where
+    ( ToLeftJoin (IsLateral b) a b b'
+    )
+  =>
+    ToFrom (LeftOuterJoin a (b, b' -> SqlExpr (Value Bool)))
+  where
     toFrom (LeftOuterJoin lhs (rhs, on')) =
-           let
+        let toProxy :: b -> Proxy (IsLateral b)
-            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
+              let (q1, v1) = operationToSql o1 info
-                    (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"

src/Database/Esqueleto/Internal/Language.hs

@@ -1,17 +1,20 @@
-{-# LANGUAGE DeriveDataTypeable
+{-# LANGUAGE DeriveDataTypeable #-}
-           , EmptyDataDecls
+{-# LANGUAGE EmptyDataDecls #-}
-           , FlexibleContexts
+{-# LANGUAGE FlexibleContexts #-}
-           , FlexibleInstances
+{-# LANGUAGE FlexibleInstances #-}
-           , FunctionalDependencies
+{-# LANGUAGE FunctionalDependencies #-}
-           , MultiParamTypeClasses
+{-# LANGUAGE GADTs #-}
-           , TypeFamilies
+{-# LANGUAGE MultiParamTypeClasses #-}
-           , UndecidableInstances
+{-# LANGUAGE TypeFamilies #-}
-           , GADTs
+{-# 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
+    , where_
-             , distinct, distinctOn, don, distinctOnOrderBy, having, locking
+    , on
-             , sub_select, (^.), (?.)
+    , groupBy
-             , val, isNothing, just, nothing, joinV, withNonNull
+    , orderBy
-             , countRows, count, countDistinct
+    , rand
-             , not_, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)
+    , asc
-             , between, (+.), (-.), (/.), (*.)
+    , desc
-             , random_, round_, ceiling_, floor_
+    , limit
-             , min_, max_, sum_, avg_, castNum, castNumM
+    , offset
-             , coalesce, coalesceDefault
+    , distinct
-             , lower_, upper_, trim_, ltrim_, rtrim_, length_, left_, right_
+    , distinctOn
-             , like, ilike, (%), concat_, (++.), castString
+    , don
-             , subList_select, valList, justList
+    , distinctOnOrderBy
-             , in_, notIn, exists, notExists
+    , having
-             , set, (=.), (+=.), (-=.), (*=.), (/=.)
+    , locking
-             , case_, toBaseId, (<#), (<&>)
+    , 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

src/Database/Esqueleto/Internal/PersistentImport.hs

@@ -142,9 +142,36 @@ module Database.Esqueleto.Internal.PersistentImport
     ) where
 
 import Database.Persist.Sql hiding
-  ( BackendSpecificFilter, Filter(..), PersistQuery, SelectOpt(..)
+       ( BackendSpecificFilter
-  , Update(..), delete, deleteWhereCount, updateWhereCount, selectList
+       , Filter(..)
-  , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.)
+       , PersistQuery
-  , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.)
+       , SelectOpt(..)
-  , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource
+       , Update(..)
-  , update , count )
+       , count
+       , delete
+       , deleteCascadeWhere
+       , deleteWhereCount
+       , getPersistMap
+       , limitOffsetOrder
+       , listToJSON
+       , mapToJSON
+       , selectKeysList
+       , selectList
+       , selectSource
+       , update
+       , updateWhereCount
+       , (!=.)
+       , (*=.)
+       , (+=.)
+       , (-=.)
+       , (/<-.)
+       , (/=.)
+       , (<-.)
+       , (<.)
+       , (<=.)
+       , (=.)
+       , (==.)
+       , (>.)
+       , (>=.)
+       , (||.)
+       )

src/Database/Esqueleto/Internal/Sql.hs

@@ -1,31 +1,27 @@
-{-# LANGUAGE DeriveDataTypeable
+{-# LANGUAGE CPP #-}
-           , EmptyDataDecls
+{-# LANGUAGE ConstraintKinds #-}
-           , FlexibleContexts
+{-# LANGUAGE DeriveDataTypeable #-}
-           , FlexibleInstances
+{-# LANGUAGE EmptyDataDecls #-}
-           , FunctionalDependencies
+{-# LANGUAGE FlexibleContexts #-}
-           , MultiParamTypeClasses
+{-# LANGUAGE FlexibleInstances #-}
-           , TypeFamilies
+{-# LANGUAGE FunctionalDependencies #-}
-           , UndecidableInstances
+{-# LANGUAGE GADTs #-}
-           , GADTs
+{-# LANGUAGE InstanceSigs #-}
- #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ConstraintKinds
+{-# LANGUAGE OverloadedStrings #-}
-           , EmptyDataDecls
+{-# LANGUAGE Rank2Types #-}
-           , FlexibleContexts
+{-# LANGUAGE ScopedTypeVariables #-}
-           , FlexibleInstances
+{-# LANGUAGE TypeFamilies #-}
-           , FunctionalDependencies
+{-# LANGUAGE UndecidableInstances #-}
-           , GADTs
+
-           , MultiParamTypeClasses
+
-           , OverloadedStrings
-           , UndecidableInstances
-           , ScopedTypeVariables
-           , InstanceSigs
-           , Rank2Types
-           , CPP
- #-}
 -- | 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(..)

src/Database/Esqueleto/MySQL.hs

@@ -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

src/Database/Esqueleto/PostgreSQL.hs

@@ -1,11 +1,13 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings
+{-# LANGUAGE GADTs #-}
-           , GADTs, CPP, Rank2Types
+{-# LANGUAGE OverloadedStrings #-}
-           , ScopedTypeVariables
+{-# 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 qualified Data.Text.Internal.Builder                   as TLB
+import Control.Arrow (first, (***))
-import           Data.Time.Clock                              (UTCTime)
-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
+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.Persist.Class (OnlyOneUniqueKey)
 
 -- | (@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 ::
+unsafeSqlAggregateFunction
-     UnsafeSqlFunctionArgument a
+    :: UnsafeSqlFunctionArgument a
     => TLB.Builder
     -> AggMode
     -> a
     -> [OrderByClause]
     -> SqlExpr (Value b)
-unsafeSqlAggregateFunction name mode args orderByClauses =
+unsafeSqlAggregateFunction name mode args orderByClauses = ERaw Never $ \info ->
-  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
+        aggMode =
-                    AggModeAll -> "" -- ALL is the default, so we don't need to
+            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 ::
+arrayAggWith
-     AggMode
+    :: 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/
+-- @since 2.5.3
-arrayAggDistinct ::
+arrayAggDistinct
-     (PersistField a, PersistField [a])
+    :: (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,
+upsert
-      PersistEntity record,
+    ::
-      OnlyOneUniqueKey record,
+    ( MonadIO m
-      PersistRecordBackend record SqlBackend,
+    , PersistEntity record
-      IsPersistBackend (PersistEntityBackend 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,
+upsertBy
-    PersistEntity record,
+    ::
-    IsPersistBackend (PersistEntityBackend record))
+    (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. (
+insertSelectWithConflict
-    FinalResult a,
+    :: forall a m val
-    KnowResult a ~ (Unique val),
+     . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
-    MonadIO m,
+    => a
-    PersistEntity val) =>
+    -- ^ Unique constructor or a unique, this is used just to get the name of
-  a
+    -- the postgres constraint, the value(s) is(are) never used, so if you have
-  -- ^ 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.
+    -- 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. (
+insertSelectWithConflictCount
-    FinalResult a,
+    :: forall a val m
-    KnowResult a ~ (Unique val),
+     . (FinalResult a, KnowResult a ~ Unique val, MonadIO m, PersistEntity val)
-    MonadIO m,
+    => a
-    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 "

src/Database/Esqueleto/PostgreSQL/JSON.hs

@@ -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,

src/Database/Esqueleto/PostgreSQL/JSON/Instances.hs

@@ -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)