{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Axis.Time
-- Copyright   :  (c) Tim Docker 2010, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Calculate and render time axes

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)

-- | A typeclass abstracting the functions we need
-- to be able to plot against an axis of time type @d@.
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 Day
d     = Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
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 Day
d TimeOfDay
tod) = Day -> DiffTime -> UTCTime
UTCTime Day
d (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
    tvFromUTCTime :: UTCTime -> LocalTime
tvFromUTCTime (UTCTime Day
d 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

----------------------------------------------------------------------

-- | Map a UTCTime value to a plot coordinate.
doubleFromUTCTime :: UTCTime -> Double
doubleFromUTCTime :: UTCTime -> Double
doubleFromUTCTime 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)))

-- | Map a plot coordinate to a UTCTime.
utcTimeFromDouble :: Double -> UTCTime
utcTimeFromDouble :: Double -> UTCTime
utcTimeFromDouble 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
   (Integer
i,Double
d) = Double -> (Integer, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
v

-- | Map a Day value to a plot coordinate.
doubleFromDay :: Day -> Double
doubleFromDay :: Day -> Double
doubleFromDay Day
d = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Day -> Integer
toModifiedJulianDay Day
d)

-- | Map a plot coordinate to a Day.
dayFromDouble :: Double -> Day
dayFromDouble :: Double -> Day
dayFromDouble Double
v = Integer -> Day
ModifiedJulianDay (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v)

----------------------------------------------------------------------

-- | TimeSeq is a (potentially infinite) set of times. When passed
--   a reference time, the function returns a a pair of lists. The first
--   contains all times in the set less than the reference time in
--   decreasing order. The second contains all times in the set greater
--   than or equal to the reference time, in increasing order.
type TimeSeq = UTCTime -> ([UTCTime],[UTCTime])

coverTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
coverTS TimeSeq
tseq UTCTime
minT 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 Int
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 Int
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 TimeSeq
tseq UTCTime
minT 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
    ([UTCTime]
ts1,[UTCTime]
ts2) = TimeSeq
tseq UTCTime
minT

elemTS :: UTCTime -> TimeSeq -> Bool
elemTS :: UTCTime -> TimeSeq -> Bool
elemTS UTCTime
t TimeSeq
tseq = case TimeSeq
tseq UTCTime
t of
    ([UTCTime]
_,UTCTime
t0:[UTCTime]
_) | UTCTime
t UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== UTCTime
t0 -> Bool
True
    ([UTCTime], [UTCTime])
_                  -> Bool
False

-- | How to display a time
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)

-- | Create an 'AxisFn' to for a time axis.
--
--   The values to be plotted against this axis can be created with
--   'doubleFromLocalTime'.
--
--   Implementation detail: 'PlotValue' constraint is needed to use `vmap`.
timeValueAxis ::
  TimeValue t
  => TimeSeq
  -- ^ Set the minor ticks, and the final range will be aligned to its
  --   elements.
  -> TimeSeq
  -- ^ Set the labels and grid.
  -> TimeLabelFn
  -> TimeLabelAlignment
  -> TimeSeq
  -- ^ Set the second line of labels.
  -> TimeLabelFn
  -- ^ Format @t@ for labels.
  -> TimeLabelAlignment
  -> AxisFn t
timeValueAxis :: TimeSeq
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> TimeSeq
-> TimeLabelFn
-> TimeLabelAlignment
-> AxisFn t
timeValueAxis TimeSeq
tseq TimeSeq
lseq TimeLabelFn
labelf TimeLabelAlignment
lal TimeSeq
cseq TimeLabelFn
contextf TimeLabelAlignment
clal [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,Double
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,Double
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) | (UTCTime
t,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) | (UTCTime
t,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
    (UTCTime
minT,UTCTime
maxT)  = case [t]
pts of
                       [] -> (UTCTime
refTimeValue,UTCTime
refTimeValue)
                       [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 Double
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 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 UTCTime -> b
f [UTCTime]
ts 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)
          | (UTCTime
m1,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 TimeLabelAlignment
BetweenTicks p
m1 t
m2 = p -> t -> p
forall t t t.
(TimeValue t, TimeValue t, TimeValue t) =>
t -> t -> t
avg p
m1 t
m2
    align TimeLabelAlignment
UnderTicks   p
m1 t
_  = p
m1

    avg :: t -> t -> t
avg t
m1 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
/Double
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' (x
v1,x
v2) (Double
v3,Double
v4) 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' (x
v3,x
v4) (Double
d1,Double
d2) 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 a
t 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 NominalDiffTime
step t :: UTCTime
t@(UTCTime Day
day 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 (NominalDiffTime
1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
1000)
millis10 :: TimeSeq
millis10 = NominalDiffTime -> TimeSeq
secondSeq (NominalDiffTime
1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
100)
millis100 :: TimeSeq
millis100 = NominalDiffTime -> TimeSeq
secondSeq (NominalDiffTime
1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
10)
seconds :: TimeSeq
seconds = NominalDiffTime -> TimeSeq
secondSeq NominalDiffTime
1
fiveSeconds :: TimeSeq
fiveSeconds = NominalDiffTime -> TimeSeq
secondSeq NominalDiffTime
5

minutes, fiveMinutes :: TimeSeq
minutes :: TimeSeq
minutes = NominalDiffTime -> TimeSeq
secondSeq NominalDiffTime
60
fiveMinutes :: TimeSeq
fiveMinutes = NominalDiffTime -> TimeSeq
secondSeq (NominalDiffTime
5 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60)

-- | A 'TimeSeq' for hours.
hours :: TimeSeq
hours :: TimeSeq
hours = NominalDiffTime -> TimeSeq
secondSeq (NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60)

-- | A 'TimeSeq' for calendar days.
days :: TimeSeq
days :: TimeSeq
days 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 Day
d = Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
0

-- | A 'TimeSeq' for calendar months.
months :: TimeSeq
months :: TimeSeq
months 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 (Integer
y,Int
m,Int
_) = 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 Int
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 (-Integer
1)
        fwd :: Day -> Day
fwd      = Integer -> Day -> Day
addGregorianMonthsClip Integer
1
        toTime :: Day -> UTCTime
toTime Day
d = Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
0

-- | A 'TimeSeq' for calendar years.
years :: TimeSeq
years :: TimeSeq
years 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 Integer
y = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
1 Int
1) DiffTime
0

