mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-31 04:34:52 +09:00
Remove GitOld module, it's not in use anymore
This commit is contained in:
fr33domlover
parent
fe4d1e1afe
commit
4bd33b59e5
1 changed files with 0 additions and 127 deletions
|
|
@ -1,127 +0,0 @@
|
||||||
{- 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
|
|
||||||
-}
|
|
||||||
Loading…
Reference in a new issue