Atom and RSS feeds for repo history

src/Vervis/Changes.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -22,6 +22,7 @@ where
 import Prelude
 
 import Data.Text (Text)
+import Data.Time.Clock (UTCTime)
 
 import Data.EventTime.Local
 
@@ -29,5 +30,5 @@ data LogEntry = LogEntry
     { leAuthor  :: Text
     , leHash    :: Text
     , leMessage :: Text
-    , leTime    :: EventTime
+    , leTime    :: (UTCTime, EventTime)
     }

src/Vervis/Darcs.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -197,8 +197,10 @@ readChangesView path off lim = fmap maybeRight $ runExceptT $ do
             , leHash    = decodeStrict $ encodePatchHash h
             , leMessage = piTitle pi
             , leTime    =
-                intervalToEventTime $
+                ( piTime pi
-                FriendlyConvert $
+                , intervalToEventTime $
-                now `diffUTCTime` piTime pi
+                  FriendlyConvert $
+                  now `diffUTCTime` piTime pi
+                )
             }
     return (total, map (uncurry toLE) $ reverse $ snd ps)

src/Vervis/Git.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -36,8 +36,10 @@ import Data.Set (Set)
 import Data.String (fromString)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock ()
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import System.Hourglass (timeCurrent)
-import Time.Types (Elapsed (..))
+import Time.Types (Elapsed (..), Seconds (..))
 
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.DList as D (DList, empty, snoc, toList)
@@ -158,12 +160,15 @@ readChangesView path ref off lim = withRepo (fromString path) $ \ git -> do
             , leHash    = toText $ toHex $ unObjId oid
             , leMessage = toText $ takeLine $ commitMessage commit
             , leTime    =
-                intervalToEventTime $
+                ( utc t
-                FriendlyConvert $
+                , intervalToEventTime $
-                now - t
+                  FriendlyConvert $
+                  now - t
+                )
             }
             where
             Elapsed t = gitTimeUTC $ personTime $ commitAuthor commit
