haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Modify SqlSelect to remove the backwards FunDep. Remove the need for the Value newtype

Browse Source
This commit is contained in:
belevy 2021-02-13 19:47:15 -06:00
parent 096c1acfd6
commit 8aff51b4d8
9 changed files with 371 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Database/Esqueleto.hs
View File

@ -1,7 +1,8 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
-- | The @esqueleto@ EDSL (embedded domain specific language). -- | The @esqueleto@ EDSL (embedded domain specific language).
-- This module replaces @Database.Persist@, so instead of -- This module replaces @Database.Persist@, so instead of
-- importing that module you should just import this one: -- importing that module you should just import this one:
@ -74,6 +75,8 @@ module Database.Esqueleto
, else_ , else_
, from , from
, Value(..) , Value(..)
, pattern Value
, unValue
, ValueList(..) , ValueList(..)
, OrderBy , OrderBy
, DistinctOn , DistinctOn
@ -123,13 +126,13 @@ module Database.Esqueleto
, module Database.Esqueleto.Internal.PersistentImport , module Database.Esqueleto.Internal.PersistentImport
) where ) where
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader (ReaderT)
import Data.Int (Int64) import Data.Int (Int64)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Database.Esqueleto.Internal.Language import Database.Esqueleto.Internal.Language
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.PersistentImport
import Database.Esqueleto.Internal.Sql import Database.Esqueleto.Internal.Sql
import qualified Database.Persist import qualified Database.Persist

22
src/Database/Esqueleto/Experimental.hs
View File

@ -170,6 +170,7 @@ module Database.Esqueleto.Experimental
, then_ , then_
, else_ , else_
, Value(..) , Value(..)
, pattern Value
, ValueList(..) , ValueList(..)
, OrderBy , OrderBy
, DistinctOn , DistinctOn
@ -218,16 +219,19 @@ module Database.Esqueleto.Experimental
, module Database.Esqueleto.Internal.PersistentImport , module Database.Esqueleto.Internal.PersistentImport
) where ) where
import Database.Esqueleto.Internal.Internal hiding (From, from, on) import Database.Esqueleto.Internal.Internal hiding
import Database.Esqueleto.Internal.PersistentImport (From,
from,
on)
import Database.Esqueleto.Internal.PersistentImport
import Database.Esqueleto.Experimental.From import Database.Esqueleto.Experimental.From
import Database.Esqueleto.Experimental.From.CommonTableExpression import Database.Esqueleto.Experimental.From.CommonTableExpression
import Database.Esqueleto.Experimental.From.Join import Database.Esqueleto.Experimental.From.Join
import Database.Esqueleto.Experimental.From.SqlSetOperation import Database.Esqueleto.Experimental.From.SqlSetOperation
import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAlias
import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToAliasReference
import Database.Esqueleto.Experimental.ToMaybe import Database.Esqueleto.Experimental.ToMaybe
-- $setup -- $setup
-- --

9
src/Database/Esqueleto/Experimental/ToAlias.hs
View File

