-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE TupleSections #-}

module Duckling.Time.Helpers
  ( -- Patterns
    hasNoDirection, isADayOfWeek, isAMonth, isAnHourOfDay, isAPartOfDay
  , isATimeOfDay, isDurationGreaterThan, isDOMInteger, isDOMOrdinal, isDOMValue
  , isGrainFinerThan, isGrainCoarserThan, isGrainOfTime
  , isIntegerBetween, isNotLatent , isOrdinalBetween, isMidnightOrNoon
  , isOkWithThisNext, sameGrain, hasTimezone, hasNoTimezone, today
    -- Production
  , cycleLastOf, cycleN, cycleNth, cycleNthAfter, dayOfMonth, dayOfWeek
  , durationAfter, durationAgo, durationBefore, mkOkForThisNext, form, hour
  , hourMinute, hourMinuteSecond, inDuration, intersect, intersectDOM, interval
  , inTimezone, longWEBefore, minute, minutesAfter, minutesBefore, mkLatent
  , month, monthDay, notLatent, now, nthDOWOfMonth, partOfDay, predLastOf
  , predNth, predNthAfter, predNthClosest, season, second, timeOfDayAMPM
  , weekday, weekend, workweek, withDirection, year, yearMonthDay, tt, durationIntervalAgo
  , inDurationInterval, intersectWithReplacement, yearADBC, yearMonth
  , predEveryNDaysFrom, timeCycle
    -- Other
  , getIntValue, timeComputed, toTimeObjectM
  -- Rule constructors
  , mkRuleInstants, mkRuleDaysOfWeek, mkRuleMonths, mkRuleMonthsWithLatent
  , mkRuleSeasons, mkRuleHolidays, mkRuleHolidays'
  ) where

import Control.Applicative ((<|>))
import Data.Maybe
import Data.Ord (comparing)
import Data.Text (Text)
import Data.Tuple.Extra (both)
import Prelude
import qualified Data.Time as Time
import qualified Data.Time.LocalTime.TimeZone.Series as Series

import Duckling.Dimensions.Types
import Duckling.Duration.Types (DurationData (DurationData))
import Duckling.Ordinal.Types (OrdinalData (OrdinalData))
import Duckling.Time.TimeZone.Parse (parseTimezone)
import Duckling.Time.Types
  ( TimeData(TimeData)
  , mkSeriesPredicate
  , mkSecondPredicate
  , mkMinutePredicate
  , mkHourPredicate
  , mkAMPMPredicate
  , mkMonthPredicate
  , mkDayOfTheWeekPredicate
  , mkDayOfTheMonthPredicate
  , mkYearPredicate
  , mkIntersectPredicate
  , mkTimeIntervalsPredicate
  , mkReplaceIntersectPredicate
  , runPredicate
  , AMPM(..)
  )
import Duckling.Types
import qualified Duckling.Duration.Types as TDuration
import qualified Duckling.Numeral.Types as TNumeral
import qualified Duckling.Ordinal.Types as TOrdinal
import qualified Duckling.Time.Types as TTime
import qualified Duckling.TimeGrain.Types as TG

getIntValue :: Token -> Maybe Int
getIntValue :: Token -> Maybe Int
getIntValue (Token Dimension a
Numeral a
nd) = Double -> Maybe Int
TNumeral.getIntValue (Double -> Maybe Int) -> Double -> Maybe Int
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd
getIntValue (Token Dimension a
Ordinal OrdinalData {TOrdinal.value = x}) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
getIntValue Token
_ = Maybe Int
forall a. Maybe a
Nothing

timeNegPeriod :: DurationData -> DurationData
timeNegPeriod :: DurationData -> DurationData
timeNegPeriod (DurationData Int
v Grain
g) = DurationData :: Int -> Grain -> DurationData
DurationData
  {grain :: Grain
TDuration.grain = Grain
g, value :: Int
TDuration.value = Int -> Int
forall a. Num a => a -> a
negate Int
v}

timeShiftPeriod :: Int -> DurationData -> DurationData
timeShiftPeriod :: Int -> DurationData -> DurationData
timeShiftPeriod Int
n dd :: DurationData
dd@DurationData{value :: DurationData -> Int
TDuration.value = Int
v} =
  DurationData
dd{value :: Int
TDuration.value = Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n}

-- -----------------------------------------------------------------
-- Time predicates

timeComputed :: [TTime.TimeObject] -> TTime.Predicate
timeComputed :: [TimeObject] -> Predicate
timeComputed [TimeObject]
xs = SeriesPredicate -> Predicate
mkSeriesPredicate SeriesPredicate
series
  where
    series :: SeriesPredicate
series TimeObject
t TimeContext
_ = ([TimeObject] -> [TimeObject]
forall a. [a] -> [a]
reverse [TimeObject]
start, [TimeObject]
end)
      where
        ([TimeObject]
start, [TimeObject]
end) = (TimeObject -> Bool)
-> [TimeObject] -> ([TimeObject], [TimeObject])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((TimeObject -> TimeObject -> Bool)
-> TimeObject -> TimeObject -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip TimeObject -> TimeObject -> Bool
TTime.timeBefore TimeObject
t) [TimeObject]
xs

timeCycle :: TG.Grain -> TTime.Predicate
timeCycle :: Grain -> Predicate
timeCycle Grain
grain = SeriesPredicate -> Predicate
mkSeriesPredicate SeriesPredicate
series
  where
  series :: SeriesPredicate
series TimeObject
t TimeContext
_ = Grain -> Int -> TimeObject -> ([TimeObject], [TimeObject])
TTime.timeSequence Grain
grain Int
1 (TimeObject -> ([TimeObject], [TimeObject]))
-> TimeObject -> ([TimeObject], [TimeObject])
forall a b. (a -> b) -> a -> b
$ TimeObject -> Grain -> TimeObject
TTime.timeRound TimeObject
t Grain
grain

timeSecond :: Int -> TTime.Predicate
timeSecond :: Int -> Predicate
timeSecond Int
n = Int -> Predicate
mkSecondPredicate Int
n

timeMinute :: Int -> TTime.Predicate
timeMinute :: Int -> Predicate
timeMinute Int
n = Int -> Predicate
mkMinutePredicate Int
n

timeHour :: Bool -> Int -> TTime.Predicate
timeHour :: Bool -> Int -> Predicate
timeHour Bool
is12H Int
n = Bool -> Int -> Predicate
mkHourPredicate Bool
is12H Int
n

timeDayOfWeek :: Int -> TTime.Predicate
timeDayOfWeek :: Int -> Predicate
timeDayOfWeek Int
n = Int -> Predicate
mkDayOfTheWeekPredicate Int
n

timeDayOfMonth :: Int -> TTime.Predicate
timeDayOfMonth :: Int -> Predicate
timeDayOfMonth Int
n = Int -> Predicate
mkDayOfTheMonthPredicate Int
n

timeMonth :: Int -> TTime.Predicate
timeMonth :: Int -> Predicate
timeMonth Int
n = Int -> Predicate
mkMonthPredicate Int
n

timeYear :: Int -> TTime.Predicate
timeYear :: Int -> Predicate
timeYear Int
n = Int -> Predicate
mkYearPredicate Int
n

-- | Takes `n` cycles of `f`
takeN :: Int -> Bool -> TTime.Predicate -> TTime.Predicate
takeN :: Int -> Bool -> Predicate -> Predicate
takeN Int
n Bool
notImmediate Predicate
f = SeriesPredicate -> Predicate
mkSeriesPredicate SeriesPredicate
series
  where
  series :: SeriesPredicate
series TimeObject
t TimeContext
context =
    case Maybe TimeObject
slot of
      Just TimeObject
nth -> if TimeObject -> TimeObject -> Bool
TTime.timeStartsBeforeTheEndOf TimeObject
t TimeObject
nth
        then ([], [TimeObject
nth])
        else ([TimeObject
nth], [])
      Maybe TimeObject
Nothing -> ([], [])
    where
      baseTime :: TimeObject
