sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 11:44:51 +09:00
Code Issues Activity

Reuse the getSharerInboxR code to implement getProjectInboxR

Browse source
This commit is contained in:
fr33domlover 2019-06-09 16:45:53 +00:00
parent f4e324e587
commit bad1844cfc
1 changed files with 19 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/Vervis/Handler/Inbox.hs
View file

@ -143,16 +143,13 @@ getInboxR = do
<div><pre>#{decodeUtf8 body} <div><pre>#{decodeUtf8 body}
|] |]
getSharerInboxR :: ShrIdent -> Handler TypedContent getInbox :: Route App -> AppDB InboxId -> Handler TypedContent
getSharerInboxR shr = do getInbox here getInboxId = do
(total, pages, mpage) <- runDB $ do (total, pages, mpage) <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr ibid <- getInboxId
p <- getValBy404 $ UniquePersonIdent sid
let ibid = personInbox p
getPageAndNavCount getPageAndNavCount
(countItems ibid) (countItems ibid)
(\ off lim -> map adaptItem <$> getItems ibid off lim) (\ off lim -> map adaptItem <$> getItems ibid off lim)
let here = SharerInboxR shr
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRoutePageLocal <- getEncodeRoutePageLocal encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here let pageUrl = encodeRoutePageLocal here
@ -231,8 +228,23 @@ getSharerInboxR shr = do
(Just act, Nothing) -> Left $ persistJSONValue act (Just act, Nothing) -> Left $ persistJSONValue act
(Nothing, Just obj) -> Right $ persistJSONValue obj (Nothing, Just obj) -> Right $ persistJSONValue obj
getSharerInboxR :: ShrIdent -> Handler TypedContent
getSharerInboxR shr = getInbox here getInboxId
where
here = SharerInboxR shr
getInboxId = do
sid <- getKeyBy404 $ UniqueSharer shr
p <- getValBy404 $ UniquePersonIdent sid
return $ personInbox p
getProjectInboxR :: ShrIdent -> PrjIdent -> Handler TypedContent getProjectInboxR :: ShrIdent -> PrjIdent -> Handler TypedContent
getProjectInboxR _ _ = error "TODO implement getProjectInboxR" getProjectInboxR shr prj = getInbox here getInboxId
where
here = ProjectInboxR shr prj
getInboxId = do
sid <- getKeyBy404 $ UniqueSharer shr
j <- getValBy404 $ UniqueProject prj sid
return $ projectInbox j
postSharerInboxR :: ShrIdent -> Handler () postSharerInboxR :: ShrIdent -> Handler ()
postSharerInboxR shrRecip = do postSharerInboxR shrRecip = do