vervis/src/Vervis.hs

{- This file is part of Vervis.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis
    ( subdirs
    , lastChange
    , timeAgo
    )
where

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
    _base :/ tree <- buildL dir
    return $ case tree of
        Dir _ cs ->
            let dirName (Dir n _) = Just n
                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