Merge pull request #97 from Philonous/joins

fix rendering of joins

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_'.
 --

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

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