1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 22:54:50 +09:00

Remove GitOld module, it's not in use anymore

This commit is contained in:
fr33domlover 2018-12-12 07:59:19 +00:00
parent fe4d1e1afe
commit 4bd33b59e5

View file

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