baseTime = TimeContext -> TimeObject
TTime.refTime TimeContext
context
      ([TimeObject]
past, [TimeObject]
future) = Predicate -> SeriesPredicate
runPredicate Predicate
f TimeObject
baseTime TimeContext
context
      fut :: [TimeObject]
fut = case [TimeObject]
future of
        (TimeObject
ahead:[TimeObject]
rest)
          | Bool
notImmediate Bool -> Bool -> Bool
&& Maybe TimeObject -> Bool
forall a. Maybe a -> Bool
isJust (TimeObject -> TimeObject -> Maybe TimeObject
TTime.timeIntersect TimeObject
ahead TimeObject
baseTime) -> [TimeObject]
rest
        [TimeObject]
_ -> [TimeObject]
future
      slot :: Maybe TimeObject
slot = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then case [TimeObject]
fut of
          (TimeObject
start:[TimeObject]
_) -> case Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop Int
n [TimeObject]
fut of
            (TimeObject
end:[TimeObject]
_) -> TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just (TimeObject -> Maybe TimeObject) -> TimeObject -> Maybe TimeObject
forall a b. (a -> b) -> a -> b
$ TimeIntervalType -> TimeObject -> TimeObject -> TimeObject
TTime.timeInterval TimeIntervalType
TTime.Open TimeObject
start TimeObject
end
            [TimeObject]
_ -> Maybe TimeObject
forall a. Maybe a
Nothing
          [TimeObject]
_ -> Maybe TimeObject
forall a. Maybe a
Nothing
        else case [TimeObject]
