58bba86 · denis · git.iko.soy

git.iko.soy/denis

Channel and post pagination (and I think something else but I don’t remember)

commit58bba860fc5a562eed0915d8da6b31e6c11f5157 authoriko <ilyakooo0@gmail.com> dateSun 28 Apr 2019, 21:11 (7 years ago) parentbe4e284

8 files changed+116−94

compare with master

unifiedsplit

denis/docs/Docs.hs+3 denis/src/Data/Post.hs+9−9 denis/src/Data/PostElement.hs+10−9 denis/src/Data/Query.hs+45−26 denis/src/Server/API/Channels.hs+7−9 denis/src/Server/API/Posts.hs+8−12 denis/src/Server/LimitingRequest.hs−29 denis/src/Server/Query/Pagination.hs+34

denis/docs/Docs.hs+3

@@ -50,6 +50,9 @@ instance ToSample Word64 where

5050instance ToSample Log where

5151 toSamples _ = noSamples

5252

53+instance ToSample () where

54+ toSamples _ = singleSample ()

55+

5356normalizer :: String -> String

5457normalizer (' ':' ':' ':' ':'`':'`':'`':xs) = "```" ++ normalizer xs

5558normalizer (x:xs) = x : normalizer xs

denis/src/Data/Post.hs+9−9

@@ -15,7 +15,7 @@ module Data.Post (

1515 QuoteId,

1616 PostRowResponse(..),

1717 PostCreation(..)

18−) where

18+) where

1919

2020import Data.Int (Int64)

2121import qualified Generics.SOP as SOP

@@ -37,10 +37,10 @@ instance ToSample Post where

3737 where time = UTCTime (ModifiedJulianDay 1000) 8

3838

3939instance ToSample PostCreation where

40− toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]

41−

40+ toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]

4241

43−-- MARK: Actual type

42+

43+-- MARK: Actual type

4444

4545type PostId = Int64

4646type QuoteId = Int64

@@ -51,7 +51,7 @@ data Post = Post {

5151 updated :: UTCTime,

5252 postTags :: V.Vector Text,

5353 postBody :: [PostElement Post]

54−}

54+} deriving (Show)

5555

5656instance ToJSON Post where

5757 toJSON (Post pId aId tm tags pb) = object [

@@ -59,7 +59,7 @@ instance ToJSON Post where

5959 "authorId" .= aId,

6060 "updated" .= tm,

6161 "tags" .= tags,

62− "body" .= pb ]

62+ "body" .= pb ]

6363

6464data PostCreation = PostCreation {

6565 postCreationBody :: [PostElement Post],

@@ -72,12 +72,12 @@ instance SOP.HasDatatypeInfo PostCreation

7272instance ToJSON PostCreation where

7373 toJSON (PostCreation body tags) = object [

7474 "tags" .= tags,

75− "body" .= body ]

75+ "body" .= body ]

7676

7777instance FromJSON PostCreation where

78− parseJSON = withObject "post creation" $ \e ->

78+ parseJSON = withObject "post creation" $ \e ->

7979 PostCreation <$> e .: "body" <*> e .: "tags"

80−

80+

8181

8282-- MARK: Rows

8383

denis/src/Data/PostElement.hs+10−9

@@ -16,7 +16,7 @@ module Data.PostElement (

1616 MkElementRow,

1717 PostElementRow(..),

1818 elementsToRows

19−) where

19+) where

2020

2121import Data.Int (Int64)

2222import qualified Generics.SOP as SOP

@@ -42,8 +42,9 @@ data PostElement a = Markdown Text

4242 | Image Text

4343 | Quote PostQuote

4444 | Attachment Text

45+ deriving (Show)

4546

46−instance ToJSON (PostElement t) where

47+instance ToJSON (PostElement t) where

4748 toJSON (Markdown m) = object ["markdown" .= m]

4849 toJSON (Latex l) = object ["latex" .= l]

