diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index c1a8cd7..d615351 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -390,7 +390,8 @@ infixl 6 +., -. infixr 5 ++. infix 4 ==., >=., >., <=., <., !=. infixr 3 &&., =., +=., -=., *=., /=. -infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin`, `like` +infixr 2 ||., `like` +infixl 2 `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `FullOuterJoin` -- | Syntax sugar for 'case_'. -- diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 1cd8893..ff09906 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -936,19 +936,20 @@ makeFrom info mode fs = ret where ret = case collectOnClauses fs of Left expr -> throw $ mkExc expr - Right fs' -> keyword $ uncommas' (map (mk Never mempty) fs') + Right fs' -> keyword $ uncommas' (map (mk Never) fs') keyword = case mode of UPDATE -> id _ -> first ("\nFROM " <>) - mk _ onClause (FromStart i def) = base i def <> onClause - mk paren onClause (FromJoin lhs kind rhs monClause) = + mk _ (FromStart i def) = base i def + mk paren (FromJoin lhs kind rhs monClause) = first (parensM paren) $ - mconcat [ mk Parens onClause lhs + mconcat [ mk Never lhs , (fromKind kind, mempty) - , mk Never (maybe mempty makeOnClause monClause) rhs + , mk Parens rhs + , maybe mempty makeOnClause monClause ] - mk _ _ (OnClause _) = error "Esqueleto/Sql/makeFrom: never here (is collectOnClauses working?)" + mk _ (OnClause _) = error "Esqueleto/Sql/makeFrom: never here (is collectOnClauses working?)" base ident@(I identText) def = let db@(DBName dbText) = entityDB def diff --git a/test/Test.hs b/test/Test.hs index 5c8d379..9d355b0 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -439,6 +439,19 @@ main = do retArt `shouldBe` article retTag `shouldBe` tag + it "respects the associativity of joins" $ + run $ do + insert' p1 + ps <- select . from $ + \((p :: SqlExpr (Entity Person)) + `LeftOuterJoin` + (( q :: SqlExpr (Entity Person)) + `InnerJoin` (r :: SqlExpr (Entity Person)))) -> do + on (val False) -- Inner join is empty + on (val True) + return p + liftIO $ (entityVal <$> ps) `shouldBe` [p1] + describe "select/where_" $ do it "works for a simple example with (==.)" $ run $ do