From 5a78c156c2dda69da138e8b8263dccf6aed45828 Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Thu, 27 Apr 2017 22:49:48 -0500 Subject: [PATCH 1/4] Fixing composite key support for group by --- .editorconfig | 20 ++++++++++++++++++++ src/Database/Esqueleto/Internal/Sql.hs | 11 +++++++++-- stack-8.0.yaml | 4 ++-- stack.yaml | 2 +- test/Test.hs | 16 ++++++++++++++++ 5 files changed, 48 insertions(+), 5 deletions(-) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..9f49510 --- /dev/null +++ b/.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 diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 97779c2..ad14c40 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/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 diff --git a/stack-8.0.yaml b/stack-8.0.yaml index 8935c8c..5b854e7 100644 --- a/stack-8.0.yaml +++ b/stack-8.0.yaml @@ -1,6 +1,6 @@ # resolver: nightly-2017-01-10 -resolver: lts-7.16 -compiler: ghc-8.0.2 +resolver: lts-8.8 +# compiler: ghc-8.0.2 packages: - '.' diff --git a/stack.yaml b/stack.yaml index 177aa94..12a3c04 120000 --- a/stack.yaml +++ b/stack.yaml @@ -1 +1 @@ -stack-7.10.yaml \ No newline at end of file +stack-8.0.yaml \ No newline at end of file diff --git a/test/Test.hs b/test/Test.hs index cb7189b..e54bb9b 100644 --- a/test/Test.hs +++ b/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 From 43813cdfe2b253e9f08669bd89cc8f05b5d44265 Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Fri, 28 Apr 2017 00:08:05 -0500 Subject: [PATCH 2/4] Test suite still broken --- src/Database/Esqueleto/Internal/Sql.hs | 4 +-- test/Test.hs | 45 +++++++++++++++++++------- 2 files changed, 34 insertions(+), 15 deletions(-) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index ad14c40..fe0c66a 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -76,8 +76,6 @@ 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 = Q { unQ :: W.WriterT SideData (S.State IdentState) a } @@ -1105,7 +1103,7 @@ makeGroupBy info (GroupBy fields) = first ("\nGROUP BY " <>) build match :: SomeValue SqlExpr -> (TLB.Builder, [PersistValue]) match (SomeValue (ERaw _ f)) = f info - -- match (SomeValue (ECompositeKey f)) = (mconcat $ f info, mempty) + match (SomeValue (ECompositeKey f)) = (mconcat $ f info, mempty) makeHaving :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue]) makeHaving _ NoWhere = mempty diff --git a/test/Test.hs b/test/Test.hs index e54bb9b..8cb7955 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -72,6 +72,19 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| title String authorId PersonId deriving Eq Show + + Lord + county String + dogs Int Maybe + Primary county + deriving Show + + Deed + contract String + ownerId LordId + Primary contract + deriving Show + Follow follower PersonId followed PersonId @@ -132,6 +145,10 @@ main = do p3 = Person "Mike" (Just 17) Nothing 3 p4 = Person "Livia" (Just 17) (Just 18) 4 p5 = Person "Mitch" Nothing Nothing 5 + l1 = Lord "Cornwall" (Just 36) + l2 = Lord "Dorset" Nothing + l3 = Lord "Chester" (Just 17) + hspec $ do describe "select" $ do it "works for a single value" $ @@ -1078,19 +1095,23 @@ main = do 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) + l1k <- insert l1 + l2k <- insert l2 + l3k <- insert l3 + liftIO $ putStrLn "****** l3 ******" + replicateM_ 3 (insert $ Deed "" l1k) + liftIO $ putStrLn "****** l1k ******" + replicateM_ 7 (insert $ Deed "" l3k) + liftIO $ putStrLn "****** l3k ******" + (ret :: [(Value (Key Lord), Value Int)]) <- select $ from $ + \ ( lord `InnerJoin` deed ) -> do + on $ lord ^. LordId ==. deed ^. DeedOwnerId + groupBy (lord ^. LordId) + return (lord ^. LordId, count $ deed ^. DeedId) + liftIO $ putStrLn "****** ret ******" liftIO $ print ret - liftIO $ ret `shouldBe` [ (Value p1k, Value 3) - , (Value p3k, Value 7) ] + liftIO $ ret `shouldBe` [ (Value l1k, Value 3) + , (Value l3k, Value 7) ] it "GROUP BY works with HAVING" $ run $ do From 5609d78de4443d1f79bdcbc0dd86e458a67cea34 Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Thu, 4 May 2017 21:45:35 -0500 Subject: [PATCH 3/4] Helps if you vary the primary key --- Makefile | 9 +++++++++ test/Test.hs | 20 +++++++++++--------- 2 files changed, 20 insertions(+), 9 deletions(-) diff --git a/Makefile b/Makefile index c27246a..1e78236 100644 --- a/Makefile +++ b/Makefile @@ -5,3 +5,12 @@ build-7.10: build-8.0: STACK_YAML="stack-8.0.yaml" stack build + +ghci: + stack ghci + +test: + stack test + +test-ghci: + stack ghci esqueleto:test:test diff --git a/test/Test.hs b/test/Test.hs index 8cb7955..e3eed29 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1098,20 +1098,22 @@ main = do l1k <- insert l1 l2k <- insert l2 l3k <- insert l3 - liftIO $ putStrLn "****** l3 ******" - replicateM_ 3 (insert $ Deed "" l1k) - liftIO $ putStrLn "****** l1k ******" - replicateM_ 7 (insert $ Deed "" l3k) - liftIO $ putStrLn "****** l3k ******" + -- liftIO $ putStrLn "****** l3 ******" + mapM_ (\k -> insert $ Deed k l1k) (map show [1..3]) + + -- liftIO $ putStrLn "****** l1k ******" + mapM_ (\k -> insert $ Deed k l3k) (map show [4..10]) + + -- liftIO $ putStrLn "****** l3k ******" (ret :: [(Value (Key Lord), Value Int)]) <- select $ from $ \ ( lord `InnerJoin` deed ) -> do on $ lord ^. LordId ==. deed ^. DeedOwnerId groupBy (lord ^. LordId) return (lord ^. LordId, count $ deed ^. DeedId) - liftIO $ putStrLn "****** ret ******" - liftIO $ print ret - liftIO $ ret `shouldBe` [ (Value l1k, Value 3) - , (Value l3k, Value 7) ] + -- liftIO $ putStrLn "****** ret ******" + -- liftIO $ print ret + liftIO $ ret `shouldBe` [ (Value l3k, Value 7) + , (Value l1k, Value 3) ] it "GROUP BY works with HAVING" $ run $ do From 14a28ab32d18b3356e28ef93de4ac5de81148e35 Mon Sep 17 00:00:00 2001 From: Chris Allen Date: Thu, 25 May 2017 11:19:41 -0500 Subject: [PATCH 4/4] Cleanup --- test/Test.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/test/Test.hs b/test/Test.hs index e3eed29..17255a5 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -1098,20 +1098,15 @@ main = do l1k <- insert l1 l2k <- insert l2 l3k <- insert l3 - -- liftIO $ putStrLn "****** l3 ******" mapM_ (\k -> insert $ Deed k l1k) (map show [1..3]) - -- liftIO $ putStrLn "****** l1k ******" mapM_ (\k -> insert $ Deed k l3k) (map show [4..10]) - -- liftIO $ putStrLn "****** l3k ******" (ret :: [(Value (Key Lord), Value Int)]) <- select $ from $ \ ( lord `InnerJoin` deed ) -> do on $ lord ^. LordId ==. deed ^. DeedOwnerId groupBy (lord ^. LordId) return (lord ^. LordId, count $ deed ^. DeedId) - -- liftIO $ putStrLn "****** ret ******" - -- liftIO $ print ret liftIO $ ret `shouldBe` [ (Value l3k, Value 7) , (Value l1k, Value 3) ]