@ -1,12 +1,13 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Database.Esqueleto.Experimental.ToAlias module Database.Esqueleto.Experimental.ToAlias
where where
import Database.Esqueleto.Internal.Internal hiding (From, from, on) import Database.Esqueleto.Internal.Internal hiding (From,
import Database.Esqueleto.Internal.PersistentImport 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." #-} {-# DEPRECATED ToAliasT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
type ToAliasT a = a type ToAliasT a = a
@ -15,7 +16,7 @@ type ToAliasT a = a
class ToAlias a where class ToAlias a where
toAlias :: a -> SqlQuery a toAlias :: a -> SqlQuery a
instance ToAlias (SqlExpr (Value a)) where instance {-# OVERLAPPABLE #-} ToAlias (SqlExpr a) where
toAlias e@(ERaw m f) toAlias e@(ERaw m f)
| Just _ <- sqlExprMetaAlias m, not (sqlExprMetaIsReference m) = pure e | Just _ <- sqlExprMetaAlias m, not (sqlExprMetaIsReference m) = pure e
| otherwise = do | otherwise = do

11
src/Database/Esqueleto/Experimental/ToAliasReference.hs
View File

@ -1,13 +1,14 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Database.Esqueleto.Experimental.ToAliasReference module Database.Esqueleto.Experimental.ToAliasReference
where where
import Data.Coerce import Data.Coerce
import Database.Esqueleto.Internal.Internal hiding (From, from, on) import Database.Esqueleto.Internal.Internal hiding (From,
import Database.Esqueleto.Internal.PersistentImport 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." #-} {-# DEPRECATED ToAliasReferenceT "This type alias doesn't do anything. Please delete it. Will be removed in the next release." #-}
type ToAliasReferenceT a = a type ToAliasReferenceT a = a
@ -16,7 +17,7 @@ type ToAliasReferenceT a = a
class ToAliasReference a where class ToAliasReference a where
toAliasReference :: Ident -> a -> SqlQuery a toAliasReference :: Ident -> a -> SqlQuery a
instance ToAliasReference (SqlExpr (Value a)) where instance {-# OVERLAPPABLE #-} ToAliasReference (SqlExpr a) where
toAliasReference aliasSource (ERaw m _) toAliasReference aliasSource (ERaw m _)
| Just alias <- sqlExprMetaAlias m = pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info -> | Just alias <- sqlExprMetaAlias m = pure $ ERaw m{sqlExprMetaIsReference = True} $ \_ info ->
(useIdent info aliasSource <> "." <> useIdent info alias, []) (useIdent info aliasSource <> "." <> useIdent info alias, [])

21
src/Database/Esqueleto/Experimental/ToMaybe.hs
View File

@ -1,11 +1,12 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
module Database.Esqueleto.Experimental.ToMaybe module Database.Esqueleto.Experimental.ToMaybe
where where
import Database.Esqueleto.Internal.Internal hiding (From(..), from, on) import Database.Esqueleto.Internal.Internal hiding (From (..),
import Database.Esqueleto.Internal.PersistentImport (Entity(..)) from, on)
import Database.Esqueleto.Internal.PersistentImport (Entity (..))
type family Nullable a where type family Nullable a where
Nullable (Maybe a) = a Nullable (Maybe a) = a
@ -15,18 +16,10 @@ class ToMaybe a where
type ToMaybeT a type ToMaybeT a
toMaybe :: a -> 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 instance (ToMaybe a, ToMaybe b) => ToMaybe (a,b) where
type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b) type ToMaybeT (a, b) = (ToMaybeT a, ToMaybeT b)

392
src/Database/Esqueleto/Internal/Internal.hs
View File

File diff suppressed because it is too large Load Diff

25
src/Database/Esqueleto/Internal/Language.hs
View File

@ -1,12 +1,13 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- | This is an internal module, anything exported by this module -- | This is an internal module, anything exported by this module
-- may change without a major version bump. Please use only -- 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 " #-} {-# DEPRECATED "Use Database.Esqueleto.Internal.Internal instead. This module will be removed in 3.5.0.0 " #-}
( -- * The pretty face ( -- * The pretty face
from from
, Value(..) , Value
, pattern Value
, unValue
, ValueList(..) , ValueList(..)
, SomeValue(..) , SomeValue(..)
, ToSomeValues(..) , ToSomeValues(..)
@ -136,5 +139,5 @@ module Database.Esqueleto.Internal.Language
, subSelectUnsafe , subSelectUnsafe
) where ) where
import Database.Esqueleto.Internal.Internal import Database.Esqueleto.Internal.Internal
import Database.Esqueleto.Internal.PersistentImport import Database.Esqueleto.Internal.PersistentImport

125
test/Common/Test.hs
View File

@ -1,25 +1,25 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
@ -62,37 +62,41 @@ module Common.Test
, Key(..) , Key(..)
) where ) where
import Control.Monad (forM_, replicateM, replicateM_, void) import Control.Monad (forM_, replicateM,
import Control.Monad.Catch (MonadCatch) replicateM_, void)
import Control.Monad.Reader (ask) import Control.Monad.Catch (MonadCatch)
import Data.Either import Control.Monad.Reader (ask)
import Data.Time import Data.Either
import Data.Time
#if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ >= 806
import Control.Monad.Fail (MonadFail) import Control.Monad.Fail (MonadFail)
#endif #endif
import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT) import Control.Monad.Logger (MonadLogger (..),
import Control.Monad.Trans.Reader (ReaderT) NoLoggingT,
import qualified Data.Attoparsec.Text as AP runNoLoggingT)
import Data.Char (toLower, toUpper) import Control.Monad.Trans.Reader (ReaderT)
import Data.Monoid ((<>)) import qualified Data.Attoparsec.Text as AP
import Database.Esqueleto import Data.Char (toLower, toUpper)
import Database.Esqueleto.Experimental hiding (from, on) import Data.Monoid ((<>))
import qualified Database.Esqueleto.Experimental as Experimental import Database.Esqueleto
import Database.Persist.TH import Database.Esqueleto.Experimental hiding (from, on)
import Test.Hspec import qualified Database.Esqueleto.Experimental as Experimental
import UnliftIO import Database.Persist.TH
import Test.Hspec
import UnliftIO
import Data.Conduit (ConduitT, runConduit, (.|)) import Data.Conduit (ConduitT, runConduit,
import qualified Data.Conduit.List as CL (.|))
import qualified Data.List as L import qualified Data.Conduit.List as CL
import qualified Data.Set as S import qualified Data.List as L
import qualified Data.Text as Text import qualified Data.Set as S
import qualified Data.Text.Internal.Lazy as TL import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as TLB 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.ExprParser as P
import qualified Database.Esqueleto.Internal.Sql as EI import qualified Database.Esqueleto.Internal.Sql as EI
import qualified UnliftIO.Resource as R import qualified UnliftIO.Resource as R
-- Test schema -- Test schema
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
@ -497,16 +501,14 @@ testSelectSource run = do
describe "selectSource" $ do describe "selectSource" $ do
it "works for a simple example" $ run $ do it "works for a simple example" $ run $ do
let query = selectSource $ let query = selectSource $
from $ \person -> Experimental.from $ Table @Person
return person
p1e <- insert' p1 p1e <- insert' p1
ret <- runConduit $ query .| CL.consume ret <- runConduit $ query .| CL.consume
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "can run a query many times" $ run $ do it "can run a query many times" $ run $ do
let query = selectSource $ let query = selectSource $
from $ \person -> Experimental.from $ Table @Person
return person
p1e <- insert' p1 p1e <- insert' p1
ret0 <- runConduit $ query .| CL.consume ret0 <- runConduit $ query .| CL.consume
ret1 <- runConduit $ query .| CL.consume ret1 <- runConduit $ query .| CL.consume
@ -535,17 +537,16 @@ testSelectFrom run = do
describe "select/from" $ do describe "select/from" $ do
it "works for a simple example" $ run $ do it "works for a simple example" $ run $ do
p1e <- insert' p1 p1e <- insert' p1
ret <- ret <- select $ Experimental.from $ Table @Person
select $
from $ \person ->
return person
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "works for a simple self-join (one entity)" $ run $ do it "works for a simple self-join (one entity)" $ run $ do
p1e <- insert' p1 p1e <- insert' p1
ret <- ret <-
select $ select $ do
from $ \(person1, person2) -> person1 :& person2 <-
Experimental.from $ Table @Person
`crossJoin` Table @Person
return (person1, person2) return (person1, person2)
liftIO $ ret `shouldBe` [ (p1e, p1e) ] liftIO $ ret `shouldBe` [ (p1e, p1e) ]
@ -553,8 +554,10 @@ testSelectFrom run = do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
ret <- ret <-
select $ select $ do
from $ \(person1, person2) -> person1 :& person2 <-
Experimental.from $ Table @Person
`crossJoin` Table @Person
return (person1, person2) return (person1, person2)
liftIO $ liftIO $
ret ret
@ -669,7 +672,7 @@ testSelectFrom run = do
number = 101 number = 101
Right thePk = keyFromValues [toPersistValue number] Right thePk = keyFromValues [toPersistValue number]
fcPk <- insert fc fcPk <- insert fc
[Entity _ ret] <- select $ from return [Entity _ ret] <- select $ Experimental.from $ Table @Frontcover
liftIO $ do liftIO $ do
ret `shouldBe` fc ret `shouldBe` fc
fcPk `shouldBe` thePk fcPk `shouldBe` thePk

