    {-# 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 = doubleFromTimeValue . utctimeFromTV

        timeValueFromDouble  :: Double -> t
        timeValueFromDouble = tvFromUTCTime . timeValueFromDouble

    instance TimeValue UTCTime where
        utctimeFromTV       = id
        tvFromUTCTime       = id
        doubleFromTimeValue = doubleFromUTCTime
        timeValueFromDouble = utcTimeFromDouble

    instance TimeValue Day where
        utctimeFromTV d     = UTCTime d 0
        tvFromUTCTime       = utctDay
        doubleFromTimeValue = doubleFromDay
        timeValueFromDouble = dayFromDouble

    instance TimeValue LocalTime where
        utctimeFromTV (LocalTime d tod) = UTCTime d (timeOfDayToTime tod)
        tvFromUTCTime (UTCTime d dt)    = LocalTime d (timeToTimeOfDay dt)

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

    instance PlotValue LocalTime where
        toValue    = doubleFromTimeValue
        fromValue  = timeValueFromDouble
        autoAxis   = autoTimeValueAxis

    instance PlotValue UTCTime where
        toValue    = doubleFromTimeValue
        fromValue  = timeValueFromDouble
        autoAxis   = autoTimeValueAxis

    instance PlotValue Day where
        toValue    = doubleFromTimeValue
        fromValue  = timeValueFromDouble
        autoAxis   = autoTimeValueAxis

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

    -- | Map a UTCTime value to a plot coordinate.
    doubleFromUTCTime :: UTCTime -> Double
    doubleFromUTCTime ut = fromIntegral (toModifiedJulianDay (utctDay ut))
                  + fromRational (timeOfDayToDayFraction (timeToTimeOfDay (utctDayTime ut)))

    -- | Map a plot coordinate to a UTCTime.
    utcTimeFromDouble :: Double -> UTCTime
    utcTimeFromDouble v =
      UTCTime (ModifiedJulianDay i) (timeOfDayToTime (dayFractionToTimeOfDay (toRational d)))
     where
       (i,d) = properFraction v

    -- | Map a Day value to a plot coordinate.
    doubleFromDay :: Day -> Double
    doubleFromDay d = fromIntegral (toModifiedJulianDay d)

    -- | Map a plot coordinate to a Day.
    dayFromDouble :: Double -> Day
    dayFromDouble v = ModifiedJulianDay (truncate 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 tseq minT maxT = min' ++ enumerateTS tseq minT maxT ++ max'
      where
        min' =  if elemTS minT tseq then [] else take 1 (fst (tseq minT))
        max' =  if elemTS maxT tseq then [] else take 1 (snd (tseq maxT))

    enumerateTS :: TimeSeq -> UTCTime -> UTCTime -> [UTCTime]
    enumerateTS tseq minT maxT =
        reverse (takeWhile (>=minT) ts1)  ++ takeWhile (<=maxT) ts2
      where
        (ts1,ts2) = tseq minT

    elemTS :: UTCTime -> TimeSeq -> Bool
    elemTS t tseq = case tseq t of
        (_,t0:_) | t == t0 -> True
        _                  -> False

    -- | How to display a time
    type TimeLabelFn = UTCTime -> String

    data TimeLabelAlignment = UnderTicks
                            | BetweenTicks
                            deriving (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 tseq lseq labelf lal cseq contextf clal pts = AxisData {
        _axis_visibility = def,
        _axis_viewport = vmap' (tvFromUTCTime min', tvFromUTCTime max'),
        _axis_tropweiv = invmap' (tvFromUTCTime min', tvFromUTCTime max'),
        _axis_ticks    = [ (tvFromUTCTime t,2) | t <- times] ++ [ (tvFromUTCTime t,5) | t <- ltimes, visible t],
        _axis_labels   = [ [ (tvFromUTCTime t,l) | (t,l) <- labels labelf   ltimes lal, visible t]
                         , [ (tvFromUTCTime t,l) | (t,l) <- labels contextf ctimes clal, visible t]
                         ],
        _axis_grid     = [ tvFromUTCTime t     | t <- ltimes, visible t]
        }
      where
        (minT,maxT)  = case pts of
                           [] -> (refTimeValue,refTimeValue)
                           ps -> (minimum (map utctimeFromTV ps), maximum (map utctimeFromTV ps))
        refTimeValue = timeValueFromDouble 0

        times, ltimes, ctimes :: [UTCTime]
        times        = coverTS tseq minT maxT
        ltimes       = coverTS lseq minT maxT
        ctimes       = coverTS cseq minT maxT
        min'         = minimum times
        max'         = maximum times
        visible t    = min' <= t && t <= max'
        labels f ts lal' =
            [ (align lal' m1' m2', f m1)
              | (m1,m2) <- zip ts (tail ts)
              , let m1' = if m1<min' then min' else m1
              , let m2' = if m2>max' then max' else m2 ]

        align BetweenTicks m1 m2 = avg m1 m2
        align UnderTicks   m1 _  = m1

        avg m1 m2    = timeValueFromDouble $ m1' + (m2' - m1')/2
         where
          m1' = doubleFromTimeValue m1
          m2' = doubleFromTimeValue m2

    vmap' :: TimeValue x => (x,x) -> Range -> x -> Double
    vmap' (v1,v2) (v3,v4) v = v3 + (doubleFromTimeValue v - doubleFromTimeValue v1) * (v4-v3)
                                  / (doubleFromTimeValue v2 - doubleFromTimeValue v1)

    invmap' :: TimeValue x => (x,x) -> Range -> Double -> x
    invmap' (v3,v4) (d1,d2) d = timeValueFromDouble (doubleFromTimeValue v3 + ( (d-d1) * doubleRange
                                                       / (d2-d1) ))
        where doubleRange = doubleFromTimeValue v4 - doubleFromTimeValue v3

    truncateTo :: Real a => a -> a -> a
    truncateTo t step = t - t `mod'` step

    secondSeq :: NominalDiffTime -> TimeSeq
    secondSeq step t@(UTCTime day dt) = (iterate rev t1, tail (iterate fwd t1))
      where t0       = UTCTime day (truncateTo dt step')
            t1       = if t0 < t then t0 else rev t0
            rev      = addUTCTime (negate step)
            fwd      = addUTCTime step
            step'    = realToFrac step

    millis1, millis10, millis100, seconds, fiveSeconds :: TimeSeq
    millis1 = secondSeq (1 / 1000)
    millis10 = secondSeq (1 / 100)
    millis100 = secondSeq (1 / 10)
    seconds = secondSeq 1
    fiveSeconds = secondSeq 5

    minutes, fiveMinutes :: TimeSeq
    minutes = secondSeq 60
    fiveMinutes = secondSeq (5 * 60)

    -- | A 'TimeSeq' for hours.
    hours :: TimeSeq
    hours = secondSeq (60 * 60)

    -- | A 'TimeSeq' for calendar days.
    days :: TimeSeq
    days t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
      where t0       = utctDay t
            t1       = if toTime t0 < t then t0 else rev t0
            rev      = pred
            fwd      = succ
            toTime d = UTCTime d 0

    -- | A 'TimeSeq' for calendar months.
    months :: TimeSeq
    months t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
      where t0       = let (y,m,_) = toGregorian $ utctDay t in fromGregorian y m 1
            t1       = if toTime t0 < t then t0 else rev t0
            rev      = addGregorianMonthsClip (-1)
            fwd      = addGregorianMonthsClip 1
            toTime d = UTCTime d 0

    -- | A 'TimeSeq' for calendar years.
    years :: TimeSeq
    years t = (map toTime $ iterate rev t1, map toTime $ tail (iterate fwd t1))
      where t0       = toGregorian (utctDay t) ^. _1
            t1       = if toTime t0 < t then t0 else rev t0
            rev      = pred
            fwd      = succ
            toTime y = UTCTime (fromGregorian y 1 1) 0

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

    -- | 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 pts
        | null pts     = timeValueAxis days    days    (ft "%d-%b-%y") UnderTicks
                                               noTime  (ft "") UnderTicks []
        | 100*dsec<1   = timeValueAxis millis1   millis1  (ft "%S%Q") UnderTicks
                                                 noTime (ft "%S%Q") UnderTicks pts
        | 10*dsec<1    = timeValueAxis millis10  millis10  (ft "%S%Q") UnderTicks
                                                 noTime (ft "%S%Q") UnderTicks pts
        | dsec<1       = timeValueAxis millis10  millis100 (ft "%S%Q") UnderTicks
                                                 seconds (ft "%M:%S") BetweenTicks pts
        | dsec<5       = timeValueAxis millis100 seconds (ft "%M:%S%Q") UnderTicks
                                                 seconds (ft "%M:%S") BetweenTicks pts
        | dsec<32      = timeValueAxis seconds seconds (ft "%Ss") UnderTicks
                                               minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
        | dsec<120     = timeValueAxis seconds fiveSeconds (ft "%Ss") UnderTicks
                                               minutes (ft "%d-%b-%y %H:%M") BetweenTicks pts
        | dsec<7*60    = timeValueAxis fiveSeconds minutes (ft "%Mm") UnderTicks
                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts
        | dsec<32*60   = timeValueAxis minutes minutes (ft "%Mm") UnderTicks
                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts
        | dsec<90*60   = timeValueAxis minutes fiveMinutes (ft "%Mm") UnderTicks
                                               hours   (ft "%d-%b-%y %H:00") BetweenTicks pts
        | dsec<4*3600  = timeValueAxis fiveMinutes hours (ft "%H:%M") UnderTicks
                                                   days  (ft "%d-%b-%y") BetweenTicks pts
        | dsec<32*3600 = timeValueAxis hours  hours  (ft "%H:%M") UnderTicks
                                              days   (ft "%d-%b-%y") BetweenTicks pts
        | dday<4       = timeValueAxis hours  days   (ft "%d-%b-%y") BetweenTicks
                                              noTime (ft "") BetweenTicks pts
        | dday<12      = timeValueAxis days   days   (ft "%d-%b") BetweenTicks
                                              years  (ft "%Y") BetweenTicks pts
        | dday<45      = timeValueAxis days   days   (ft "%d") BetweenTicks
                                              months (ft "%b-%y") BetweenTicks pts
        | dday<95      = timeValueAxis days   months (ft "%b-%y") BetweenTicks
                                              noTime (ft "") BetweenTicks pts
        | dday<450     = timeValueAxis months months (ft "%b-%y") BetweenTicks
                                              noTime (ft "") BetweenTicks pts
        | dday<735     = timeValueAxis months months (ft "%b") BetweenTicks
                                              years  (ft "%Y") BetweenTicks pts
        | dday<1800    = timeValueAxis months years (ft "%Y") BetweenTicks
                                              noTime (ft "") BetweenTicks pts
        | otherwise    = timeValueAxis years  years (ft "%Y") BetweenTicks
                                              noTime (ft "") BetweenTicks pts
      where
        upts  = map utctimeFromTV pts
        dsec  = diffUTCTime t1 t0  -- seconds
        dday  = dsec / 86400       -- days
        t1    = maximum upts
        t0    = minimum upts
        ft    = formatTime defaultTimeLocale