Experimental changes to Vervis.
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/KrXYo
SSH:
darcs clone USERNAME@vervis.peers.community:KrXYo
Tags
TODO
GitOld.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | {- This file is part of Vervis.
-
- Written in 2016, 2018 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/>.
-}
{- LANGUAGE OverloadedStrings #-}
{- LANGUAGE GeneralizedNewtypeDeriving #-}
{- LANGUAGE DeriveGeneric #-}
module Vervis.GitOld
( lastChange
--, timeAgo
--, timeAgo'
)
where
import Prelude
import Control.Monad (join)
-- import Control.Monad.Fix (MonadFix)
-- import Control.Monad.IO.Class
-- import Control.Monad.Trans.RWS (RWST (..))
-- import Data.CaseInsensitive (CI)
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.Time.Units
-- import GHC.Generics
-- import System.Directory.Tree hiding (name, file, err)
-- import System.FilePath ((</>))
-- 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
-- | Return the subdirs of a given dir
{-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
_ -> []-}
-- | Determine the time of the last commit in a given git branch
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
-- | Determine the time of the last commit in any branch for a given repo
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 elapseds = map gitTimeUTC times
return $ if null elapseds
then Nothing
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"
showPeriod (Period y _ _) = T.pack (show y) <> " years"
showDuration :: Duration -> Text
showDuration (Duration (Hours h) (Minutes m) (Seconds s) _) =
case (h, m, s) of
(0, 0, 0) -> "now"
(0, 0, _) -> T.pack (show s) <> " seconds"
(0, _, _) -> T.pack (show m) <> " minutes"
_ -> T.pack (show h) <> " hours"
showAgo :: Period -> Duration -> Text
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 Text
timeAgo dt = do
now <- dateCurrent
return $ timeAgo' now dt
timeAgo' :: DateTime -> DateTime -> Text
timeAgo' now dt =
let sec = timeDiff now dt
(period, duration) = fromSec sec
in showAgo period duration
-}
|