106
test/PostgreSQL/Test.hs
View File

@ -1,53 +1,55 @@
{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# LANGUAGE FlexibleContexts {-# LANGUAGE FlexibleContexts #-}
, LambdaCase {-# LANGUAGE LambdaCase #-}
, NamedFieldPuns {-# LANGUAGE NamedFieldPuns #-}
, OverloadedStrings {-# LANGUAGE OverloadedStrings #-}
, RankNTypes {-# LANGUAGE PartialTypeSignatures #-}
, ScopedTypeVariables {-# LANGUAGE RankNTypes #-}
, TypeApplications {-# LANGUAGE ScopedTypeVariables #-}
, TypeFamilies {-# LANGUAGE TypeApplications #-}
, PartialTypeSignatures {-# LANGUAGE TypeFamilies #-}
#-}
module Main (main) where module Main (main) where
import Data.Coerce import Control.Arrow ((&&&))
import Data.Foldable import Control.Monad (void, when)
import qualified Data.Map.Strict as Map import Control.Monad.Catch (MonadCatch, catch)
import Data.Map (Map) import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Time import Control.Monad.Logger (runNoLoggingT,
import Control.Arrow ((&&&)) runStderrLoggingT)
import Control.Monad (void, when) import Control.Monad.Trans.Reader (ReaderT, ask)
import Control.Monad.Catch (MonadCatch, catch) import qualified Control.Monad.Trans.Resource as R
import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.Aeson hiding (Value)
import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT) import qualified Data.Aeson as A (Value)
import Control.Monad.Trans.Reader (ReaderT, ask) import Data.ByteString (ByteString)
import qualified Control.Monad.Trans.Resource as R import qualified Data.Char as Char
import Data.Aeson hiding (Value) import Data.Coerce
import qualified Data.Aeson as A (Value) import Data.Foldable
import Data.ByteString (ByteString) import qualified Data.List as L
import qualified Data.Char as Char import Data.Map (Map)
import qualified Data.List as L import qualified Data.Map.Strict as Map
import Data.Ord (comparing) import Data.Ord (comparing)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding as TE
import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime) import Data.Time
import Database.Esqueleto hiding (random_) import Data.Time.Clock (UTCTime, diffUTCTime,
import Database.Esqueleto.Experimental hiding (random_, from, on) getCurrentTime)
import qualified Database.Esqueleto.Experimental as Experimental import Database.Esqueleto hiding (random_)
import qualified Database.Esqueleto.Internal.Sql as ES import Database.Esqueleto.Experimental hiding (from, on, random_)
import Database.Esqueleto.PostgreSQL (random_) import qualified Database.Esqueleto.Experimental as Experimental
import qualified Database.Esqueleto.PostgreSQL as EP import qualified Database.Esqueleto.Internal.Sql as ES
import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.)) 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 qualified Database.Esqueleto.PostgreSQL.JSON as JSON
import Database.Persist.Postgresql (withPostgresqlConn) import Database.Persist.Postgresql (withPostgresqlConn)
import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..)) import Database.PostgreSQL.Simple (ExecStatus (..),
import System.Environment SqlError (..))
import Test.Hspec import System.Environment
import Test.Hspec.QuickCheck import Test.Hspec
import Test.Hspec.QuickCheck
import Common.Test import Common.Test
import PostgreSQL.MigrateJSON import PostgreSQL.MigrateJSON
@ -1076,7 +1078,7 @@ testInsertSelectWithConflict =
from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum) from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
) )
(\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)]) (\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 $ n1 `shouldBe` 3
liftIO $ n2 `shouldBe` 3 liftIO $ n2 `shouldBe` 3
let test = map (OneUnique "test" . personFavNum) [p1,p2,p3] let test = map (OneUnique "test" . personFavNum) [p1,p2,p3]
@ -1226,7 +1228,7 @@ testLateralQuery = do
select $ do select $ do
l :& c <- l :& c <-
Experimental.from $ Table @Lord Experimental.from $ Table @Lord
`CrossJoin` \lord -> do `crossJoinLateral` \lord -> do
deed <- Experimental.from $ Table @Deed deed <- Experimental.from $ Table @Deed
where_ $ lord ^. LordId ==. deed ^. DeedOwnerId where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
pure $ countRows @Int pure $ countRows @Int
@ -1241,7 +1243,7 @@ testLateralQuery = do
pure $ countRows @Int pure $ countRows @Int
res <- select $ do res <- select $ do
l :& c <- Experimental.from $ Table @Lord l :& c <- Experimental.from $ Table @Lord
`InnerJoin` subquery `innerJoinLateral` subquery
`Experimental.on` (const $ val True) `Experimental.on` (const $ val True)
pure (l, c) pure (l, c)
@ -1252,9 +1254,9 @@ testLateralQuery = do
it "supports LEFT JOIN LATERAL" $ do it "supports LEFT JOIN LATERAL" $ do
run $ do run $ do
res <- select $ do res <- select $ do
l :& c <- Experimental.from $ Table @Lord l :& c <- Experimental.from $ table @Lord
`LeftOuterJoin` (\lord -> do `leftJoinLateral` (\lord -> do
deed <- Experimental.from $ Table @Deed deed <- Experimental.from $ table @Deed
where_ $ lord ^. LordId ==. deed ^. DeedOwnerId where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
pure $ countRows @Int) pure $ countRows @Int)
`Experimental.on` (const $ val True) `Experimental.on` (const $ val True)
@ -1295,7 +1297,7 @@ testLateralQuery = do
type JSONValue = Maybe (JSONB A.Value) 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 createSaneSQL act q vals = run $ do
(query, args) <- showQuery ES.SELECT $ fromValue act (query, args) <- showQuery ES.SELECT $ fromValue act
liftIO $ query `shouldBe` q liftIO $ query `shouldBe` q