4950 toJSON (Image i) = object ["image" .= i]

@@ -51,7 +52,7 @@ instance ToJSON (PostElement t) where

5152 toJSON (Attachment a) = object ["attachment" .= a]

5253

5354instance FromJSON (PostElement t) where

54− parseJSON = withObject "post element" $ \e ->

55+ parseJSON = withObject "post element" $ \e ->

5556 Markdown <$> e .: "markdown" <|>

5657 Latex <$> e .: "latex" <|>

5758 Image <$> e .: "image" <|>

@@ -75,7 +76,7 @@ rowsToElement :: MkElementRow (Maybe (PostElement p))

7576rowsToElement (Just m) Nothing Nothing Nothing Nothing = Just $ Markdown m

7677rowsToElement Nothing (Just l) Nothing Nothing Nothing = Just $ Latex l

7778rowsToElement Nothing Nothing (Just i) Nothing Nothing = Just $ Image i

78−-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =

79+-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =

7980-- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs

8081rowsToElement Nothing Nothing Nothing Nothing (Just a) = Just $ Attachment a

8182rowsToElement _ _ _ _ _ = Nothing

@@ -98,21 +99,21 @@ elementsToRows :: Int64 -> [PostElement a] -> [PostElementRow a]

9899elementsToRows pId els = map (\(el, f) -> elemenToRow f el) . zip els . map (PostElementRow pId) $ [0..]

99100

100101

101−-- -- MARK: Quote

102+-- -- MARK: Quote

102103

103104data PostQuote = PostQuote {

104105 quoteId :: Int64,

105106 quoteBody :: [PostElement PostQuote],

106107 quotePostId :: Int64

107−}

108+} deriving (Show)

108109

109110instance ToJSON PostQuote where

110111 toJSON (PostQuote qId pb pId) = object [

111− "id" .= qId,

112+ "id" .= qId,

112113 "postId" .= pId,

113114 "quoteBody" .= pb ]

114115

115−

116+

116117-- -- MARK: PostQuoteRow

117118

