Fixing composite key support for group by

.editorconfig

@@ -0,0 +1,20 @@
+# http://editorconfig.org
+root = true
+
+[Makefile]
+indent_style = tabs
+indent_size = 8
+end_of_line = lf
+charset = utf-8
+trim_trailing_whitespace = true
+insert_final_newline = true
+
+[*.{hs,md,php}]
+indent_style = space
+indent_size = 2
+tab_width = 2
+end_of_line = lf
+charset = utf-8
+trim_trailing_whitespace = true
+insert_final_newline = true
+max_line_length = 80

src/Database/Esqueleto/Internal/Sql.hs

@@ -76,6 +76,7 @@ import qualified Data.Text.Lazy.Builder as TLB
 
 import Database.Esqueleto.Internal.Language
 
+import System.IO.Unsafe
 
 -- | SQL backend for @esqueleto@ using 'SqlPersistT'.
 newtype SqlQuery a =
@@ -1099,13 +1100,19 @@ makeGroupBy :: IdentInfo -> GroupByClause -> (TLB.Builder, [PersistValue])
 makeGroupBy _ (GroupBy []) = (mempty, [])
 makeGroupBy info (GroupBy fields) = first ("\nGROUP BY " <>) build
   where
-    build = uncommas' $ map (\(SomeValue (ERaw _ f)) -> f info) fields
+    build :: (TLB.Builder, [PersistValue])
+    build = uncommas' $ map match fields
+
+    match :: SomeValue SqlExpr -> (TLB.Builder, [PersistValue])
+    match (SomeValue (ERaw _ f)) = f info
+    -- match (SomeValue (ECompositeKey f)) = (mconcat $ f info, mempty)
 
 makeHaving :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])
 makeHaving _    NoWhere                    = mempty
 makeHaving info (Where (ERaw _ f))         = first ("\nHAVING " <>) (f info)
-makeHaving _    (Where (ECompositeKey _ )) = unexpectedCompositeKeyError "makeHaving"
+makeHaving _    (Where (ECompositeKey _)) = unexpectedCompositeKeyError "makeHaving"
 
+-- makeHaving, makeWhere and makeOrderBy
 makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue])
 makeOrderBy _    [] = mempty
 makeOrderBy info os = first ("\nORDER BY " <>) . uncommas' $ concatMap mk os

stack-8.0.yaml

@@ -1,6 +1,6 @@
 # resolver: nightly-2017-01-10
-resolver: lts-7.16
+resolver: lts-8.8
-compiler: ghc-8.0.2
+# compiler: ghc-8.0.2
 
 packages:
 - '.'

stack.yaml

@@ -1 +1 @@
-stack-7.10.yaml
+stack-8.0.yaml

test/Test.hs

@@ -1076,6 +1076,22 @@ main = do
                                   , (Entity p1k p1, Value 3)
                                   , (Entity p3k p3, Value 7) ]
 
+      it "GROUP BY works with COUNT and InnerJoin" $
+        run $ do
+          p1k <- insert p1
+          p2k <- insert p2
+          p3k <- insert p3
+          replicateM_ 3 (insert $ BlogPost "" p1k)
+          replicateM_ 7 (insert $ BlogPost "" p3k)
+          (ret :: [(Value (Key Person), Value Int)]) <- select $ from $
+            \ ( person `InnerJoin` post ) -> do
+            on $ person ^. PersonId ==. post ^. BlogPostAuthorId
+            groupBy (person ^. PersonId)
+            return (person ^. PersonId, count $ post ^. BlogPostId)
+          liftIO $ print ret
+          liftIO $ ret `shouldBe` [ (Value p1k, Value 3)
+                                  , (Value p3k, Value 7) ]
+
       it "GROUP BY works with HAVING" $
         run $ do
           p1k <- insert p1