Display last change for Darcs repos in homepage

This commit is contained in:
fr33domlover 2018-04-09 22:00:01 +00:00
parent c768659f57
commit c172784d61
4 changed files with 55 additions and 22 deletions

View file

@ -17,6 +17,7 @@ module Vervis.Darcs
( readSourceView ( readSourceView
, readWikiView , readWikiView
, readChangesView , readChangesView
, lastChange
) )
where where
@ -33,7 +34,7 @@ import Data.Maybe (listToMaybe, mapMaybe)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
import Data.Text.Encoding.Error (strictDecode) import Data.Text.Encoding.Error (strictDecode)
import Data.Time.Clock (getCurrentTime, diffUTCTime) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
import Data.Traversable (for) import Data.Traversable (for)
import Development.Darcs.Internal.Hash.Codec import Development.Darcs.Internal.Hash.Codec
import Development.Darcs.Internal.Inventory.Parser 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) 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

View file

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

View file

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

View file

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