Test suite still broken
This commit is contained in:
parent
5a78c156c2
commit
43813cdfe2
@ -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
|
||||||
|
|||||||
45
test/Test.hs
45
test/Test.hs
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user