mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-25 17:07:53 +09:00
For latest-version patches, provide a 'previousVersions' list
This commit is contained in:
parent
a06d273107
commit
fa3348513a
2 changed files with 34 additions and 20 deletions
|
@ -38,6 +38,7 @@ import Control.Monad
|
||||||
import Data.Bifunctor
|
import Data.Bifunctor
|
||||||
import Data.Bitraversable
|
import Data.Bitraversable
|
||||||
import Data.Function
|
import Data.Function
|
||||||
|
import Data.List.NonEmpty (NonEmpty (..))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Traversable
|
import Data.Traversable
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
|
@ -249,20 +250,23 @@ getSharerPatchVersionR
|
||||||
-> KeyHashid Patch
|
-> KeyHashid Patch
|
||||||
-> Handler TypedContent
|
-> Handler TypedContent
|
||||||
getSharerPatchVersionR shr talkhid ptkhid = do
|
getSharerPatchVersionR shr talkhid ptkhid = do
|
||||||
(vcs, patch) <- runDB $ do
|
(vcs, patch, versions) <- runDB $ do
|
||||||
(_, _, Entity tid _, repo, _) <- getSharerPatch404 shr talkhid
|
(_, _, Entity tid _, repo, v :| vs) <- getSharerPatch404 shr talkhid
|
||||||
(,) <$> case repo of
|
ptid <- decodeKeyHashid404 ptkhid
|
||||||
|
(,,) <$> case repo of
|
||||||
Left (_, Entity _ trl) ->
|
Left (_, Entity _ trl) ->
|
||||||
repoVcs <$> getJust (ticketRepoLocalRepo trl)
|
repoVcs <$> getJust (ticketRepoLocalRepo trl)
|
||||||
Right _ ->
|
Right _ ->
|
||||||
error "TODO determine mediaType of patch of remote repo"
|
error "TODO determine mediaType of patch of remote repo"
|
||||||
<*> do ptid <- decodeKeyHashid404 ptkhid
|
<*> do pt <- get404 ptid
|
||||||
pt <- get404 ptid
|
|
||||||
unless (patchTicket pt == tid) notFound
|
unless (patchTicket pt == tid) notFound
|
||||||
return pt
|
return pt
|
||||||
|
<*> pure (if ptid == v then vs else [])
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
let versionAP = AP.Patch
|
encodePatchId <- getEncodeKeyHashid
|
||||||
|
let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId
|
||||||
|
versionAP = AP.Patch
|
||||||
{ AP.patchId = encodeRouteLocal here
|
{ AP.patchId = encodeRouteLocal here
|
||||||
, AP.patchAttributedTo = encodeRouteHome $ SharerR shr
|
, AP.patchAttributedTo = encodeRouteHome $ SharerR shr
|
||||||
, AP.patchPublished = patchCreated patch
|
, AP.patchPublished = patchCreated patch
|
||||||
|
@ -272,6 +276,8 @@ getSharerPatchVersionR shr talkhid ptkhid = do
|
||||||
VCSDarcs -> PatchTypeDarcs
|
VCSDarcs -> PatchTypeDarcs
|
||||||
VCSGit -> error "TODO add PatchType for git patches"
|
VCSGit -> error "TODO add PatchType for git patches"
|
||||||
, AP.patchContent = patchContent patch
|
, AP.patchContent = patchContent patch
|
||||||
|
, AP.patchPrevVersions =
|
||||||
|
map (encodeRouteLocal . versionUrl) versions
|
||||||
}
|
}
|
||||||
provideHtmlAndAP versionAP $ redirectToPrettyJSON here
|
provideHtmlAndAP versionAP $ redirectToPrettyJSON here
|
||||||
where
|
where
|
||||||
|
@ -512,11 +518,11 @@ getRepoPatchVersionR
|
||||||
-> KeyHashid Patch
|
-> KeyHashid Patch
|
||||||
-> Handler TypedContent
|
-> Handler TypedContent
|
||||||
getRepoPatchVersionR shr rp ltkhid ptkhid = do
|
getRepoPatchVersionR shr rp ltkhid ptkhid = do
|
||||||
(vcs, patch, author) <- runDB $ do
|
(vcs, patch, author, versions) <- runDB $ do
|
||||||
(_, Entity _ repo, Entity tid _, _, _, _, ta, _) <- getRepoPatch404 shr rp ltkhid
|
(_, Entity _ repo, Entity tid _, _, _, _, ta, v :| vs) <- getRepoPatch404 shr rp ltkhid
|
||||||
(repoVcs repo,,)
|
ptid <- decodeKeyHashid404 ptkhid
|
||||||
<$> do ptid <- decodeKeyHashid404 ptkhid
|
(repoVcs repo,,,)
|
||||||
pt <- get404 ptid
|
<$> do pt <- get404 ptid
|
||||||
unless (patchTicket pt == tid) notFound
|
unless (patchTicket pt == tid) notFound
|
||||||
return pt
|
return pt
|
||||||
<*> bitraverse
|
<*> bitraverse
|
||||||
|
@ -531,9 +537,12 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
|
||||||
return (i, ro)
|
return (i, ro)
|
||||||
)
|
)
|
||||||
ta
|
ta
|
||||||
|
<*> pure (if ptid == v then vs else [])
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
let versionAP = AP.Patch
|
encodePatchId <- getEncodeKeyHashid
|
||||||
|
let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId
|
||||||
|
versionAP = AP.Patch
|
||||||
{ AP.patchId = encodeRouteLocal here
|
{ AP.patchId = encodeRouteLocal here
|
||||||
, AP.patchAttributedTo =
|
, AP.patchAttributedTo =
|
||||||
case author of
|
case author of
|
||||||
|
@ -550,6 +559,8 @@ getRepoPatchVersionR shr rp ltkhid ptkhid = do
|
||||||
VCSDarcs -> PatchTypeDarcs
|
VCSDarcs -> PatchTypeDarcs
|
||||||
VCSGit -> error "TODO add PatchType for git patches"
|
VCSGit -> error "TODO add PatchType for git patches"
|
||||||
, AP.patchContent = patchContent patch
|
, AP.patchContent = patchContent patch
|
||||||
|
, AP.patchPrevVersions =
|
||||||
|
map (encodeRouteLocal . versionUrl) versions
|
||||||
}
|
}
|
||||||
provideHtmlAndAP versionAP $ redirectToPrettyJSON here
|
provideHtmlAndAP versionAP $ redirectToPrettyJSON here
|
||||||
where
|
where
|
||||||
|
|
|
@ -845,6 +845,7 @@ data Patch u = Patch
|
||||||
, patchContext :: LocalURI
|
, patchContext :: LocalURI
|
||||||
, patchType :: PatchType
|
, patchType :: PatchType
|
||||||
, patchContent :: Text
|
, patchContent :: Text
|
||||||
|
, patchPrevVersions :: [LocalURI]
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ActivityPub Patch where
|
instance ActivityPub Patch where
|
||||||
|
@ -864,15 +865,17 @@ instance ActivityPub Patch where
|
||||||
<*> withAuthorityO a (o .: "context")
|
<*> withAuthorityO a (o .: "context")
|
||||||
<*> o .: "mediaType"
|
<*> o .: "mediaType"
|
||||||
<*> o .: "content"
|
<*> o .: "content"
|
||||||
|
<*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= [])
|
||||||
|
|
||||||
toSeries a (Patch id_ attrib published context typ content)
|
toSeries a (Patch id_ attrib published context typ content vers)
|
||||||
= "id" .= ObjURI a id_
|
= "id" .= ObjURI a id_
|
||||||
<> "type" .= ("Patch" :: Text)
|
<> "type" .= ("Patch" :: Text)
|
||||||
<> "attributedTo" .= attrib
|
<> "attributedTo" .= attrib
|
||||||
<> "context" .= ObjURI a context
|
<> "context" .= ObjURI a context
|
||||||
<> "published" .= published
|
<> "published" .= published
|
||||||
<> "mediaType" .= typ
|
<> "mediaType" .= typ
|
||||||
<> "content" .= content
|
<> "content" .= content
|
||||||
|
<> "previousVersions" .= map (ObjURI a) vers
|
||||||
|
|
||||||
data TicketLocal = TicketLocal
|
data TicketLocal = TicketLocal
|
||||||
{ ticketId :: LocalURI
|
{ ticketId :: LocalURI
|
||||||
|
|
Loading…
Add table
Reference in a new issue