118119-- data PostQuoteRow = PostQuoteRow {

@@ -122,7 +123,7 @@ instance ToJSON PostQuote where

122123

123124-- instance SOP.Generic PostQuoteRow

124125-- instance SOP.HasDatatypeInfo PostQuoteRow

125−

126+

126127-- rowsToQuote :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> PostQuoteRow -> Maybe PostQuote

127128-- rowsToQuote erqs pqrs (PostQuoteRow qId pId) = do

128129-- elementRows <- M.lookup qId erqs

denis/src/Data/Query.hs+45−26

@@ -53,7 +53,7 @@ import qualified GHC.Generics as GHC

5353import Data.Int (Int64)

5454import Data.ByteString.Char8 (pack)

5555import GHC.Generics (Generic)

56−import Data.Aeson

56+import Data.Aeson hiding (Null)

5757import Servant.Docs

5858import Data.Proxy

5959import Data.Vector (Vector, toList, fromList)

@@ -61,6 +61,7 @@ import Data.Text (Text)

6161import Data.Channel.NamedChannel

6262import Data.Channel.AnonymousChannel

6363import Data.Maybe (fromMaybe)

64+import Squeal.PostgreSQL.Render

6465

6566-- MARK: Documentation

6667

@@ -81,7 +82,12 @@ postViewT te = from $ subquery (postsQ te `As` #posts) &

8182 innerJoin (table #postElements)

8283 (#posts ! #postRowId .== #postElements ! #rowElementId)

8384

84−getPostQ :: TableEndo Schema params _ 'Ungrouped -> TableEndo Schema params _ 'Ungrouped -> Query Schema params (RowPG PostRowResponse)

85+getPostQ

86+ :: TableEndo Schema params _ 'Ungrouped

87+ -- ^ PostRowResponse endo

88+ -> TableEndo Schema params _ 'Ungrouped

89+ -- ^ PostRow endo

90+ -> Query Schema params (RowPG PostRowResponse)

8591getPostQ oTe te = select (

8692 #posts ! #postRowId :*

8793 #posts ! #postRowAuthorId :*

@@ -142,21 +148,26 @@ getAllUsersQ = selectStar $ from $ table #users

142148getPostsByIdQ :: [PostId] -> Maybe (Query Schema '[] (RowPG PostRowResponse))

143149getPostsByIdQ pIds = case idsToColumn pIds of

144150 Just idQ -> Just $ selectDotStar #posts $ from (subquery (idQ `As` #ids) &

145− innerJoin (subquery $ getPostQ id id `As` #posts)

151+ innerJoin (subquery $ getPostQ (orderBy [#posts ! #postRowId & Desc] . orderBy [#postElements ! #rowElementOrd & Asc]) id `As` #posts)

146152 (#ids ! #id .== #posts ! #postRowId))

147153 Nothing -> Nothing

148154

149155

150156type Limit = Word64

151157

152−getLastNPostsQ :: Limit -> Query Schema params (RowPG PostRowResponse)

153−getLastNPostsQ lim = getPostQ

154− (limit lim . orderBy [#posts ! #postRowUpdateTime & Desc]) id

158+isNotFalse

159+ :: Expression schema from grouping params ('Null ty)

160+ -- ^ possibly @NULL@

161+ -> Condition schema from grouping params

162+isNotFalse x = UnsafeExpression $ renderExpression x <+> "IS NOT FALSE"

155163

156−getLastNPostsForUserQ :: Limit -> Query Schema (TuplePG (Only UserId)) (RowPG PostRowResponse)

157−getLastNPostsForUserQ lim = getPostQ

158− (limit lim . orderBy [#posts ! #postRowUpdateTime & Desc])

159− (where_ $ #postRowAuthorId .== param @1)

164+getLastPostsQ :: TableEndo _ _ _ _ -> Limit -> Query Schema ('Null (PG Int64) ': params) (RowPG PostRowResponse)

165+getLastPostsQ te lim = getPostQ

166+ (orderBy [#posts ! #postRowId & Desc] . orderBy [#postElements ! #rowElementOrd & Asc])

167+ (limit lim . te . where_ (isNotFalse $ #posts ! #postRowId .< param @1) . orderBy [#posts ! #postRowId & Desc])

168+

169+getLastNPostsForUserQ :: Limit -> Query Schema (TuplePG (Maybe PostId, UserId)) (RowPG PostRowResponse)

170+getLastNPostsForUserQ = getLastPostsQ $ where_ (#posts ! #postRowAuthorId .== param @2)

160171

161172createPostRowQ :: Manipulation Schema (TuplePG (UserId, Vector Text)) (RowPG (Only PostId))

162173createPostRowQ = insertRow #posts

@@ -214,10 +225,17 @@ updateNamedChannelQ = update_ #channels

214225 )

215226 (#namedChannelFullOwner .== param @2 .&& #namedChannelFullId .== param @1)

216227

217−

218−getChannelPostsQ :: Limit -> [UserId] -> Vector Text -> Query Schema '[] (RowPG PostRowResponse)

228+getChannelPostsQ

229+ :: Limit

230+ -> [UserId]

231+ -> Vector Text

232+ -> Query

233+ Schema

234+ (TuplePG (Only (Maybe PostId))) -- ^ post id from which to start

235+ (RowPG PostRowResponse)

219236getChannelPostsQ lim uIds tags = selectStar $ from (subquery $ postsQ' `As` #bar) &

220− orderBy [#postRowUpdateTime & Desc] & limit lim

237+ where_ ( isNotFalse $ #postRowId .< param @1) &

238+ orderBy [#postRowId & Desc] . orderBy [#rowElementOrd & Asc] & limit lim

221239 where

222240 unionWithUsers = case idsToColumn uIds of

223241 Just uIdsQ -> selectDotStar #posts' (from $ subquery (uIdsQ `As` #uIds) &

@@ -280,10 +298,11 @@ verifiedUsers uIds =

280298

281299-- MARK: FrontEnd functions

282300

283−getPostsForUser :: Word64 -> UserId -> StaticPQ (Maybe (ResponseWithUsers [Post]))

284−getPostsForUser lim uId = do

285− postRows <- runQueryParams (getLastNPostsForUserQ lim) (Only uId) >>= getRows

286− rowsToPosts postRows `liftMaybe` wrapIntoResponse

301+-- Nothing <=> no user

302+getPostsForUser :: Maybe PostId -> Limit -> UserId -> StaticPQ (Maybe (ResponseWithUsers [Post]))

303+getPostsForUser pId lim uId = do

304+ postRows <- runQueryParams (getLastNPostsForUserQ lim) (pId, uId) >>= getRows

305+ wrapIntoResponse (fromMaybe [] . rowsToPosts $ postRows)

287306

288307getPosts :: [PostId] -> StaticPQ (Maybe (ResponseWithUsers [Post]))

289308getPosts pId =

@@ -293,9 +312,9 @@ getPosts pId =

293312 rowsToPosts postRows `liftMaybe` wrapIntoResponse

294313 Nothing -> return Nothing

295314

296−getLastPosts :: Word64 -> StaticPQ (Maybe (ResponseWithUsers [Post]))

297−getLastPosts n = do

298− postRows <- runQuery (getLastNPostsQ n) >>= getRows

315+getLastPosts :: Maybe PostId -> Limit -> StaticPQ (Maybe (ResponseWithUsers [Post]))

316+getLastPosts pId lim = do

317+ postRows <- runQueryParams (getLastPostsQ id lim) (Only pId) >>= getRows

299318 rowsToPosts postRows `liftMaybe` wrapIntoResponse

300319

301320getUser :: UserId -> StaticPQ User

@@ -329,16 +348,16 @@ updateChannel uId req = commitedTransactionallyUpdate $ do

329348 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})

330349 return ()

331350

332−getChannelPosts :: UserId -> Limit -> NamedChannelId -> StaticPQ (ResponseWithUsers [Post])

333−getChannelPosts uId lim cId = do

351+getChannelPosts :: UserId -> Maybe PostId -> Limit -> NamedChannelId -> StaticPQ (ResponseWithUsers [Post])

352+getChannelPosts uId pId lim cId = do

334353 channel <- getChannelForUser uId cId

335− postRows <- runQuery (getChannelPostsQ lim (toList $ namedChannelFullPeopleIds channel) (namedChannelFullTags channel))

354+ postRows <- runQueryParams (getChannelPostsQ lim (toList $ namedChannelFullPeopleIds channel) (namedChannelFullTags channel)) (Only pId)

336355 >>= getRows

337356 fmap (fromMaybe $ ResponseWithUsers mempty mempty) $ rowsToPosts postRows `liftMaybe` wrapIntoResponse

338357

339−getAnonymousChannelPosts :: Limit -> AnonymousChannel -> StaticPQ (ResponseWithUsers [Post])

340−getAnonymousChannelPosts lim (AnonymousChannel tags people) = do

341− postRows <- runQuery (getChannelPostsQ lim people tags) >>= getRows

358+getAnonymousChannelPosts :: Maybe PostId -> Limit -> AnonymousChannel -> StaticPQ (ResponseWithUsers [Post])

359+getAnonymousChannelPosts pId lim (AnonymousChannel tags people) = do

360+ postRows <- runQueryParams (getChannelPostsQ lim people tags) (Only pId) >>= getRows

342361 fmap (fromMaybe $ ResponseWithUsers mempty mempty) $ rowsToPosts postRows `liftMaybe` wrapIntoResponse

343362

344363getAllChannels :: UserId -> StaticPQ [NamedChannel UserId]

denis/src/Server/API/Channels.hs+7−9

@@ -17,18 +17,16 @@ import Servant.Server

1717import Data.Query

1818import Data.User

1919import Data.Connection

20−import Server.LimitingRequest

2120import Data.Channel.NamedChannel

2221import Data.Channel.AnonymousChannel

2322import qualified Data.Post as P

23+import Server.Query.Pagination

2424

2525-- MARK: Implementation

2626

27−type NamedChannelRequest = LimitingRequest NamedChannelId

28−

2927type ChannelsApi = Post '[JSON] [NamedChannel UserId] :<|>

30− "get" :> ReqBody '[JSON] NamedChannelRequest :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

31− "getAnonymous" :> ReqBody '[JSON] (LimitingRequest AnonymousChannel) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

28+ "get" :> ReqBody '[JSON] (PaginatingRequest P.PostId NamedChannelId) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

29+ "getAnonymous" :> ReqBody '[JSON] (PaginatingRequest P.PostId AnonymousChannel) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

3230 "create" :> ReqBody '[JSON] NamedChannelCreationRequest :> Post '[JSON] NamedChannelId :<|>

3331 "update" :> ReqBody '[JSON] (NamedChannel UserId) :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent :<|>

3432 "delete" :> ReqBody '[JSON] NamedChannelId :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent

@@ -40,11 +38,11 @@ channelsApi uId = getChannelsApi uId :<|> getChannel uId :<|> getAnonymousChanne

4038getChannelsApi :: UserId -> App [NamedChannel UserId]

4139getChannelsApi uId = runQnotFound $ getAllChannels uId

4240

43−getAnonymousChannelsApi :: LimitingRequest AnonymousChannel -> App (ResponseWithUsers [P.Post])

44−getAnonymousChannelsApi (LimitingRequest req lim) = runQnotFound $ getAnonymousChannelPosts lim req

41+getAnonymousChannelsApi :: PaginatingRequest P.PostId AnonymousChannel -> App (ResponseWithUsers [P.Post])

42+getAnonymousChannelsApi (PaginatingRequest pId lim req) = runQnotFound $ getAnonymousChannelPosts pId lim req

4543

46−getChannel :: UserId -> NamedChannelRequest -> App (ResponseWithUsers [P.Post])

47−getChannel uId (LimitingRequest cId lim) = runQnotFound $ getChannelPosts uId lim cId

44+getChannel :: UserId -> PaginatingRequest P.PostId NamedChannelId -> App (ResponseWithUsers [P.Post])

45+getChannel uId (PaginatingRequest pId lim cId) = runQnotFound $ getChannelPosts uId pId lim cId

4846

4947createChannelApi :: UserId -> NamedChannelCreationRequest -> App NamedChannelId

5048createChannelApi uId req = maybeNotFound . runQnotFound $ createNewChannel uId req

denis/src/Server/API/Posts.hs+8−12

@@ -8,8 +8,7 @@

99module Server.API.Posts (

1010 PostApi,

11− postApi,

12− UserPostsRequest

11+ postApi

1312) where

1413

1514import Servant.API

@@ -19,16 +18,13 @@ import Servant.Server

1918import Data.Query

2019import Data.User

2120import Data.Connection

22−import Data.Word (Word64)

23−import Server.LimitingRequest

21+import Server.Query.Pagination

2422

2523-- MARK: Implementation

2624

27−type UserPostsRequest = LimitingRequest UserId

28−

2925type PostApi = ReqBody '[JSON] [P.PostId] :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

30− "last" :> ReqBody '[JSON] Word64 :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

31− "forUser" :> ReqBody '[JSON] UserPostsRequest :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

26+ "last" :> ReqBody '[JSON] (PaginatingRequest P.PostId ()) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

27+ "forUser" :> ReqBody '[JSON] (PaginatingRequest P.PostId UserId) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>

3228 "publish" :> ReqBody '[JSON] P.PostCreation :> Post '[JSON] P.PostId

3329

3430postApi :: UserId -> ServerT PostApi App

@@ -37,11 +33,11 @@ postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPos

3733getPostsApi :: [P.PostId] -> App (ResponseWithUsers [P.Post])

3834getPostsApi = maybeNotFound . runQnotFound . getPosts

3935

40−lastPosts :: Word64 -> App (ResponseWithUsers [P.Post])

41−lastPosts = maybeNotFound . runQnotFound . getLastPosts

36+lastPosts :: PaginatingRequest P.PostId () -> App (ResponseWithUsers [P.Post])

37+lastPosts (PaginatingRequest pId lim _) = maybeNotFound . runQnotFound $ getLastPosts pId lim

4238

43−getPostsForUserApi :: UserPostsRequest -> App (ResponseWithUsers [P.Post])

44−getPostsForUserApi (LimitingRequest uId lim) = maybeNotFound . runQnotFound $ getPostsForUser lim uId

39+getPostsForUserApi :: PaginatingRequest P.PostId UserId -> App (ResponseWithUsers [P.Post])

40+getPostsForUserApi (PaginatingRequest pId lim uId) = maybeNotFound . runQnotFound $ getPostsForUser pId lim uId

4541

4642publishPostApi :: UserId -> P.PostCreation -> App P.PostId

4743publishPostApi uId = runQerror . publishPost uId

denis/src/Server/LimitingRequest.hsdeleted−29

@@ -1,29 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Server.LimitingRequest (

4− LimitingRequest(..)

5−) where

6−

7−import Data.Word (Word64)

8−import Servant.Docs (ToSample, toSamples, samples)

9−import Data.Aeson

10−import Data.Proxy

11−

12−instance (ToSample r) => ToSample (LimitingRequest r) where

13− toSamples _ = samples $ LimitingRequest <$> (map snd $ toSamples Proxy) <*> [1, 11, 17]

14−

15−

16−data LimitingRequest r = LimitingRequest {

17− requestRequest :: r,

18− requestLimit :: Word64

19−}

20−

21−instance (ToJSON r) => ToJSON (LimitingRequest r) where

22− toJSON (LimitingRequest r l) = object [

23− "request" .= r,

24− "limit" .= l ]

25−

26−instance (FromJSON r) => FromJSON (LimitingRequest r) where

27− parseJSON = withObject "limiting request" $ \e ->

28− LimitingRequest <$> e .: "request" <*> e .: "limit"

29−

denis/src/Server/Query/Pagination.hsnew file+34

@@ -0,0 +1,34 @@

1+{-# LANGUAGE

2+ DataKinds ,

3+ DeriveGeneric ,

4+ OverloadedLabels,

5+ OverloadedStrings ,

6+ TypeApplications ,

7+ TypeOperators,

8+ FlexibleInstances,

9+ MultiParamTypeClasses,

10+ TypeFamilies,

11+ UndecidableInstances,

12+ UndecidableSuperClasses #-}

13+

14+module Server.Query.Pagination (

15+ PaginatingRequest(..)

16+ ) where

17+

18+import Data.Query

19+import GHC.Generics

20+import Data.Aeson

21+import Servant.Docs

22+import Data.Proxy

23+

24+instance (ToSample i, ToSample r) => ToSample (PaginatingRequest i r) where

25+ toSamples _ = samples $ PaginatingRequest <$> ([const Nothing, Just] <*> [snd . head $ toSamples Proxy]) <*> [20] <*> map snd (toSamples Proxy)

26+

27+data PaginatingRequest i r = PaginatingRequest {

28+ exclusiveFrom :: Maybe i,

29+ limit :: Limit,

30+ request :: r

31+} deriving (Generic)

32+

33+instance (ToJSON r, ToJSON i) => ToJSON (PaginatingRequest i r) where

34+instance (FromJSON r, FromJSON i) => FromJSON (PaginatingRequest i r) where