Display last change for Darcs repos in homepage

src/Vervis/Darcs.hs

@@ -17,6 +17,7 @@ module Vervis.Darcs
     ( readSourceView
     , readWikiView
     , readChangesView
+    , lastChange
     )
 where
 
@@ -33,7 +34,7 @@ import Data.Maybe (listToMaybe, mapMaybe)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
 import Data.Text.Encoding.Error (strictDecode)
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
+import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
 import Data.Traversable (for)
 import Development.Darcs.Internal.Hash.Codec
 import Development.Darcs.Internal.Inventory.Parser
@@ -204,3 +205,16 @@ readChangesView path off lim = fmap maybeRight $ runExceptT $ do
                 )
             }
     return (total, map (uncurry toLE) $ reverse $ snd ps)
+
+lastChange :: FilePath -> UTCTime -> IO (Maybe EventTime)
+lastChange path now = fmap maybeRight $ runExceptT $ do
+    total <- ExceptT $ readLatestInventory path latestInventorySizeP
+    let lim = 1
+        off = total - lim
+    (_, l) <- ExceptT $ readLatestInventory path $ latestInventoryPageP off lim
+    return $ case reverse l of
+        []            -> Never
+        (pi, _ph) : _ ->
+            intervalToEventTime $
+            FriendlyConvert $
+            now `diffUTCTime` piTime pi

src/Vervis/GitOld.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.
  -
@@ -19,8 +19,8 @@
 
 module Vervis.GitOld
     ( lastChange
-    , timeAgo
+    --, timeAgo
-    , timeAgo'
+    --, timeAgo'
     )
 where
 
@@ -35,23 +35,24 @@ import Data.Foldable (toList)
 import Data.Git
 import Data.Git.Revision
 import Data.Git.Repository
+import Data.Git.Types (GitTime (..))
 -- import Data.Hashable (Hashable)
 -- import Data.HashMap.Lazy (HashMap)
 -- import Data.HashSet (HashSet)
 import Data.Hourglass
 import Data.Maybe (fromMaybe{-, mapMaybe-})
-import Data.Monoid ((<>))
+-- import Data.Monoid ((<>))
-import Data.Text (Text)
+-- import Data.Text (Text)
 -- import Data.Time.Units
 -- import GHC.Generics
 -- import System.Directory.Tree hiding (name, file, err)
 -- import System.FilePath ((</>))
-import System.Hourglass (dateCurrent)
+-- import System.Hourglass (dateCurrent)
 
 -- import qualified Control.Monad.Trans.RWS as RWS
 -- import qualified Data.CaseInsensitive as CI
 -- import qualified Data.HashMap.Lazy as M
-import qualified Data.Text as T
+-- import qualified Data.Text as T
 
 -- | Return the subdirs of a given dir
 {-subdirs :: FilePath -> IO [FilePath]
@@ -73,17 +74,18 @@ lastBranchChange git branch = do
     return $ fromMaybe (error "mtime is Nothing") mtime
 
 -- | Determine the time of the last commit in any branch for a given repo
-lastChange :: FilePath -> IO (Maybe DateTime)
+lastChange :: FilePath -> IO (Maybe Elapsed)
 lastChange path = withRepo (fromString path) $ \ git -> do
      --TODO add a better intro to json-state, the docs are bad there
 
     names <- branchList git
     times <- traverse (lastBranchChange git) $ map refNameRaw $ toList names
-    let datetimes = map timeConvert times
+    let elapseds = map gitTimeUTC times
-    return $ if null datetimes
+    return $ if null elapseds
         then Nothing
-        else Just $ maximum datetimes
+        else Just $ maximum elapseds
 
+{-
 showPeriod :: Period -> Text
 showPeriod (Period 0 0 d) = T.pack (show d) <> " days"
 showPeriod (Period 0 m _) = T.pack (show m) <> " months"
@@ -122,3 +124,4 @@ timeAgo' now dt =
     let sec = timeDiff now dt
         (period, duration) = fromSec sec
     in  showAgo period duration
+-}

src/Vervis/Handler/Home.hs

@@ -21,15 +21,22 @@ where
 import Vervis.Import hiding (on)
 
 import Database.Esqueleto hiding ((==.))
-import Vervis.GitOld
 import Yesod.Auth.Account (newAccountR)
+import Data.Time.Clock (diffUTCTime)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
+import Time.Types (Elapsed (..), Seconds (..))
 
 import qualified Database.Esqueleto as E ((==.))
 
+import Vervis.Darcs
 import Vervis.Model.Ident
 import Vervis.Model.Repo
 import Vervis.Path
 
+import Data.EventTime.Local
+import qualified Vervis.GitOld as G
+import qualified Vervis.Darcs as D
+
 intro :: Handler Html
 intro = do
     rows <- do
@@ -48,17 +55,22 @@ intro = do
                     , repo ^. RepoIdent
                     , repo ^. RepoVcs
                     )
+        now <- liftIO getCurrentTime
+        let utc (Seconds i) = posixSecondsToUTCTime $ fromIntegral i
         forM repos $
             \ (Value sharer, Value mproj, Value repo, Value vcs) -> do
-                ago <- case vcs of
-                    VCSDarcs -> return "[Not implemented yet]"
-                    VCSGit -> do
                 path <- askRepoDir sharer repo
-                        mdt <- liftIO $ lastChange path
+                mlast <- case vcs of
-                        case mdt of
+                    VCSDarcs -> liftIO $ D.lastChange path now
-                            Nothing -> return "never"
+                    VCSGit -> do
-                            Just dt -> liftIO $ timeAgo dt
+                        mel <- liftIO $ G.lastChange path
-                return (sharer, mproj, repo, vcs, ago)
+                        return $ Just $ case mel of
+                            Nothing -> Never
+                            Just (Elapsed t) ->
+                                intervalToEventTime $
+                                FriendlyConvert $
+                                now `diffUTCTime` utc t
+                return (sharer, mproj, repo, vcs, mlast)
     defaultLayout $ do
         setTitle "Welcome to Vervis!"
         $(widgetFile "homepage")

templates/homepage.hamlet

@@ -46,7 +46,11 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
             Darcs
           $of VCSGit
             Git
-      <td>#{ago}
+      <td>
+        $maybe t <- ago
+          #{t}
+        $nothing
+          Error
 
 <h2>People