past of
          (TimeObject
end:[TimeObject]
_) -> case Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop ((- Int
n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [TimeObject]
past of
            (TimeObject
start:[TimeObject]
_) -> TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just (TimeObject -> Maybe TimeObject) -> TimeObject -> Maybe TimeObject
forall a b. (a -> b) -> a -> b
$ TimeIntervalType -> TimeObject -> TimeObject -> TimeObject
TTime.timeInterval TimeIntervalType
TTime.Closed TimeObject
start TimeObject
end
            [TimeObject]
_ -> Maybe TimeObject
forall a. Maybe a
Nothing
          [TimeObject]
_ -> Maybe TimeObject
forall a. Maybe a
Nothing

-- | -1 is the first element in the past
-- | 0 is the first element in the future
takeNth :: Int -> Bool -> TTime.Predicate -> TTime.Predicate
takeNth :: Int -> Bool -> Predicate -> Predicate
takeNth Int
n Bool
notImmediate Predicate
f = SeriesPredicate -> Predicate
mkSeriesPredicate SeriesPredicate
series
  where
  series :: SeriesPredicate
series TimeObject
t TimeContext
context =
    case [TimeObject]
rest of
      [] -> ([], [])
      (TimeObject
nth:[TimeObject]
_) -> if TimeObject -> TimeObject -> Bool
TTime.timeStartsBeforeTheEndOf TimeObject
t TimeObject
nth
        then ([], [TimeObject
nth])
        else ([TimeObject
nth], [])
    where
      baseTime :: TimeObject
baseTime = TimeContext -> TimeObject
TTime.refTime TimeContext
context
      ([TimeObject]
past, [TimeObject]
future) = Predicate -> SeriesPredicate
runPredicate Predicate
f TimeObject
baseTime TimeContext
context
      rest :: [TimeObject]
rest = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then case [TimeObject]
future of
          (TimeObject
ahead:[TimeObject]
_) | Bool
notImmediate Bool -> Bool -> Bool
&& Maybe TimeObject -> Bool
forall a. Maybe a -> Bool
isJust (TimeObject -> TimeObject -> Maybe TimeObject
TTime.timeIntersect TimeObject
ahead TimeObject
baseTime)
            -> Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TimeObject]
future
          [TimeObject]
_ -> Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop Int
n [TimeObject]
future
        else Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop (- (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [TimeObject]
past

-- | Like `takeNth`, but takes the nth cyclic predicate after `basePred`
takeNthAfter
  :: Int
  -> Bool
  -> TTime.Predicate
  -> TTime.Predicate
  -> TTime.Predicate
takeNthAfter :: Int -> Bool -> Predicate -> Predicate -> Predicate
takeNthAfter Int
n Bool
notImmediate Predicate
cyclicPred Predicate
basePred =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
basePred
  where
    f :: TimeObject -> TimeContext -> Maybe TimeObject
f TimeObject
t TimeContext
ctx =
      let ([TimeObject]
past, [TimeObject]
future) = Predicate -> SeriesPredicate
runPredicate Predicate
cyclicPred TimeObject
t TimeContext
ctx
          rest :: [TimeObject]
rest = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
                   then case [TimeObject]
future of
                     (TimeObject
ahead:[TimeObject]
_) | Bool
notImmediate Bool -> Bool -> Bool
&& TimeObject -> TimeObject -> Bool
TTime.timeBefore TimeObject
ahead TimeObject
t
                       -> Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [TimeObject]
future
                     [TimeObject]
_ -> Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop Int
n [TimeObject]
future
                   else Int -> [TimeObject] -> [TimeObject]
forall a. Int -> [a] -> [a]
drop (- (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) [TimeObject]
past
      in case [TimeObject]
rest of
           [] -> Maybe TimeObject
forall a. Maybe a
Nothing
           (TimeObject
nth:[TimeObject]
_) -> TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just TimeObject
nth

-- | Take the nth closest value to `basePred` among those yielded by
-- `cyclicPred`.
-- n = 0 is the closest value, n = 1 is the second closest value, etc.
-- n < 0 is treated as n = 0.
takeNthClosest :: Int -> TTime.Predicate -> TTime.Predicate -> TTime.Predicate
takeNthClosest :: Int -> Predicate -> Predicate -> Predicate
takeNthClosest Int
n Predicate
cyclicPred Predicate
basePred =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
basePred
  where
  f :: TimeObject -> TimeContext -> Maybe TimeObject
f TimeObject
t TimeContext
ctx = Int
-> [TimeObject]
-> [TimeObject]
-> Maybe TimeObject
-> Maybe TimeObject
nth (Int
n Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` Int
0) [TimeObject]
past [TimeObject]
future Maybe TimeObject
forall a. Maybe a
Nothing
    where
    ([TimeObject]
past, [TimeObject]
future) = Predicate -> SeriesPredicate
runPredicate Predicate
cyclicPred TimeObject
t TimeContext
ctx
    nth :: Int
-> [TimeObject]
-> [TimeObject]
-> Maybe TimeObject
-> Maybe TimeObject
nth Int
n [TimeObject]
pa [TimeObject]
fu Maybe TimeObject
res
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe TimeObject
res
      | Bool
otherwise = case (Maybe TimeObject -> Maybe NominalDiffTime)
-> Maybe TimeObject -> Maybe TimeObject -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (TimeObject -> Maybe TimeObject -> Maybe NominalDiffTime
forall (f :: * -> *).
Functor f =>
TimeObject -> f TimeObject -> f NominalDiffTime
against TimeObject
t) Maybe TimeObject
x Maybe TimeObject
y of
          Ordering
GT -> Int
-> [TimeObject]
-> [TimeObject]
-> Maybe TimeObject
-> Maybe TimeObject
nth (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ([TimeObject] -> [TimeObject]
forall a. [a] -> [a]
tailSafe [TimeObject]
pa) [TimeObject]
fu Maybe TimeObject
x
          Ordering
_ -> Int
-> [TimeObject]
-> [TimeObject]
-> Maybe TimeObject
-> Maybe TimeObject
nth (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [TimeObject]
pa ([TimeObject] -> [TimeObject]
forall a. [a] -> [a]
tailSafe [TimeObject]
fu) Maybe TimeObject
y
      where (Maybe TimeObject
x,Maybe TimeObject
y) = ([TimeObject] -> Maybe TimeObject)
-> ([TimeObject], [TimeObject])
-> (Maybe TimeObject, Maybe TimeObject)
forall a b. (a -> b) -> (a, a) -> (b, b)
both [TimeObject] -> Maybe TimeObject
forall a. [a] -> Maybe a
listToMaybe ([TimeObject]
pa,[TimeObject]
fu)
    against :: TimeObject -> f TimeObject -> f NominalDiffTime
against TimeObject
t = (TimeObject -> NominalDiffTime)
-> f TimeObject -> f NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a
negate (NominalDiffTime -> NominalDiffTime)
-> (TimeObject -> NominalDiffTime) -> TimeObject -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeObject -> TimeObject -> NominalDiffTime
TTime.diffStartTime TimeObject
t)
    tailSafe :: [a] -> [a]
tailSafe (a
_:[a]
xs) = [a]
xs
    tailSafe [] = []

-- | Takes the last occurrence of `cyclicPred` within `basePred`.
takeLastOf :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate
takeLastOf :: Predicate -> Predicate -> Predicate
takeLastOf Predicate
cyclicPred Predicate
basePred =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
basePred
  where
    f :: TTime.TimeObject -> TTime.TimeContext -> Maybe TTime.TimeObject
    f :: TimeObject -> TimeContext -> Maybe TimeObject
f TimeObject
t TimeContext
ctx =
      case Predicate -> SeriesPredicate
runPredicate Predicate
cyclicPred (TimeObject -> TimeObject
TTime.timeStartingAtTheEndOf TimeObject
t) TimeContext
ctx of
        (TimeObject
nth:[TimeObject]
_, [TimeObject]
_) -> TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just TimeObject
nth
        ([TimeObject], [TimeObject])
_ -> Maybe TimeObject
forall a. Maybe a
Nothing

-- | Assumes the grain of `pred1` is smaller than the one of `pred2`
timeCompose :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate
timeCompose :: Predicate -> Predicate -> Predicate
timeCompose Predicate
pred1 Predicate
pred2 = Predicate -> Predicate -> Predicate
mkIntersectPredicate Predicate
pred1 Predicate
pred2

timeComposeWithReplacement
  :: TTime.Predicate -> TTime.Predicate -> TTime.Predicate -> TTime.Predicate
timeComposeWithReplacement :: Predicate -> Predicate -> Predicate -> Predicate
timeComposeWithReplacement Predicate
pred1 Predicate
pred2 Predicate
pred3 =
  Predicate -> Predicate -> Predicate -> Predicate
mkReplaceIntersectPredicate Predicate
pred1 Predicate
pred2 Predicate
pred3

addDuration :: DurationData -> TTime.TimeObject -> TTime.TimeObject
addDuration :: DurationData -> TimeObject -> TimeObject
addDuration (DurationData Int
n Grain
g) TimeObject
t = TimeObject -> Grain -> Integer -> TimeObject
TTime.timePlus TimeObject
t Grain
g (Integer -> TimeObject) -> Integer -> TimeObject
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n

mergeDuration :: TTime.Predicate -> DurationData -> TTime.Predicate
mergeDuration :: Predicate -> DurationData -> Predicate
mergeDuration Predicate
pred1 dd :: DurationData
dd@(DurationData Int
_ Grain
g) =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
pred1
  where
    f :: TimeObject -> TimeContext -> Maybe TimeObject
f x :: TimeObject
x@TTime.TimeObject{grain :: TimeObject -> Grain
TTime.grain = Grain
tg} TimeContext
_ = TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just (TimeObject -> Maybe TimeObject) -> TimeObject -> Maybe TimeObject
forall a b. (a -> b) -> a -> b
$ DurationData -> TimeObject -> TimeObject
addDuration DurationData
dd TimeObject
t'
      where
        g' :: Grain
g' = Grain -> Grain -> Grain
forall a. Ord a => a -> a -> a
min Grain
tg Grain
g
        t' :: TimeObject
t' = if Grain
g' Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
tg then TimeObject
x else TimeObject -> Grain -> TimeObject
TTime.timeRound TimeObject
x Grain
g'

shiftDuration :: TTime.Predicate -> DurationData -> TTime.Predicate
shiftDuration :: Predicate -> DurationData -> Predicate
shiftDuration Predicate
pred1 dd :: DurationData
dd@(DurationData Int
_ Grain
g) =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
pred1
  where
    f :: TimeObject -> TimeContext -> Maybe TimeObject
f TimeObject
x TimeContext
_ = TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just (TimeObject -> Maybe TimeObject)
-> (Grain -> TimeObject) -> Grain -> Maybe TimeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DurationData -> TimeObject -> TimeObject
addDuration DurationData
dd (TimeObject -> TimeObject)
-> (Grain -> TimeObject) -> Grain -> TimeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeObject -> Grain -> TimeObject
TTime.timeRound TimeObject
x (Grain -> Maybe TimeObject) -> Grain -> Maybe TimeObject
forall a b. (a -> b) -> a -> b
$ Grain -> Grain
TG.lower Grain
g

shiftTimezone :: Series.TimeZoneSeries -> TTime.Predicate -> TTime.Predicate
shiftTimezone :: TimeZoneSeries -> Predicate -> Predicate
shiftTimezone TimeZoneSeries
providedSeries Predicate
pred1 =
  SeriesPredicate -> Predicate
mkSeriesPredicate (SeriesPredicate -> Predicate) -> SeriesPredicate -> Predicate
forall a b. (a -> b) -> a -> b
$! Bool
-> (TimeObject -> TimeContext -> Maybe TimeObject)
-> Predicate
-> SeriesPredicate
TTime.timeSeqMap Bool
False TimeObject -> TimeContext -> Maybe TimeObject
f Predicate
pred1
  where
    f :: TimeObject -> TimeContext -> Maybe TimeObject
f x :: TimeObject
x@(TTime.TimeObject UTCTime
s Grain
_ Maybe UTCTime
_) TimeContext
ctx =
      let Time.TimeZone Int
ctxOffset Bool
_ String
_ =
            TimeZoneSeries -> UTCTime -> TimeZone
Series.timeZoneFromSeries (TimeContext -> TimeZoneSeries
TTime.tzSeries TimeContext
ctx) UTCTime
s
          Time.TimeZone Int
providedOffset Bool
_ String
_ =
            TimeZoneSeries -> UTCTime -> TimeZone
Series.timeZoneFromSeries TimeZoneSeries
providedSeries UTCTime
s
      -- This forgets about TTime.end, but it's OK since we act on time-of-days.
      in TimeObject -> Maybe TimeObject
forall a. a -> Maybe a
Just (TimeObject -> Maybe TimeObject)
-> (Int -> TimeObject) -> Int -> Maybe TimeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeObject -> Grain -> Integer -> TimeObject
TTime.timePlus TimeObject
x Grain
TG.Minute (Integer -> TimeObject) -> (Int -> Integer) -> Int -> TimeObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Maybe TimeObject) -> Int -> Maybe TimeObject
forall a b. (a -> b) -> a -> b
$
           Int
ctxOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
providedOffset

-- -----------------------------------------------------------------
-- Patterns

isGrainFinerThan :: TG.Grain -> Predicate
isGrainFinerThan :: Grain -> Predicate
isGrainFinerThan Grain
value (Token Dimension a
Time TimeData{TTime.timeGrain = g}) = Grain
g Grain -> Grain -> Bool
forall a. Ord a => a -> a -> Bool
< Grain
value
isGrainFinerThan Grain
_ Token
_ = Bool
False

isGrainCoarserThan :: TG.Grain -> Predicate
isGrainCoarserThan :: Grain -> Predicate
isGrainCoarserThan Grain
value (Token Dimension a
Time TimeData{TTime.timeGrain = g}) = Grain
g Grain -> Grain -> Bool
forall a. Ord a => a -> a -> Bool
> Grain
value
isGrainCoarserThan Grain
_ Token
_ = Bool
False

isGrainOfTime :: TG.Grain -> Predicate
isGrainOfTime :: Grain -> Predicate
isGrainOfTime Grain
value (Token Dimension a
Time TimeData{TTime.timeGrain = g}) = Grain
g Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
value
isGrainOfTime Grain
_ Token
_ = Bool
False

sameGrain :: TimeData -> TimeData -> Bool
sameGrain :: TimeData -> TimeData -> Bool
sameGrain TimeData{timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g} TimeData{timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
h} = Grain
g Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
h

hasTimezone :: Predicate
hasTimezone :: Predicate
hasTimezone (Token Dimension a
Time TimeData{TTime.hasTimezone = tz}) = Bool
tz
hasTimezone Token
_ = Bool
False

hasNoTimezone :: Predicate
hasNoTimezone :: Predicate
hasNoTimezone = Bool -> Bool
not (Bool -> Bool) -> Predicate -> Predicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate
hasTimezone

isADayOfWeek :: Predicate
isADayOfWeek :: Predicate
isADayOfWeek (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just Form
TTime.DayOfWeek -> Bool
True
  Maybe Form
_ -> Bool
False
isADayOfWeek Token
_ = Bool
False

isATimeOfDay :: Predicate
isATimeOfDay :: Predicate
isATimeOfDay (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just (TTime.TimeOfDay Maybe Int
_ Bool
_) -> Bool
True
  Maybe Form
_ -> Bool
False
isATimeOfDay Token
_ = Bool
False

isAPartOfDay :: Predicate
isAPartOfDay :: Predicate
isAPartOfDay (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just Form
TTime.PartOfDay -> Bool
True
  Maybe Form
_ -> Bool
False
isAPartOfDay Token
_ = Bool
False

isAMonth :: Predicate
isAMonth :: Predicate
isAMonth (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just (TTime.Month Int
_) -> Bool
True
  Maybe Form
_ -> Bool
False
isAMonth Token
_ = Bool
False

isAnHourOfDay :: Predicate
isAnHourOfDay :: Predicate
isAnHourOfDay (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just (TTime.TimeOfDay (Just Int
_) Bool
_) | TimeData -> Grain
TTime.timeGrain a
TimeData
td Grain -> Grain -> Bool
forall a. Ord a => a -> a -> Bool
> Grain
TG.Minute -> Bool
True
  Maybe Form
_ -> Bool
False
isAnHourOfDay Token
_ = Bool
False

isMidnightOrNoon :: Predicate
isMidnightOrNoon :: Predicate
isMidnightOrNoon (Token Dimension a
Time a
td) = case TimeData -> Maybe Form
TTime.form a
TimeData
td of
  Just (TTime.TimeOfDay (Just Int
x) Bool
_) -> Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12
  Maybe Form
_ -> Bool
False
isMidnightOrNoon Token
_ = Bool
False

isNotLatent :: Predicate
isNotLatent :: Predicate
isNotLatent (Token Dimension a
Time a
td) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TimeData -> Bool
TTime.latent a
TimeData
td
isNotLatent Token
_ = Bool
False

hasNoDirection :: Predicate
hasNoDirection :: Predicate
hasNoDirection (Token Dimension a
Time a
td) = Maybe IntervalDirection -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe IntervalDirection -> Bool)
-> Maybe IntervalDirection -> Bool
forall a b. (a -> b) -> a -> b
$ TimeData -> Maybe IntervalDirection
TTime.direction a
TimeData
td
hasNoDirection Token
_ = Bool
False

isIntegerBetween :: Int -> Int -> Predicate
isIntegerBetween :: Int -> Int -> Predicate
isIntegerBetween Int
low Int
high (Token Dimension a
Numeral a
nd) = NumeralData -> Bool
TNumeral.okForAnyTime a
NumeralData
nd
  Bool -> Bool -> Bool
&& Double -> Int -> Int -> Bool
TNumeral.isIntegerBetween (NumeralData -> Double
TNumeral.value a
NumeralData
nd) Int
low Int
high
isIntegerBetween Int
_ Int
_ Token
_ = Bool
False

isOrdinalBetween :: Int -> Int -> Predicate
isOrdinalBetween :: Int -> Int -> Predicate
isOrdinalBetween Int
low Int
high (Token Dimension a
Ordinal a
od) =
  Int -> Int -> Int -> Bool
forall a. Ord a => a -> a -> a -> Bool
TOrdinal.isBetween (OrdinalData -> Int
TOrdinal.value a
OrdinalData
od) Int
low Int
high
isOrdinalBetween Int
_ Int
_ Token
_ = Bool
False

isDurationGreaterThan :: TG.Grain -> Predicate
isDurationGreaterThan :: Grain -> Predicate
isDurationGreaterThan Grain
value (Token Dimension a
Duration DurationData{TDuration.grain = grain}) = Grain
grain Grain -> Grain -> Bool
forall a. Ord a => a -> a -> Bool
> Grain
value
isDurationGreaterThan Grain
_ Token
_ = Bool
False

isDOMOrdinal :: Predicate
isDOMOrdinal :: Predicate
isDOMOrdinal = Int -> Int -> Predicate
isOrdinalBetween Int
1 Int
31

isDOMInteger :: Predicate
isDOMInteger :: Predicate
isDOMInteger = Int -> Int -> Predicate
isIntegerBetween Int
1 Int
31

isDOMValue :: Predicate
isDOMValue :: Predicate
isDOMValue = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> (Token -> [Bool]) -> Predicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Predicate] -> Token -> [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Predicate
isDOMOrdinal, Predicate
isDOMInteger]

isOkWithThisNext :: Predicate
isOkWithThisNext :: Predicate
isOkWithThisNext (Token Dimension a
Time TimeData {TTime.okForThisNext = True}) = Bool
True
isOkWithThisNext Token
_ = Bool
False

-- -----------------------------------------------------------------
-- Production

-- Pass the interval second
intersect :: TimeData -> TimeData -> Maybe TimeData
intersect :: TimeData -> TimeData -> Maybe TimeData
intersect TimeData
td1 TimeData
td2 =
  case (TimeData, TimeData) -> TimeData
intersect' (TimeData
td1, TimeData
td2) of
    TTime.TimeData { timePred :: TimeData -> Predicate
TTime.timePred = Predicate
pred }
      | Predicate -> Bool
TTime.isEmptyPredicate Predicate
pred -> Maybe TimeData
forall a. Maybe a
Nothing
    TimeData
res -> TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just TimeData
res

intersectWithReplacement :: TimeData -> TimeData -> TimeData -> Maybe TimeData
intersectWithReplacement :: TimeData -> TimeData -> TimeData -> Maybe TimeData
intersectWithReplacement
  (TimeData Predicate
pred1 Bool
_ Grain
g1 Bool
_ Maybe Form
_ Maybe IntervalDirection
_ Bool
_ Maybe Text
h1 Bool
_)
  (TimeData Predicate
pred2 Bool
_ Grain
g2 Bool
_ Maybe Form
_ Maybe IntervalDirection
_ Bool
_ Maybe Text
h2 Bool
_)
  (TimeData Predicate
pred3 Bool
_ Grain
g3 Bool
_ Maybe Form
_ Maybe IntervalDirection
_ Bool
_ Maybe Text
h3 Bool
_)
  | Grain
g1 Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
g2 Bool -> Bool -> Bool
&& Grain
g2 Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
g3 = TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Predicate -> Predicate -> Predicate -> Predicate
timeComposeWithReplacement Predicate
pred1 Predicate
pred2 Predicate
pred3
    , timeGrain :: Grain
TTime.timeGrain = Grain
g1
    , direction :: Maybe IntervalDirection
TTime.direction = Maybe IntervalDirection
forall a. Maybe a
Nothing
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h1 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
h2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
h3
    }
  | Bool
otherwise = Maybe TimeData
forall a. Maybe a
Nothing

intersect' :: (TimeData, TimeData) -> TimeData
intersect' :: (TimeData, TimeData) -> TimeData
intersect' (TimeData Predicate
pred1 Bool
_ Grain
g1 Bool
_ Maybe Form
_ Maybe IntervalDirection
d1 Bool
_ Maybe Text
h1 Bool
_, TimeData Predicate
pred2 Bool
_ Grain
g2 Bool
_ Maybe Form
_ Maybe IntervalDirection
d2 Bool
_ Maybe Text
h2 Bool
_)
  | Grain
g1 Grain -> Grain -> Bool
forall a. Ord a => a -> a -> Bool
< Grain
g2 = TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Predicate -> Predicate -> Predicate
timeCompose Predicate
pred1 Predicate
pred2
    , timeGrain :: Grain
TTime.timeGrain = Grain
g1
    , direction :: Maybe IntervalDirection
TTime.direction = Maybe IntervalDirection
d1 Maybe IntervalDirection
-> Maybe IntervalDirection -> Maybe IntervalDirection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe IntervalDirection
d2
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h1 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
h2
    }
  | Bool
otherwise = TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Predicate -> Predicate -> Predicate
timeCompose Predicate
pred2 Predicate
pred1
    , timeGrain :: Grain
TTime.timeGrain = Grain
g2
    , direction :: Maybe IntervalDirection
TTime.direction = Maybe IntervalDirection
d1 Maybe IntervalDirection
-> Maybe IntervalDirection -> Maybe IntervalDirection
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe IntervalDirection
d2
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h1 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
h2
    }

now :: TimeData
now :: TimeData
now = TimeData
td {timeGrain :: Grain
TTime.timeGrain = Grain
TG.NoGrain}
  where
    td :: TimeData
td = Grain -> Int -> TimeData
cycleNth Grain
TG.Second Int
0

today :: TimeData
today :: TimeData
today = Grain -> Int -> TimeData
cycleNth Grain
TG.Day Int
0

hour :: Bool -> Int -> TimeData
hour :: Bool -> Int -> TimeData
hour Bool
is12H Int
n = Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n) Bool
is12H (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Bool -> Int -> Predicate
timeHour Bool
is12H Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Hour}

minute :: Int -> TimeData
minute :: Int -> TimeData
minute Int
n = TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Int -> Predicate
timeMinute Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Minute}

second :: Int -> TimeData
second :: Int -> TimeData
second Int
n = TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Int -> Predicate
timeSecond Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Second}

dayOfWeek :: Int -> TimeData
dayOfWeek :: Int -> TimeData
dayOfWeek Int
n = Form -> TimeData -> TimeData
form Form
TTime.DayOfWeek (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Int -> Predicate
timeDayOfWeek Int
n
  , timeGrain :: Grain
TTime.timeGrain = Grain
TG.Day
  , notImmediate :: Bool
TTime.notImmediate = Bool
True
  }

dayOfMonth :: Int -> TimeData
dayOfMonth :: Int -> TimeData
dayOfMonth Int
n = TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Int -> Predicate
timeDayOfMonth Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Day}

month :: Int -> TimeData
month :: Int -> TimeData
month Int
n = Form -> TimeData -> TimeData
form Month :: Int -> Form
TTime.Month {month :: Int
TTime.month = Int
n} (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Int -> Predicate
timeMonth Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Month}

-- | Converts 2-digits to a year between 1950 and 2050
year :: Int -> TimeData
year :: Int -> TimeData
year Int
n = TimeData
TTime.timedata'{timePred :: Predicate
TTime.timePred = Int -> Predicate
timeYear Int
y, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Year}
  where
    y :: Int
y = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
99 then Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
50) Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2000 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
50 else Int
n

yearADBC :: Int -> TimeData
yearADBC :: Int -> TimeData
yearADBC Int
n =
  TimeData
TTime.timedata'{timePred :: Predicate
TTime.timePred = Int -> Predicate
timeYear Int
n, timeGrain :: Grain
TTime.timeGrain = Grain
TG.Year}

yearMonth :: Int -> Int -> TimeData
yearMonth :: Int -> Int -> TimeData
yearMonth Int
y Int
m = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
year Int
y, Int -> TimeData
month Int
m)

yearMonthDay :: Int -> Int -> Int -> TimeData
yearMonthDay :: Int -> Int -> Int -> TimeData
yearMonthDay Int
y Int
m Int
d = (TimeData, TimeData) -> TimeData
intersect' (Int -> Int -> TimeData
yearMonth Int
y Int
m, Int -> TimeData
dayOfMonth Int
d)

monthDay :: Int -> Int -> TimeData
monthDay :: Int -> Int -> TimeData
monthDay Int
m Int
d = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
month Int
m, Int -> TimeData
dayOfMonth Int
d)

hourMinute :: Bool -> Int -> Int -> TimeData
hourMinute :: Bool -> Int -> Int -> TimeData
hourMinute Bool
is12H Int
h Int
m = Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h) Bool
is12H (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$
  (TimeData, TimeData) -> TimeData
intersect' (Bool -> Int -> TimeData
hour Bool
is12H Int
h, Int -> TimeData
minute Int
m)

hourMinuteSecond :: Bool -> Int -> Int -> Int -> TimeData
hourMinuteSecond :: Bool -> Int -> Int -> Int -> TimeData
hourMinuteSecond Bool
is12H Int
h Int
m Int
s = Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
h) Bool
is12H (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$
  (TimeData, TimeData) -> TimeData
intersect' ((TimeData, TimeData) -> TimeData
intersect' (Bool -> Int -> TimeData
hour Bool
is12H Int
h, Int -> TimeData
minute Int
m), Int -> TimeData
second Int
s)

season :: TimeData
season :: TimeData
season = TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Predicate
TTime.seasonPredicate
  , timeGrain :: Grain
TTime.timeGrain = Grain
TG.Day
  }

-- | Note that this function is not the counterpart of `weekend`.
-- `weekend` returns an interval while `weekday` returns a single day.
weekday :: TimeData
weekday :: TimeData
weekday = TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Predicate
TTime.weekdayPredicate
  , timeGrain :: Grain
TTime.timeGrain = Grain
TG.Day
  }

cycleN :: Bool -> TG.Grain -> Int -> TimeData
cycleN :: Bool -> Grain -> Int -> TimeData
cycleN Bool
notImmediate Grain
grain Int
n = TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Int -> Bool -> Predicate -> Predicate
takeN Int
n Bool
notImmediate (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ Grain -> Predicate
timeCycle Grain
grain
  , timeGrain :: Grain
TTime.timeGrain = Grain
grain
  }

cycleNth :: TG.Grain -> Int -> TimeData
cycleNth :: Grain -> Int -> TimeData
cycleNth Grain
grain Int
n = TimeData
TTime.timedata'
  {timePred :: Predicate
TTime.timePred = Int -> Bool -> Predicate -> Predicate
takeNth Int
n Bool
False (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ Grain -> Predicate
timeCycle Grain
grain, timeGrain :: Grain
TTime.timeGrain = Grain
grain}

cycleNthAfter :: Bool -> TG.Grain -> Int -> TimeData -> TimeData
cycleNthAfter :: Bool -> Grain -> Int -> TimeData -> TimeData
cycleNthAfter Bool
notImmediate Grain
grain Int
n TimeData {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p} =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Int -> Bool -> Predicate -> Predicate -> Predicate
takeNthAfter Int
n Bool
notImmediate (Grain -> Predicate
timeCycle Grain
grain) Predicate
p
    , timeGrain :: Grain
TTime.timeGrain = Grain
grain
    }

cycleLastOf :: TG.Grain -> TimeData -> TimeData
cycleLastOf :: Grain -> TimeData -> TimeData
cycleLastOf Grain
grain TimeData {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p} = TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Predicate -> Predicate -> Predicate
takeLastOf (Grain -> Predicate
timeCycle Grain
grain) Predicate
p
  , timeGrain :: Grain
TTime.timeGrain = Grain
grain
  }

-- Generalized version of cycleLastOf with custom predicate
predLastOf :: TimeData -> TimeData -> TimeData
predLastOf :: TimeData -> TimeData -> TimeData
predLastOf TimeData {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
cyclicPred, timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g} TimeData
base =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Predicate -> Predicate -> Predicate
takeLastOf Predicate
cyclicPred (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ TimeData -> Predicate
TTime.timePred TimeData
base
    , timeGrain :: Grain
TTime.timeGrain = Grain
g
    }

-- Generalized version of cycleNth with custom predicate
predNth :: Int -> Bool -> TimeData -> TimeData
predNth :: Int -> Bool -> TimeData -> TimeData
predNth Int
n Bool
notImmediate TimeData
  {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p, timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g, holiday :: TimeData -> Maybe Text
TTime.holiday = Maybe Text
h} =
  TimeData
TTime.timedata'
    {timePred :: Predicate
TTime.timePred = Int -> Bool -> Predicate -> Predicate
takeNth Int
n Bool
notImmediate Predicate
p
    , timeGrain :: Grain
TTime.timeGrain = Grain
g
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h}

-- Generalized version of `cycleNthAfter` with custom predicate
predNthAfter :: Int -> TimeData -> TimeData -> TimeData
predNthAfter :: Int -> TimeData -> TimeData -> TimeData
predNthAfter Int
n TimeData
  {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p, timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g, holiday :: TimeData -> Maybe Text
TTime.holiday = Maybe Text
h} TimeData
base =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Int -> Bool -> Predicate -> Predicate -> Predicate
takeNthAfter Int
n Bool
True Predicate
p (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ TimeData -> Predicate
TTime.timePred TimeData
base
    , timeGrain :: Grain
TTime.timeGrain = Grain
g
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h
    }

-- This function can be used to express predicates invoving "closest",
-- such as "the second closest Monday to Oct 5th"
predNthClosest :: Int -> TimeData -> TimeData -> TimeData
predNthClosest :: Int -> TimeData -> TimeData -> TimeData
predNthClosest Int
n TimeData
  {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p, timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g, holiday :: TimeData -> Maybe Text
TTime.holiday = Maybe Text
h} TimeData
base =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Int -> Predicate -> Predicate -> Predicate
takeNthClosest Int
n Predicate
p (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ TimeData -> Predicate
TTime.timePred TimeData
base
    , timeGrain :: Grain
TTime.timeGrain = Grain
g
    , holiday :: Maybe Text
TTime.holiday = Maybe Text
h
    }

-- This function is used for periodic events, for example,
-- "every 365 days" or "every 8 years".
-- `given` is a known example of the event.
-- Do not export
predEveryFrom :: TG.Grain -> Int -> TTime.TimeObject -> TimeData
predEveryFrom :: Grain -> Int -> TimeObject -> TimeData
predEveryFrom Grain
periodGrain Int
period TimeObject
given = TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = Grain -> Int -> TimeObject -> Predicate
TTime.periodicPredicate Grain
periodGrain Int
period TimeObject
given
    , timeGrain :: Grain
TTime.timeGrain = TimeObject -> Grain
TTime.grain TimeObject
given
    }

predEveryNDaysFrom :: Int -> (Integer, Int, Int) -> Maybe TimeData
predEveryNDaysFrom :: Int -> (Integer, Int, Int) -> Maybe TimeData
predEveryNDaysFrom Int
period (Integer, Int, Int)
given = do
  TimeObject
date <- (Integer, Int, Int) -> Maybe TimeObject
toTimeObjectM (Integer, Int, Int)
given
  TimeData -> Maybe TimeData
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ Grain -> Int -> TimeObject -> TimeData
predEveryFrom Grain
TG.Day Int
period TimeObject
date

toTimeObjectM :: (Integer, Int, Int) -> Maybe TTime.TimeObject
toTimeObjectM :: (Integer, Int, Int) -> Maybe TimeObject
toTimeObjectM (Integer
year, Int
month, Int
day) = do
  Day
day <- Integer -> Int -> Int -> Maybe Day
Time.fromGregorianValid Integer
year Int
month Int
day
  TimeObject -> Maybe TimeObject
forall (m :: * -> *) a. Monad m => a -> m a
return TimeObject :: UTCTime -> Grain -> Maybe UTCTime -> TimeObject
TTime.TimeObject
    { start :: UTCTime
TTime.start = Day -> DiffTime -> UTCTime
Time.UTCTime Day
day DiffTime
0
    , grain :: Grain
TTime.grain = Grain
TG.Day
    , end :: Maybe UTCTime
TTime.end = Maybe UTCTime
forall a. Maybe a
Nothing
    }

interval' :: TTime.TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' :: TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
intervalType (TimeData Predicate
p1 Bool
_ Grain
g1 Bool
_ Maybe Form
_ Maybe IntervalDirection
_ Bool
_ Maybe Text
_ Bool
_, TimeData Predicate
p2 Bool
_ Grain
g2 Bool
_ Maybe Form
_ Maybe IntervalDirection
_ Bool
_ Maybe Text
_ Bool
_) =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = TimeIntervalType -> Predicate -> Predicate -> Predicate
mkTimeIntervalsPredicate TimeIntervalType
intervalType' Predicate
p1 Predicate
p2
    , timeGrain :: Grain
TTime.timeGrain = Grain -> Grain -> Grain
forall a. Ord a => a -> a -> a
min Grain
g1 Grain
g2
    }
    where
      intervalType' :: TimeIntervalType
intervalType'
        | Grain
g1 Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
g2 Bool -> Bool -> Bool
&& Grain
g1 Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
TG.Day = TimeIntervalType
TTime.Closed
        | Bool
otherwise = TimeIntervalType
intervalType

interval :: TTime.TimeIntervalType -> TimeData -> TimeData -> Maybe TimeData
interval :: TimeIntervalType -> TimeData -> TimeData -> Maybe TimeData
interval TimeIntervalType
intervalType TimeData
td1 TimeData
td2 =
  case TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
intervalType (TimeData
td1, TimeData
td2) of
    TTime.TimeData { timePred :: TimeData -> Predicate
TTime.timePred = Predicate
pred }
      | Predicate -> Bool
TTime.isEmptyPredicate Predicate
pred -> Maybe TimeData
forall a. Maybe a
Nothing
    TimeData
res -> TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just TimeData
res

mkOkForThisNext :: TimeData -> TimeData
mkOkForThisNext :: TimeData -> TimeData
mkOkForThisNext TimeData
td = TimeData
td {okForThisNext :: Bool
TTime.okForThisNext = Bool
True}

durationAgo :: DurationData -> TimeData
durationAgo :: DurationData -> TimeData
durationAgo DurationData
dd = DurationData -> TimeData
inDuration (DurationData -> TimeData) -> DurationData -> TimeData
forall a b. (a -> b) -> a -> b
$ DurationData -> DurationData
timeNegPeriod DurationData
dd

durationIntervalAgo :: DurationData -> TimeData
durationIntervalAgo :: DurationData -> TimeData
durationIntervalAgo DurationData
dd = DurationData -> TimeData
inDurationInterval (DurationData -> TimeData) -> DurationData -> TimeData
forall a b. (a -> b) -> a -> b
$ DurationData -> DurationData
timeNegPeriod DurationData
dd

durationAfter :: DurationData -> TimeData -> TimeData
durationAfter :: DurationData -> TimeData -> TimeData
durationAfter DurationData
dd TimeData {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
pred1, timeGrain :: TimeData -> Grain
TTime.timeGrain = Grain
g} =
  TimeData
TTime.timedata'
    { timePred :: Predicate
TTime.timePred = if Grain
g Grain -> Grain -> Bool
forall a. Eq a => a -> a -> Bool
== Grain
TG.NoGrain
      then Predicate -> DurationData -> Predicate
shiftDuration Predicate
pred1 DurationData
dd
      else Predicate -> DurationData -> Predicate
mergeDuration Predicate
pred1 DurationData
dd
    , timeGrain :: Grain
TTime.timeGrain = DurationData -> Grain
TDuration.grain DurationData
dd
    }

durationBefore :: DurationData -> TimeData -> TimeData
durationBefore :: DurationData -> TimeData -> TimeData
durationBefore DurationData
dd TimeData
pred1 = DurationData -> TimeData -> TimeData
durationAfter (DurationData -> DurationData
timeNegPeriod DurationData
dd) TimeData
pred1

inDuration :: DurationData -> TimeData
inDuration :: DurationData -> TimeData
inDuration DurationData
dd = TimeData
TTime.timedata'
  { timePred :: Predicate
TTime.timePred = Predicate -> DurationData -> Predicate
shiftDuration Predicate
t DurationData
dd
  , timeGrain :: Grain
TTime.timeGrain = DurationData -> Grain
TDuration.grain DurationData
dd
  }
  where
    t :: Predicate
t = Int -> Bool -> Predicate -> Predicate
takeNth Int
0 Bool
False (Predicate -> Predicate) -> Predicate -> Predicate
forall a b. (a -> b) -> a -> b
$ Grain -> Predicate
timeCycle Grain
TG.Second

inDurationInterval :: DurationData -> TimeData
inDurationInterval :: DurationData -> TimeData
inDurationInterval DurationData
dd = TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
TTime.Open
  (DurationData -> TimeData
inDuration DurationData
dd, DurationData -> TimeData
inDuration (DurationData -> TimeData) -> DurationData -> TimeData
forall a b. (a -> b) -> a -> b
$ Int -> DurationData -> DurationData
timeShiftPeriod Int
1 DurationData
dd)

inTimezone :: Text -> TimeData -> Maybe TimeData
inTimezone :: Text -> TimeData -> Maybe TimeData
inTimezone Text
input td :: TimeData
td@TimeData {timePred :: TimeData -> Predicate
TTime.timePred = Predicate
p} = do
  TimeZone
tz <- Text -> Maybe TimeZone
parseTimezone Text
input
  TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ TimeData
td {timePred :: Predicate
TTime.timePred = TimeZoneSeries -> Predicate -> Predicate
shiftTimezone (TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries
Series.TimeZoneSeries TimeZone
tz []) Predicate
p, hasTimezone :: Bool
TTime.hasTimezone = Bool
True}

withHoliday :: Text -> TimeData -> TimeData
withHoliday :: Text -> TimeData -> TimeData
withHoliday Text
n TimeData
td = TimeData
td {holiday :: Maybe Text
TTime.holiday = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n}

mkLatent :: TimeData -> TimeData
mkLatent :: TimeData -> TimeData
mkLatent TimeData
td = TimeData
td {latent :: Bool
TTime.latent = Bool
True}

notLatent :: TimeData -> TimeData
notLatent :: TimeData -> TimeData
notLatent TimeData
td = TimeData
td {latent :: Bool
TTime.latent = Bool
False}

form :: TTime.Form -> TimeData -> TimeData
form :: Form -> TimeData -> TimeData
form Form
f TimeData
td = TimeData
td {form :: Maybe Form
TTime.form = Form -> Maybe Form
forall a. a -> Maybe a
Just Form
f}

partOfDay :: TimeData -> TimeData
partOfDay :: TimeData -> TimeData
partOfDay TimeData
td = Form -> TimeData -> TimeData
form Form
TTime.PartOfDay TimeData
td

timeOfDay :: Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay :: Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay Maybe Int
h Bool
is12H = Form -> TimeData -> TimeData
form TimeOfDay :: Maybe Int -> Bool -> Form
TTime.TimeOfDay {hours :: Maybe Int
TTime.hours = Maybe Int
h, is12H :: Bool
TTime.is12H = Bool
is12H}

timeOfDayAMPM :: Bool -> TimeData -> TimeData
timeOfDayAMPM :: Bool -> TimeData -> TimeData
timeOfDayAMPM Bool
isAM TimeData
tod = Maybe Int -> Bool -> TimeData -> TimeData
timeOfDay Maybe Int
forall a. Maybe a
Nothing Bool
False (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ (TimeData, TimeData) -> TimeData
intersect' (TimeData
tod, TimeData
ampm)
  where
    ampm :: TimeData
ampm = TimeData
TTime.timedata'
           { timePred :: Predicate
TTime.timePred = Predicate
ampmPred
           , timeGrain :: Grain
TTime.timeGrain = Grain
TG.Hour
           }
    ampmPred :: Predicate
ampmPred = if Bool
isAM then AMPM -> Predicate
mkAMPMPredicate AMPM
AM else AMPM -> Predicate
mkAMPMPredicate AMPM
PM

withDirection :: TTime.IntervalDirection -> TimeData -> TimeData
withDirection :: IntervalDirection -> TimeData -> TimeData
withDirection IntervalDirection
dir TimeData
td = TimeData
td {direction :: Maybe IntervalDirection
TTime.direction = IntervalDirection -> Maybe IntervalDirection
forall a. a -> Maybe a
Just IntervalDirection
dir}

longWEBefore :: TimeData -> TimeData
longWEBefore :: TimeData -> TimeData
longWEBefore TimeData
monday = TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
TTime.Open (TimeData
start, TimeData
end)
  where
    start :: TimeData
start = (TimeData, TimeData) -> TimeData
intersect' (TimeData
fri, Bool -> Int -> TimeData
hour Bool
False Int
18)
    end :: TimeData
end = (TimeData, TimeData) -> TimeData
intersect' (TimeData
tue, Bool -> Int -> TimeData
hour Bool
False Int
0)
    fri :: TimeData
fri = Bool -> Grain -> Int -> TimeData -> TimeData
cycleNthAfter Bool
False Grain
TG.Day (- Int
3) TimeData
monday
    tue :: TimeData
tue = Bool -> Grain -> Int -> TimeData -> TimeData
cycleNthAfter Bool
False Grain
TG.Day Int
1 TimeData
monday

weekend :: TimeData
weekend :: TimeData
weekend = TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
TTime.Open (TimeData
fri, TimeData
mon)
  where
    fri :: TimeData
fri = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
dayOfWeek Int
5, Bool -> Int -> TimeData
hour Bool
False Int
18)
    mon :: TimeData
mon = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
dayOfWeek Int
1, Bool -> Int -> TimeData
hour Bool
False Int
0)

workweek :: TimeData
workweek :: TimeData
workweek = TimeIntervalType -> (TimeData, TimeData) -> TimeData
interval' TimeIntervalType
TTime.Open (TimeData
mon, TimeData
fri)
  where
    mon :: TimeData
mon = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
dayOfWeek Int
1, Bool -> Int -> TimeData
hour Bool
False Int
10)
    fri :: TimeData
fri = (TimeData, TimeData) -> TimeData
intersect' (Int -> TimeData
dayOfWeek Int
5, Bool -> Int -> TimeData
hour Bool
False Int
18)

-- Zero-indexed weeks, Monday is 1
-- Use `predLastOf` for last day of week of month
nthDOWOfMonth :: Int -> Int -> Int -> TimeData
nthDOWOfMonth :: Int -> Int -> Int -> TimeData
nthDOWOfMonth Int
n Int
dow Int
m = Int -> TimeData -> TimeData -> TimeData
predNthAfter (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TimeData
dow_ TimeData
month_
  where
    dow_ :: TimeData
dow_ = Int -> TimeData
dayOfWeek Int
dow
    month_ :: TimeData
month_ = Int -> TimeData
month Int
m

intersectDOM :: TimeData -> Token -> Maybe TimeData
intersectDOM :: TimeData -> Token -> Maybe TimeData
intersectDOM TimeData
td Token
token = do
  Int
n <- Token -> Maybe Int
getIntValue Token
token
  TimeData -> TimeData -> Maybe TimeData
intersect (Int -> TimeData
dayOfMonth Int
n) TimeData
td

minutesBefore :: Int -> TimeData -> Maybe TimeData
minutesBefore :: Int -> TimeData -> Maybe TimeData
minutesBefore Int
n TimeData {form :: TimeData -> Maybe Form
TTime.form = Just (TTime.TimeOfDay (Just Int
0) Bool
is12H)} =
  TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> TimeData
hourMinute Bool
is12H Int
23 (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
minutesBefore Int
n TimeData {form :: TimeData -> Maybe Form
TTime.form = Just (TTime.TimeOfDay (Just Int
1) Bool
True)} =
  TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> TimeData
hourMinute Bool
True Int
12 (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
minutesBefore Int
n TimeData {form :: TimeData -> Maybe Form
TTime.form = Just (TTime.TimeOfDay (Just Int
h) Bool
is12H)} =
  TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> TimeData
hourMinute Bool
is12H (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
minutesBefore Int
_ TimeData
_ = Maybe TimeData
forall a. Maybe a
Nothing

minutesAfter :: Int -> TimeData -> Maybe TimeData
minutesAfter :: Int -> TimeData -> Maybe TimeData
minutesAfter Int
n TimeData {form :: TimeData -> Maybe Form
TTime.form = Just (TTime.TimeOfDay (Just Int
h) Bool
is12H)} =
  TimeData -> Maybe TimeData
forall a. a -> Maybe a
Just (TimeData -> Maybe TimeData) -> TimeData -> Maybe TimeData
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> TimeData
hourMinute Bool
is12H Int
h Int
n
minutesAfter Int
_ TimeData
_ = Maybe TimeData
forall a. Maybe a
Nothing

-- | Convenience helper to return a time token from a rule
tt :: TimeData -> Maybe Token
tt :: TimeData -> Maybe Token
tt = Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (TimeData -> Token) -> TimeData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension TimeData -> TimeData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension TimeData
Time

-- | Rule constructors
mkSingleRegexRule :: Text -> String -> Maybe Token -> Rule
mkSingleRegexRule :: Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
pattern Maybe Token
token = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
name
  , pattern :: Pattern
pattern = [String -> PatternItem
regex String
pattern]
  , prod :: Production
prod = Maybe Token -> Production
forall a b. a -> b -> a
const Maybe Token
token
  }

mkRuleInstants :: [(Text, TG.Grain, Int, String)] -> [Rule]
mkRuleInstants :: [(Text, Grain, Int, String)] -> [Rule]
mkRuleInstants = ((Text, Grain, Int, String) -> Rule)
-> [(Text, Grain, Int, String)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Grain, Int, String) -> Rule
go
  where
    go :: (Text, Grain, Int, String) -> Rule
go (Text
name, Grain
grain, Int
n, String
ptn) = Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule)
-> (TimeData -> Maybe Token) -> TimeData -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> Maybe Token
tt (TimeData -> Rule) -> TimeData -> Rule
forall a b. (a -> b) -> a -> b
$
      Grain -> Int -> TimeData
cycleNth Grain
grain Int
n

mkRuleDaysOfWeek :: [(Text, String)] -> [Rule]
mkRuleDaysOfWeek :: [(Text, String)] -> [Rule]
mkRuleDaysOfWeek [(Text, String)]
daysOfWeek = ((Text, String) -> Int -> Rule)
-> [(Text, String)] -> [Int] -> [Rule]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, String) -> Int -> Rule
go [(Text, String)]
daysOfWeek [Int
1..Int
7]
  where
    go :: (Text, String) -> Int -> Rule
go (Text
name, String
ptn) Int
i =
      Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule)
-> (TimeData -> Maybe Token) -> TimeData -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> Maybe Token
tt (TimeData -> Maybe Token)
-> (TimeData -> TimeData) -> TimeData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> TimeData
mkOkForThisNext (TimeData -> Rule) -> TimeData -> Rule
forall a b. (a -> b) -> a -> b
$ Int -> TimeData
dayOfWeek Int
i

mkRuleMonths :: [(Text, String)] -> [Rule]
mkRuleMonths :: [(Text, String)] -> [Rule]
mkRuleMonths = [(Text, String, Bool)] -> [Rule]
mkRuleMonthsWithLatent ([(Text, String, Bool)] -> [Rule])
-> ([(Text, String)] -> [(Text, String, Bool)])
-> [(Text, String)]
-> [Rule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, String) -> (Text, String, Bool))
-> [(Text, String)] -> [(Text, String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> String -> (Text, String, Bool))
-> (Text, String) -> (Text, String, Bool)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (,, Bool
False))

mkRuleMonthsWithLatent :: [(Text, String, Bool)] -> [Rule]
mkRuleMonthsWithLatent :: [(Text, String, Bool)] -> [Rule]
mkRuleMonthsWithLatent [(Text, String, Bool)]
months  = ((Text, String, Bool) -> Int -> Rule)
-> [(Text, String, Bool)] -> [Int] -> [Rule]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, String, Bool) -> Int -> Rule
go [(Text, String, Bool)]
months [Int
1..Int
12]
  where
    go :: (Text, String, Bool) -> Int -> Rule
go (Text
name, String
ptn, Bool
latent) Int
i =
      Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule)
-> (TimeData -> Maybe Token) -> TimeData -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> Maybe Token
tt (TimeData -> Maybe Token)
-> (TimeData -> TimeData) -> TimeData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
latent then TimeData -> TimeData
mkLatent else TimeData -> TimeData
forall a. a -> a
id)
      (TimeData -> TimeData)
-> (TimeData -> TimeData) -> TimeData -> TimeData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> TimeData
mkOkForThisNext (TimeData -> Rule) -> TimeData -> Rule
forall a b. (a -> b) -> a -> b
$ Int -> TimeData
month Int
i

mkRuleSeasons :: [(Text, String, TimeData, TimeData)] -> [Rule]
mkRuleSeasons :: [(Text, String, TimeData, TimeData)] -> [Rule]
mkRuleSeasons = ((Text, String, TimeData, TimeData) -> Rule)
-> [(Text, String, TimeData, TimeData)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, TimeData, TimeData) -> Rule
go
  where
    go :: (Text, String, TimeData, TimeData) -> Rule
go (Text
name, String
ptn, TimeData
start, TimeData
end) = Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule) -> Maybe Token -> Rule
forall a b. (a -> b) -> a -> b
$
      Dimension TimeData -> TimeData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension TimeData
Time (TimeData -> Token) -> (TimeData -> TimeData) -> TimeData -> Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeData -> TimeData
mkOkForThisNext (TimeData -> Token) -> Maybe TimeData -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeIntervalType -> TimeData -> TimeData -> Maybe TimeData
interval TimeIntervalType
TTime.Open TimeData
start TimeData
end

mkRuleHolidays :: [(Text, String, TimeData)] -> [Rule]
mkRuleHolidays :: [(Text, String, TimeData)] -> [Rule]
mkRuleHolidays = ((Text, String, TimeData) -> Rule)
-> [(Text, String, TimeData)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, TimeData) -> Rule
go
  where
    go :: (Text, String, TimeData) -> Rule
go (Text
name, String
ptn, TimeData
td) = Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule)
-> (TimeData -> Maybe Token) -> TimeData -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeData -> Maybe Token
tt
      (TimeData -> Rule) -> TimeData -> Rule
forall a b. (a -> b) -> a -> b
$ Text -> TimeData -> TimeData
withHoliday Text
name (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ TimeData -> TimeData
mkOkForThisNext TimeData
td

mkRuleHolidays' :: [(Text, String, Maybe TimeData)] -> [Rule]
mkRuleHolidays' :: [(Text, String, Maybe TimeData)] -> [Rule]
mkRuleHolidays' = ((Text, String, Maybe TimeData) -> Rule)
-> [(Text, String, Maybe TimeData)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, Maybe TimeData) -> Rule
go
  where
    go :: (Text, String, Maybe TimeData) -> Rule
go (Text
name, String
ptn, Maybe TimeData
td) = Text -> String -> Maybe Token -> Rule
mkSingleRegexRule Text
name String
ptn (Maybe Token -> Rule) -> Maybe Token -> Rule
forall a b. (a -> b) -> a -> b
$ do
      TimeData
td <- Maybe TimeData
td
      TimeData -> Maybe Token
tt (TimeData -> Maybe Token) -> TimeData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Text -> TimeData -> TimeData
withHoliday Text
name (TimeData -> TimeData) -> TimeData -> TimeData
forall a b. (a -> b) -> a -> b
$ TimeData -> TimeData
mkOkForThisNext TimeData
td