{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
#include "thyme.h"
#if HLINT
#include "cabal_macros.h"
#endif
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)
{-# 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
""
{-# 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
{-# INLINE humanRelTime #-}
humanRelTime :: UTCTime -> UTCTime -> String
humanRelTime :: UTCTime -> UTCTime -> String
humanRelTime UTCTime
ref UTCTime
time = UTCTime -> UTCTime -> ShowS
humanRelTimes UTCTime
ref UTCTime
time String
""
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)
] 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
..}