diff --git a/esqueleto.cabal b/esqueleto.cabal index 1eaf420..7c07394 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -30,6 +30,7 @@ library exposed-modules: Database.Esqueleto Database.Esqueleto.Experimental + Database.Esqueleto.Experimental.Aggregates Database.Esqueleto.Internal.Language Database.Esqueleto.Internal.Sql Database.Esqueleto.Internal.Internal diff --git a/src/Database/Esqueleto/Experimental.hs b/src/Database/Esqueleto/Experimental.hs index 3dc8b44..a96d1d5 100644 --- a/src/Database/Esqueleto/Experimental.hs +++ b/src/Database/Esqueleto/Experimental.hs @@ -53,6 +53,8 @@ module Database.Esqueleto.Experimental , with , withRecursive + , agg + -- ** Internals , From(..) , ToMaybe(..) @@ -219,9 +221,13 @@ module Database.Esqueleto.Experimental , module Database.Esqueleto.Internal.PersistentImport ) where -import Database.Esqueleto.Internal.Internal hiding (From, from, on) +import Data.Coerce +import Database.Esqueleto.Internal.Internal hiding + (From, from, groupBy, on, sum_, (?.), (^.)) +import qualified Database.Esqueleto.Internal.Internal as I ((?.), (^.)) import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Experimental.Aggregates import Database.Esqueleto.Experimental.From import Database.Esqueleto.Experimental.From.CommonTableExpression import Database.Esqueleto.Experimental.From.Join @@ -561,3 +567,4 @@ import Database.Esqueleto.Experimental.ToMaybe -- ) -- @ -- +-- diff --git a/src/Database/Esqueleto/Experimental/Aggregates.hs b/src/Database/Esqueleto/Experimental/Aggregates.hs new file mode 100644 index 0000000..0968d4c --- /dev/null +++ b/src/Database/Esqueleto/Experimental/Aggregates.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Database.Esqueleto.Experimental.Aggregates + where + +import Control.Monad.IO.Class +import qualified Control.Monad.Trans.Writer as W +import Data.Coerce (Coercible, coerce) +import Database.Esqueleto.Internal.Internal + ( GroupByClause(..) + , SideData(..) + , SqlExpr(..) + , SqlQuery(..) + , SqlSelect(..) + , ToSomeValues(..) + , noMeta + , select + , unsafeSqlFunction + ) +import qualified Database.Esqueleto.Internal.Internal as I +import Database.Esqueleto.Internal.PersistentImport + ( Entity + , EntityField + , Key + , PersistEntity + , PersistField + , SqlReadT + , persistIdField + ) + +class SqlExprEntity expr where + (^.) :: (PersistEntity val, PersistField typ) + => expr (Entity val) + -> EntityField val typ + -> expr typ + (?.) :: (PersistEntity val, PersistField typ) + => expr (Maybe (Entity val)) + -> EntityField val typ + -> expr (Maybe typ) + + -- | Project a field of an entity. +instance SqlExprEntity SqlExpr where + (^.) = (I.^.) + (?.) = (I.?.) + +newtype SqlAggregate a = SqlAggregate { agg :: SqlExpr a } +deriving via SqlExpr instance SqlExprEntity SqlAggregate + +test :: (PersistEntity ent, PersistField a, PersistField b, PersistField c) + => SqlExpr (Maybe (Entity ent)) + -> EntityField ent a + -> SqlExpr b + -> SqlExpr c + -> SqlQuery (SqlExpr (Maybe a), SqlExpr b, SqlExpr (Maybe Int), SqlExpr Int) +test ent field y other = do + groupBy (ent, y) $ \(ent', y') -> + pure (ent' ?. field, y', sum_ other, countRows_) + +countRows_ :: (PersistField n, Integral n) => SqlAggregate n +countRows_ = SqlAggregate $ ERaw noMeta $ \_ _ -> ("COUNT(*)", []) + +-- Tuple magic, only SqlExprs are on the leaves. +-- The Coercible instance from the SqlExpr a -> SqlExpr b allows 0 cost casting +class Coercible a r => Aggregateable a r | a -> r, r -> a where + toAggregate :: a -> r + toAggregate = coerce + + fromAggregate :: r -> a + fromAggregate = coerce + +instance Aggregateable () () where +instance Aggregateable (SqlExpr a) (SqlAggregate a) where +instance (Aggregateable a ra, Aggregateable b rb) => Aggregateable (a,b) (ra, rb) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + ) => Aggregateable (a,b,c) (ra,rb,rc) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + , Aggregateable d rd + ) => Aggregateable (a,b,c,d) (ra,rb,rc,rd) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + , Aggregateable d rd + , Aggregateable e re + ) => Aggregateable (a,b,c,d,e) (ra,rb,rc,rd,re) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + , Aggregateable d rd + , Aggregateable e re + , Aggregateable f rf + ) => Aggregateable (a,b,c,d,e,f) (ra,rb,rc,rd,re,rf) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + , Aggregateable d rd + , Aggregateable e re + , Aggregateable f rf + , Aggregateable g rg + ) => Aggregateable (a,b,c,d,e,f,g) (ra,rb,rc,rd,re,rf,rg) where +instance + ( Aggregateable a ra + , Aggregateable b rb + , Aggregateable c rc + , Aggregateable d rd + , Aggregateable e re + , Aggregateable f rf + , Aggregateable g rg + , Aggregateable h rh + ) => Aggregateable (a,b,c,d,e,f,g,h) (ra,rb,rc,rd,re,rf,rg,rh) where + +sum_ :: (PersistField a, PersistField n, Integral n) => SqlExpr a -> SqlAggregate (Maybe n) +sum_ = coerce . unsafeSqlFunction "SUM" + +groupBy :: ( ToSomeValues a + , Aggregateable a a' + , Aggregateable b b' + ) => a -> (a' -> SqlQuery b') -> SqlQuery b +groupBy a f = do + Q $ W.tell $ mempty{sdGroupByClause = GroupBy $ toSomeValues a } + fmap fromAggregate $ f $ toAggregate a diff --git a/src/Database/Esqueleto/Experimental/From/Join.hs b/src/Database/Esqueleto/Experimental/From/Join.hs index 6d847f1..e855f0c 100644 --- a/src/Database/Esqueleto/Experimental/From/Join.hs +++ b/src/Database/Esqueleto/Experimental/From/Join.hs @@ -10,22 +10,21 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + module Database.Esqueleto.Experimental.From.Join where -import Data.Bifunctor (first) +import Control.Arrow (first) import Data.Kind (Constraint) import Data.Proxy import qualified Data.Text.Lazy.Builder as TLB import Database.Esqueleto.Experimental.From -import Database.Esqueleto.Experimental.From.SqlSetOperation import Database.Esqueleto.Experimental.ToAlias import Database.Esqueleto.Experimental.ToAliasReference import Database.Esqueleto.Experimental.ToMaybe import Database.Esqueleto.Internal.Internal hiding (From(..), from, fromJoin, on) -import Database.Esqueleto.Internal.PersistentImport - (Entity(..), EntityField, PersistEntity, PersistField) import GHC.TypeLits -- | A left-precedence pair. Pronounced \"and\". Used to represent expressions @@ -40,30 +39,41 @@ import GHC.TypeLits -- See the examples at the beginning of this module to see how this -- operator is used in 'JOIN' operations. data (:&) a b = a :& b + deriving (Show, Eq) infixl 2 :& instance (ToMaybe a, ToMaybe b) => ToMaybe (a :& b) where type ToMaybeT (a :& b) = (ToMaybeT a :& ToMaybeT b) toMaybe (a :& b) = (toMaybe a :& toMaybe b) -class ValidOnClause a +fromInductiveTupleP :: Proxy (a :& b) -> Proxy (a, b) +fromInductiveTupleP = const Proxy +toInductiveTuple :: (a, b) -> (a :& b) +toInductiveTuple (a, b) = a :& b + +instance (SqlSelect a a', SqlSelect b b') => SqlSelect (a :& b) (a' :& b') where + sqlSelectCols esc (a :& b) = sqlSelectCols esc (a, b) + sqlSelectColCount = sqlSelectColCount . fromInductiveTupleP + sqlSelectProcessRow p = fmap toInductiveTuple . sqlSelectProcessRow (fromInductiveTupleP p) + +class ValidOnClause a where + -- | An @ON@ clause that describes how two tables are related. This should be + -- used as an infix operator after a 'JOIN'. For example, + -- + -- @ + -- select $ + -- from $ table \@Person + -- \`innerJoin\` table \@BlogPost + -- \`on\` (\\(p :& bP) -> + -- p ^. PersonId ==. bP ^. BlogPostAuthorId) + -- @ + on :: a -> (b -> SqlExpr Bool) -> (a, b -> SqlExpr Bool) + on = (,) +infix 9 `on` + instance {-# OVERLAPPABLE #-} ToFrom a a' => ValidOnClause a instance ValidOnClause (a -> SqlQuery b) --- | An @ON@ clause that describes how two tables are related. This should be --- used as an infix operator after a 'JOIN'. For example, --- --- @ --- select $ --- from $ table \@Person --- \`innerJoin\` table \@BlogPost --- \`on\` (\\(p :& bP) -> --- p ^. PersonId ==. bP ^. BlogPostAuthorId) --- @ -on :: ValidOnClause a => a -> (b -> SqlExpr Bool) -> (a, b -> SqlExpr Bool) -on = (,) -infix 9 `on` - type family ErrorOnLateral a :: Constraint where ErrorOnLateral (a -> SqlQuery b) = TypeError ('Text "LATERAL can only be used for INNER, LEFT, and CROSS join kinds.") ErrorOnLateral _ = () diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index c42f4a4..71e22b9 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# language DerivingStrategies, GeneralizedNewtypeDeriving #-} {-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} @@ -24,6 +25,7 @@ -- tracker so we can safely support it. module Database.Esqueleto.Internal.Internal where +import Data.Kind (Constraint) import Control.Applicative ((<|>)) import Data.Coerce (Coercible, coerce) import Control.Arrow (first, (***)) @@ -534,14 +536,14 @@ subSelectForeign expr foreignKey k = 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) + +(^.) :: (PersistEntity val, PersistField typ) => SqlExpr (Entity val) -> EntityField val typ -> SqlExpr typ -ERaw m f ^. field +(ERaw m f) ^. field | isIdField field = idFieldValue - | Just alias <- sqlExprMetaAlias m = + | Just alias <- sqlExprMetaAlias m = ERaw noMeta $ \_ info -> f Never info <> ("." <> useIdent info (aliasedEntityColumnIdent alias fieldDef), []) | otherwise = ERaw noMeta $ \_ info -> (dot info $ persistFieldDef field, []) @@ -563,7 +565,10 @@ ERaw m f ^. field \p info -> (parensM p $ uncommas $ dot info <$> idFields, []) - ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity val))) + getProxy :: EntityField ent val -> Proxy (SqlExpr (Entity ent)) + getProxy = const Proxy + + ed = entityDef $ getEntityVal $ getProxy field dot info fieldDef = sourceIdent info <> "." <> fieldIdent @@ -1136,6 +1141,13 @@ data SomeValue where class ToSomeValues a where toSomeValues :: a -> [SomeValue] +instance {-# INCOHERENT #-} PersistField a => ToSomeValues (SqlExpr a) where + toSomeValues a = [SomeValue a] +instance PersistEntity a => ToSomeValues (SqlExpr (Entity a)) where + toSomeValues a = [SomeValue $ a ^. persistIdField] +instance PersistEntity a => ToSomeValues (SqlExpr (Maybe (Entity a))) where + toSomeValues a = [SomeValue $ a ?. persistIdField] + instance ( ToSomeValues a , ToSomeValues b @@ -2077,8 +2089,6 @@ parensM Parens = parens data OrderByType = ASC | DESC -instance ToSomeValues (SqlExpr a) where - toSomeValues a = [SomeValue a] fieldName :: (PersistEntity val, PersistField typ) @@ -3042,13 +3052,8 @@ instance (SqlSelect a ra, SqlSelect b rb) => SqlSelect (a, b) (ra, rb) where ] 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 + let (fstP, sndP) = fromTupleP p + colCountFst = sqlSelectColCount fstP processRow row = let (rowFst, rowSnd) = splitAt colCountFst row in (,) <$> sqlSelectProcessRow fstP rowFst diff --git a/test/Common/Test.hs b/test/Common/Test.hs index d36c5c0..6bfc967 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,41 +62,38 @@ 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 + (countRows_, from, groupBy, on, sum_, (?.), (^.)) +import qualified Database.Esqueleto.Experimental as EX +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| @@ -458,10 +455,10 @@ testSubSelect run = do eres <- try $ run $ do setup bad <- select $ - from $ \n -> do + from $ \(n :: SqlExpr (Entity Numbers)) -> do pure $ (,) (n ^. NumbersInt) $ subSelectUnsafe $ - from $ \n' -> do + from $ \(n' :: SqlExpr (Entity Numbers)) -> do pure (just (n' ^. NumbersDouble)) good <- select $ from $ \n -> do @@ -484,10 +481,10 @@ testSubSelect run = do eres <- try $ run $ do setup select $ - from $ \n -> do + from $ \(n :: SqlExpr (Entity Numbers)) -> do pure $ (,) (n ^. NumbersInt) $ subSelectUnsafe $ - from $ \n' -> do + from $ \(n' :: SqlExpr (Entity Numbers)) -> do where_ $ val False pure (n' ^. NumbersDouble) case eres of @@ -501,14 +498,14 @@ testSelectSource run = do describe "selectSource" $ do it "works for a simple example" $ run $ do let query = selectSource $ - Experimental.from $ Table @Person + EX.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 $ - Experimental.from $ Table @Person + EX.from $ Table @Person p1e <- insert' p1 ret0 <- runConduit $ query .| CL.consume ret1 <- runConduit $ query .| CL.consume @@ -537,7 +534,7 @@ testSelectFrom run = do describe "select/from" $ do it "works for a simple example" $ run $ do p1e <- insert' p1 - ret <- select $ Experimental.from $ Table @Person + ret <- select $ EX.from $ Table @Person liftIO $ ret `shouldBe` [ p1e ] it "works for a simple self-join (one entity)" $ run $ do @@ -545,7 +542,7 @@ testSelectFrom run = do ret <- select $ do person1 :& person2 <- - Experimental.from $ Table @Person + EX.from $ Table @Person `crossJoin` Table @Person return (person1, person2) liftIO $ ret `shouldBe` [ (p1e, p1e) ] @@ -556,7 +553,7 @@ testSelectFrom run = do ret <- select $ do person1 :& person2 <- - Experimental.from $ Table @Person + EX.from $ Table @Person `crossJoin` Table @Person return (person1, person2) liftIO $ @@ -672,7 +669,7 @@ testSelectFrom run = do number = 101 Right thePk = keyFromValues [toPersistValue number] fcPk <- insert fc - [Entity _ ret] <- select $ Experimental.from $ Table @Frontcover + [Entity _ ret] <- select $ EX.from $ Table @Frontcover liftIO $ do ret `shouldBe` fc fcPk `shouldBe` thePk @@ -879,9 +876,9 @@ testSelectSubQuery run = describe "select subquery" $ do it "works" $ run $ do _ <- insert' p1 let q = do - p <- Experimental.from $ Table @Person + p <- EX.from $ Table @Person return ( p ^. PersonName, p ^. PersonAge) - ret <- select $ Experimental.from q + ret <- select $ EX.from q liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ] it "supports sub-selecting Maybe entities" $ run $ do @@ -890,11 +887,11 @@ testSelectSubQuery run = describe "select subquery" $ do l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int]) let l1WithDeeds = do d <- l1Deeds pure (l1e, Just d) - let q = Experimental.from $ do + let q = EX.from $ do (lords :& deeds) <- - Experimental.from $ Table @Lord + EX.from $ Table @Lord `LeftOuterJoin` Table @Deed - `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) + `EX.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) pure (lords, deeds) ret <- select q @@ -905,8 +902,8 @@ testSelectSubQuery run = describe "select subquery" $ do _ <- insert' p3 let q = do (name, age) <- - Experimental.from $ SubQuery $ do - p <- Experimental.from $ Table @Person + EX.from $ SubQuery $ do + p <- EX.from $ Table @Person return ( p ^. PersonName, p ^. PersonAge) orderBy [ asc age ] pure name @@ -920,13 +917,13 @@ testSelectSubQuery run = describe "select subquery" $ do mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) let q = do - (lord :& deed) <- Experimental.from $ Table @Lord + (lord :& deed) <- EX.from $ Table @Lord `InnerJoin` Table @Deed - `Experimental.on` (\(lord :& deed) -> + `EX.on` (\(lord :& deed) -> lord ^. LordId ==. deed ^. DeedOwnerId) return (lord ^. LordId, deed ^. DeedId) q' = do - (lordId, deedId) <- Experimental.from $ SubQuery q + (lordId, deedId) <- EX.from $ SubQuery q groupBy (lordId) return (lordId, count deedId) (ret :: [(Value (Key Lord), Value Int)]) <- select q' @@ -941,15 +938,15 @@ testSelectSubQuery run = describe "select subquery" $ do mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) let q = do - (lord :& deed) <- Experimental.from $ Table @Lord + (lord :& deed) <- EX.from $ Table @Lord `InnerJoin` Table @Deed - `Experimental.on` (\(lord :& deed) -> + `EX.on` (\(lord :& deed) -> lord ^. LordId ==. deed ^. DeedOwnerId) - groupBy (lord ^. LordId) + groupBy (lord) return (lord ^. LordId, count (deed ^. DeedId)) (ret :: [(Value Int)]) <- select $ do - (lordId, deedCount) <- Experimental.from $ SubQuery q + (lordId, deedCount) <- EX.from $ SubQuery q where_ $ deedCount >. val (3 :: Int) return (count lordId) @@ -962,9 +959,9 @@ testSelectSubQuery run = describe "select subquery" $ do mapM_ (\k -> insert $ Deed k l3k) (map show [4..10 :: Int]) let q = do - (lord :& deed) <- Experimental.from $ Table @Lord - `InnerJoin` (Experimental.from $ Table @Deed) - `Experimental.on` (\(lord :& deed) -> + (lord :& deed) <- EX.from $ Table @Lord + `InnerJoin` (EX.from $ Table @Deed) + `EX.on` (\(lord :& deed) -> lord ^. LordId ==. deed ^. DeedOwnerId) groupBy (lord ^. LordId) return (lord ^. LordId, count (deed ^. DeedId)) @@ -976,11 +973,11 @@ testSelectSubQuery run = describe "select subquery" $ do l1k <- insert l1 l3k <- insert l3 let q = do - (lord :& (_, dogCounts)) <- Experimental.from $ Table @Lord + (lord :& (_, dogCounts)) <- EX.from $ Table @Lord `LeftOuterJoin` do - lord <- Experimental.from $ Table @Lord + lord <- EX.from $ Table @Lord pure (lord ^. LordId, lord ^. LordDogs) - `Experimental.on` (\(lord :& (lordId, _)) -> + `EX.on` (\(lord :& (lordId, _)) -> just (lord ^. LordId) ==. lordId) groupBy (lord ^. LordId, dogCounts) return (lord ^. LordId, dogCounts) @@ -990,19 +987,19 @@ testSelectSubQuery run = describe "select subquery" $ do it "unions" $ run $ do _ <- insert p1 _ <- insert p2 - let q = Experimental.from $ + let q = EX.from $ (do - p <- Experimental.from $ Table @Person + p <- EX.from $ Table @Person where_ $ not_ $ isNothing $ p ^. PersonAge return (p ^. PersonName)) `union_` (do - p <- Experimental.from $ Table @Person + p <- EX.from $ Table @Person where_ $ isNothing $ p ^. PersonAge return (p ^. PersonName)) `union_` (do - p <- Experimental.from $ Table @Person + p <- EX.from $ Table @Person where_ $ isNothing $ p ^. PersonAge return (p ^. PersonName)) names <- select q @@ -2350,7 +2347,7 @@ testExperimentalFrom run = do _ <- insert' p2 p3e <- insert' p3 peopleWithAges <- select $ do - people <- Experimental.from $ Table @Person + people <- EX.from $ Table @Person where_ $ not_ $ isNothing $ people ^. PersonAge return people liftIO $ peopleWithAges `shouldMatchList` [p1e, p3e] @@ -2363,9 +2360,9 @@ testExperimentalFrom run = do d2e <- insert' $ Deed "2" (entityKey l1e) lordDeeds <- select $ do (lords :& deeds) <- - Experimental.from $ Table @Lord + EX.from $ Table @Lord `InnerJoin` Table @Deed - `Experimental.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId) + `EX.on` (\(l :& d) -> l ^. LordId ==. d ^. DeedOwnerId) pure (lords, deeds) liftIO $ lordDeeds `shouldMatchList` [ (l1e, d1e) , (l1e, d2e) @@ -2379,9 +2376,9 @@ testExperimentalFrom run = do d2e <- insert' $ Deed "2" (entityKey l1e) lordDeeds <- select $ do (lords :& deeds) <- - Experimental.from $ Table @Lord + EX.from $ Table @Lord `LeftOuterJoin` Table @Deed - `Experimental.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) + `EX.on` (\(l :& d) -> just (l ^. LordId) ==. d ?. DeedOwnerId) pure (lords, deeds) liftIO $ lordDeeds `shouldMatchList` [ (l1e, Just d1e) @@ -2393,8 +2390,8 @@ testExperimentalFrom run = do insert_ l1 insert_ l2 insert_ l3 - delete $ void $ Experimental.from $ Table @Lord - lords <- select $ Experimental.from $ Table @Lord + delete $ void $ EX.from $ Table @Lord + lords <- select $ EX.from $ Table @Lord liftIO $ lords `shouldMatchList` [] it "supports implicit cross joins" $ do @@ -2402,11 +2399,11 @@ testExperimentalFrom run = do l1e <- insert' l1 l2e <- insert' l2 ret <- select $ do - lords1 <- Experimental.from $ Table @Lord - lords2 <- Experimental.from $ Table @Lord + lords1 <- EX.from $ Table @Lord + lords2 <- EX.from $ Table @Lord pure (lords1, lords2) ret2 <- select $ do - (lords1 :& lords2) <- Experimental.from $ Table @Lord `CrossJoin` Table @Lord + (lords1 :& lords2) <- EX.from $ Table @Lord `CrossJoin` Table @Lord pure (lords1,lords2) liftIO $ ret `shouldMatchList` ret2 liftIO $ ret `shouldMatchList` [ (l1e, l1e) @@ -2420,12 +2417,12 @@ testExperimentalFrom run = do run $ void $ do let q = do (persons :& profiles :& posts) <- - Experimental.from $ Table @Person + EX.from $ Table @Person `InnerJoin` Table @Profile - `Experimental.on` (\(people :& profiles) -> + `EX.on` (\(people :& profiles) -> people ^. PersonId ==. profiles ^. ProfilePerson) `LeftOuterJoin` Table @BlogPost - `Experimental.on` (\(people :& _ :& posts) -> + `EX.on` (\(people :& _ :& posts) -> just (people ^. PersonId) ==. posts ?. BlogPostAuthorId) pure (persons, posts, profiles) --error . show =<< renderQuerySelect q @@ -2437,7 +2434,7 @@ testExperimentalFrom run = do insert_ p3 -- Pretend this isnt all posts upperNames <- select $ do - author <- Experimental.from $ SelectQuery $ Experimental.from $ Table @Person + author <- EX.from $ SelectQuery $ EX.from $ Table @Person pure $ upper_ $ author ^. PersonName liftIO $ upperNames `shouldMatchList` [ Value "JOHN"