    {-# LANGUAGE CPP #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ViewPatterns #-}
    #include "thyme.h"

    module Data.Thyme.Format.Human
        ( humanTimeDiff
        , humanTimeDiffs
        , humanRelTime
        , humanRelTimes
        ) where

    import Prelude
    import Control.Applicative
    import Control.Arrow
    import Control.Lens
    import Control.Monad
    import Data.AdditiveGroup
    import Data.AffineSpace
    import Data.Foldable
    import Data.Thyme.Internal.Micro
    import Data.Monoid
    import Data.Thyme.Clock.Internal
    import Data.VectorSpace

    data Unit = Unit
        { unit :: Micro
        , single :: ShowS
        , plural :: ShowS
        }
    LENS(Unit,plural,ShowS)

    -- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.
    {-# INLINE humanTimeDiff #-}
    humanTimeDiff :: (TimeDiff d) => d -> String
    humanTimeDiff d = humanTimeDiffs d ""

    -- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.
    {-# ANN humanTimeDiffs "HLint: ignore Use fromMaybe" #-}
    humanTimeDiffs :: (TimeDiff d) => d -> ShowS
    humanTimeDiffs td = (if signed < 0 then (:) '-' else id) . diff where
        signed@(Micro . abs -> us) = td ^. microseconds
        diff = maybe id id . getFirst . fold $
            zipWith (approx us . unit) (tail units) units

    -- | Display one 'UTCTime' relative to another, in a human-readable form.
    {-# INLINE humanRelTime #-}
    humanRelTime :: UTCTime -> UTCTime -> String
    humanRelTime ref time = humanRelTimes ref time ""

    -- | Display one 'UTCTime' relative to another, in a human-readable form.
    humanRelTimes :: UTCTime -> UTCTime -> ShowS
    humanRelTimes ref time = thence $ humanTimeDiffs diff where
        (diff, thence) = case compare delta zeroV of
            LT -> (negateV delta, ((++) "in " .))
            EQ -> (zeroV, const $ (++) "right now")
            GT -> (delta, (. (++) " ago"))
            where delta = time .-. ref

    approx :: Micro -> Micro -> Unit -> First ShowS
    approx us next Unit {..} = First $
            shows n . inflection <$ guard (us < next) where
        n = fst $ microQuotRem (us ^+^ half) unit where
            half = Micro . fst $ microQuotRem unit (Micro 2)
        inflection = if n == 1 then single else plural

    units :: [Unit]
    units = scanl (&)
        (Unit (Micro 1) (" microsecond" ++) (" microseconds" ++))
        [ times "millisecond"   1000
        , times "second"        1000
        , times "minute"        60
        , times "hour"          60
        , times "day"           24
        , times "week"          7
        , times "month"         (30.4368 / 7)
        , times "year"          12
        , times "decade"        10
        , times "century"       10 >>> set _plural (" centuries" ++)
        , times "millennium"    10 >>> set _plural (" millennia" ++)
        , const (Unit maxBound id id) -- upper bound needed for humanTimeDiffs.diff
        ] where
        times :: String -> Rational -> Unit -> Unit
        times ((++) . (:) ' ' -> single) r Unit {unit}
            = Unit {unit = r *^ unit, plural = single . (:) 's', ..}