Test suite still broken

This commit is contained in:
Chris Allen 2017-04-28 00:08:05 -05:00
parent 5a78c156c2
commit 43813cdfe2
2 changed files with 34 additions and 15 deletions

View File

@ -76,8 +76,6 @@ import qualified Data.Text.Lazy.Builder as TLB
import Database.Esqueleto.Internal.Language import Database.Esqueleto.Internal.Language
import System.IO.Unsafe
-- | SQL backend for @esqueleto@ using 'SqlPersistT'. -- | SQL backend for @esqueleto@ using 'SqlPersistT'.
newtype SqlQuery a = newtype SqlQuery a =
Q { unQ :: W.WriterT SideData (S.State IdentState) 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 SqlExpr -> (TLB.Builder, [PersistValue])
match (SomeValue (ERaw _ f)) = f info 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 :: IdentInfo -> WhereClause -> (TLB.Builder, [PersistValue])
makeHaving _ NoWhere = mempty makeHaving _ NoWhere = mempty

View File

@ -72,6 +72,19 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
title String title String
authorId PersonId authorId PersonId
deriving Eq Show deriving Eq Show
Lord
county String
dogs Int Maybe
Primary county
deriving Show
Deed
contract String
ownerId LordId
Primary contract
deriving Show
Follow Follow
follower PersonId follower PersonId
followed PersonId followed PersonId
@ -132,6 +145,10 @@ main = do
p3 = Person "Mike" (Just 17) Nothing 3 p3 = Person "Mike" (Just 17) Nothing 3
p4 = Person "Livia" (Just 17) (Just 18) 4 p4 = Person "Livia" (Just 17) (Just 18) 4
p5 = Person "Mitch" Nothing Nothing 5 p5 = Person "Mitch" Nothing Nothing 5
l1 = Lord "Cornwall" (Just 36)
l2 = Lord "Dorset" Nothing
l3 = Lord "Chester" (Just 17)
hspec $ do hspec $ do
describe "select" $ do describe "select" $ do
it "works for a single value" $ it "works for a single value" $
@ -1078,19 +1095,23 @@ main = do
it "GROUP BY works with COUNT and InnerJoin" $ it "GROUP BY works with COUNT and InnerJoin" $
run $ do run $ do
p1k <- insert p1 l1k <- insert l1
p2k <- insert p2 l2k <- insert l2
p3k <- insert p3 l3k <- insert l3
replicateM_ 3 (insert $ BlogPost "" p1k) liftIO $ putStrLn "****** l3 ******"
replicateM_ 7 (insert $ BlogPost "" p3k) replicateM_ 3 (insert $ Deed "" l1k)
(ret :: [(Value (Key Person), Value Int)]) <- select $ from $ liftIO $ putStrLn "****** l1k ******"
\ ( person `InnerJoin` post ) -> do replicateM_ 7 (insert $ Deed "" l3k)
on $ person ^. PersonId ==. post ^. BlogPostAuthorId liftIO $ putStrLn "****** l3k ******"
groupBy (person ^. PersonId) (ret :: [(Value (Key Lord), Value Int)]) <- select $ from $
return (person ^. PersonId, count $ post ^. BlogPostId) \ ( 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 $ print ret
liftIO $ ret `shouldBe` [ (Value p1k, Value 3) liftIO $ ret `shouldBe` [ (Value l1k, Value 3)
, (Value p3k, Value 7) ] , (Value l3k, Value 7) ]
it "GROUP BY works with HAVING" $ it "GROUP BY works with HAVING" $
run $ do run $ do