From 29354ff1ed1065093c7384f830da89974dc01e1a Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Mon, 2 Sep 2019 02:41:50 +0000
Subject: [PATCH] Provide darcs log in ActivityPub format
---
src/Vervis/Handler/Repo/Darcs.hs | 59 +++++++++++++++++++++++++++-----
1 file changed, 50 insertions(+), 9 deletions(-)
diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs
index ba77ec0..4a25116 100644
--- a/src/Vervis/Handler/Repo/Darcs.hs
+++ b/src/Vervis/Handler/Repo/Darcs.hs
@@ -54,12 +54,14 @@ import Yesod.FedURI
import Yesod.RenderSource
import Data.ByteString.Char8.Local (takeLine)
+import Data.Paginate.Local
import Text.FilePath.Local (breakExt)
import qualified Darcs.Local.Repository as D (createRepo)
import Vervis.ActivityPub
import Vervis.ChangeFeed (changeFeed)
+import Vervis.Changes
import Vervis.Form.Repo
import Vervis.Foundation
import Vervis.Path
@@ -100,19 +102,58 @@ getDarcsRepoSource repository user repo dir = do
getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent
getDarcsRepoHeadChanges shar repo = do
path <- askRepoDir shar repo
- (_, _, entries, navModel) <- getPageAndNavTop $
- \ o l -> do
+ let here = RepoHeadChangesR shar repo
+ encodeRouteLocal <- getEncodeRouteLocal
+ encodeRouteHome <- getEncodeRouteHome
+ encodeRoutePageLocal <- getEncodeRoutePageLocal
+ let pageUrl = encodeRoutePageLocal here
+ getChanges o l = do
mv <- liftIO $ D.readChangesView path o l
case mv of
Nothing -> notFound
Just v -> return v
- let changes = changesW shar repo entries
- pageNav = navWidget navModel
- feed = changeFeed shar repo Nothing VCSDarcs entries
- selectRep $ do
- provideRep $ defaultLayout $(widgetFile "repo/changes-darcs")
- provideRep $ atomFeed feed
- provideRep $ rssFeed feed
+ 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
+ in $(widgetFile "repo/changes-darcs")
getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
getDarcsRepoChanges shar repo tag = notFound