diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index 73cc2b9..8e861c6 100644 --- a/src/Vervis/Darcs.hs +++ b/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 diff --git a/src/Vervis/GitOld.hs b/src/Vervis/GitOld.hs index 8c5e3cf..203f6a3 100644 --- a/src/Vervis/GitOld.hs +++ b/src/Vervis/GitOld.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016 by fr33domlover . + - Written in 2016, 2018 by fr33domlover . - - ♡ 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 +-} diff --git a/src/Vervis/Handler/Home.hs b/src/Vervis/Handler/Home.hs index 7d4e6e2..c43b201 100644 --- a/src/Vervis/Handler/Home.hs +++ b/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]" + 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") diff --git a/templates/homepage.hamlet b/templates/homepage.hamlet index 7feaf81..5c0c2b1 100644 --- a/templates/homepage.hamlet +++ b/templates/homepage.hamlet @@ -46,7 +46,11 @@ $# . Darcs $of VCSGit Git - #{ago} + + $maybe t <- ago + #{t} + $nothing + Error

People