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