From 6e2a8b259d8d45275d0ddf8ad934f8fa2479a930 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@rel4tion.org>
Date: Fri, 6 May 2016 10:21:44 +0000
Subject: [PATCH] More EventTime utils and support for GitTime

---
 src/Data/EventTime/Local.hs | 40 +++++++++++++++++++++++++++++++++++--
 src/Data/Git/Local.hs       |  8 ++++++++
 src/Data/Hourglass/Local.hs | 10 ++++++++++
 3 files changed, 56 insertions(+), 2 deletions(-)

diff --git a/src/Data/EventTime/Local.hs b/src/Data/EventTime/Local.hs
index 74181b6..9b70b57 100644
--- a/src/Data/EventTime/Local.hs
+++ b/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:
 --
@@ -142,6 +154,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDown a) where
                         | 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
                 _ -> orig
 
 -- | Human friendly event time conversion. Renders a time interval rounded to
@@ -200,6 +213,7 @@ instance IntervalToEventTime a => IntervalToEventTime (RoundDownWait a) where
                         if n < 365 * 2
                             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
@@ -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
diff --git a/src/Data/Git/Local.hs b/src/Data/Git/Local.hs
index 4d6d047..9adba89 100644
--- a/src/Data/Git/Local.hs
+++ b/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
diff --git a/src/Data/Hourglass/Local.hs b/src/Data/Hourglass/Local.hs
index be0d1a8..ffc8337 100644
--- a/src/Data/Hourglass/Local.hs
+++ b/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