{-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE AllowAmbiguousTypes #-} module Database.Beam.Test.SQL ( tests ) where import Database.Beam.Test.Schema hiding (tests) import Database.Beam import Database.Beam.Backend.SQL.AST import Data.Time.Clock import Data.Text (Text) import Test.Tasty import Test.Tasty.HUnit tests :: TestTree tests = testGroup "SQL generation tests" [ simpleSelect , simpleWhere , simpleJoin , selfJoin , leftJoin , leftJoinSingle , aggregates , orderBy , joinHaving , maybeFieldTypes , tableEquality , related , selectCombinators , limitOffset , existsTest , updateCurrent , updateNullable , noEmptyIns -- Regressions for github issues , testGroup "Regression tests" [ gh70OrderByInFirstJoinCausesIncorrectProjection ] ] -- | Ensure simple select selects the right fields simpleSelect :: TestTree simpleSelect = testCase "All fields are present in a simple all_ query" $ do SqlSelect Select { selectTable = SelectTable { .. } , .. } <- pure (select (all_ (_employees employeeDbSettings))) selectGrouping @?= Nothing selectOrdering @?= [] selectWhere @?= Nothing selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectQuantifier @?= Nothing Just (FromTable (TableNamed "employees") (Just tblName)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField tblName "first_name"), Just "res0") , (ExpressionFieldName (QualifiedField tblName "last_name"), Just "res1") , (ExpressionFieldName (QualifiedField tblName "phone_number"), Just "res2") , (ExpressionFieldName (QualifiedField tblName "age"), Just "res3") , (ExpressionFieldName (QualifiedField tblName "salary"), Just "res4") , (ExpressionFieldName (QualifiedField tblName "hire_date"), Just "res5") , (ExpressionFieldName (QualifiedField tblName "leave_date"), Just "res6") , (ExpressionFieldName (QualifiedField tblName "created"), Just "res7") ] -- | Simple select with WHERE clause simpleWhere :: TestTree simpleWhere = testCase "guard_ clauses are successfully translated into WHERE statements" $ do SqlSelect Select { selectTable = SelectTable { .. } , .. } <- pure $ select $ do e <- all_ (_employees employeeDbSettings) guard_ (_employeeSalary e >. 120202 &&. _employeeAge e <. 30 &&. _employeeFirstName e ==. _employeeLastName e) pure e selectGrouping @?= Nothing selectOrdering @?= [] selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectQuantifier @?= Nothing Just (FromTable (TableNamed "employees") (Just employees)) <- pure selectFrom let salaryCond = ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField employees "salary")) (ExpressionValue (Value (120202 :: Double))) ageCond = ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField employees "age")) (ExpressionValue (Value (30 :: Int))) nameCond = ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField employees "first_name")) (ExpressionFieldName (QualifiedField employees "last_name")) selectWhere @?= Just (ExpressionBinOp "AND" salaryCond (ExpressionBinOp "AND" ageCond nameCond)) -- | Ensure that multiple tables are correctly joined simpleJoin :: TestTree simpleJoin = testCase "Introducing multiple tables results in an inner join" $ do SqlSelect Select { selectTable = SelectTable { .. } , .. } <- pure $ select $ do e <- all_ (_employees employeeDbSettings) r <- all_ (_roles employeeDbSettings) pure (_employeePhoneNumber e, _roleName r) selectGrouping @?= Nothing selectOrdering @?= [] selectWhere @?= Nothing selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectQuantifier @?= Nothing Just (InnerJoin (FromTable (TableNamed "employees") (Just employees)) (FromTable (TableNamed "roles") (Just roles)) Nothing) <- pure selectFrom selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField employees "phone_number"), Just "res0" ) , ( ExpressionFieldName (QualifiedField roles "name"), Just "res1") ] -- | Ensure that multiple joins on the same table are correctly referenced selfJoin :: TestTree selfJoin = testCase "Table names are unique and properly used in self joins" $ do SqlSelect Select { selectTable = SelectTable { .. } , .. } <- pure $ select $ do e1 <- all_ (_employees employeeDbSettings) e2 <- relatedBy_ (_employees employeeDbSettings) (\e2 -> _employeeFirstName e1 ==. _employeeLastName e2) e3 <- relatedBy_ (_employees employeeDbSettings) (\e3 -> _employeePhoneNumber e1 ==. _employeeLastName e3 &&. _employeePhoneNumber e3 ==. _employeeFirstName e2) pure (_employeeFirstName e1, _employeeLastName e2, _employeePhoneNumber e3) selectGrouping @?= Nothing selectOrdering @?= [] selectWhere @?= Nothing selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectQuantifier @?= Nothing Just (InnerJoin (InnerJoin (FromTable (TableNamed "employees") (Just e1)) (FromTable (TableNamed "employees") (Just e2)) (Just joinCondition12)) (FromTable (TableNamed "employees") (Just e3)) (Just joinCondition123)) <- pure selectFrom assertBool "Table names are not unique" (e1 /= e2 && e1 /= e3 && e2 /= e3) joinCondition12 @?= ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField e1 "first_name")) (ExpressionFieldName (QualifiedField e2 "last_name")) joinCondition123 @?= ExpressionBinOp "AND" (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField e1 "phone_number")) (ExpressionFieldName (QualifiedField e3 "last_name"))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField e3 "phone_number")) (ExpressionFieldName (QualifiedField e2 "first_name"))) -- | Ensure that left joins are properly generated leftJoin :: TestTree leftJoin = testCase "leftJoin_ generates the right join" $ do SqlSelect Select { selectTable = SelectTable { selectWhere = Nothing, selectFrom } } <- pure $ select $ do r <- all_ (_roles employeeDbSettings) e <- leftJoin_ (all_ (_employees employeeDbSettings)) (\e -> primaryKey e ==. _roleForEmployee r) pure (e, r) Just (LeftJoin (FromTable (TableNamed "roles") (Just roles)) (FromTable (TableNamed "employees") (Just employees)) (Just cond)) <- pure selectFrom let andE = ExpressionBinOp "AND" eqE = ExpressionCompOp "==" Nothing firstNameCond = eqE (ExpressionFieldName (QualifiedField employees "first_name")) (ExpressionFieldName (QualifiedField roles "for_employee__first_name")) lastNameCond = eqE (ExpressionFieldName (QualifiedField employees "last_name")) (ExpressionFieldName (QualifiedField roles "for_employee__last_name")) createdCond = eqE (ExpressionFieldName (QualifiedField employees "created")) (ExpressionFieldName (QualifiedField roles "for_employee__created")) cond @?= andE (andE firstNameCond lastNameCond) createdCond -- | Ensure that left joins which return a single column are properly typed. The -- point of this test is to test for compile-time errors. The same query -- should be generated as above. leftJoinSingle :: TestTree leftJoinSingle = testCase "leftJoin_ generates the right join (single return value)" $ do SqlSelect Select { selectTable = SelectTable { selectWhere = Nothing, selectFrom } } <- pure $ select $ do r <- all_ (_roles employeeDbSettings) e <- leftJoin_ (do e <- all_ (_employees employeeDbSettings) pure (primaryKey e, _employeeAge e)) (\(key, _) -> key ==. _roleForEmployee r) pure (e, r) Just (LeftJoin (FromTable (TableNamed "roles") (Just roles)) (FromTable (TableNamed "employees") (Just employees)) (Just cond)) <- pure selectFrom let andE = ExpressionBinOp "AND" eqE = ExpressionCompOp "==" Nothing firstNameCond = eqE (ExpressionFieldName (QualifiedField employees "first_name")) (ExpressionFieldName (QualifiedField roles "for_employee__first_name")) lastNameCond = eqE (ExpressionFieldName (QualifiedField employees "last_name")) (ExpressionFieldName (QualifiedField roles "for_employee__last_name")) createdCond = eqE (ExpressionFieldName (QualifiedField employees "created")) (ExpressionFieldName (QualifiedField roles "for_employee__created")) cond @?= andE (andE firstNameCond lastNameCond) createdCond -- | Ensure that aggregations cause the correct GROUP BY clause to be generated aggregates :: TestTree aggregates = testGroup "Aggregate support" [ basicAggregate , basicHaving , aggregateInJoin , aggregateInJoinReverse , aggregateOverTopLevel , filterAfterTopLevelAggregate , joinTopLevelAggregate , joinTopLevelAggregate2 ] where basicAggregate = testCase "Basic aggregate support" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $ do e <- all_ (_employees employeeDbSettings) pure e Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "age"), Just "res0" ) , ( ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ], Just "res1") ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField t0 "age") ]) selectHaving @?= Nothing basicHaving = testCase "Basic HAVING support" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do (age, maxNameLength) <- aggregate_ (\e -> ( group_ (_employeeAge e) , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $ all_ (_employees employeeDbSettings) guard_ (maxNameLength >. 42) pure (age, maxNameLength) Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "age"), Just "res0" ) , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ] , ExpressionValue (Value (0 :: Int)) ], Just "res1" ) ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField t0 "age") ]) selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name")) ] , ExpressionValue (Value (0 :: Int)) ]) (ExpressionValue (Value (42 :: Int)))) aggregateInJoin = testCase "Aggregate in JOIN" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do (age, maxFirstNameLength) <- aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $ all_ (_employees employeeDbSettings) role <- all_ (_roles employeeDbSettings) pure (age, maxFirstNameLength, _roleName role) Just (InnerJoin (FromTable (TableFromSubSelect subselect) (Just t0)) (FromTable (TableNamed "roles") (Just t1)) Nothing) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "res0"), Just "res0") , (ExpressionFieldName (QualifiedField t0 "res1"), Just "res1") , (ExpressionFieldName (QualifiedField t1 "name"), Just "res2") ] selectWhere @?= Nothing selectGrouping @?= Nothing selectHaving @?= Nothing Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure subselect Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "age"), Just "res0") , (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))], Just "res1") ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "age")]) selectHaving @?= Nothing aggregateInJoinReverse = testCase "Aggregate in JOIN (reverse order)" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do role <- all_ (_roles employeeDbSettings) (age, maxFirstNameLength) <- aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $ all_ (_employees employeeDbSettings) pure (age, maxFirstNameLength, _roleName role) Just (InnerJoin (FromTable (TableNamed "roles") (Just t0)) (FromTable (TableFromSubSelect subselect) (Just t1)) Nothing) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t1 "res0"), Just "res0") , (ExpressionFieldName (QualifiedField t1 "res1"), Just "res1") , (ExpressionFieldName (QualifiedField t0 "name"), Just "res2") ] selectWhere @?= Nothing selectGrouping @?= Nothing selectHaving @?= Nothing Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure subselect Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "age"), Just "res0") , (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))], Just "res1") ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "age")]) selectHaving @?= Nothing aggregateOverTopLevel = testCase "Aggregate over top-level" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $ limit_ 10 (all_ (_employees employeeDbSettings)) Just (FromTable (TableFromSubSelect subselect) (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [(ExpressionFieldName (QualifiedField t0 "res3"),Just "res0"),(ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0"))], Just "res1")] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "res3")]) selectHaving @?= Nothing selectLimit subselect @?= Just 10 selectOffset subselect @?= Nothing selectOrdering subselect @?= [] SelectTable {selectFrom = Just (FromTable (TableNamed "employees") (Just t0')), .. } <- pure $ selectTable subselect selectWhere @?= Nothing selectGrouping @?= Nothing selectHaving @?= Nothing selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0' "first_name"), Just "res0") , (ExpressionFieldName (QualifiedField t0' "last_name"), Just "res1") , (ExpressionFieldName (QualifiedField t0' "phone_number"), Just "res2") , (ExpressionFieldName (QualifiedField t0' "age"), Just "res3") , (ExpressionFieldName (QualifiedField t0' "salary"), Just "res4") , (ExpressionFieldName (QualifiedField t0' "hire_date"), Just "res5") , (ExpressionFieldName (QualifiedField t0' "leave_date"), Just "res6") , (ExpressionFieldName (QualifiedField t0' "created"), Just "res7") ] -- assertFailure ("Select " ++ show s) filterAfterTopLevelAggregate = testCase "Filter after top-level aggregate" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ filter_ (\(_, l) -> l <. 10 ||. l >. 20) $ aggregate_ (\e -> ( group_ (_employeeAge e) , fromMaybe_ 0 (max_ (charLength_ (_employeeFirstName e)))) ) $ limit_ 10 (all_ (_employees employeeDbSettings)) Just (FromTable (TableFromSubSelect subselect) (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "res3"),Just "res0") , (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0"))] , ExpressionValue (Value (0 :: Int)) ], Just "res1") ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "res3")]) selectHaving @?= Just (ExpressionBinOp "OR" (ExpressionCompOp "<" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ] , ExpressionValue (Value (0 :: Int)) ]) (ExpressionValue (Value (10 :: Int)))) (ExpressionCompOp ">" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "res0")) ] , ExpressionValue (Value (0 :: Int)) ]) (ExpressionValue (Value (20 :: Int))))) selectLimit subselect @?= Just 10 selectOffset subselect @?= Nothing selectOrdering subselect @?= [] SelectTable {selectFrom = Just (FromTable (TableNamed "employees") (Just t0')), .. } <- pure $ selectTable subselect selectWhere @?= Nothing selectGrouping @?= Nothing selectHaving @?= Nothing selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0' "first_name"), Just "res0") , (ExpressionFieldName (QualifiedField t0' "last_name"), Just "res1") , (ExpressionFieldName (QualifiedField t0' "phone_number"), Just "res2") , (ExpressionFieldName (QualifiedField t0' "age"), Just "res3") , (ExpressionFieldName (QualifiedField t0' "salary"), Just "res4") , (ExpressionFieldName (QualifiedField t0' "hire_date"), Just "res5") , (ExpressionFieldName (QualifiedField t0' "leave_date"), Just "res6") , (ExpressionFieldName (QualifiedField t0' "created"), Just "res7") ] joinTopLevelAggregate = testCase "Join against top-level aggregate" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do (lastName, firstNameLength) <- filter_ (\(_, charLength) -> fromMaybe_ 0 charLength >. 10) $ aggregate_ (\e -> (group_ (_employeeLastName e), max_ (charLength_ (_employeeFirstName e)))) $ limit_ 10 (all_ (_employees employeeDbSettings)) role <- relatedBy_ (_roles employeeDbSettings) (\r -> _roleName r ==. lastName) pure (firstNameLength, role, lastName) Just (InnerJoin (FromTable (TableFromSubSelect subselect) (Just t0)) (FromTable (TableNamed "roles") (Just t1)) (Just joinCond) ) <- pure selectFrom joinCond @?= ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField t1 "name")) (ExpressionFieldName (QualifiedField t0 "res0")) selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "res1"), Just "res0" ) , ( ExpressionFieldName (QualifiedField t1 "for_employee__first_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField t1 "for_employee__last_name"), Just "res2" ) , ( ExpressionFieldName (QualifiedField t1 "for_employee__created"), Just "res3" ) , ( ExpressionFieldName (QualifiedField t1 "name"), Just "res4" ) , ( ExpressionFieldName (QualifiedField t1 "started"), Just "res5" ) , ( ExpressionFieldName (QualifiedField t0 "res0"), Just "res6" ) ] selectWhere @?= Nothing selectHaving @?= Nothing selectGrouping @?= Nothing Select { selectTable = SelectTable { .. }, selectLimit = Nothing , selectOffset = Nothing, selectOrdering = [] } <- pure subselect Just (FromTable (TableFromSubSelect employeesSelect) (Just t0')) <- pure selectFrom selectWhere @?= Nothing selectHaving @?= Just (ExpressionCompOp ">" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))] , ExpressionValue (Value (0 :: Int)) ]) (ExpressionValue (Value (10 :: Int)))) selectGrouping @?= Just (Grouping [ (ExpressionFieldName (QualifiedField t0' "res1")) ]) selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0' "res1"), Just "res0" ) , ( ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))], Just "res1" ) ] Select { selectTable = SelectTable { .. }, selectLimit = Just 10 , selectOffset = Nothing, selectOrdering = [] } <- pure employeesSelect Just (FromTable (TableNamed "employees") (Just t0'')) <- pure selectFrom selectWhere @?= Nothing selectHaving @?= Nothing selectGrouping @?= Nothing selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0'' "first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField t0'' "last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField t0'' "phone_number"), Just "res2" ) , ( ExpressionFieldName (QualifiedField t0'' "age"), Just "res3" ) , ( ExpressionFieldName (QualifiedField t0'' "salary"), Just "res4" ) , ( ExpressionFieldName (QualifiedField t0'' "hire_date"), Just "res5" ) , ( ExpressionFieldName (QualifiedField t0'' "leave_date"), Just "res6" ) , ( ExpressionFieldName (QualifiedField t0'' "created"), Just "res7" ) ] joinTopLevelAggregate2 = testCase "Join against top-level aggregate (places reversed)" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do role <- all_ (_roles employeeDbSettings) (lastName, firstNameLength) <- filter_ (\(_, charLength) -> charLength >. 10) $ aggregate_ (\e -> ( group_ (_employeeLastName e) , fromMaybe_ 0 $ max_ (charLength_ (_employeeFirstName e))) ) $ limit_ 10 (all_ (_employees employeeDbSettings)) guard_ (_roleName role ==. lastName) pure (firstNameLength, role, lastName) Just (InnerJoin (FromTable (TableNamed "roles") (Just t0)) (FromTable (TableFromSubSelect subselect) (Just t1)) Nothing) <- pure selectFrom selectWhere @?= Just (ExpressionBinOp "AND" (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField t1 "res1")) (ExpressionValue (Value (10 :: Int)))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField t0 "name")) (ExpressionFieldName (QualifiedField t1 "res0")))) selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t1 "res1"), Just "res0" ) , ( ExpressionFieldName (QualifiedField t0 "for_employee__first_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField t0 "for_employee__last_name"), Just "res2" ) , ( ExpressionFieldName (QualifiedField t0 "for_employee__created"), Just "res3" ) , ( ExpressionFieldName (QualifiedField t0 "name"), Just "res4" ) , ( ExpressionFieldName (QualifiedField t0 "started"), Just "res5" ) , ( ExpressionFieldName (QualifiedField t1 "res0"), Just "res6" ) ] selectHaving @?= Nothing selectGrouping @?= Nothing Select { selectTable = SelectTable { .. }, selectLimit = Nothing , selectOffset = Nothing, selectOrdering = [] } <- pure subselect Just (FromTable (TableFromSubSelect employeesSelect) (Just t0')) <- pure selectFrom selectWhere @?= Nothing selectHaving @?= Nothing selectGrouping @?= Just (Grouping [ (ExpressionFieldName (QualifiedField t0' "res1")) ]) selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0' "res1"), Just "res0" ) , ( ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0' "res0"))] , ExpressionValue (Value (0 :: Int)) ] , Just "res1" ) ] Select { selectTable = SelectTable { .. }, selectLimit = Just 10 , selectOffset = Nothing, selectOrdering = [] } <- pure employeesSelect Just (FromTable (TableNamed "employees") (Just t0'')) <- pure selectFrom selectWhere @?= Nothing selectHaving @?= Nothing selectGrouping @?= Nothing selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0'' "first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField t0'' "last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField t0'' "phone_number"), Just "res2" ) , ( ExpressionFieldName (QualifiedField t0'' "age"), Just "res3" ) , ( ExpressionFieldName (QualifiedField t0'' "salary"), Just "res4" ) , ( ExpressionFieldName (QualifiedField t0'' "hire_date"), Just "res5" ) , ( ExpressionFieldName (QualifiedField t0'' "leave_date"), Just "res6" ) , ( ExpressionFieldName (QualifiedField t0'' "created"), Just "res7" ) ] -- | ORDER BY orderBy :: TestTree orderBy = testGroup "ORDER BY tests" [ simpleOrdering , orderCombination , orderLimitsOffsets , orderJoin , orderJoinReversed ] where simpleOrdering = testCase "Simple Ordering" $ do SqlSelect Select { selectTable = select , selectLimit = Just 100, selectOffset = Just 5 , selectOrdering = ordering } <- pure $ select $ limit_ 100 $ offset_ 5 $ orderBy_ (asc_ . _roleStarted) $ all_ (_roles employeeDbSettings) select @?= SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "for_employee__first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__created"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "name"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "started"), Just "res4" ) ] , selectFrom = Just (FromTable (TableNamed "roles") (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } ordering @?= [ OrderingAsc (ExpressionFieldName (QualifiedField "t0" "started")) ] orderCombination = testCase "Order combined query" $ do SqlSelect Select { selectTable = select , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = ordering } <- pure $ select $ orderBy_ (asc_ . _roleStarted) $ (all_ (_roles employeeDbSettings) `unionAll_` all_ (_roles employeeDbSettings)) let expSelect = SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "for_employee__first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__created"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "name"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "started"), Just "res4" ) ] , selectFrom = Just (FromTable (TableNamed "roles") (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } select @?= UnionTables True expSelect expSelect ordering @?= [ OrderingAsc (ExpressionFieldName (UnqualifiedField "res4")) ] orderLimitsOffsets = testCase "Order after LIMIT/OFFSET" $ do SqlSelect Select { selectTable = s , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = ordering } <- pure $ select $ orderBy_ (asc_ . _roleStarted) $ limit_ 100 $ offset_ 5 $ all_ (_roles employeeDbSettings) let rolesSelect = SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "for_employee__first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "for_employee__created"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "name"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "started"), Just "res4" ) ] , selectFrom = Just (FromTable (TableNamed "roles") (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } s @?= SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "res0"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "res1"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "res2"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "res3"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "res4"), Just "res4" ) ] , selectFrom = Just (FromTable (TableFromSubSelect (Select { selectTable = rolesSelect, selectLimit = Just 100 , selectOffset = Just 5, selectOrdering = [] })) (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } ordering @?= [ OrderingAsc (ExpressionFieldName (QualifiedField "t0" "res4")) ] orderJoin = testCase "Order join" $ do SqlSelect Select { selectTable = select , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do oldestEmployees <- limit_ 10 $ orderBy_ ((,) <$> (asc_ <$> _employeeAge) <*> (desc_ <$> (charLength_ <$> _employeeFirstName))) $ all_ (_employees employeeDbSettings) role <- relatedBy_ (_roles employeeDbSettings) (\r -> _roleForEmployee r ==. primaryKey oldestEmployees) pure (_employeeFirstName oldestEmployees, _employeeLastName oldestEmployees, _employeeAge oldestEmployees, _roleName role) selectProjection select @?= ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "res0"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "res1"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "res3"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t1" "name"), Just "res3" ) ] let subselectExp = Select { selectTable = subselectTableExp, selectLimit = Just 10, selectOffset = Nothing , selectOrdering = [ OrderingAsc (ExpressionFieldName (QualifiedField "t0" "age")) , OrderingDesc (ExpressionCharLength (ExpressionFieldName (QualifiedField "t0" "first_name"))) ] } subselectTableExp = SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "phone_number"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "age"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "salary"), Just "res4" ) , ( ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res5" ) , ( ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6" ) , ( ExpressionFieldName (QualifiedField "t0" "created"), Just "res7" ) ] , selectFrom = Just (FromTable (TableNamed "employees") (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } joinCondExp = ExpressionBinOp "AND" (ExpressionBinOp "AND" (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t1" "for_employee__first_name")) (ExpressionFieldName (QualifiedField "t0" "res0"))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t1" "for_employee__last_name")) (ExpressionFieldName (QualifiedField "t0" "res1")))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t1" "for_employee__created")) (ExpressionFieldName (QualifiedField "t0" "res7"))) selectFrom select @?= Just (InnerJoin (FromTable (TableFromSubSelect subselectExp) (Just "t0")) (FromTable (TableNamed "roles") (Just "t1")) (Just joinCondExp)) selectWhere select @?= Nothing selectGrouping select @?= Nothing selectHaving select @?= Nothing orderJoinReversed = testCase "Order join (reversed)" $ do SqlSelect Select { selectTable = s , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do role <- all_ (_roles employeeDbSettings) oldestEmployees <- limit_ 10 $ orderBy_ ((,) <$> (asc_ <$> _employeeAge) <*> (desc_ <$> (charLength_ <$> _employeeFirstName))) $ all_ (_employees employeeDbSettings) guard_ (_roleForEmployee role ==. primaryKey oldestEmployees) pure (_employeeFirstName oldestEmployees, _employeeLastName oldestEmployees, _employeeAge oldestEmployees, _roleName role) selectProjection s @?= ProjExprs [ ( ExpressionFieldName (QualifiedField "t1" "res0"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t1" "res1"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t1" "res3"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "name"), Just "res3" ) ] selectWhere s @?= Just (ExpressionBinOp "AND" (ExpressionBinOp "AND" (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t0" "for_employee__first_name")) (ExpressionFieldName (QualifiedField "t1" "res0"))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t0" "for_employee__last_name")) (ExpressionFieldName (QualifiedField "t1" "res1")))) (ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "t0" "for_employee__created")) (ExpressionFieldName (QualifiedField "t1" "res7")))) selectGrouping s @?= Nothing selectHaving s @?= Nothing let subselect = Select { selectTable = subselectTable, selectLimit = Just 10, selectOffset = Nothing , selectOrdering = [ OrderingAsc (ExpressionFieldName (QualifiedField "t0" "age")) , OrderingDesc (ExpressionCharLength (ExpressionFieldName (QualifiedField "t0" "first_name"))) ] } subselectTable = SelectTable { selectProjection = ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "last_name"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "phone_number"), Just "res2" ) , ( ExpressionFieldName (QualifiedField "t0" "age"), Just "res3" ) , ( ExpressionFieldName (QualifiedField "t0" "salary"), Just "res4" ) , ( ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res5" ) , ( ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6" ) , ( ExpressionFieldName (QualifiedField "t0" "created"), Just "res7" ) ] , selectFrom = Just (FromTable (TableNamed "employees") (Just "t0")) , selectWhere = Nothing , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } selectFrom s @?= Just (InnerJoin (FromTable (TableNamed "roles") (Just "t0")) (FromTable (TableFromSubSelect subselect) (Just "t1")) Nothing) -- | HAVING clause should not be floated out of a join joinHaving :: TestTree joinHaving = testCase "HAVING clause should not be floated out of a join" $ do SqlSelect Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure $ select $ do (age, maxFirstNameLength) <- filter_ (\(_, nameLength) -> fromMaybe_ 0 nameLength >=. 20) $ aggregate_ (\e -> (group_ (_employeeAge e), max_ (charLength_ (_employeeFirstName e)))) $ all_ (_employees employeeDbSettings) role <- all_ (_roles employeeDbSettings) pure (age, maxFirstNameLength, _roleName role) Just (InnerJoin (FromTable (TableFromSubSelect subselect) (Just t0)) (FromTable (TableNamed "roles") (Just t1)) Nothing) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "res0"), Just "res0") , (ExpressionFieldName (QualifiedField t0 "res1"), Just "res1") , (ExpressionFieldName (QualifiedField t1 "name"), Just "res2") ] selectWhere @?= Nothing selectGrouping @?= Nothing selectHaving @?= Nothing Select { selectTable = SelectTable { .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure subselect Just (FromTable (TableNamed "employees") (Just t0)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField t0 "age"), Just "res0") , (ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))], Just "res1") ] selectWhere @?= Nothing selectGrouping @?= Just (Grouping [ExpressionFieldName (QualifiedField t0 "age")]) selectHaving @?= Just (ExpressionCompOp ">=" Nothing (ExpressionCoalesce [ ExpressionAgg "MAX" Nothing [ExpressionCharLength (ExpressionFieldName (QualifiedField t0 "first_name"))] , ExpressionValue (Value (0 :: Int)) ]) (ExpressionValue (Value (20 :: Int)))) -- | Ensure that isJustE and isNothingE work correctly for simple types maybeFieldTypes :: TestTree maybeFieldTypes = testCase "Simple maybe field types" $ do SqlSelect Select { selectTable = SelectTable { selectWhere = Just selectWhere, selectFrom } } <- pure $ select $ do e <- all_ (_employees employeeDbSettings) guard_ (isNothing_ (_employeeLeaveDate e)) pure e Just (FromTable (TableNamed "employees") (Just employees)) <- pure selectFrom selectWhere @?= ExpressionIsNull (ExpressionFieldName (QualifiedField employees "leave_date")) -- | Ensure isJustE and isNothingE work correctly for table and composite types -- | Ensure maybeE works for simple types -- | Ensure equality works for tables tableEquality :: TestTree tableEquality = testGroup "Equality comparisions among table expressions and table literals" [ tableExprToTableExpr, tableExprToTableLiteral ] where tableExprToTableExpr = testCase "Equality comparison between two table expressions" $ do SqlSelect Select { selectTable = SelectTable { selectWhere = Just selectWhere, selectFrom } } <- pure $ select $ do d <- all_ (_departments employeeDbSettings) guard_ (d ==. d) pure d Just (FromTable (TableNamed "departments") (Just depts)) <- pure selectFrom let andE = ExpressionBinOp "AND"; orE = ExpressionBinOp "OR" eqE = ExpressionCompOp "==" Nothing maybeEqE a b = ExpressionCase [ (andE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value True)) , (orE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value False)) ] (eqE a b) nameCond = eqE (ExpressionFieldName (QualifiedField depts "name")) (ExpressionFieldName (QualifiedField depts "name")) firstNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__first_name")) (ExpressionFieldName (QualifiedField depts "head__first_name")) lastNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__last_name")) (ExpressionFieldName (QualifiedField depts "head__last_name")) createdCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__created")) (ExpressionFieldName (QualifiedField depts "head__created")) selectWhere @?= andE (andE (andE nameCond firstNameCond) lastNameCond) createdCond tableExprToTableLiteral = testCase "Equality comparison between table expression and table literal" $ do now <- getCurrentTime let exp = DepartmentT "Sales" (EmployeeId (Just "Jane") (Just "Smith") (Just now)) SqlSelect Select { selectTable = SelectTable { selectWhere = Just selectWhere, selectFrom } } <- pure $ select $ do d <- all_ (_departments employeeDbSettings) guard_ (d ==. val_ exp) pure d Just (FromTable (TableNamed "departments") (Just depts)) <- pure selectFrom let andE = ExpressionBinOp "AND"; orE = ExpressionBinOp "OR" eqE = ExpressionCompOp "==" Nothing maybeEqE a b = ExpressionCase [ (andE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value True)) , (orE (ExpressionIsNull a) (ExpressionIsNull b), ExpressionValue (Value False)) ] (eqE a b) nameCond = eqE (ExpressionFieldName (QualifiedField depts "name")) (ExpressionValue (Value ("Sales" :: Text))) firstNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__first_name")) (ExpressionValue (Value ("Jane" :: Text))) lastNameCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__last_name")) (ExpressionValue (Value ("Smith" :: Text))) createdCond = maybeEqE (ExpressionFieldName (QualifiedField depts "head__created")) (ExpressionValue (Value now)) selectWhere @?= andE (andE (andE nameCond firstNameCond) lastNameCond) createdCond -- | Ensure related_ generates the correct ON conditions related :: TestTree related = testCase "related_ generate the correct ON conditions" $ do SqlSelect Select { .. } <- pure $ select $ do r <- all_ (_roles employeeDbSettings) e <- related_ (_employees employeeDbSettings) (_roleForEmployee r) pure (e, r) pure () -- | Ensure select can be joined with UNION, INTERSECT, and EXCEPT selectCombinators :: TestTree selectCombinators = testGroup "UNION, INTERSECT, EXCEPT support" [ basicUnion , fieldNamesCapturedCorrectly , basicIntersect , basicExcept , equalProjectionsDontHaveSubSelects , unionWithGuards ] where basicUnion = testCase "Basic UNION support" $ do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s (Maybe _) ) hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (as_ @Text $ val_ "leave", _employeeLeaveDate e) SqlSelect Select { selectTable = UnionTables False a b } <- pure (select (union_ hireDates leaveDates)) a @?= SelectTable Nothing (ProjExprs [ (ExpressionValue (Value ("hire" :: Text)), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res1") ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) Nothing Nothing Nothing b @?= SelectTable Nothing (ProjExprs [ (ExpressionValue (Value ("leave" :: Text)), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res1") ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) (Just (ExpressionIsNotNull (ExpressionFieldName (QualifiedField "t0" "leave_date")))) Nothing Nothing pure () fieldNamesCapturedCorrectly = testCase "UNION field names are propagated correctly" $ do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) ) hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (as_ @Text $ val_ "leave", _employeeAge e, _employeeLeaveDate e) SqlSelect Select { selectTable = SelectTable { .. }, selectLimit = Nothing, selectOffset = Nothing, selectOrdering = [] } <- pure (select $ do (type_, age, date) <- limit_ 10 (union_ hireDates leaveDates) guard_ (age <. 22) pure (type_, age + 23, date)) Just (FromTable (TableFromSubSelect subselect) (Just subselectTbl)) <- pure selectFrom selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField subselectTbl "res0"), Just "res0") , (ExpressionBinOp "+" (ExpressionFieldName (QualifiedField subselectTbl "res1")) (ExpressionValue (Value (23 :: Int))), Just "res1") , (ExpressionFieldName (QualifiedField subselectTbl "res2"), Just "res2") ] selectHaving @?= Nothing selectGrouping @?= Nothing selectWhere @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField subselectTbl "res1")) (ExpressionValue (Value (22 :: Int)))) Select { selectTable = UnionTables False hireDatesQuery leaveDatesQuery , selectLimit = Just 10, selectOffset = Nothing , selectOrdering = [] } <- pure subselect hireDatesQuery @?= SelectTable Nothing (ProjExprs [ ( ExpressionValue (Value ("hire" :: Text)), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "age"), Just "res1" ) , ( ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res2" ) ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) Nothing Nothing Nothing leaveDatesQuery @?= SelectTable Nothing (ProjExprs [ ( ExpressionValue (Value ("leave" :: Text)), Just "res0" ) , ( ExpressionFieldName (QualifiedField "t0" "age"), Just "res1") , ( ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res2") ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) (Just (ExpressionIsNotNull (ExpressionFieldName (QualifiedField "t0" "leave_date")))) Nothing Nothing pure () basicIntersect = testCase "intersect_ generates INTERSECT combination" $ do let hireDates = do e <- all_ (_employees employeeDbSettings) pure (_employeeFirstName e, _employeeLastName e) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (_employeeFirstName e, _employeeLastName e) SqlSelect Select { selectTable = IntersectTables False _ _ } <- pure $ select $ intersect_ hireDates leaveDates pure () basicExcept = testCase "except_ generates EXCEPT combination" $ do let hireDates = do e <- all_ (_employees employeeDbSettings) pure (_employeeFirstName e, _employeeLastName e) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (_employeeFirstName e, _employeeLastName e) SqlSelect Select { selectTable = ExceptTable False _ _ } <- pure $ select $ except_ hireDates leaveDates pure () equalProjectionsDontHaveSubSelects = testCase "Equal projections dont have sub-selects" $ do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Text, QExpr Expression s Int ) hireDates = do e <- all_ (_employees employeeDbSettings) pure (_employeeFirstName e, _employeeLastName e, _employeeAge e) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (_employeeFirstName e, _employeeLastName e, _employeeAge e) SqlSelect Select { selectTable = ExceptTable False _ _ } <- pure $ select $ do (firstName, lastName, age) <- except_ hireDates leaveDates pure (firstName, (lastName, age)) pure () unionWithGuards = testCase "UNION with guards" $ do let leaveDates, hireDates :: Q _ _ s ( QExpr Expression s Text, QExpr Expression s Int, QExpr Expression s (Maybe _) ) hireDates = do e <- all_ (_employees employeeDbSettings) pure (as_ @Text $ val_ "hire", _employeeAge e, just_ (_employeeHireDate e)) leaveDates = do e <- all_ (_employees employeeDbSettings) guard_ (isJust_ (_employeeLeaveDate e)) pure (as_ @Text $ val_ "leave", _employeeAge e, _employeeLeaveDate e) SqlSelect Select { selectTable = SelectTable { selectFrom = Just (FromTable (TableFromSubSelect (Select (UnionTables False a b) [] Nothing Nothing)) (Just t0)) , selectProjection = proj , selectWhere = Just where_ , selectGrouping = Nothing , selectHaving = Nothing , selectQuantifier = Nothing } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = [] } <- pure (select (filter_ (\(_, age, _) -> age <. 40) (union_ hireDates leaveDates))) a @?= SelectTable Nothing (ProjExprs [ (ExpressionValue (Value ("hire" :: Text)), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "age"), Just "res1") , (ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res2") ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) Nothing Nothing Nothing b @?= SelectTable Nothing (ProjExprs [ (ExpressionValue (Value ("leave" :: Text)), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "age"), Just "res1") , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res2") ]) (Just (FromTable (TableNamed "employees") (Just "t0"))) (Just (ExpressionIsNotNull (ExpressionFieldName (QualifiedField "t0" "leave_date")))) Nothing Nothing proj @?= ProjExprs [ ( ExpressionFieldName (QualifiedField t0 "res0"), Just "res0" ) , ( ExpressionFieldName (QualifiedField t0 "res1"), Just "res1" ) , ( ExpressionFieldName (QualifiedField t0 "res2"), Just "res2" ) ] where_ @?= ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "res1")) (ExpressionValue (Value (40 :: Int))) pure () -- | Ensure simple selects can be used with limit_ and offset_ limitOffset :: TestTree limitOffset = testGroup "LIMIT/OFFSET support" [ limitSupport, offsetSupport, limitOffsetSupport , limitPlacedOnUnion ] where limitSupport = testCase "Basic LIMIT support" $ do SqlSelect Select { selectLimit, selectOffset } <- pure $ select $ limit_ 100 $ limit_ 20 (all_ (_employees employeeDbSettings)) selectLimit @?= Just 20 selectOffset @?= Nothing offsetSupport = testCase "Basic OFFSET support" $ do SqlSelect Select { selectLimit, selectOffset } <- pure $ select $ offset_ 2 $ offset_ 100 (all_ (_employees employeeDbSettings)) selectLimit @?= Nothing selectOffset @?= Just 102 limitOffsetSupport = testCase "Basic LIMIT .. OFFSET .. support" $ do SqlSelect Select { selectLimit, selectOffset } <- pure $ select $ offset_ 2 $ limit_ 100 (all_ (_roles employeeDbSettings)) selectLimit @?= Just 98 selectOffset @?= Just 2 limitPlacedOnUnion = testCase "LIMIT placed on UNION" $ do SqlSelect Select { selectOffset = Nothing, selectLimit = Just 10 , selectOrdering = [] , selectTable = UnionTables False a b } <- pure $ select $ limit_ 10 $ union_ (filter_ (\e -> _employeeAge e <. 40) (all_ (_employees employeeDbSettings))) (filter_ (\e -> _employeeAge e >. 50) (do { e <- all_ (_employees employeeDbSettings); pure e { _employeeFirstName = _employeeLastName e, _employeeLastName = _employeeFirstName e} })) selectProjection a @?= ProjExprs [ (ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "last_name"), Just "res1") , (ExpressionFieldName (QualifiedField "t0" "phone_number"), Just "res2") , (ExpressionFieldName (QualifiedField "t0" "age"), Just "res3") , (ExpressionFieldName (QualifiedField "t0" "salary"), Just "res4") , (ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res5") , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6") , (ExpressionFieldName (QualifiedField "t0" "created"), Just "res7") ] selectFrom a @?= Just (FromTable (TableNamed "employees") (Just "t0")) selectWhere a @?= Just (ExpressionCompOp "<" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (40 :: Int)))) selectGrouping a @?= Nothing selectHaving a @?= Nothing selectProjection b @?= ProjExprs [ (ExpressionFieldName (QualifiedField "t0" "last_name"), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res1") , (ExpressionFieldName (QualifiedField "t0" "phone_number"), Just "res2") , (ExpressionFieldName (QualifiedField "t0" "age"), Just "res3") , (ExpressionFieldName (QualifiedField "t0" "salary"), Just "res4") , (ExpressionFieldName (QualifiedField "t0" "hire_date"), Just "res5") , (ExpressionFieldName (QualifiedField "t0" "leave_date"), Just "res6") , (ExpressionFieldName (QualifiedField "t0" "created"), Just "res7") ] selectFrom b @?= Just (FromTable (TableNamed "employees") (Just "t0")) selectWhere b @?= Just (ExpressionCompOp ">" Nothing (ExpressionFieldName (QualifiedField "t0" "age")) (ExpressionValue (Value (50 :: Int)))) selectGrouping b @?= Nothing selectHaving b @?= Nothing -- | Ensures exists predicates generate table names that do not overlap existsTest :: TestTree existsTest = testGroup "EXISTS() tests" [ existsInWhere ] where existsInWhere = testCase "EXISTS() in WHERE" $ do SqlSelect Select { selectOffset = Nothing, selectLimit = Nothing , selectOrdering = [] , selectTable = SelectTable { .. } } <- pure $ select $ do role <- all_ (_roles employeeDbSettings) guard_ (not_ (exists_ (do dept <- all_ (_departments employeeDbSettings) guard_ (_departmentName dept ==. _roleName role) pure (as_ @Int 1)))) pure role let existsQuery = Select { selectOffset = Nothing, selectLimit = Nothing , selectOrdering = [] , selectTable = SelectTable { selectQuantifier = Nothing , selectProjection = ProjExprs [ (ExpressionValue (Value (1 :: Int)), Just "res0") ] , selectGrouping = Nothing , selectHaving = Nothing , selectWhere = Just joinExpr , selectFrom = Just (FromTable (TableNamed "departments") (Just "sub_t0")) } } joinExpr = ExpressionCompOp "==" Nothing (ExpressionFieldName (QualifiedField "sub_t0" "name")) (ExpressionFieldName (QualifiedField "t0" "name")) selectGrouping @?= Nothing selectWhere @?= Just (ExpressionUnOp "NOT" (ExpressionExists existsQuery)) selectHaving @?= Nothing selectQuantifier @?= Nothing selectFrom @?= Just (FromTable (TableNamed "roles") (Just "t0")) -- | UPDATE can correctly get the current value updateCurrent :: TestTree updateCurrent = testCase "UPDATE can use current value" $ do SqlUpdate Update { .. } <- pure $ update (_employees employeeDbSettings) (\employee -> [ _employeeAge employee <-. current_ (_employeeAge employee) + 1]) (\employee -> _employeeFirstName employee ==. "Joe") updateTable @?= "employees" updateFields @?= [ (UnqualifiedField "age", ExpressionBinOp "+" (ExpressionFieldName (UnqualifiedField "age")) (ExpressionValue (Value (1 :: Int)))) ] updateWhere @?= Just (ExpressionCompOp "==" Nothing (ExpressionFieldName (UnqualifiedField "first_name")) (ExpressionValue (Value ("Joe" :: String)))) updateNullable :: TestTree updateNullable = testCase "UPDATE can correctly set a nullable field" $ do curTime <- getCurrentTime let employeeKey :: PrimaryKey EmployeeT (Nullable Identity) employeeKey = EmployeeId (Just "John") (Just "Smith") (Just curTime) SqlUpdate Update { .. } <- pure $ update (_departments employeeDbSettings) (\department -> [ _departmentHead department <-. val_ employeeKey ]) (\department -> _departmentName department ==. "Sales") updateTable @?= "departments" updateFields @?= [ (UnqualifiedField "head__first_name", ExpressionValue (Value ("John" :: Text))) , (UnqualifiedField "head__last_name", ExpressionValue (Value ("Smith" :: Text))) , (UnqualifiedField "head__created", ExpressionValue (Value curTime)) ] updateWhere @?= Just (ExpressionCompOp "==" Nothing (ExpressionFieldName (UnqualifiedField "name")) (ExpressionValue (Value ("Sales" :: String)))) -- | Ensure empty IN operators transform into FALSE noEmptyIns :: TestTree noEmptyIns = testCase "Empty INs are transformed to FALSE" $ do SqlSelect Select { selectTable = SelectTable {..} } <- pure $ select $ do e <- all_ (_employees employeeDbSettings) guard_ (_employeeFirstName e `in_` []) pure e selectWhere @?= Just (ExpressionValue (Value False)) -- | ORDER BY in first join causes incorrect projection in subquery gh70OrderByInFirstJoinCausesIncorrectProjection :: TestTree gh70OrderByInFirstJoinCausesIncorrectProjection = testGroup "#70: ORDER BY as first join causes incorrect projection" [ testCase "Simple" simple , testCase "Grouping" grouping , testCase "Top-level OFFSET 0" topLevelOffs0 ] where employees = "t0"; roles = "t1" eqE = ExpressionCompOp "==" Nothing andE = ExpressionBinOp "AND" firstNameCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__first_name")) (ExpressionFieldName (QualifiedField employees "res0")) lastNameCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__last_name")) (ExpressionFieldName (QualifiedField employees "res1")) createdCond = eqE (ExpressionFieldName (QualifiedField roles "for_employee__created")) (ExpressionFieldName (QualifiedField employees "res7")) simple = do let employeesMakingSixFigures = orderBy_ (\e -> desc_ (_employeeAge e)) $ filter_ (\e -> _employeeSalary e >=. 100000) $ all_ (_employees employeeDbSettings) richEmployeesAndRoles = do employee <- employeesMakingSixFigures role <- all_ (_roles employeeDbSettings) guard_ (_roleForEmployee role `references_` employee) pure (_roleName role, employee) SqlSelect Select { selectTable = SelectTable { .. } , .. } <- pure $ select richEmployeesAndRoles selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField roles "name") , Just "res0") , (ExpressionFieldName (QualifiedField employees "res0"), Just "res1") , (ExpressionFieldName (QualifiedField employees "res1"), Just "res2") , (ExpressionFieldName (QualifiedField employees "res2"), Just "res3") , (ExpressionFieldName (QualifiedField employees "res3"), Just "res4") , (ExpressionFieldName (QualifiedField employees "res4"), Just "res5") , (ExpressionFieldName (QualifiedField employees "res5"), Just "res6") , (ExpressionFieldName (QualifiedField employees "res6"), Just "res7") , (ExpressionFieldName (QualifiedField employees "res7"), Just "res8") ] selectGrouping @?= Nothing selectOrdering @?= [] selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectWhere @?= Just (andE (andE firstNameCond lastNameCond) createdCond) Just (InnerJoin (FromTable (TableFromSubSelect subselect) (Just "t0")) (FromTable (TableNamed "roles") (Just "t1")) Nothing) <- pure selectFrom Select { selectTable = SelectTable { .. } , .. } <- pure subselect selectGrouping @?= Nothing selectLimit @?= Nothing selectOffset @?= Nothing selectHaving @?= Nothing selectOrdering @?= [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "age")) ] selectWhere @?= Just (ExpressionCompOp ">=" Nothing (ExpressionFieldName (QualifiedField "t0" "salary")) (ExpressionValue (Value (100000 :: Double)))) selectProjection @?= ProjExprs [ (ExpressionFieldName (QualifiedField "t0" "first_name") , Just "res0") , (ExpressionFieldName (QualifiedField "t0" "last_name") , Just "res1") , (ExpressionFieldName (QualifiedField "t0" "phone_number") , Just "res2") , (ExpressionFieldName (QualifiedField "t0" "age") , Just "res3") , (ExpressionFieldName (QualifiedField "t0" "salary") , Just "res4") , (ExpressionFieldName (QualifiedField "t0" "hire_date") , Just "res5") , (ExpressionFieldName (QualifiedField "t0" "leave_date") , Just "res6") , (ExpressionFieldName (QualifiedField "t0" "created") , Just "res7") ] grouping = do let employeeNamesWhoMakeSixFiguresOnAverage = orderBy_ (\(fn, _) -> desc_ fn) $ filter_ (\(_, sl) -> sl >=. val_ 100000) $ aggregate_ (\e -> ( group_ (_employeeFirstName e) , fromMaybe_ 0 $ avg_ (_employeeSalary e) )) $ all_ (_employees employeeDbSettings) richEmployeeNamesAndRoles = do (fn, sl) <- employeeNamesWhoMakeSixFiguresOnAverage role <- all_ (_roles employeeDbSettings) let EmployeeId roleForEmployee_firstName _ _ = _roleForEmployee role guard_ (roleForEmployee_firstName ==. fn) pure (_roleName role, fn, sl) SqlSelect Select { selectTable = SelectTable { selectQuantifier = Nothing , selectProjection = ProjExprs [ (ExpressionFieldName (QualifiedField "t1" "name"), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "res0"), Just "res1") , (ExpressionFieldName (QualifiedField "t0" "res1"), Just "res2") ] , selectGrouping = Nothing, selectHaving = Nothing , selectWhere = Just selectWhere , selectFrom = Just (InnerJoin (FromTable (TableFromSubSelect Select { selectTable = SelectTable { selectQuantifier = Nothing , selectWhere = Nothing , .. } , selectLimit = Nothing, selectOffset = Nothing , selectOrdering = selectOrdering }) (Just "t0")) (FromTable (TableNamed "roles") (Just "t1")) Nothing) } , selectOrdering = [] , selectLimit = Nothing , selectOffset = Nothing } <- pure $ select $ richEmployeeNamesAndRoles selectWhere @?= firstNameCond selectOrdering @?= [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "first_name")) ] selectGrouping @?= Just (Grouping [ ExpressionFieldName (QualifiedField "t0" "first_name") ]) selectHaving @?= Just (ExpressionCompOp ">=" Nothing (ExpressionCoalesce [ ExpressionAgg "AVG" Nothing [ ExpressionFieldName (QualifiedField "t0" "salary") ] , ExpressionValue (Value (0 :: Double)) ]) (ExpressionValue (Value (100000 :: Double)))) selectProjection @?= ProjExprs [ ( ExpressionFieldName (QualifiedField "t0" "first_name"), Just "res0" ) , ( ExpressionCoalesce [ ExpressionAgg "AVG" Nothing [ ExpressionFieldName (QualifiedField "t0" "salary") ] , ExpressionValue (Value (0 :: Double)) ] , Just "res1" ) ] topLevelOffs0 = do SqlSelect actual <- pure $ select $ do e <- orderBy_ (\e -> desc_ (_employeeAge e)) $ offset_ 0 $ filter_ (\e -> _employeeSalary e >=. val_ 100000) $ all_ (_employees employeeDbSettings) role <- all_ (_roles employeeDbSettings) let EmployeeId roleForEmployee_firstName _ _ = _roleForEmployee role guard_ (roleForEmployee_firstName ==. _employeeFirstName e) pure (_roleName role, _employeeFirstName e) let expected = Select { selectTable = SelectTable { selectQuantifier = Nothing , selectProjection = ProjExprs [ (ExpressionFieldName (QualifiedField "t1" "name"), Just "res0") , (ExpressionFieldName (QualifiedField "t0" "res0"), Just "res1") ] , selectGrouping = Nothing, selectHaving = Nothing , selectWhere = Just firstNameCond , selectFrom = Just (InnerJoin (FromTable (TableFromSubSelect Select { selectTable = SelectTable { selectQuantifier = Nothing , selectProjection = ProjExprs [ (ExpressionFieldName (QualifiedField "t0" "first_name") , Just "res0") , (ExpressionFieldName (QualifiedField "t0" "last_name") , Just "res1") , (ExpressionFieldName (QualifiedField "t0" "phone_number") , Just "res2") , (ExpressionFieldName (QualifiedField "t0" "age") , Just "res3") , (ExpressionFieldName (QualifiedField "t0" "salary") , Just "res4") , (ExpressionFieldName (QualifiedField "t0" "hire_date") , Just "res5") , (ExpressionFieldName (QualifiedField "t0" "leave_date") , Just "res6") , (ExpressionFieldName (QualifiedField "t0" "created") , Just "res7") ] , selectWhere = Just (ExpressionCompOp ">=" Nothing (ExpressionFieldName (QualifiedField "t0" "salary")) (ExpressionValue (Value (100000 :: Double)))) , selectFrom = Just (FromTable (TableNamed "employees") (Just "t0")) , selectGrouping = Nothing, selectHaving = Nothing } , selectLimit = Nothing, selectOffset = Just 0 , selectOrdering = [ OrderingDesc (ExpressionFieldName (QualifiedField "t0" "age"))] }) (Just "t0")) (FromTable (TableNamed "roles") (Just "t1")) Nothing) } , selectOrdering = [] , selectLimit = Nothing , selectOffset = Nothing } actual @?= expected