+            utc (Seconds i) = posixSecondsToUTCTime $ fromIntegral i
     return (noNodes graph, map (uncurry mkrow) pairs')
 
 listRefs :: FilePath -> IO (Set Text, Set Text)

src/Vervis/Handler/Repo.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -63,6 +63,7 @@ import System.Hourglass (dateCurrent)
 import Text.Blaze.Html (Html)
 import Yesod.Auth (requireAuthId)
 import Yesod.Core (defaultLayout, setMessage)
+import Yesod.Core.Content (TypedContent)
 import Yesod.Core.Handler (lookupPostParam, redirect, notFound)
 import Yesod.Form.Functions (runFormPost)
 import Yesod.Form.Types (FormResult (..))
@@ -97,9 +98,7 @@ import Vervis.Widget.Sharer
 import qualified Darcs.Local.Repository as D (createRepo)
 import qualified Data.ByteString.Lazy as BL (ByteString)
 import qualified Data.Git.Local as G (createRepo)
-import qualified Vervis.Darcs as D (readSourceView, readChangesView)
 import qualified Vervis.Formatting as F
-import qualified Vervis.Git as G (readSourceView, readChangesView, listRefs)
 
 getReposR :: ShrIdent -> Handler Html
 getReposR user = do
@@ -245,14 +244,14 @@ getRepoSourceR shar repo refdir = do
             []           -> notFound
             (ref:dir) -> getGitRepoSource repository shar repo ref dir
 
-getRepoHeadChangesR :: ShrIdent -> RpIdent -> Handler Html
+getRepoHeadChangesR :: ShrIdent -> RpIdent -> Handler TypedContent
 getRepoHeadChangesR user repo = do
     repository <- runDB $ selectRepo user repo
     case repoVcs repository of
         VCSDarcs -> getDarcsRepoHeadChanges user repo
         VCSGit -> getGitRepoHeadChanges repository user repo
 
-getRepoChangesR :: ShrIdent -> RpIdent -> Text -> Handler Html
+getRepoChangesR :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getRepoChangesR shar repo ref = do
     repository <- runDB $ selectRepo shar repo
     case repoVcs repository of

src/Vervis/Handler/Repo/Darcs.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -35,7 +35,9 @@ import System.Directory (doesFileExist)
 import Text.Blaze.Html (Html)
 import Yesod.Core (defaultLayout, setTitle)
 import Yesod.Core.Content (TypedContent, typeOctet)
-import Yesod.Core.Handler (sendFile, notFound)
+import Yesod.Core.Handler (selectRep, provideRep, sendFile, notFound)
+import Yesod.AtomFeed (atomFeed)
+import Yesod.RssFeed (rssFeed)
 
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
@@ -44,6 +46,7 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
 
 import Data.ByteString.Char8.Local (takeLine)
 import Text.FilePath.Local (breakExt)
+import Vervis.ChangeFeed (changeFeed)
 import Vervis.Form.Repo
 import Vervis.Foundation
 import Vervis.Path
@@ -74,7 +77,7 @@ getDarcsRepoSource repository user repo dir = do
                 dirs = zip parent (tail $ inits parent)
             defaultLayout $(widgetFile "repo/source-darcs")
 
-getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler Html
+getDarcsRepoHeadChanges :: ShrIdent -> RpIdent -> Handler TypedContent
 getDarcsRepoHeadChanges shar repo = do
     path <- askRepoDir shar repo
     (entries, navModel) <- getPageAndNav $
@@ -85,9 +88,13 @@ getDarcsRepoHeadChanges shar repo = do
                 Just v  -> return v
     let changes = changesW entries
         pageNav = navWidget navModel
-    defaultLayout $(widgetFile "repo/changes-darcs")
+        feed = changeFeed shar repo Nothing VCSDarcs entries
+    selectRep $ do
+        provideRep $ defaultLayout $(widgetFile "repo/changes-darcs")
+        provideRep $ atomFeed feed
+        provideRep $ rssFeed feed
 
-getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler Html
+getDarcsRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getDarcsRepoChanges shar repo tag = notFound
 
 getDarcsDownloadR :: ShrIdent -> RpIdent -> [Text] -> Handler TypedContent

src/Vervis/Handler/Repo/Git.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -44,7 +44,10 @@ import System.Directory (createDirectoryIfMissing)
 import System.Hourglass (dateCurrent)
 import Text.Blaze.Html (Html)
 import Yesod.Core (defaultLayout)
-import Yesod.Core.Handler (notFound)
+import Yesod.Core.Content (TypedContent)
+import Yesod.Core.Handler (selectRep, provideRep, notFound)
+import Yesod.AtomFeed (atomFeed)
+import Yesod.RssFeed (rssFeed)
 
 import qualified Data.DList as D
 import qualified Data.Set as S (member)
@@ -53,6 +56,7 @@ import qualified Data.Text.Lazy.Encoding as L (decodeUtf8With)
 import Data.ByteString.Char8.Local (takeLine)
 import Data.Git.Local
 import Text.FilePath.Local (breakExt)
+import Vervis.ChangeFeed (changeFeed)
 import Vervis.Form.Repo
 import Vervis.Foundation
 import Vervis.Path
@@ -83,11 +87,11 @@ getGitRepoSource repository user repo ref dir = do
                 dirs = zip parent (tail $ inits parent)
             defaultLayout $(widgetFile "repo/source-git")
 
-getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler Html
+getGitRepoHeadChanges :: Repo -> ShrIdent -> RpIdent -> Handler TypedContent
 getGitRepoHeadChanges repository shar repo =
     getGitRepoChanges shar repo $ repoMainBranch repository
 
-getGitRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler Html
+getGitRepoChanges :: ShrIdent -> RpIdent -> Text -> Handler TypedContent
 getGitRepoChanges shar repo ref = do
     path <- askRepoDir shar repo
     (branches, tags) <- liftIO $ G.listRefs path
@@ -98,5 +102,9 @@ getGitRepoChanges shar repo ref = do
             let refSelect = refSelectW shar repo branches tags
                 changes = changesW entries
                 pageNav = navWidget navModel
-            defaultLayout $(widgetFile "repo/changes-git")
+                feed = changeFeed shar repo (Just ref) VCSGit entries
+            selectRep $ do
+                provideRep $ defaultLayout $(widgetFile "repo/changes-git")
+                provideRep $ atomFeed feed
+                provideRep $ rssFeed feed
         else notFound

templates/repo/widget/changes.hamlet

@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+$# Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -18,7 +18,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
     <th>Hash
     <th>Message
     <th>Time
-  $forall LogEntry author hash message time <- entries
+  $forall LogEntry author hash message (_, time) <- entries
     <tr>
       <td>#{author}
       <td .hash>#{T.take 10 hash}

vervis.cabal

@@ -101,6 +101,7 @@ library
                        Vervis.Avatar
                        Vervis.BinaryBody
                        Vervis.Changes
+                       Vervis.ChangeFeed
                        Vervis.Colour
                        Vervis.Content
                        Vervis.Darcs
@@ -313,6 +314,7 @@ library
                      , yesod-core
                      , yesod-form
                      , yesod-mail-send
+                     , yesod-newsfeed
                      , yesod-static
                      , yesod-persistent
                        -- for reading gzipped darcs inventory via utils in