diff --git a/src/Vervis.hs b/src/Vervis.hs index 3c698cc..ade4c84 100644 --- a/src/Vervis.hs +++ b/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 diff --git a/vervis.cabal b/vervis.cabal index 10a8a20..9fce8d8 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -29,8 +29,10 @@ library exposed-modules: Vervis -- other-modules: -- other-extensions: - build-depends: base >=4.8 && <5 + 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