Return formatted last change time for a repo

This commit is contained in:
fr33domlover 2016-01-29 00:59:27 +00:00
parent ccdd98ca7e
commit f51aa09159
2 changed files with 64 additions and 2 deletions

View file

@ -15,11 +15,20 @@
module Vervis
( subdirs
, lastChange
, timeAgo
)
where
import Data.Maybe (mapMaybe)
import Control.Monad (join)
import Data.Foldable (toList)
import Data.Git
import Data.Git.Revision
import Data.Git.Repository
import Data.Hourglass
import Data.Maybe (fromMaybe, mapMaybe)
import System.Directory.Tree
import System.Hourglass (dateCurrent)
subdirs :: FilePath -> IO [FilePath]
subdirs dir = do
@ -30,3 +39,54 @@ subdirs dir = do
dirName _ = Nothing
in mapMaybe dirName cs
_ -> []
lastBranchChange :: Git -> String -> IO GitTime
lastBranchChange git branch = do
mref <- resolveRevision git $ Revision branch []
mco <- traverse (getCommitMaybe git) mref
let mtime = fmap (personTime . commitCommitter) (join mco)
return $ fromMaybe (error "mtime is Nothing") mtime
lastChange :: FilePath -> IO DateTime
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 $ maximum datetimes
showPeriod :: Period -> String
showPeriod (Period 0 0 d) = show d ++ " days"
showPeriod (Period 0 m _) = show m ++ " months"
showPeriod (Period y _ _) = show y ++ " years"
showDuration :: Duration -> String
showDuration (Duration (Hours h) (Minutes m) (Seconds s) _) =
case (h, m, s) of
(0, 0, 0) -> "now"
(0, 0, _) -> show s ++ " seconds"
(0, _, _) -> show m ++ " minutes"
_ -> show h ++ " hours"
showAgo :: Period -> Duration -> String
showAgo (Period 0 0 0) d = showDuration d
showAgo p _ = showPeriod p
fromSec :: Seconds -> (Period, Duration)
fromSec sec =
let d = 3600 * 24
m = 30 * d
y = 365 * d
fs (Seconds n) = fromIntegral n
(years, yrest) = sec `divMod` Seconds y
(months, mrest) = yrest `divMod` Seconds m
(days, drest) = mrest `divMod` Seconds d
in (Period (fs years) (fs months) (fs days), fst $ fromSeconds drest)
timeAgo :: DateTime -> IO String
timeAgo dt = do
now <- dateCurrent
let sec = timeDiff now dt
(period, duration) = fromSec sec
return $ showAgo period duration

View file

@ -31,6 +31,8 @@ library
-- other-extensions:
build-depends: base >=4.8 && <5
, directory-tree >=0.12
, hit >=0.6.3
, hourglass
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -Wall