{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.Rendering.Chart.Axis.Time(
TimeSeq,
TimeLabelFn,
TimeLabelAlignment(..),
TimeValue (..),
timeValueAxis,
autoTimeValueAxis,
days, months, years,
) where
import Data.Default.Class
#if MIN_VERSION_time(1,5,0)
import Data.Time hiding (months)
#else
import Data.Time
import System.Locale (defaultTimeLocale)
#endif
import Data.Fixed
import Control.Lens
import Graphics.Rendering.Chart.Axis.Types
import Graphics.Rendering.Chart.Geometry (Range)
class TimeValue t where
utctimeFromTV :: t -> UTCTime
tvFromUTCTime :: UTCTime -> t
{-# MINIMAL utctimeFromTV, tvFromUTCTime #-}
doubleFromTimeValue :: t -> Double
doubleFromTimeValue = UTCTime -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue (UTCTime -> Double) -> (t -> UTCTime) -> t -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> UTCTime
forall t. TimeValue t => t -> UTCTime
utctimeFromTV
timeValueFromDouble :: Double -> t
timeValueFromDouble = UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime (UTCTime -> t) -> (Double -> UTCTime) -> Double -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> UTCTime
forall t. TimeValue t => Double -> t
timeValueFromDouble
instance TimeValue UTCTime where
utctimeFromTV :: UTCTime -> UTCTime
utctimeFromTV = UTCTime -> UTCTime
forall a. a -> a
id
tvFromUTCTime :: UTCTime -> UTCTime
tvFromUTCTime = UTCTime -> UTCTime
forall a. a -> a
id
doubleFromTimeValue :: UTCTime -> Double
doubleFromTimeValue = UTCTime -> Double
doubleFromUTCTime
timeValueFromDouble :: Double -> UTCTime
timeValueFromDouble = Double -> UTCTime
utcTimeFromDouble
instance TimeValue Day where
utctimeFromTV :: Day -> UTCTime
utctimeFromTV d :: Day
d = Day -> DiffTime -> UTCTime
UTCTime Day
d 0
tvFromUTCTime :: UTCTime -> Day
tvFromUTCTime = UTCTime -> Day
utctDay
doubleFromTimeValue :: Day -> Double
doubleFromTimeValue = Day -> Double
doubleFromDay
timeValueFromDouble :: Double -> Day
timeValueFromDouble = Double -> Day
dayFromDouble
instance TimeValue LocalTime where
utctimeFromTV :: LocalTime -> UTCTime
utctimeFromTV (LocalTime d :: Day
d tod :: TimeOfDay
tod) = Day -> DiffTime -> UTCTime
UTCTime Day
d (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
tvFromUTCTime :: UTCTime -> LocalTime
tvFromUTCTime (UTCTime d :: Day
d dt :: DiffTime
dt) = Day -> TimeOfDay -> LocalTime
LocalTime Day
d (DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
dt)
instance PlotValue LocalTime where
toValue :: LocalTime -> Double
toValue = LocalTime -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue
fromValue :: Double -> LocalTime
fromValue = Double -> LocalTime
forall t. TimeValue t => Double -> t
timeValueFromDouble
autoAxis :: AxisFn LocalTime
autoAxis = AxisFn LocalTime
forall t. TimeValue t => AxisFn t
autoTimeValueAxis
instance PlotValue UTCTime where
toValue :: UTCTime -> Double
toValue = UTCTime -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue
fromValue :: Double -> UTCTime
fromValue = Double -> UTCTime
forall t. TimeValue t => Double -> t
timeValueFromDouble
autoAxis :: AxisFn UTCTime
autoAxis = AxisFn UTCTime
forall t. TimeValue t => AxisFn t
autoTimeValueAxis
instance PlotValue Day where
toValue :: Day -> Double
toValue = Day -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue
fromValue :: Double -> Day
fromValue = Double -> Day
forall t. TimeValue t => Double -> t
timeValueFromDouble
autoAxis :: AxisFn Day
autoAxis = AxisFn Day
forall t. TimeValue t => AxisFn t
autoTimeValueAxis
doubleFromUTCTime :: UTCTime -> Double
doubleFromUTCTime :: UTCTime -> Double
doubleFromUTCTime ut :: UTCTime
ut = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Integer
toModifiedJulianDay (UTCTime -> Day
utctDay UTCTime
ut))
Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (TimeOfDay -> Rational
timeOfDayToDayFraction (DiffTime -> TimeOfDay
timeToTimeOfDay (UTCTime -> DiffTime
utctDayTime UTCTime
ut)))
utcTimeFromDouble :: Double -> UTCTime
utcTimeFromDouble :: Double -> UTCTime
utcTimeFromDouble v :: Double
v =
Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
i) (TimeOfDay -> DiffTime
timeOfDayToTime (Rational -> TimeOfDay
dayFractionToTimeOfDay (Double -> Rational
forall a. Real a => a -> Rational
toRational Double
d)))
where
(i :: Integer
i,d :: Double
d) = Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
v
doubleFromDay :: Day -> Double
doubleFromDay :: Day -> Double
doubleFromDay d :: Day
d = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Integer
toModifiedJulianDay Day
d)
dayFromDouble :: Double -> Day
dayFromDouble :: Double -> Day
dayFromDouble v :: Double
v = Integer -> Day
ModifiedJulianDay (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v)
type TimeSeq = UTCTime -> ([UTCTime],[UTCTime])
coverTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS tseq :: TimeSeq
tseq minT :: UTCTime
minT maxT :: UTCTime
maxT = [UTCTime]
min' [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. [a] -> [a] -> [a]
++ TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
enumerateTS TimeSeq
tseq UTCTime
minT UTCTime
maxT [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. [a] -> [a] -> [a]
++ [UTCTime]
max'
where
min' :: [UTCTime]
min' = if UTCTime -> TimeSeq -> Bool
elemTS UTCTime
minT TimeSeq
tseq then [] else Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take 1 (([UTCTime], [UTCTime]) -> [UTCTime]
forall a b. (a, b) -> a
fst (TimeSeq
tseq UTCTime
minT))
max' :: [UTCTime]
max' = if UTCTime -> TimeSeq -> Bool
elemTS UTCTime
maxT TimeSeq
tseq then [] else Int -> [UTCTime] -> [UTCTime]
forall a. Int -> [a] -> [a]
take 1 (([UTCTime], [UTCTime]) -> [UTCTime]
forall a b. (a, b) -> b
snd (TimeSeq
tseq UTCTime
maxT))
enumerateTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
enumerateTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
enumerateTS tseq :: TimeSeq
tseq minT :: UTCTime
minT maxT :: UTCTime
maxT =
[UTCTime] -> [UTCTime]
forall a. [a] -> [a]
reverse ((UTCTime -> Bool) -> [UTCTime] -> [UTCTime]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>=UTCTime
minT) [UTCTime]
ts1) [UTCTime] -> [UTCTime] -> [UTCTime]
forall a. [a] -> [a] -> [a]
++ (UTCTime -> Bool) -> [UTCTime] -> [UTCTime]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<=UTCTime
maxT) [UTCTime]
ts2
where
(ts1 :: [UTCTime]
ts1,ts2 :: [UTCTime]
ts2) = TimeSeq
tseq UTCTime
minT
elemTS :: UTCTime -> TimeSeq -> Bool
elemTS :: UTCTime -> TimeSeq -> Bool
elemTS t :: UTCTime
t tseq :: TimeSeq
tseq = case TimeSeq
tseq UTCTime
t of
(_,t0 :: UTCTime
t0:_) | UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime
t0 -> Bool
True
_ -> Bool
False
type TimeLabelFn = UTCTime -> String
data TimeLabelAlignment = UnderTicks
| BetweenTicks
deriving (Int -> TimeLabelAlignment -> ShowS
[TimeLabelAlignment] -> ShowS
TimeLabelAlignment -> String
(Int -> TimeLabelAlignment -> ShowS)
-> (TimeLabelAlignment -> String)
-> ([TimeLabelAlignment] -> ShowS)
-> Show TimeLabelAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeLabelAlignment] -> ShowS
$cshowList :: [TimeLabelAlignment] -> ShowS
show :: TimeLabelAlignment -> String
$cshow :: TimeLabelAlignment -> String
showsPrec :: Int -> TimeLabelAlignment -> ShowS
$cshowsPrec :: Int -> TimeLabelAlignment -> ShowS
Show)
timeValueAxis ::
TimeValue t
=> TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis :: TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis tseq :: TimeSeq
tseq lseq :: TimeSeq
lseq labelf :: TimeLabelFn
labelf lal :: TimeLabelAlignment
lal cseq :: TimeSeq
cseq contextf :: TimeLabelFn
contextf clal :: TimeLabelAlignment
clal pts :: [t]
pts = AxisData :: forall x.
AxisVisibility
-> (Range -> x -> Double)
-> (Range -> Double -> x)
-> [(x, Double)]
-> [[(x, String)]]
-> [x]
-> AxisData x
AxisData {
_axis_visibility :: AxisVisibility
_axis_visibility = AxisVisibility
forall a. Default a => a
def,
_axis_viewport :: Range -> t -> Double
_axis_viewport = (t, t) -> Range -> t -> Double
forall x. TimeValue x => (x, x) -> Range -> x -> Double
vmap' (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
min', UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
max'),
_axis_tropweiv :: Range -> Double -> t
_axis_tropweiv = (t, t) -> Range -> Double -> t
forall x. TimeValue x => (x, x) -> Range -> Double -> x
invmap' (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
min', UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
max'),
_axis_ticks :: [(t, Double)]
_axis_ticks = [ (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
t,2) | UTCTime
t <- [UTCTime]
times] [(t, Double)] -> [(t, Double)] -> [(t, Double)]
forall a. [a] -> [a] -> [a]
++ [ (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
t,5) | UTCTime
t <- [UTCTime]
ltimes, UTCTime -> Bool
visible UTCTime
t],
_axis_labels :: [[(t, String)]]
_axis_labels = [ [ (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
t,String
l) | (t :: UTCTime
t,l :: String
l) <- TimeLabelFn
-> [UTCTime] -> TimeLabelAlignment -> [(UTCTime, String)]
forall b.
(UTCTime -> b) -> [UTCTime] -> TimeLabelAlignment -> [(UTCTime, b)]
labels TimeLabelFn
labelf [UTCTime]
ltimes TimeLabelAlignment
lal, UTCTime -> Bool
visible UTCTime
t]
, [ (UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
t,String
l) | (t :: UTCTime
t,l :: String
l) <- TimeLabelFn
-> [UTCTime] -> TimeLabelAlignment -> [(UTCTime, String)]
forall b.
(UTCTime -> b) -> [UTCTime] -> TimeLabelAlignment -> [(UTCTime, b)]
labels TimeLabelFn
contextf [UTCTime]
ctimes TimeLabelAlignment
clal, UTCTime -> Bool
visible UTCTime
t]
],
_axis_grid :: [t]
_axis_grid = [ UTCTime -> t
forall t. TimeValue t => UTCTime -> t
tvFromUTCTime UTCTime
t | UTCTime
t <- [UTCTime]
ltimes, UTCTime -> Bool
visible UTCTime
t]
}
where
(minT :: UTCTime
minT,maxT :: UTCTime
maxT) = case [t]
pts of
[] -> (UTCTime
refTimeValue,UTCTime
refTimeValue)
ps :: [t]
ps -> ([UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((t -> UTCTime) -> [t] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map t -> UTCTime
forall t. TimeValue t => t -> UTCTime
utctimeFromTV [t]
ps), [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((t -> UTCTime) -> [t] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map t -> UTCTime
forall t. TimeValue t => t -> UTCTime
utctimeFromTV [t]
ps))
refTimeValue :: UTCTime
refTimeValue = Double -> UTCTime
forall t. TimeValue t => Double -> t
timeValueFromDouble 0
times, ltimes, ctimes :: [UTCTime]
times :: [UTCTime]
times = TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS TimeSeq
tseq UTCTime
minT UTCTime
maxT
ltimes :: [UTCTime]
ltimes = TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS TimeSeq
lseq UTCTime
minT UTCTime
maxT
ctimes :: [UTCTime]
ctimes = TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS TimeSeq
cseq UTCTime
minT UTCTime
maxT
min' :: UTCTime
min' = [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [UTCTime]
times
max' :: UTCTime
max' = [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
times
visible :: UTCTime -> Bool
visible t :: UTCTime
t = UTCTime
min' UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
t Bool -> Bool -> Bool
&& UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
max'
labels :: (UTCTime -> b) -> [UTCTime] -> TimeLabelAlignment -> [(UTCTime, b)]
labels f :: UTCTime -> b
f ts :: [UTCTime]
ts lal' :: TimeLabelAlignment
lal' =
[ (TimeLabelAlignment -> UTCTime -> UTCTime -> UTCTime
forall p t.
(TimeValue p, TimeValue t) =>
TimeLabelAlignment -> p -> t -> p
align TimeLabelAlignment
lal' UTCTime
m1' UTCTime
m2', UTCTime -> b
f UTCTime
m1)
| (m1 :: UTCTime
m1,m2 :: UTCTime
m2) <- [UTCTime] -> [UTCTime] -> [(UTCTime, UTCTime)]
forall a b. [a] -> [b] -> [(a, b)]
zip [UTCTime]
ts ([UTCTime] -> [UTCTime]
forall a. [a] -> [a]
tail [UTCTime]
ts)
, let m1' :: UTCTime
m1' = if UTCTime
m1UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<UTCTime
min' then UTCTime
min' else UTCTime
m1
, let m2' :: UTCTime
m2' = if UTCTime
m2UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>UTCTime
max' then UTCTime
max' else UTCTime
m2 ]
align :: TimeLabelAlignment -> p -> t -> p
align BetweenTicks m1 :: p
m1 m2 :: t
m2 = p -> t -> p
forall t t t.
(TimeValue t, TimeValue t, TimeValue t) =>
t -> t -> t
avg p
m1 t
m2
align UnderTicks m1 :: p
m1 _ = p
m1
avg :: t -> t -> t
avg m1 :: t
m1 m2 :: t
m2 = Double -> t
forall t. TimeValue t => Double -> t
timeValueFromDouble (Double -> t) -> Double -> t
forall a b. (a -> b) -> a -> b
$ Double
m1' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
m2' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m1')Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/2
where
m1' :: Double
m1' = t -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue t
m1
m2' :: Double
m2' = t -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue t
m2
vmap' :: TimeValue x => (x,x) -> Range -> x -> Double
vmap' :: (x, x) -> Range -> x -> Double
vmap' (v1 :: x
v1,v2 :: x
v2) (v3 :: Double
v3,v4 :: Double
v4) v :: x
v = Double
v3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
v4Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
v3)
Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v1)
invmap' :: TimeValue x => (x,x) -> Range -> Double -> x
invmap' :: (x, x) -> Range -> Double -> x
invmap' (v3 :: x
v3,v4 :: x
v4) (d1 :: Double
d1,d2 :: Double
d2) d :: Double
d = Double -> x
forall t. TimeValue t => Double -> t
timeValueFromDouble (x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ( (Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
doubleRange
Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
d2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
d1) ))
where doubleRange :: Double
doubleRange = x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v4 Double -> Double -> Double
forall a. Num a => a -> a -> a
- x -> Double
forall t. TimeValue t => t -> Double
doubleFromTimeValue x
v3
truncateTo :: Real a => a -> a -> a
truncateTo :: a -> a -> a
truncateTo t :: a
t step :: a
step = a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
t a -> a -> a
forall a. Real a => a -> a -> a
`mod'` a
step
secondSeq :: NominalDiffTime -> TimeSeq
secondSeq :: NominalDiffTime -> TimeSeq
secondSeq step :: NominalDiffTime
step t :: UTCTime
t@(UTCTime day :: Day
day dt :: DiffTime
dt) = ((UTCTime -> UTCTime) -> UTCTime -> [UTCTime]
forall a. (a -> a) -> a -> [a]
iterate UTCTime -> UTCTime
rev UTCTime
t1, [UTCTime] -> [UTCTime]
forall a. [a] -> [a]
tail ((UTCTime -> UTCTime) -> UTCTime -> [UTCTime]
forall a. (a -> a) -> a -> [a]
iterate UTCTime -> UTCTime
fwd UTCTime
t1))
where t0 :: UTCTime
t0 = Day -> DiffTime -> UTCTime
UTCTime Day
day (DiffTime -> DiffTime -> DiffTime
forall a. Real a => a -> a -> a
truncateTo DiffTime
dt DiffTime
step')
t1 :: UTCTime
t1 = if UTCTime
t0 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t then UTCTime
t0 else UTCTime -> UTCTime
rev UTCTime
t0
rev :: UTCTime -> UTCTime
rev = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate NominalDiffTime
step)
fwd :: UTCTime -> UTCTime
fwd = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
step
step' :: DiffTime
step' = NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
step
millis1, millis10, millis100, seconds, fiveSeconds :: TimeSeq
millis1 :: TimeSeq
millis1 = NominalDiffTime -> TimeSeq
secondSeq (1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ 1000)
millis10 :: TimeSeq
millis10 = NominalDiffTime -> TimeSeq
secondSeq (1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ 100)
millis100 :: TimeSeq
millis100 = NominalDiffTime -> TimeSeq
secondSeq (1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ 10)
seconds :: TimeSeq
seconds = NominalDiffTime -> TimeSeq
secondSeq 1
fiveSeconds :: TimeSeq
fiveSeconds = NominalDiffTime -> TimeSeq
secondSeq 5
minutes, fiveMinutes :: TimeSeq
minutes :: TimeSeq
minutes = NominalDiffTime -> TimeSeq
secondSeq 60
fiveMinutes :: TimeSeq
fiveMinutes = NominalDiffTime -> TimeSeq
secondSeq (5 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* 60)
hours :: TimeSeq
hours :: TimeSeq
hours = NominalDiffTime -> TimeSeq
secondSeq (60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* 60)
days :: TimeSeq
days :: TimeSeq
days t :: UTCTime
t = ((Day -> UTCTime) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Day -> UTCTime
toTime ([Day] -> [UTCTime]) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ (Day -> Day) -> Day -> [Day]
forall a. (a -> a) -> a -> [a]
iterate Day -> Day
rev Day
t1, (Day -> UTCTime) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Day -> UTCTime
toTime ([Day] -> [UTCTime]) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ [Day] -> [Day]
forall a. [a] -> [a]
tail ((Day -> Day) -> Day -> [Day]
forall a. (a -> a) -> a -> [a]
iterate Day -> Day
fwd Day
t1))
where t0 :: Day
t0 = UTCTime -> Day
utctDay UTCTime
t
t1 :: Day
t1 = if Day -> UTCTime
toTime Day
t0 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t then Day
t0 else Day -> Day
rev Day
t0
rev :: Day -> Day
rev = Day -> Day
forall a. Enum a => a -> a
pred
fwd :: Day -> Day
fwd = Day -> Day
forall a. Enum a => a -> a
succ
toTime :: Day -> UTCTime
toTime d :: Day
d = Day -> DiffTime -> UTCTime
UTCTime Day
d 0
months :: TimeSeq
months :: TimeSeq
months t :: UTCTime
t = ((Day -> UTCTime) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Day -> UTCTime
toTime ([Day] -> [UTCTime]) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ (Day -> Day) -> Day -> [Day]
forall a. (a -> a) -> a -> [a]
iterate Day -> Day
rev Day
t1, (Day -> UTCTime) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Day -> UTCTime
toTime ([Day] -> [UTCTime]) -> [Day] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ [Day] -> [Day]
forall a. [a] -> [a]
tail ((Day -> Day) -> Day -> [Day]
forall a. (a -> a) -> a -> [a]
iterate Day -> Day
fwd Day
t1))
where t0 :: Day
t0 = let (y :: Integer
y,m :: Int
m,_) = Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
t in Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m 1
t1 :: Day
t1 = if Day -> UTCTime
toTime Day
t0 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t then Day
t0 else Day -> Day
rev Day
t0
rev :: Day -> Day
rev = Integer -> Day -> Day
addGregorianMonthsClip (-1)
fwd :: Day -> Day
fwd = Integer -> Day -> Day
addGregorianMonthsClip 1
toTime :: Day -> UTCTime
toTime d :: Day
d = Day -> DiffTime -> UTCTime
UTCTime Day
d 0
years :: TimeSeq
years :: TimeSeq
years t :: UTCTime
t = ((Integer -> UTCTime) -> [Integer] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> UTCTime
toTime ([Integer] -> [UTCTime]) -> [Integer] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ (Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate Integer -> Integer
rev Integer
t1, (Integer -> UTCTime) -> [Integer] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> UTCTime
toTime ([Integer] -> [UTCTime]) -> [Integer] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Integer]
forall a. [a] -> [a]
tail ((Integer -> Integer) -> Integer -> [Integer]
forall a. (a -> a) -> a -> [a]
iterate Integer -> Integer
fwd Integer
t1))
where t0 :: Integer
t0 = Day -> (Integer, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
t) (Integer, Int, Int)
-> Getting Integer (Integer, Int, Int) Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer (Integer, Int, Int) Integer
forall s t a b. Field1 s t a b => Lens s t a b
_1
t1 :: Integer
t1 = if Integer -> UTCTime
toTime Integer
t0 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
t then Integer
t0 else Integer -> Integer
rev Integer
t0
rev :: Integer -> Integer
rev = Integer -> Integer
forall a. Enum a => a -> a
pred
fwd :: Integer -> Integer
fwd = Integer -> Integer
forall a. Enum a => a -> a
succ
toTime :: Integer -> UTCTime
toTime y :: Integer
y = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y 1 1) 0
noTime :: TimeSeq
noTime :: TimeSeq
noTime _ = ([],[])
autoTimeValueAxis :: TimeValue t => AxisFn t
autoTimeValueAxis :: AxisFn t
autoTimeValueAxis pts :: [t]
pts
| [t] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [t]
pts = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
days TimeSeq
days (String -> TimeLabelFn
ft "%d-%b-%y") TimeLabelAlignment
UnderTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
UnderTicks []
| 100NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<1 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
millis1 TimeSeq
millis1 (String -> TimeLabelFn
ft "%S%Q") TimeLabelAlignment
UnderTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "%S%Q") TimeLabelAlignment
UnderTicks [t]
pts
| 10NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<1 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
millis10 TimeSeq
millis10 (String -> TimeLabelFn
ft "%S%Q") TimeLabelAlignment
UnderTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "%S%Q") TimeLabelAlignment
UnderTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<1 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
millis10 TimeSeq
millis100 (String -> TimeLabelFn
ft "%S%Q") TimeLabelAlignment
UnderTicks
TimeSeq
seconds (String -> TimeLabelFn
ft "%M:%S") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<5 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
millis100 TimeSeq
seconds (String -> TimeLabelFn
ft "%M:%S%Q") TimeLabelAlignment
UnderTicks
TimeSeq
seconds (String -> TimeLabelFn
ft "%M:%S") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<32 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
seconds TimeSeq
seconds (String -> TimeLabelFn
ft "%Ss") TimeLabelAlignment
UnderTicks
TimeSeq
minutes (String -> TimeLabelFn
ft "%d-%b-%y %H:%M") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<120 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
seconds TimeSeq
fiveSeconds (String -> TimeLabelFn
ft "%Ss") TimeLabelAlignment
UnderTicks
TimeSeq
minutes (String -> TimeLabelFn
ft "%d-%b-%y %H:%M") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<7NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*60 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
fiveSeconds TimeSeq
minutes (String -> TimeLabelFn
ft "%Mm") TimeLabelAlignment
UnderTicks
TimeSeq
hours (String -> TimeLabelFn
ft "%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<32NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*60 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
minutes TimeSeq
minutes (String -> TimeLabelFn
ft "%Mm") TimeLabelAlignment
UnderTicks
TimeSeq
hours (String -> TimeLabelFn
ft "%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<90NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*60 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
minutes TimeSeq
fiveMinutes (String -> TimeLabelFn
ft "%Mm") TimeLabelAlignment
UnderTicks
TimeSeq
hours (String -> TimeLabelFn
ft "%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<4NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*3600 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
fiveMinutes TimeSeq
hours (String -> TimeLabelFn
ft "%H:%M") TimeLabelAlignment
UnderTicks
TimeSeq
days (String -> TimeLabelFn
ft "%d-%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<32NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*3600 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
hours TimeSeq
hours (String -> TimeLabelFn
ft "%H:%M") TimeLabelAlignment
UnderTicks
TimeSeq
days (String -> TimeLabelFn
ft "%d-%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<4 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
hours TimeSeq
days (String -> TimeLabelFn
ft "%d-%b-%y") TimeLabelAlignment
BetweenTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<12 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
days TimeSeq
days (String -> TimeLabelFn
ft "%d-%b") TimeLabelAlignment
BetweenTicks
TimeSeq
years (String -> TimeLabelFn
ft "%Y") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<45 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
days TimeSeq
days (String -> TimeLabelFn
ft "%d") TimeLabelAlignment
BetweenTicks
TimeSeq
months (String -> TimeLabelFn
ft "%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<95 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
days TimeSeq
months (String -> TimeLabelFn
ft "%b-%y") TimeLabelAlignment
BetweenTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<450 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
months TimeSeq
months (String -> TimeLabelFn
ft "%b-%y") TimeLabelAlignment
BetweenTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<735 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
months TimeSeq
months (String -> TimeLabelFn
ft "%b") TimeLabelAlignment
BetweenTicks
TimeSeq
years (String -> TimeLabelFn
ft "%Y") TimeLabelAlignment
BetweenTicks [t]
pts
| NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<1800 = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
months TimeSeq
years (String -> TimeLabelFn
ft "%Y") TimeLabelAlignment
BetweenTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
BetweenTicks [t]
pts
| Bool
otherwise = TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
forall t.
TimeValue t =>
TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
years TimeSeq
years (String -> TimeLabelFn
ft "%Y") TimeLabelAlignment
BetweenTicks
TimeSeq
noTime (String -> TimeLabelFn
ft "") TimeLabelAlignment
BetweenTicks [t]
pts
where
upts :: [UTCTime]
upts = (t -> UTCTime) -> [t] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
map t -> UTCTime
forall t. TimeValue t => t -> UTCTime
utctimeFromTV [t]
pts
dsec :: NominalDiffTime
dsec = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t1 UTCTime
t0
dday :: NominalDiffTime
dday = NominalDiffTime
dsec NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ 86400
t1 :: UTCTime
t1 = [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UTCTime]
upts
t0 :: UTCTime
t0 = [UTCTime] -> UTCTime
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [UTCTime]
upts
ft :: String -> TimeLabelFn
ft = TimeLocale -> String -> TimeLabelFn
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale