on master help sign in
Maybe fixed direction bug (?)
e141ccciko
denis/src/Data/Query.hs+49−38
@@ -176,15 +176,20 @@ isNotFalse x = UnsafeExpression $ renderExpression x <+> "IS NOT FALSE"
176getLastPostsQ
176getLastPostsQ
177 :: TableEndo _ _ _ _
177 :: TableEndo _ _ _ _
178 -> Limit
178 -> Limit
179− -> ConditionOp Schema _ _ _ _ _ _
179+ -> P.PaginationDirection
180 -> Query Schema ('Null (PG Int64) ': params) (RowPG PostRowResponse)
180 -> Query Schema ('Null (PG Int64) ': params) (RowPG PostRowResponse)
181−getLastPostsQ te lim (.^) = getPostQ
181+getLastPostsQ te lim dir = getPostQ
182− (orderBy [#postElements ! #rowElementOrd & Asc] . orderBy [#posts ! #postRowId & Desc])
182+ (orderBy [#postElements ! #rowElementId & Desc, #postElements ! #rowElementOrd & Asc])
183+ (limit lim .
184+ te .
185+ where_ (ifThenElse (isNull $ param @1) true $ #posts ! #postRowId .^ param @1) .
183− (limit lim . te . where_ (isNotFalse $ #posts ! #postRowId .^ param @1) . orderBy [#posts ! #postRowId & Desc])
186+ orderBy [#posts ! #postRowId & order])
187+ where
188+ ((.^), order) = directionToOperator dir
184
189
185getLastNPostsForUserQ
190getLastNPostsForUserQ
186 :: Limit
191 :: Limit
187− -> ConditionOp Schema _ _ _ _ _ _
192+ -> P.PaginationDirection
188 -> Query Schema (TuplePG (Maybe PostId, UserId)) (RowPG PostRowResponse)
193 -> Query Schema (TuplePG (Maybe PostId, UserId)) (RowPG PostRowResponse)
189getLastNPostsForUserQ = getLastPostsQ $ where_ (#posts ! #postRowAuthorId .== param @2)
194getLastNPostsForUserQ = getLastPostsQ $ where_ (#posts ! #postRowAuthorId .== param @2)
190
195
@@ -246,24 +251,21 @@ updateNamedChannelQ = update_ #channels
246
251
247getChannelPostsQ
252getChannelPostsQ
248 :: Limit
253 :: Limit
249− -> ConditionOp Schema _ _ _ _ _ _
254+ -> P.PaginationDirection
250 -> [UserId]
255 -> [UserId]
251 -> Vector Text
256 -> Vector Text
252 -> Query
257 -> Query
253 Schema
258 Schema
254 (TuplePG (Only (Maybe PostId))) -- ^ post id from which to start
259 (TuplePG (Only (Maybe PostId))) -- ^ post id from which to start
255 (RowPG PostRowResponse)
260 (RowPG PostRowResponse)
256−getChannelPostsQ lim (.^) uIds tags = selectStar $ from (subquery $ postsQ' `As` #bar) &
261+getChannelPostsQ lim dir uIds tags = getLastPostsQ
257− where_ (isNotFalse $ #postRowId .^ param @1) &
262+ (where_ $ jsonbLit tags .?| #postRowTags .|| isUser #postRowAuthorId)
258− orderBy [#rowElementOrd & Asc] & limit lim . orderBy [#postRowId & Desc]
263+ lim
264+ dir
259 where
265 where
260− unionWithUsers = case idsToColumn uIds of
266+ isUser = case idsToColumn uIds of
261− Just uIdsQ -> selectDotStar #posts' (from $ subquery (uIdsQ `As` #uIds) &
267+ Just uIdsQ -> (`in_` uIdsQ)
262− innerJoin (subquery $ getPostQ id id `As` #posts')
263− (#uIds ! #id .== #posts' ! #postRowAuthorId)) &
264− union
265− Nothing -> id
268+ Nothing -> const $ false
266− postsQ' = unionWithUsers $ getPostQ id $ where_ $ jsonbLit tags .?| #postRowTags
267
269
268getTagsQ :: Query Schema '[] (RowPG (Only String))
270getTagsQ :: Query Schema '[] (RowPG (Only String))
269getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $
271getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $
@@ -323,9 +325,9 @@ type ChatQueryParams = TuplePG
323
325
324getChatsQ
326getChatsQ
325 :: Limit
327 :: Limit
326− -> ConditionOp Schema _ _ _ _ _ _
328+ -> P.PaginationDirection
327 -> Query Schema ChatQueryParams (RowPG ChatsResponse)
329 -> Query Schema ChatQueryParams (RowPG ChatsResponse)
328−getChatsQ lim (.^) = select (
330+getChatsQ lim dir = select (
329 #chats ! #messageId `as` #chatResponseMessageId :*
331 #chats ! #messageId `as` #chatResponseMessageId :*
330 #messages ! #messageStorageAuthorId `as` #chatResponseMessageAuthorId :*
332 #messages ! #messageStorageAuthorId `as` #chatResponseMessageAuthorId :*
331 #messages ! #messageStorageDestinationGroupId `as` #chatResponseMessageDestinationGroupId :*
333 #messages ! #messageStorageDestinationGroupId `as` #chatResponseMessageDestinationGroupId :*
@@ -345,9 +347,11 @@ getChatsQ lim (.^) = select (
345 where_ (isNull (#groupChats ! #groupChatUsers) .||
347 where_ (isNull (#groupChats ! #groupChatUsers) .||
346 (#groupChats ! #groupChatUsers .? param @2)) &
348 (#groupChats ! #groupChatUsers .? param @2)) &
347 where_ (isNotFalse $ #chats ! #messageId .^ param @3) &
349 where_ (isNotFalse $ #chats ! #messageId .^ param @3) &
348− orderBy [#chats ! #messageId & Desc] &
350+ orderBy [#chats ! #messageId & order] &
349− limit lim
351+ limit lim &
352+ orderBy [#chats ! #messageId & Desc]
350 where
353 where
354+ ((.^), order) = directionToOperator dir
351 chatsQ :: Query Schema _ ChatsQueryResponse
355 chatsQ :: Query Schema _ ChatsQueryResponse
352 chatsQ = unionAll groupChats userChats
356 chatsQ = unionAll groupChats userChats
353 where
357 where
@@ -381,33 +385,39 @@ getChatsQ lim (.^) = select (
381
385
382getMessagesQ
386getMessagesQ
383 :: Limit
387 :: Limit
384− -> ConditionOp Schema _ _ _ _ _ _
388+ -> P.PaginationDirection
385 -> Query Schema (TuplePG
389 -> Query Schema (TuplePG
386 ( UserId
390 ( UserId
387 , UserId
391 , UserId
388 , Maybe MessageId
392 , Maybe MessageId
389 )) (RowPG MessageStorage)
393 )) (RowPG MessageStorage)
390−getMessagesQ lim (.^) = selectStar (from (table #messages) &
394+getMessagesQ lim dir = selectStar (from (table #messages) &
391 where_ (isNotNull #messageStorageDestinationUserId .&&
395 where_ (isNotNull #messageStorageDestinationUserId .&&
392 ((#messageStorageAuthorId .== param @1 .&& #messageStorageDestinationUserId .== param @2) .||
396 ((#messageStorageAuthorId .== param @1 .&& #messageStorageDestinationUserId .== param @2) .||
393 (#messageStorageDestinationUserId .== param @1 .&& #messageStorageAuthorId .== param @2))) &
397 (#messageStorageDestinationUserId .== param @1 .&& #messageStorageAuthorId .== param @2))) &
394 where_ (isNotFalse $ #messageStorageId .^ param @3) &
398 where_ (isNotFalse $ #messageStorageId .^ param @3) &
395− orderBy [#messageStorageId & Desc] &
399+ orderBy [#messageStorageId & order] &
396− limit lim)
400+ limit lim &
401+ orderBy [#messageStorageId & Desc])
402+ where
403+ ((.^), order) = directionToOperator dir
397
404
398getGroupMessagesQ
405getGroupMessagesQ
399 :: Limit
406 :: Limit
400− -> ConditionOp Schema _ _ _ _ _ _
407+ -> P.PaginationDirection
401 -> Query Schema (TuplePG
408 -> Query Schema (TuplePG
402 ( GroupChatId
409 ( GroupChatId
403 , Maybe MessageId
410 , Maybe MessageId
404 )) (RowPG MessageStorage)
411 )) (RowPG MessageStorage)
405−getGroupMessagesQ lim (.^) = selectStar (from (table #messages) &
412+getGroupMessagesQ lim dir = selectStar (from (table #messages) &
406 where_ (isNotNull #messageStorageDestinationGroupId .&&
413 where_ (isNotNull #messageStorageDestinationGroupId .&&
407 (#messageStorageDestinationGroupId .== param @1)) &
414 (#messageStorageDestinationGroupId .== param @1)) &
408 where_ (isNotFalse $ #messageStorageId .^ param @2) &
415 where_ (isNotFalse $ #messageStorageId .^ param @2) &
409− orderBy [#messageStorageId & Desc] &
416+ orderBy [#messageStorageId & order] &
410− limit lim)
417+ limit lim &
418+ orderBy [#messageStorageId & Desc])
419+ where
420+ ((.^), order) = directionToOperator dir
411
421
412-- String -- user id as String
422-- String -- user id as String
413getGroupChatForUserQ :: Query Schema (TuplePG (String, GroupChatId)) (RowPG GroupChat)
423getGroupChatForUserQ :: Query Schema (TuplePG (String, GroupChatId)) (RowPG GroupChat)
@@ -473,7 +483,7 @@ getPostsForUser
473 -> UserId
483 -> UserId
474 -> StaticPQ (Maybe (ResponseWithUsers [Post]))
484 -> StaticPQ (Maybe (ResponseWithUsers [Post]))
475getPostsForUser pId lim dir uId = do
485getPostsForUser pId lim dir uId = do
476− postRows <- runQueryParams (getLastNPostsForUserQ lim $ directionToOperator dir) (pId, uId) >>= getRows
486+ postRows <- runQueryParams (getLastNPostsForUserQ lim dir) (pId, uId) >>= getRows
477 wrapIntoResponse (fromMaybe [] . rowsToPosts $ postRows)
487 wrapIntoResponse (fromMaybe [] . rowsToPosts $ postRows)
478
488
479getPosts :: [PostId] -> StaticPQ (Maybe (ResponseWithUsers [Post]))
489getPosts :: [PostId] -> StaticPQ (Maybe (ResponseWithUsers [Post]))
@@ -490,7 +500,7 @@ getLastPosts
490 -> P.PaginationDirection
500 -> P.PaginationDirection
491 -> StaticPQ (Maybe (ResponseWithUsers [Post]))
501 -> StaticPQ (Maybe (ResponseWithUsers [Post]))
492getLastPosts pId lim dir = do
502getLastPosts pId lim dir = do
493− postRows <- runQueryParams (getLastPostsQ id lim $ directionToOperator dir) (Only pId) >>= getRows
503+ postRows <- runQueryParams (getLastPostsQ id lim dir) (Only pId) >>= getRows
494 rowsToPosts postRows `liftMaybe` wrapIntoResponse
504 rowsToPosts postRows `liftMaybe` wrapIntoResponse
495
505
496getUser :: UserId -> StaticPQ User
506getUser :: UserId -> StaticPQ User
@@ -535,7 +545,7 @@ getChannelPosts uId pId lim dir cId = do
535 channel <- getChannelForUser uId cId
545 channel <- getChannelForUser uId cId
536 postRows <- runQueryParams (getChannelPostsQ
546 postRows <- runQueryParams (getChannelPostsQ
537 lim
547 lim
538− (directionToOperator dir)
548+ dir
539 (toList $ namedChannelFullPeopleIds channel)
549 (toList $ namedChannelFullPeopleIds channel)
540 (namedChannelFullTags channel))
550 (namedChannelFullTags channel))
541 (Only pId)
551 (Only pId)
@@ -549,7 +559,7 @@ getAnonymousChannelPosts
549 -> AnonymousChannel
559 -> AnonymousChannel
550 -> StaticPQ (ResponseWithUsers [Post])
560 -> StaticPQ (ResponseWithUsers [Post])
551getAnonymousChannelPosts pId lim dir (AnonymousChannel tags people) = do
561getAnonymousChannelPosts pId lim dir (AnonymousChannel tags people) = do
552− postRows <- runQueryParams (getChannelPostsQ lim (directionToOperator dir) people tags) (Only pId) >>= getRows
562+ postRows <- runQueryParams (getChannelPostsQ lim dir people tags) (Only pId) >>= getRows
553 fmap (fromMaybe $ ResponseWithUsers mempty mempty) $ rowsToPosts postRows `liftMaybe` wrapIntoResponse
563 fmap (fromMaybe $ ResponseWithUsers mempty mempty) $ rowsToPosts postRows `liftMaybe` wrapIntoResponse
554
564
555getAllChannels :: UserId -> StaticPQ [NamedChannel UserId]
565getAllChannels :: UserId -> StaticPQ [NamedChannel UserId]
@@ -572,7 +582,7 @@ getDialogs
572 -> P.PaginationDirection
582 -> P.PaginationDirection
573 -> StaticPQ (ResponseWithUsers [Dialog])
583 -> StaticPQ (ResponseWithUsers [Dialog])
574getDialogs uId mId lim dir = do
584getDialogs uId mId lim dir = do
575− resp <- runQueryParams (getChatsQ lim $ directionToOperator dir) (uId, Just $ show uId, mId) >>= getRows
585+ resp <- runQueryParams (getChatsQ lim dir) (uId, Just $ show uId, mId) >>= getRows
576 (>>= fromMaybe500) $ (responseToDialogs uId resp `liftMaybe` wrapIntoResponse)
586 (>>= fromMaybe500) $ (responseToDialogs uId resp `liftMaybe` wrapIntoResponse)
577
587
578getMessagesInUserChat
588getMessagesInUserChat
@@ -583,7 +593,7 @@ getMessagesInUserChat
583 -> P.PaginationDirection
593 -> P.PaginationDirection
584 -> StaticPQ [Message]
594 -> StaticPQ [Message]
585getMessagesInUserChat selfId uId mId lim dir = do
595getMessagesInUserChat selfId uId mId lim dir = do
586− resp <- runQueryParams (getMessagesQ lim $ directionToOperator dir) (selfId, uId, mId) >>= getRows
596+ resp <- runQueryParams (getMessagesQ lim dir) (selfId, uId, mId) >>= getRows
587 fromMaybe500 . sequence . map restoreMessage $ resp
597 fromMaybe500 . sequence . map restoreMessage $ resp
588
598
589getMessagesInGroupChat
599getMessagesInGroupChat
@@ -595,7 +605,7 @@ getMessagesInGroupChat
595 -> StaticPQ [Message]
605 -> StaticPQ [Message]
596getMessagesInGroupChat selfId gId mId lim dir = do
606getMessagesInGroupChat selfId gId mId lim dir = do
597 _ <- getGroupChatForUser selfId gId
607 _ <- getGroupChatForUser selfId gId
598− resp <- runQueryParams (getGroupMessagesQ lim $ directionToOperator dir) (gId, mId) >>= getRows
608+ resp <- runQueryParams (getGroupMessagesQ lim dir) (gId, mId) >>= getRows
599 (return . sequence . map restoreMessage $ resp) >>= fromMaybe500
609 (return . sequence . map restoreMessage $ resp) >>= fromMaybe500
600
610
601sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId
611sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId
@@ -645,9 +655,10 @@ getGroupChatForUser uId gId = do
645
655
646directionToOperator
656directionToOperator
647 :: P.PaginationDirection
657 :: P.PaginationDirection
648− -> ConditionOp schema from grouping params nullity0 nullity1 (ty :: PGType)
658+ -> (ConditionOp schema0 from0 grouping0 params0 nullity0 nullity1 (ty :: PGType),
659+ (Expression schema2 from2 grouping2 params2 _ -> SortExpression schema2 from2 grouping2 params2))
649−directionToOperator P.BackPagination = (.<)
660+directionToOperator P.BackPagination = ((.<), Desc)
650−directionToOperator P.ForwardPagination = (.>)
661+directionToOperator P.ForwardPagination = ((.>), Asc)
651
662
652foldMaybe :: [Maybe a] -> Maybe [a]
663foldMaybe :: [Maybe a] -> Maybe [a]
653foldMaybe [] = Just []
664foldMaybe [] = Just []