Return formatted last change time for a repo

src/Vervis.hs

@@ -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

vervis.cabal

@@ -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