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

Provide darcs log in ActivityPub format

Browse source
This commit is contained in:
fr33domlover 2019-09-02 02:41:50 +00:00
parent 6ffc2c9872
commit 29354ff1ed
1 changed files with 50 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

57
src/Vervis/Handler/Repo/Darcs.hs
View file

@ -54,12 +54,14 @@ import Yesod.FedURI
import Yesod.RenderSource import Yesod.RenderSource
import Data.ByteString.Char8.Local (takeLine) import Data.ByteString.Char8.Local (takeLine)
import Data.Paginate.Local
import Text.FilePath.Local (breakExt) import Text.FilePath.Local (breakExt)
import qualified Darcs.Local.Repository as D (createRepo) import qualified Darcs.Local.Repository as D (createRepo)
import Vervis.ActivityPub import Vervis.ActivityPub
import Vervis.ChangeFeed (changeFeed) import Vervis.ChangeFeed (changeFeed)
import Vervis.Changes
import Vervis.Form.Repo import Vervis.Form.Repo
import Vervis.Foundation import Vervis.Foundation
import Vervis.Path import Vervis.Path
@ -100,19 +102,58 @@ getDarcsRepoSource repository user repo dir = do
getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent
getDarcsRepoHeadChanges shar repo = do getDarcsRepoHeadChanges shar repo = do
path <- askRepoDir shar repo path <- askRepoDir shar repo
(_, _, entries, navModel) <- getPageAndNavTop $ let here = RepoHeadChangesR shar repo
\ o l -> do encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here
getChanges o l = do
mv <- liftIO $ D.readChangesView path o l mv <- liftIO $ D.readChangesView path o l
case mv of case mv of
Nothing -> notFound Nothing -> notFound
Just v -> return v Just v -> return v
let changes = changesW shar repo entries mpage <- getPageAndNavMaybe getChanges
case mpage of
Nothing -> do
(total, pages, _, _) <- getPageAndNavTop getChanges
let collection = Collection
{ collectionId = encodeRouteLocal here
, collectionType = CollectionTypeOrdered
, collectionTotalItems = Just total
, collectionCurrent = Nothing
, collectionFirst = Just $ pageUrl 1
, collectionLast = Just $ pageUrl pages
, collectionItems = [] :: [Text]
}
provideHtmlAndAP collection $ redirectFirstPage here
Just (_total, pages, items, navModel) ->
let current = nmCurrent navModel
page = CollectionPage
{ collectionPageId = pageUrl current
, collectionPageType = CollectionPageTypeOrdered
, collectionPageTotalItems = Nothing
, collectionPageCurrent = Just $ pageUrl current
, collectionPageFirst = Just $ pageUrl 1
, collectionPageLast = Just $ pageUrl pages
, collectionPagePartOf = encodeRouteLocal here
, collectionPagePrev =
if current > 1
then Just $ pageUrl $ current - 1
else Nothing
, collectionPageNext =
if current < pages
then Just $ pageUrl $ current + 1
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems =
map (encodeRouteHome . RepoPatchR shar repo . leHash)
items
}
feed = changeFeed shar repo Nothing VCSDarcs items
in provideHtmlFeedAndAP page feed $
let changes = changesW shar repo items
pageNav = navWidget navModel pageNav = navWidget navModel
feed = changeFeed shar repo Nothing VCSDarcs entries in $(widgetFile "repo/changes-darcs")
selectRep $ do
provideRep $ defaultLayout $(widgetFile "repo/changes-darcs")
provideRep $ atomFeed feed
provideRep $ rssFeed feed
getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
getDarcsRepoChanges shar repo tag = notFound getDarcsRepoChanges shar repo tag = notFound