More EventTime utils and support for GitTime

This commit is contained in:
fr33domlover 2016-05-06 10:21:44 +00:00
parent 96d73f3551
commit 6e2a8b259d
3 changed files with 56 additions and 2 deletions

View file

@ -22,12 +22,17 @@ module Data.EventTime.Local
, TimeAgo (..) , TimeAgo (..)
, EventTime (..) , EventTime (..)
-- * Conversion from time types -- * Conversion from time types
-- ** Interval conversion
-- *** Typeclass
, IntervalToEventTime (..) , IntervalToEventTime (..)
-- *** Human friendly conversion adapters
, RoundDown (..) , RoundDown (..)
, RoundNear (..) , RoundNear (..)
, RoundDownWait (..) , RoundDownWait (..)
, RoundNearWait (..) , RoundNearWait (..)
, FriendlyIntervalToEventTime , FriendlyConvert (..)
-- ** Time conversion
, SpecToEventTime (..)
-- * Display -- * Display
, showEventTime , showEventTime
) )
@ -36,6 +41,7 @@ where
import Prelude import Prelude
import Data.Text (Text, snoc) import Data.Text (Text, snoc)
import Text.Blaze (ToMarkup (..))
import qualified Formatting as F import qualified Formatting as F
@ -52,6 +58,9 @@ data TimeAgo = TimeAgo
data EventTime = Now | Ago TimeAgo | Never data EventTime = Now | Ago TimeAgo | Never
instance ToMarkup EventTime where
toMarkup = toMarkup . showEventTime
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Conversion from time types -- Conversion from time types
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
@ -108,6 +117,9 @@ data EventTime = Now | Ago TimeAgo | Never
class IntervalToEventTime i where class IntervalToEventTime i where
intervalToEventTime :: i -> EventTime intervalToEventTime :: i -> EventTime
instance IntervalToEventTime EventTime where
intervalToEventTime = id
-- | Human friendly event time conversion. Renders a time interval rounded -- | Human friendly event time conversion. Renders a time interval rounded
-- down. Example: -- down. Example:
-- --
@ -143,6 +155,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDown a) where
| otherwise -> Ago $ TimeAgo Month $ n `div` (24 * 30) | otherwise -> Ago $ TimeAgo Month $ n `div` (24 * 30)
TimeAgo Day n -> Ago $ TimeAgo Year $ n `div` 365 TimeAgo Day n -> Ago $ TimeAgo Year $ n `div` 365
_ -> orig _ -> orig
_ -> orig
-- | Human friendly event time conversion. Renders a time interval rounded to -- | Human friendly event time conversion. Renders a time interval rounded to
-- the nearest whole unit. Example: -- the nearest whole unit. Example:
@ -201,6 +214,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDownWait a) where
then Ago $ TimeAgo Month $ n `div` 30 then Ago $ TimeAgo Month $ n `div` 30
else Ago $ TimeAgo Year $ n `div` 365 else Ago $ TimeAgo Year $ n `div` 365
_ -> orig _ -> orig
_ -> orig
-- | Human friendly event time conversion. Renders a time interval rounded to -- | Human friendly event time conversion. Renders a time interval rounded to
-- the nearest whole unit, but switches unit only when the previous unit -- the nearest whole unit, but switches unit only when the previous unit
@ -226,7 +240,29 @@ newtype RoundNearWait a = RoundNearWait a
-- | Human friendly event time conversion. This is simply an alias to one of -- | Human friendly event time conversion. This is simply an alias to one of
-- the newtypes above. If you don't have a specific preference, this is a safe -- the newtypes above. If you don't have a specific preference, this is a safe
-- defauly. -- defauly.
type FriendlyIntervalToEventTime = RoundNearWait newtype FriendlyConvert a = FriendlyConvert a
instance IntervalToEventTime a => IntervalToEventTime (FriendlyConvert a) where
intervalToEventTime (FriendlyConvert a) =
intervalToEventTime (RoundDownWait a)
-- | Convert a specification of the current time into event time. This adds two
-- step on top of conversion of an interval (which is what
-- 'IntervalToEventTime' does):
--
-- (1) Get the current time
-- (2) Determine the interval between the event's time and the current time
--
-- There's also a limitation to a specific conversion mode. I need to fix this.
-- Possible solutions:
--
-- * ( ) Add fields or classes for time difference functions and typing a spec
-- type to its difference type
-- * ( ) Turn the adapters into functions of type EventTime -> EventTime
-- * (x) Make EventTime an instance of IntervalToEventTime
class SpecToEventTime s where
specToEventTime :: s -> IO EventTime
specsToEventTimes :: Functor t => t s -> IO (t EventTime)
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- Display -- Display

View file

@ -30,6 +30,7 @@ import Control.Monad (when)
import Data.Byteable (toBytes) import Data.Byteable (toBytes)
import Data.Git import Data.Git
import Data.Git.Harder import Data.Git.Harder
import Data.Git.Types (GitTime (..))
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
@ -38,6 +39,13 @@ import System.Directory.Tree
import qualified Data.ByteString as B (ByteString, writeFile) import qualified Data.ByteString as B (ByteString, writeFile)
import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.ByteString.Lazy as BL (ByteString)
import Data.EventTime.Local
import Data.Hourglass.Local ()
instance SpecToEventTime GitTime where
specToEventTime = specToEventTime . gitTimeUTC
specsToEventTimes = specsToEventTimes . fmap gitTimeUTC
initialRepoTree :: FileName -> DirTree B.ByteString initialRepoTree :: FileName -> DirTree B.ByteString
initialRepoTree repo = initialRepoTree repo =
Dir repo Dir repo

View file

@ -21,6 +21,7 @@ where
import Prelude import Prelude
import Data.Hourglass import Data.Hourglass
import Time.System
import Data.EventTime.Local import Data.EventTime.Local
@ -34,3 +35,12 @@ instance IntervalToEventTime Seconds where
| otherwise = Ago $ TimeAgo Day $ si `div` (60 * 60 * 24) | otherwise = Ago $ TimeAgo Day $ si `div` (60 * 60 * 24)
where where
si = fromIntegral s si = fromIntegral s
instance SpecToEventTime Elapsed where
specToEventTime (Elapsed event) = do
Elapsed now <- timeCurrent
return $ intervalToEventTime $ now - event
specsToEventTimes els = do
Elapsed now <- timeCurrent
return $
fmap (\ (Elapsed event) -> intervalToEventTime $ now - event) els