More EventTime utils and support for GitTime

src/Data/EventTime/Local.hs

@@ -22,12 +22,17 @@ module Data.EventTime.Local
     , TimeAgo (..)
     , EventTime (..)
       -- * Conversion from time types
+      -- ** Interval conversion
+      -- *** Typeclass
     , IntervalToEventTime (..)
+      -- *** Human friendly conversion adapters
     , RoundDown (..)
     , RoundNear (..)
     , RoundDownWait (..)
     , RoundNearWait (..)
-    , FriendlyIntervalToEventTime
+    , FriendlyConvert (..)
+      -- ** Time conversion
+    , SpecToEventTime (..)
       -- * Display
     , showEventTime
     )
@@ -36,6 +41,7 @@ where
 import Prelude
 
 import Data.Text (Text, snoc)
+import Text.Blaze (ToMarkup (..))
 
 import qualified Formatting as F
 
@@ -52,6 +58,9 @@ data TimeAgo = TimeAgo
 
 data EventTime = Now | Ago TimeAgo | Never
 
+instance ToMarkup EventTime where
+    toMarkup = toMarkup . showEventTime
+
 -------------------------------------------------------------------------------
 -- Conversion from time types
 -------------------------------------------------------------------------------
@@ -108,6 +117,9 @@ data EventTime = Now | Ago TimeAgo | Never
 class IntervalToEventTime i where
     intervalToEventTime :: i -> EventTime
 
+instance IntervalToEventTime EventTime where
+    intervalToEventTime = id
+
 -- | Human friendly event time conversion. Renders a time interval rounded
 -- down. Example:
 --
@@ -143,6 +155,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDown a) where
                         | otherwise -> Ago $ TimeAgo Month $ n `div` (24 * 30)
                     TimeAgo Day n -> Ago $ TimeAgo Year $ n `div` 365
                     _ -> orig
+                _ -> orig
 
 -- | Human friendly event time conversion. Renders a time interval rounded to
 -- the nearest whole unit. Example:
@@ -201,6 +214,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDownWait a) where
                             then Ago $ TimeAgo Month $ n `div` 30
                             else Ago $ TimeAgo Year $ n `div` 365
                     _ -> orig
+                _ -> orig
 
 -- | Human friendly event time conversion. Renders a time interval rounded to
 -- 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
 -- the newtypes above. If you don't have a specific preference, this is a safe
 -- 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

src/Data/Git/Local.hs

@@ -30,6 +30,7 @@ import Control.Monad (when)
 import Data.Byteable (toBytes)
 import Data.Git
 import Data.Git.Harder
+import Data.Git.Types (GitTime (..))
 import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8With)
 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.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 repo =
     Dir repo

src/Data/Hourglass/Local.hs

@@ -21,6 +21,7 @@ where
 import Prelude
 
 import Data.Hourglass
+import Time.System
 
 import Data.EventTime.Local
 
@@ -34,3 +35,12 @@ instance IntervalToEventTime Seconds where
         | otherwise              = Ago $ TimeAgo Day $ si `div` (60 * 60 * 24)
         where
         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