{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Graphics.Vega.VegaLite.Time
( DateTime(..)
, MonthName(..)
, DayName(..)
, TimeUnit(..)
, BaseTimeUnit(..)
, dateTimeSpec
, timeUnitSpec
) where
import qualified Data.Text as T
import Data.Aeson ((.=), object, toJSON)
import Data.Aeson.Types (Pair)
#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif
import Numeric.Natural (Natural)
import Graphics.Vega.VegaLite.Specification (VLSpec)
data DateTime
= DTYear Int
| DTQuarter Int
| DTMonth MonthName
| DTMonthNum Int
| DTWeek Int
| DTDay DayName
| DTDayNum Int
| DTDayOfYear Int
| DTDate Int
| DTHours Int
| DTMinutes Int
| DTSeconds Int
| DTMilliseconds Int
data DayName
= Mon
| Tue
| Wed
| Thu
| Fri
| Sat
| Sun
data MonthName
= Jan
| Feb
| Mar
| Apr
| May
| Jun
| Jul
| Aug
| Sep
| Oct
| Nov
| Dec
data TimeUnit
= TU BaseTimeUnit
| Utc BaseTimeUnit
| TUMaxBins Natural
| TUStep Double BaseTimeUnit
| UtcStep Double BaseTimeUnit
data BaseTimeUnit
= Year
| Quarter
| Month
| Week
| Date
| Day
| DayOfYear
| Hours
| Minutes
| Seconds
| Milliseconds
| YearQuarter
| YearQuarterMonth
| YearMonth
| YearMonthDate
| YearMonthDateHours
| YearMonthDateHoursMinutes
| YearMonthDateHoursMinutesSeconds
| YearWeek
| YearWeekDay
| YearWeekDayHours
| YearWeekDayHoursMinutes
| YearWeekDayHoursMinutesSeconds
| YearDayOfYear
| QuarterMonth
| MonthDate
| MonthDateHours
| MonthDateHoursMinutes
| MonthDateHoursMinutesSeconds
| WeekDay
| WeeksDayHours
| WeeksDayHoursMinutes
| WeeksDayHoursMinutesSeconds
| DayHours
| DayHoursMinutes
| DayHoursMinutesSeconds
| HoursMinutes
| HoursMinutesSeconds
| MinutesSeconds
| SecondsMilliseconds
baseTimeUnitLabel :: BaseTimeUnit -> T.Text
baseTimeUnitLabel :: BaseTimeUnit -> Text
baseTimeUnitLabel BaseTimeUnit
Year = Text
"year"
baseTimeUnitLabel BaseTimeUnit
Quarter = Text
"quarter"
baseTimeUnitLabel BaseTimeUnit
Month = Text
"month"
baseTimeUnitLabel BaseTimeUnit
Week = Text
"week"
baseTimeUnitLabel BaseTimeUnit
Date = Text
"date"
baseTimeUnitLabel BaseTimeUnit
Day = Text
"day"
baseTimeUnitLabel BaseTimeUnit
DayOfYear = Text
"dayofyear"
baseTimeUnitLabel BaseTimeUnit
Hours = Text
"hours"
baseTimeUnitLabel BaseTimeUnit
Minutes = Text
"minutes"
baseTimeUnitLabel BaseTimeUnit
Seconds = Text
"seconds"
baseTimeUnitLabel BaseTimeUnit
Milliseconds = Text
"milliseconds"
baseTimeUnitLabel BaseTimeUnit
YearQuarter = Text
"yearquarter"
baseTimeUnitLabel BaseTimeUnit
YearQuarterMonth = Text
"yearquartermonth"
baseTimeUnitLabel BaseTimeUnit
YearMonth = Text
"yearmonth"
baseTimeUnitLabel BaseTimeUnit
YearMonthDate = Text
"yearmonthdate"
baseTimeUnitLabel BaseTimeUnit
YearMonthDateHours = Text
"yearmonthdatehours"
baseTimeUnitLabel BaseTimeUnit
YearMonthDateHoursMinutes = Text
"yearmonthdatehoursminutes"
baseTimeUnitLabel BaseTimeUnit
YearMonthDateHoursMinutesSeconds = Text
"yearmonthdatehoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
YearWeek = Text
"yearweek"
baseTimeUnitLabel BaseTimeUnit
YearWeekDay = Text
"yearweekday"
baseTimeUnitLabel BaseTimeUnit
YearWeekDayHours = Text
"yearweekdayhours"
baseTimeUnitLabel BaseTimeUnit
YearWeekDayHoursMinutes = Text
"yearweekdayhoursminutes"
baseTimeUnitLabel BaseTimeUnit
YearWeekDayHoursMinutesSeconds = Text
"yearweekdayhoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
YearDayOfYear = Text
"yeardayofyear"
baseTimeUnitLabel BaseTimeUnit
QuarterMonth = Text
"quartermonth"
baseTimeUnitLabel BaseTimeUnit
MonthDate = Text
"monthdate"
baseTimeUnitLabel BaseTimeUnit
MonthDateHours = Text
"monthdatehours"
baseTimeUnitLabel BaseTimeUnit
MonthDateHoursMinutes = Text
"monthdatehoursminutes"
baseTimeUnitLabel BaseTimeUnit
MonthDateHoursMinutesSeconds = Text
"monthdatehoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
WeekDay = Text
"weekday"
baseTimeUnitLabel BaseTimeUnit
WeeksDayHours = Text
"weeksdayhours"
baseTimeUnitLabel BaseTimeUnit
WeeksDayHoursMinutes = Text
"weeksdayhoursminutes"
baseTimeUnitLabel BaseTimeUnit
WeeksDayHoursMinutesSeconds = Text
"weeksdayhoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
DayHours = Text
"dayhours"
baseTimeUnitLabel BaseTimeUnit
DayHoursMinutes = Text
"dayhoursminutes"
baseTimeUnitLabel BaseTimeUnit
DayHoursMinutesSeconds = Text
"dayhoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
HoursMinutes = Text
"hoursminutes"
baseTimeUnitLabel BaseTimeUnit
HoursMinutesSeconds = Text
"hoursminutesseconds"
baseTimeUnitLabel BaseTimeUnit
MinutesSeconds = Text
"minutesseconds"
baseTimeUnitLabel BaseTimeUnit
SecondsMilliseconds = Text
"secondsmilliseconds"
dateTimeProperty :: DateTime -> Pair
dateTimeProperty :: DateTime -> Pair
dateTimeProperty (DTYear Int
y) = Key
"year" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
y
dateTimeProperty (DTQuarter Int
q) = Key
"quarter" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
q
dateTimeProperty (DTMonth MonthName
mon) = Key
"month" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MonthName -> Text
monthNameLabel MonthName
mon
dateTimeProperty (DTMonthNum Int
n) = Key
"month" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
dateTimeProperty (DTWeek Int
w) = Key
"week" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
w
dateTimeProperty (DTDate Int
dt) = Key
"date" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
dt
dateTimeProperty (DTDay DayName
day) = Key
"day" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DayName -> Text
dayLabel DayName
day
dateTimeProperty (DTDayOfYear Int
n) = Key
"dayofyear" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
dateTimeProperty (DTDayNum Int
n) = Key
"day" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
dateTimeProperty (DTHours Int
h) = Key
"hours" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
h
dateTimeProperty (DTMinutes Int
m) = Key
"minutes" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
m
dateTimeProperty (DTSeconds Int
s) = Key
"seconds" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
s
dateTimeProperty (DTMilliseconds Int
ms) = Key
"milliseconds" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
ms
dateTimeSpec :: [DateTime] -> VLSpec
dateTimeSpec :: [DateTime] -> VLSpec
dateTimeSpec = [Pair] -> VLSpec
object ([Pair] -> VLSpec)
-> ([DateTime] -> [Pair]) -> [DateTime] -> VLSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DateTime -> Pair) -> [DateTime] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map DateTime -> Pair
dateTimeProperty
dayLabel :: DayName -> T.Text
dayLabel :: DayName -> Text
dayLabel DayName
Mon = Text
"Mon"
dayLabel DayName
Tue = Text
"Tue"
dayLabel DayName
Wed = Text
"Wed"
dayLabel DayName
Thu = Text
"Thu"
dayLabel DayName
Fri = Text
"Fri"
dayLabel DayName
Sat = Text
"Sat"
dayLabel DayName
Sun = Text
"Sun"
monthNameLabel :: MonthName -> T.Text
monthNameLabel :: MonthName -> Text
monthNameLabel MonthName
Jan = Text
"Jan"
monthNameLabel MonthName
Feb = Text
"Feb"
monthNameLabel MonthName
Mar = Text
"Mar"
monthNameLabel MonthName
Apr = Text
"Apr"
monthNameLabel MonthName
May = Text
"May"
monthNameLabel MonthName
Jun = Text
"Jun"
monthNameLabel MonthName
Jul = Text
"Jul"
monthNameLabel MonthName
Aug = Text
"Aug"
monthNameLabel MonthName
Sep = Text
"Sep"
monthNameLabel MonthName
Oct = Text
"Oct"
monthNameLabel MonthName
Nov = Text
"Nov"
monthNameLabel MonthName
Dec = Text
"Dec"
fromT :: T.Text -> VLSpec
fromT :: Text -> VLSpec
fromT = Text -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON
timeUnitSpec :: TimeUnit -> VLSpec
timeUnitSpec :: TimeUnit -> VLSpec
timeUnitSpec (TU BaseTimeUnit
tu) = Text -> VLSpec
fromT (BaseTimeUnit -> Text
baseTimeUnitLabel BaseTimeUnit
tu)
timeUnitSpec (Utc BaseTimeUnit
tu) = Text -> VLSpec
fromT (Text
"utc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BaseTimeUnit -> Text
baseTimeUnitLabel BaseTimeUnit
tu)
timeUnitSpec (TUStep Double
x BaseTimeUnit
tu) = [Pair] -> VLSpec
object [Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x, Key
"unit" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BaseTimeUnit -> Text
baseTimeUnitLabel BaseTimeUnit
tu]
timeUnitSpec (UtcStep Double
x BaseTimeUnit
tu) = [Pair] -> VLSpec
object [Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x, Key
"unit" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"utc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BaseTimeUnit -> Text
baseTimeUnitLabel BaseTimeUnit
tu)]
timeUnitSpec (TUMaxBins Natural
n) = [Pair] -> VLSpec
object [Key
"maxbins" Key -> Natural -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Natural
n]