{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

#include "thyme.h"
#if HLINT
#include "cabal_macros.h"
#endif

-- | Vague textual descriptions of time durations.
module Data.Thyme.Format.Human
    ( humanTimeDiff
    , humanTimeDiffs
    , humanRelTime
    , humanRelTimes
    ) where

import Prelude
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
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 :: forall d. TimeDiff d => d -> String
humanTimeDiff d
d = forall d. TimeDiff d => d -> ShowS
humanTimeDiffs d
d String
""

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

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

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

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