-- | A 'TimeSeq' for no sequence at all.
noTime :: TimeSeq
noTime :: TimeSeq
noTime UTCTime
_ = ([],[])

-- | Automatically choose a suitable time axis, based upon the time range
--   of data.  The values to be plotted against this axis can be created
--   with 'doubleFromTimeValue'.
autoTimeValueAxis :: TimeValue t => AxisFn t
autoTimeValueAxis :: AxisFn t
autoTimeValueAxis [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 String
"%d-%b-%y") TimeLabelAlignment
UnderTicks
                                           TimeSeq
noTime  (String -> TimeLabelFn
ft String
"") TimeLabelAlignment
UnderTicks []
    | NominalDiffTime
100NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%S%Q") TimeLabelAlignment
UnderTicks
                                             TimeSeq
noTime (String -> TimeLabelFn
ft String
"%S%Q") TimeLabelAlignment
UnderTicks [t]
pts
    | NominalDiffTime
10NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%S%Q") TimeLabelAlignment
UnderTicks
                                             TimeSeq
noTime (String -> TimeLabelFn
ft String
"%S%Q") TimeLabelAlignment
UnderTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%S%Q") TimeLabelAlignment
UnderTicks
                                             TimeSeq
seconds (String -> TimeLabelFn
ft String
"%M:%S") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%M:%S%Q") TimeLabelAlignment
UnderTicks
                                             TimeSeq
seconds (String -> TimeLabelFn
ft String
"%M:%S") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%Ss") TimeLabelAlignment
UnderTicks
                                           TimeSeq
minutes (String -> TimeLabelFn
ft String
"%d-%b-%y %H:%M") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%Ss") TimeLabelAlignment
UnderTicks
                                           TimeSeq
minutes (String -> TimeLabelFn
ft String
"%d-%b-%y %H:%M") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
7NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
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 String
"%Mm") TimeLabelAlignment
UnderTicks
                                           TimeSeq
hours   (String -> TimeLabelFn
ft String
"%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
32NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
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 String
"%Mm") TimeLabelAlignment
UnderTicks
                                           TimeSeq
hours   (String -> TimeLabelFn
ft String
"%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
90NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
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 String
"%Mm") TimeLabelAlignment
UnderTicks
                                           TimeSeq
hours   (String -> TimeLabelFn
ft String
"%d-%b-%y %H:00") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
4NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
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 String
"%H:%M") TimeLabelAlignment
UnderTicks
                                               TimeSeq
days  (String -> TimeLabelFn
ft String
"%d-%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
dsecNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
32NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
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 String
"%H:%M") TimeLabelAlignment
UnderTicks
                                          TimeSeq
days   (String -> TimeLabelFn
ft String
"%d-%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%d-%b-%y") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
noTime (String -> TimeLabelFn
ft String
"") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%d-%b") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
years  (String -> TimeLabelFn
ft String
"%Y") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%d") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
months (String -> TimeLabelFn
ft String
"%b-%y") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%b-%y") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
noTime (String -> TimeLabelFn
ft String
"") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%b-%y") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
noTime (String -> TimeLabelFn
ft String
"") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%b") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
years  (String -> TimeLabelFn
ft String
"%Y") TimeLabelAlignment
BetweenTicks [t]
pts
    | NominalDiffTime
ddayNominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<NominalDiffTime
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 String
"%Y") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
noTime (String -> TimeLabelFn
ft String
"") 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 String
"%Y") TimeLabelAlignment
BetweenTicks
                                          TimeSeq
noTime (String -> TimeLabelFn
ft String
"") 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  -- seconds
    dday :: NominalDiffTime
dday  = NominalDiffTime
dsec NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
86400       -- days
    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