Modify SqlSelect to remove the backwards FunDep. Remove the need for the Value newtype
This commit is contained in:
belevy
parent
096c1acfd6
commit
8aff51b4d8
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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, [])
|
||||
|
||||
@ -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)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user