Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix build under GHC 8.4 #84

Merged
merged 1 commit into from
Apr 2, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
55 changes: 35 additions & 20 deletions src/Database/Esqueleto/Internal/Sql.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@
, ScopedTypeVariables
, InstanceSigs
, Rank2Types
, CPP
#-}
-- | This is an internal module, anything exported by this module
-- may change without a major version bump. Please use only
Expand Down Expand Up @@ -65,7 +66,10 @@ import Control.Monad.Trans.Resource (MonadResource, release)
import Data.Acquire (with, allocateAcquire, Acquire)
import Data.Int (Int64)
import Data.List (intersperse)
import Data.Monoid (Last(..), (<>))
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import qualified Data.Monoid as Monoid
import Data.Proxy (Proxy(..))
import Database.Esqueleto.Internal.PersistentImport
import Database.Persist.Sql.Util (entityColumnNames, entityColumnCount, parseEntityValues, isIdField, hasCompositeKey)
Expand Down Expand Up @@ -157,25 +161,29 @@ data SideData = SideData { sdDistinctClause :: !DistinctClause
, sdLockingClause :: !LockingClause
}

instance Monoid SideData where
mempty = SideData mempty mempty mempty mempty mempty mempty mempty mempty mempty
SideData d f s w g h o l k `mappend` SideData d' f' s' w' g' h' o' l' k' =
instance Semigroup SideData where
SideData d f s w g h o l k <> SideData d' f' s' w' g' h' o' l' k' =
SideData (d <> d') (f <> f') (s <> s') (w <> w') (g <> g') (h <> h') (o <> o') (l <> l') (k <> k')

instance Monoid SideData where
mempty = SideData mempty mempty mempty mempty mempty mempty mempty mempty mempty
mappend = (<>)

-- | The @DISTINCT@ "clause".
data DistinctClause =
DistinctAll -- ^ The default, everything.
| DistinctStandard -- ^ Only @DISTINCT@, SQL standard.
| DistinctOn [SqlExpr DistinctOn] -- ^ @DISTINCT ON@, PostgreSQL extension.

instance Semigroup DistinctClause where
DistinctOn a <> DistinctOn b = DistinctOn (a <> b)
DistinctOn a <> _ = DistinctOn a
DistinctStandard <> _ = DistinctStandard
DistinctAll <> b = b

instance Monoid DistinctClause where
mempty = DistinctAll
DistinctOn a `mappend` DistinctOn b = DistinctOn (a <> b)
DistinctOn a `mappend` _ = DistinctOn a
DistinctStandard `mappend` _ = DistinctStandard
DistinctAll `mappend` b = b

mappend = (<>)

-- | A part of a @FROM@ clause.
data FromClause =
Expand Down Expand Up @@ -222,19 +230,24 @@ collectOnClauses = go []
data WhereClause = Where (SqlExpr (Value Bool))
| NoWhere

instance Semigroup WhereClause where
NoWhere <> w = w
w <> NoWhere = w
Where e1 <> Where e2 = Where (e1 &&. e2)

instance Monoid WhereClause where
mempty = NoWhere
NoWhere `mappend` w = w
w `mappend` NoWhere = w
Where e1 `mappend` Where e2 = Where (e1 &&. e2)

mappend = (<>)

-- | A @GROUP BY@ clause.
newtype GroupByClause = GroupBy [SomeValue SqlExpr]

instance Semigroup GroupByClause where
GroupBy fs <> GroupBy fs' = GroupBy (fs <> fs')

instance Monoid GroupByClause where
mempty = GroupBy []
GroupBy fs `mappend` GroupBy fs' = GroupBy (fs <> fs')
mappend = (<>)

-- | A @HAVING@ cause.
type HavingClause = WhereClause
Expand All @@ -246,17 +259,19 @@ type OrderByClause = SqlExpr OrderBy
-- | A @LIMIT@ clause.
data LimitClause = Limit (Maybe Int64) (Maybe Int64)

instance Monoid LimitClause where
mempty = Limit mzero mzero
Limit l1 o1 `mappend` Limit l2 o2 =
instance Semigroup LimitClause where
Limit l1 o1 <> Limit l2 o2 =
Limit (l2 `mplus` l1) (o2 `mplus` o1)
-- More than one 'limit' or 'offset' is issued, we want to
-- keep the latest one. That's why we use mplus with
-- "reversed" arguments.

instance Monoid LimitClause where
mempty = Limit mzero mzero
mappend = (<>)

-- | A locking clause.
type LockingClause = Last LockingKind
type LockingClause = Monoid.Last LockingKind


----------------------------------------------------------------------
Expand Down Expand Up @@ -439,7 +454,7 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where

having expr = Q $ W.tell mempty { sdHavingClause = Where expr }

locking kind = Q $ W.tell mempty { sdLockingClause = Last (Just kind) }
locking kind = Q $ W.tell mempty { sdLockingClause = Monoid.Last (Just kind) }

orderBy exprs = Q $ W.tell mempty { sdOrderByClause = exprs }
asc = EOrderBy ASC
Expand Down Expand Up @@ -1185,7 +1200,7 @@ makeLimit (conn, _) (Limit ml mo) orderByClauses =


makeLocking :: LockingClause -> (TLB.Builder, [PersistValue])
makeLocking = flip (,) [] . maybe mempty toTLB . getLast
makeLocking = flip (,) [] . maybe mempty toTLB . Monoid.getLast
where
toTLB ForUpdate = "\nFOR UPDATE"
toTLB ForShare = "\nFOR SHARE"
Expand Down
6 changes: 4 additions & 2 deletions src/Database/Esqueleto/PostgreSQL.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings
, GADTs
, GADTs, CPP
#-}
-- | This module contain PostgreSQL-specific functions.
--
Expand All @@ -22,7 +22,9 @@ module Database.Esqueleto.PostgreSQL
, unsafeSqlAggregateFunction
) where

import Data.Monoid
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import qualified Data.Text.Internal.Builder as TLB
import Data.Time.Clock (UTCTime)
import Database.Esqueleto.Internal.Language hiding (random_)
Expand Down
9 changes: 9 additions & 0 deletions stack-8.4.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
resolver: nightly-2018-04-01

packages:
- '.'

extra-deps:
- persistent-postgresql-2.8.2.0
- postgresql-simple-0.5.3.0
allow-newer: true