Display last change for Darcs repos in homepage
This commit is contained in:
parent
c768659f57
commit
c172784d61
4 changed files with 55 additions and 22 deletions
|
@ -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
|
||||
|
|
|
@ -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.Text (Text)
|
||||
-- import Data.Monoid ((<>))
|
||||
-- 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
|
||||
return $ if null datetimes
|
||||
let elapseds = map gitTimeUTC times
|
||||
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
|
||||
-}
|
||||
|
|
|
@ -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]"
|
||||
path <- askRepoDir sharer repo
|
||||
mlast <- case vcs of
|
||||
VCSDarcs -> liftIO $ D.lastChange path now
|
||||
VCSGit -> do
|
||||
path <- askRepoDir sharer repo
|
||||
mdt <- liftIO $ lastChange path
|
||||
case mdt of
|
||||
Nothing -> return "never"
|
||||
Just dt -> liftIO $ timeAgo dt
|
||||
return (sharer, mproj, repo, vcs, ago)
|
||||
mel <- liftIO $ G.lastChange path
|
||||
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")
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue