    {-# 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
    unit :: Micro
        , Unit -> ShowS
    single :: ShowS
        , Unit -> 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 -> String
    humanTimeDiff d :: d
    d = d -> ShowS
    forall d. TimeDiff d => d -> ShowS
    humanTimeDiffs d
    d ""

    -- | Display 'DiffTime' or 'NominalDiffTime' in a human-readable form.
    {-# ANN humanTimeDiffs "HLint: ignore Use fromMaybe" #-}
    humanTimeDiffs :: (TimeDiff d) => d -> ShowS
    humanTimeDiffs :: d -> ShowS
    humanTimeDiffs td :: d
    td = (if Int64
    signed Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0 then (:) '-' else ShowS
    forall a. a -> a
    id) ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    diff where
        signed :: Int64
    signed@(Int64 -> Micro
    Micro (Int64 -> Micro) -> (Int64 -> Int64) -> Int64 -> Micro
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> Int64
    forall a. Num a => a -> a
    abs -> Micro
    us) = d
    td d -> Getting Int64 d Int64 -> Int64
    forall s a. s -> Getting a s a -> a
    ^. Getting Int64 d Int64
    forall t. TimeDiff t => Iso' t Int64
    microseconds
        diff :: ShowS
    diff = ShowS -> (ShowS -> ShowS) -> Maybe ShowS -> ShowS
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ShowS
    forall a. a -> a
    id ShowS -> ShowS
    forall a. a -> a
    id (Maybe ShowS -> ShowS)
    -> ([First ShowS] -> Maybe ShowS) -> [First ShowS] -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . First ShowS -> Maybe ShowS
    forall a. First a -> Maybe a
    getFirst (First ShowS -> Maybe ShowS)
    -> ([First ShowS] -> First ShowS) -> [First ShowS] -> Maybe ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [First ShowS] -> First ShowS
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold ([First ShowS] -> ShowS) -> [First ShowS] -> ShowS
    forall a b. (a -> b) -> a -> b
    $
            (Unit -> Unit -> First ShowS) -> [Unit] -> [Unit] -> [First ShowS]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (Micro -> Micro -> Unit -> First ShowS
    approx Micro
    us (Micro -> Unit -> First ShowS)
    -> (Unit -> Micro) -> Unit -> Unit -> First ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unit -> Micro
    unit) ([Unit] -> [Unit]
    forall a. [a] -> [a]
    tail [Unit]
    units) [Unit]
    units

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

    -- | Display one 'UTCTime' relative to another, in a human-readable form.
    humanRelTimes :: UTCTime -> UTCTime -> ShowS
    humanRelTimes :: UTCTime -> UTCTime -> ShowS
    humanRelTimes ref :: UTCTime
    ref time :: UTCTime
    time = ShowS -> ShowS
    thence (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> ShowS
    forall d. TimeDiff d => d -> ShowS
    humanTimeDiffs NominalDiffTime
    diff where
        (diff :: NominalDiffTime
    diff, thence :: ShowS -> ShowS
    thence) = case NominalDiffTime -> NominalDiffTime -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare NominalDiffTime
    delta NominalDiffTime
    forall v. AdditiveGroup v => v
    zeroV of
            LT -> (NominalDiffTime -> NominalDiffTime
    forall v. AdditiveGroup v => v -> v
    negateV NominalDiffTime
    delta, (String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) "in " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .))
            EQ -> (NominalDiffTime
    forall v. AdditiveGroup v => v
    zeroV, ShowS -> ShowS -> ShowS
    forall a b. a -> b -> a
    const (ShowS -> ShowS -> ShowS) -> ShowS -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) "right now")
            GT -> (NominalDiffTime
    delta, (ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) " ago"))
            where delta :: Diff UTCTime
    delta = UTCTime
    time UTCTime -> UTCTime -> Diff UTCTime
    forall p. AffineSpace p => p -> p -> Diff p
    .-. UTCTime
    ref

    approx :: Micro -> Micro -> Unit -> First ShowS
    approx :: Micro -> Micro -> Unit -> First ShowS
    approx us :: Micro
    us next :: Micro
    next Unit {..} = Maybe ShowS -> First ShowS
    forall a. Maybe a -> First a
    First (Maybe ShowS -> First ShowS) -> Maybe ShowS -> First ShowS
    forall a b. (a -> b) -> a -> b
    $
            Int64 -> ShowS
    forall a. Show a => a -> ShowS
    shows Int64
    n ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    inflection ShowS -> Maybe () -> Maybe ShowS
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Micro
    us Micro -> Micro -> Bool
    forall a. Ord a => a -> a -> Bool
    < Micro
    next) where
        n :: Int64
    n = (Int64, Micro) -> Int64
    forall a b. (a, b) -> a
    fst ((Int64, Micro) -> Int64) -> (Int64, Micro) -> Int64
    forall a b. (a -> b) -> a -> b
    $ Micro -> Micro -> (Int64, Micro)
    microQuotRem (Micro
    us Micro -> Micro -> Micro
    forall v. AdditiveGroup v => v -> v -> v
    ^+^ Micro
    half) Micro
    unit where
            half :: Micro
    half = Int64 -> Micro
    Micro (Int64 -> Micro)
    -> ((Int64, Micro) -> Int64) -> (Int64, Micro) -> Micro
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int64, Micro) -> Int64
    forall a b. (a, b) -> a
    fst ((Int64, Micro) -> Micro) -> (Int64, Micro) -> Micro
    forall a b. (a -> b) -> a -> b
    $ Micro -> Micro -> (Int64, Micro)
    microQuotRem Micro
    unit (Int64 -> Micro
    Micro 2)
        inflection :: ShowS
    inflection = if Int64
    n Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 then ShowS
    single else ShowS
    plural

    units :: [Unit]
    units :: [Unit]
    units = (Unit -> (Unit -> Unit) -> Unit)
    -> Unit -> [Unit -> Unit] -> [Unit]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl Unit -> (Unit -> Unit) -> Unit
    forall a b. a -> (a -> b) -> b
    (&)
        (Micro -> ShowS -> ShowS -> Unit
    Unit (Int64 -> Micro
    Micro 1) (" microsecond" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) (" microseconds" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++))
        [ String -> Rational -> Unit -> Unit
    times "millisecond"   1000
        , String -> Rational -> Unit -> Unit
    times "second"        1000
        , String -> Rational -> Unit -> Unit
    times "minute"        60
        , String -> Rational -> Unit -> Unit
    times "hour"          60
        , String -> Rational -> Unit -> Unit
    times "day"           24
        , String -> Rational -> Unit -> Unit
    times "week"          7
        , String -> Rational -> Unit -> Unit
    times "month"         (30.4368 Rational -> Rational -> Rational
    forall a. Fractional a => a -> a -> a
    / 7)
        , String -> Rational -> Unit -> Unit
    times "year"          12
        , String -> Rational -> Unit -> Unit
    times "decade"        10
        , String -> Rational -> Unit -> Unit
    times "century"       10 (Unit -> Unit) -> (Unit -> Unit) -> Unit -> Unit
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Setter Unit Unit ShowS ShowS -> ShowS -> Unit -> Unit
    forall s t a b. Setter s t a b -> b -> s -> t
    set Setter Unit Unit ShowS ShowS
    Lens Unit Unit ShowS ShowS
    _plural (" centuries" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
        , String -> Rational -> Unit -> Unit
    times "millennium"    10 (Unit -> Unit) -> (Unit -> Unit) -> Unit -> Unit
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Setter Unit Unit ShowS ShowS -> ShowS -> Unit -> Unit
    forall s t a b. Setter s t a b -> b -> s -> t
    set Setter Unit Unit ShowS ShowS
    Lens Unit Unit ShowS ShowS
    _plural (" millennia" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)
        , Unit -> Unit -> Unit
    forall a b. a -> b -> a
    const (Micro -> ShowS -> ShowS -> Unit
    Unit Micro
    forall a. Bounded a => a
    maxBound ShowS
    forall a. a -> a
    id ShowS
    forall a. a -> a
    id) -- upper bound needed for humanTimeDiffs.diff
        ] where
        times :: String -> Rational -> Unit -> Unit
        times :: String -> Rational -> Unit -> Unit
    times (String -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) (String -> ShowS) -> ShowS -> String -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:) ' ' -> ShowS
    single) r :: Rational
    r Unit {Micro
    unit :: Micro
    unit :: Unit -> Micro
    unit}
            = Unit :: Micro -> ShowS -> ShowS -> Unit
    Unit {unit :: Micro
    unit = Rational
    Scalar Micro
    r Scalar Micro -> Micro -> Micro
    forall v. VectorSpace v => Scalar v -> v -> v
    *^ Micro
    unit, plural :: ShowS
    plural = ShowS
    single ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (:) 's', ..}