From ebbcc6afdc941ff7ca9f4bd1048dd745d63d5ba1 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Thu, 5 May 2016 22:20:11 +0000 Subject: [PATCH] Explore friendly rendering of event time --- src/Data/EventTime/Local.hs | 211 ++++++++++++++++++++++++++++++++++-- src/Vervis/Changes.hs | 33 ++++++ vervis.cabal | 1 + 3 files changed, 238 insertions(+), 7 deletions(-) create mode 100644 src/Vervis/Changes.hs diff --git a/src/Data/EventTime/Local.hs b/src/Data/EventTime/Local.hs index 9ef0ee3..74181b6 100644 --- a/src/Data/EventTime/Local.hs +++ b/src/Data/EventTime/Local.hs @@ -13,10 +13,22 @@ - . -} +-- | Representation and display of events times between seconds and years ago. +-- Currently the display is in terms of how much time passed since the event, +-- but more display modes can be added. module Data.EventTime.Local - ( TimeUnit (..) + ( -- * Event time types + TimeUnit (..) , TimeAgo (..) , EventTime (..) + -- * Conversion from time types + , IntervalToEventTime (..) + , RoundDown (..) + , RoundNear (..) + , RoundDownWait (..) + , RoundNearWait (..) + , FriendlyIntervalToEventTime + -- * Display , showEventTime ) where @@ -27,8 +39,199 @@ import Data.Text (Text, snoc) import qualified Formatting as F +------------------------------------------------------------------------------- +-- Event time types +------------------------------------------------------------------------------- + data TimeUnit = Second | Minute | Hour | Day | Week | Month | Year +data TimeAgo = TimeAgo + { taUnit :: TimeUnit + , taCount :: Int + } + +data EventTime = Now | Ago TimeAgo | Never + +------------------------------------------------------------------------------- +-- Conversion from time types +------------------------------------------------------------------------------- + +-- | Given a time interval representing how much time passed since an event, it +-- can be converted into an 'EventTime'. This is a class for time interval +-- types which support such a conversion. +-- +-- There is a default convetion for mapping time intervals to the human +-- friendly event time form. Other conventions can be easily added by defining +-- newtype wrappers for new conventions and making them instances of this +-- class. The purpose of the default convention if to make the actual human +-- friendly conventions easy to implement on top, and isn't expected to be +-- useful directly for display in UI. +-- +-- The default convention works like this: +-- +-- (1) Use a 1 step higher resolution unit that you normally would, but don't +-- use weeks and months at all (express years in days) +-- (2) Round downwards. Rounding to the closest integer is fine too and makes +-- the error smaller, but since higher resolution units are used, the +-- difference is small while rounding down is quicker to implement (integer +-- division does it for free). +-- +-- The conversions made using this mechanism aren't accurate, e.g. they don't +-- necessarily take into account that in some years there are 29 days in +-- February and so on, but these are small details which don't have a visible +-- effect on the human friendly display of event times. And even if in some +-- corner case they do, you can always implement an 'IntervalToEventTime' +-- instance for your specific needs. +-- +-- Additional conventions: +-- +-- * A duration of less than 1 second means 'Now'. +-- * Some time interval types may have a way to express "never", e.g. by using +-- a very high duration. But either way, this is just optional extra. +-- +-- Here's an example for the default convention: +-- +-- > -- Interval | Event time +-- > -- ============ + ========== +-- > -- 0 | Now +-- > -- 0.5 second | Now +-- > -- 1 second | 1 second +-- > -- 1 minute | 60 seconds +-- > -- 59 minutes | 3599 seconds +-- > -- 1 hour | 60 minutes +-- > -- 23 hours | 1380 minutes +-- > -- 1 day | 24 hours +-- > -- 364 days | 8736 hours +-- > -- 1 year | 365 days +-- > -- 10 years | 3650 days +-- > -- 100 years | 36500 days +class IntervalToEventTime i where + intervalToEventTime :: i -> EventTime + +-- | Human friendly event time conversion. Renders a time interval rounded +-- down. Example: +-- +-- > -- Interval | Event time +-- > -- ==================== + ========== +-- > -- 11 months | 11 months +-- > -- 1 year | 1 year +-- > -- 1 year and 1 month | 1 year +-- > -- 1 year and 6 months | 1 year +-- > -- 1 year and 7 months | 1 year +-- > -- 1 year and 11 months | 1 year -- still rounds down to 1 year +-- > -- 2 years | 2 years +-- > -- 2 years and 1 month | 2 years +newtype RoundDown a = RoundDown a + +instance IntervalToEventTime a => IntervalToEventTime (RoundDown a) where + intervalToEventTime (RoundDown a) = + let orig = intervalToEventTime a + in case orig of + Ago ta -> case ta of + TimeAgo Second n -> + if n < 60 + then orig + else Ago $ TimeAgo Minute $ n `div` 60 + TimeAgo Minute n -> + if n < 60 + then orig + else Ago $ TimeAgo Hour $ n `div` 60 + TimeAgo Hour n + | n < 24 -> orig + | n < 24 * 7 -> Ago $ TimeAgo Day $ n `div` 24 + | n < 24 * 31 -> Ago $ TimeAgo Week $ n `div` (24 * 7) + | otherwise -> Ago $ TimeAgo Month $ n `div` (24 * 30) + TimeAgo Day n -> Ago $ TimeAgo Year $ n `div` 365 + _ -> orig + +-- | Human friendly event time conversion. Renders a time interval rounded to +-- the nearest whole unit. Example: +-- +-- > -- Interval | Event time +-- > -- ==================== + ========== +-- > -- 11 months | 11 months +-- > -- 1 year | 1 year +-- > -- 1 year and 1 month | 1 year +-- > -- 1 year and 6 months | 1 year +-- > -- 1 year and 7 months | 2 years -- already rounds up to 2 years +-- > -- 1 year and 11 months | 2 years +-- > -- 2 years | 2 years +-- > -- 2 years and 1 month | 2 years +newtype RoundNear a = RoundNear a + +-- | Human friendly event time conversion. Renders a time interval rounded +-- down, but switches unit only when the previous unit reaches 2 (instead +-- of 1). Example: +-- +-- > -- Interval | Event time +-- > -- ==================== + ========== +-- > -- 11 months | 11 months +-- > -- 1 year | 12 months +-- > -- 1 year and 1 month | 12 months +-- > -- 1 year and 6 months | 18 months +-- > -- 1 year and 7 months | 19 months +-- > -- 1 year and 11 months | 23 months -- still counts in months +-- > -- 2 years | 2 years +-- > -- 2 years and 1 month | 2 years +-- > -- 2 year and 11 months | 2 year -- still rounds down to 2 years +-- > -- 3 years | 3 years +-- > -- 3 years and 1 month | 3 years +newtype RoundDownWait a = RoundDownWait a + +instance IntervalToEventTime a => IntervalToEventTime (RoundDownWait a) where + intervalToEventTime (RoundDownWait a) = + let orig = intervalToEventTime a + in case orig of + Ago ta -> case ta of + TimeAgo Second n -> + if n < 60 * 2 + then orig + else Ago $ TimeAgo Minute $ n `div` 60 + TimeAgo Minute n -> + if n < 60 * 2 + then orig + else Ago $ TimeAgo Hour $ n `div` 60 + TimeAgo Hour n + | n < 24 * 2 -> orig + | n < 24 * 14 -> Ago $ TimeAgo Day $ n `div` 24 + | n < 24 * 62 -> Ago $ TimeAgo Week $ n `div` (24 * 7) + | otherwise -> Ago $ TimeAgo Month $ n `div` (24 * 30) + TimeAgo Day n -> + if n < 365 * 2 + then Ago $ TimeAgo Month $ n `div` 30 + else Ago $ TimeAgo Year $ n `div` 365 + _ -> orig + +-- | Human friendly event time conversion. Renders a time interval rounded to +-- the nearest whole unit, but switches unit only when the previous unit +-- reaches 2 (instead of 1). Example: +-- +-- > -- Interval | Event time +-- > -- ==================== + ========== +-- > -- 11 months | 11 months +-- > -- 1 year | 12 months +-- > -- 1 year and 1 month | 12 months +-- > -- 1 year and 6 months | 18 months +-- > -- 1 year and 7 months | 19 months +-- > -- 1 year and 11 months | 23 months -- still counts in months +-- > -- 2 years | 2 years +-- > -- 2 years and 1 month | 2 years +-- > -- 1 year and 6 months | 2 years +-- > -- 1 year and 7 months | 3 years -- already rounds up to 3 years +-- > -- 2 year and 11 months | 3 year +-- > -- 3 years | 3 years +-- > -- 3 years and 1 month | 3 years +newtype RoundNearWait a = RoundNearWait a + +-- | 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 +-- defauly. +type FriendlyIntervalToEventTime = RoundNearWait + +------------------------------------------------------------------------------- +-- Display +------------------------------------------------------------------------------- + showSingle :: TimeUnit -> Text showSingle tu = case tu of @@ -47,17 +250,11 @@ showTimeUnit :: TimeUnit -> Int -> Text showTimeUnit tu 1 = showSingle tu showTimeUnit tu _ = showPlural tu -data TimeAgo = TimeAgo - { taUnit :: TimeUnit - , taCount :: Int - } showTimeAgo :: TimeAgo -> Text showTimeAgo (TimeAgo u n) = F.sformat (F.int F.% " " F.% F.stext F.% " ago") n (showTimeUnit u n) -data EventTime = Now | Ago TimeAgo | Never - showEventTime :: EventTime -> Text showEventTime Now = "Now" showEventTime (Ago ta) = showTimeAgo ta diff --git a/src/Vervis/Changes.hs b/src/Vervis/Changes.hs new file mode 100644 index 0000000..b3c583e --- /dev/null +++ b/src/Vervis/Changes.hs @@ -0,0 +1,33 @@ +{- This file is part of Vervis. + - + - Written in 2016 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | Representation of repo history log. +module Vervis.Changes + ( LogEntry (..) + ) +where + +import Prelude + +import Data.Text (Text) + +import Data.EventTime.Local + +data LogEntry = LogEntry + { leAuthor :: Text + , leHash :: Text + , leMessage :: Text + , leTime :: EventTime + } diff --git a/vervis.cabal b/vervis.cabal index bd15f36..bd05eb4 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -46,6 +46,7 @@ library Text.FilePath.Local Vervis.Application Vervis.BinaryBody + Vervis.Changes Vervis.Content Vervis.Darcs Vervis.Field.Key