{-# LANGUAGE LambdaCase #-}

-- | Functions to evaluate conditional restrictions.
module ConditionalRestriction.Internal.Evaluate where

import ConditionalRestriction.Parse.AST
  ( ComparisonOp (Eq, Gt, GtEq, Lt, LtEq),
    Condition (..),
    ConditionalRestriction (..),
    Expression (Expression),
    OpeningHours (..),
    RuleSequence (RuleSequence),
    RuleType (Additional, Normal),
    SelectorSequence
      ( TimeSel,
        TwentyFourSeven,
        WeekdaySel,
        WeekdayTime
      ),
    TimeSelector,
    TimeSpan (..),
    Token,
    WeekdayRange (SingleDay, WdayRange),
    WeekdaySelector,
  )
import ConditionalRestriction.Parse.InputData
  ( ID,
    Type (..),
    Value (..),
  )
import ConditionalRestriction.Result (Result (..))
import Data.Hourglass
  ( DateTime,
    TimeOfDay (TimeOfDay),
    WeekDay (Saturday, Sunday),
    getWeekDay,
    timeGetDate,
    timeGetTimeOfDay,
  )
import Data.List (nub)

-- | Plain text error message.
type ErrorMsg = String

-- | The 'result' function takes input data in the form of ('ID', 'Value') and a 'ConditionalRestriction' and returns
-- the result of that 'ConditionalRestriction' when applied to the input data given. If data needed for the evaluation
-- is missing or of the wrong type, it will return a list of error messages and a list of missing data types instead.
--
-- Note that this function will accept incomplete data if it is enough to evaluate the expression, but will always return
-- a complete list of needed data types.
result :: [(ID, Value)] -> ConditionalRestriction -> Result ([ErrorMsg], [(ID, Type)]) (Maybe Token)
result :: [(String, Value)]
-> ConditionalRestriction
-> Result ([String], [(String, Type)]) (Maybe String)
result [(String, Value)]
ds (ConditionalRestriction [Expression]
exprs) =
  forall {a} {a} {a}.
Eq a =>
(a -> Result ([a], [a]) Bool) -> [a] -> Result ([a], [a]) (Maybe a)
find_r (\(Expression String
_ [Condition]
conds) -> forall {t} {a} {a}.
(t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r ([(String, Value)]
-> Condition -> Result (Either String (String, Type)) Bool
fulfills [(String, Value)]
ds) [Condition]
conds) (forall a. [a] -> [a]
reverse [Expression]
exprs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Expression
Nothing -> forall e a. a -> Result e a
Ok forall a. Maybe a
Nothing
    Just (Expression String
tok [Condition]
_) -> forall e a. a -> Result e a
Ok forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
tok
  where
    find_r :: (a -> Result ([a], [a]) Bool) -> [a] -> Result ([a], [a]) (Maybe a)
find_r a -> Result ([a], [a]) Bool
f (a
x : [a]
xs) = case a -> Result ([a], [a]) Bool
f a
x of
      Ok Bool
True -> forall e a. a -> Result e a
Ok forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x
      Ok Bool
False -> (a -> Result ([a], [a]) Bool) -> [a] -> Result ([a], [a]) (Maybe a)
find_r a -> Result ([a], [a]) Bool
f [a]
xs
      Err ([a]
msgs, [a]
needed) -> case (a -> Result ([a], [a]) Bool) -> [a] -> Result ([a], [a]) (Maybe a)
find_r a -> Result ([a], [a]) Bool
f [a]
xs of
        Err ([a]
msgs', [a]
needed') -> forall e a. e -> Result e a
Err ([a]
msgs forall a. [a] -> [a] -> [a]
++ [a]
msgs', forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [a]
needed forall a. [a] -> [a] -> [a]
++ [a]
needed')
        Ok Maybe a
v -> forall e a. e -> Result e a
Err ([a]
msgs, [a]
needed)
    find_r a -> Result ([a], [a]) Bool
f [] = forall e a. a -> Result e a
Ok forall a. Maybe a
Nothing

    all_r :: (t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r t -> Result (Either a a) Bool
f (t
x : [t]
xs) = case t -> Result (Either a a) Bool
f t
x of
      Ok Bool
True -> (t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r t -> Result (Either a a) Bool
f [t]
xs
      Ok Bool
False -> Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r t -> Result (Either a a) Bool
f [t]
xs
      Err (Left a
msg) -> case (t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r t -> Result (Either a a) Bool
f [t]
xs of
        Ok Bool
_ -> forall e a. e -> Result e a
Err ([a
msg], [])
        Err ([a]
msgs, [a]
neededs) -> forall e a. e -> Result e a
Err (a
msg forall a. a -> [a] -> [a]
: [a]
msgs, [a]
neededs)
      Err (Right a
needed) -> case (t -> Result (Either a a) Bool) -> [t] -> Result ([a], [a]) Bool
all_r t -> Result (Either a a) Bool
f [t]
xs of
        Ok Bool
_ -> forall e a. e -> Result e a
Err ([], [a
needed])
        Err ([a]
msgs, [a]
neededs) -> forall e a. e -> Result e a
Err ([a]
msgs, a
needed forall a. a -> [a] -> [a]
: [a]
neededs)
    all_r t -> Result (Either a a) Bool
f [] = forall e a. a -> Result e a
Ok Bool
True

-- | The 'fulfills' function takes input data in the form of ('ID', 'Value') and a 'Condition' and returns
-- whether that condition is fulfilled. If some data is missing, it will return the missing data 'ID' and 'Type'
-- and if the given data is of the wrong type, it will return an error message.
fulfills :: [(ID, Value)] -> Condition -> Result (Either ErrorMsg (ID, Type)) Bool
fulfills :: [(String, Value)]
-> Condition -> Result (Either String (String, Type)) Bool
fulfills [(String, Value)]
ds (OH OpeningHours
oh) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"time" [(String, Value)]
ds of
  Just (VTime DateTime
t) -> forall e a. a -> Result e a
Ok forall a b. (a -> b) -> a -> b
$ DateTime -> OpeningHours -> Bool
timeIn DateTime
t OpeningHours
oh
  Just Value
_ -> forall e a. e -> Result e a
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Incorrect input type for time"
  Maybe Value
Nothing -> case OpeningHours
oh of
    OpeningHours [RuleSequence RuleType
_ SelectorSequence
TwentyFourSeven (Just Bool
o)] -> forall e a. a -> Result e a
Ok Bool
o
    OpeningHours
_ -> forall e a. e -> Result e a
Err forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
"time", Type
TTime)
fulfills [(String, Value)]
ds (Comparison String
tok ComparisonOp
op Double
val) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
tok [(String, Value)]
ds of
  Just (VNum Double
d) -> forall e a. a -> Result e a
Ok forall a b. (a -> b) -> a -> b
$ case ComparisonOp
op of
    ComparisonOp
Gt -> Double
d forall a. Ord a => a -> a -> Bool
> Double
val
    ComparisonOp
Lt -> Double
d forall a. Ord a => a -> a -> Bool
< Double
val
    ComparisonOp
GtEq -> Double
d forall a. Ord a => a -> a -> Bool
>= Double
val
    ComparisonOp
LtEq -> Double
d forall a. Ord a => a -> a -> Bool
<= Double
val
    ComparisonOp
Eq -> Double
d forall a. Eq a => a -> a -> Bool
== Double
val
  Just Value
_ -> forall e a. e -> Result e a
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Incorrect input type for " forall a. [a] -> [a] -> [a]
++ String
tok
  Maybe Value
Nothing -> forall e a. e -> Result e a
Err forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
tok, Type
TNum)
fulfills [(String, Value)]
ds (Absolute String
tok) = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
tok [(String, Value)]
ds of
  Just (VBool Bool
b) -> forall e a. a -> Result e a
Ok Bool
b
  Just Value
_ -> forall e a. e -> Result e a
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Incorrect input type for " forall a. [a] -> [a] -> [a]
++ String
tok
  Maybe Value
Nothing -> forall e a. e -> Result e a
Err forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
tok, Type
TBool)

-- | The 'timeIn' function returns wheter a 'DateTime' is within given 'OpeningHours'. Unknown values count as not
-- within the opening hours.
timeIn :: DateTime -> OpeningHours -> Bool
timeIn :: DateTime -> OpeningHours -> Bool
timeIn DateTime
t OpeningHours
oh =
  TimeOfDay -> TimeSelector -> Bool
timeInSelector TimeOfDay
time (OpeningHours -> [TimeSelector]
ohTimes OpeningHours
oh forall a. [a] -> Int -> a
!! forall a. Enum a => a -> Int
fromEnum WeekDay
weekday)
    Bool -> Bool -> Bool
|| TimeOfDay -> TimeSelector -> Bool
timeExtendedInSelector TimeOfDay
time (OpeningHours -> [TimeSelector]
ohTimes OpeningHours
oh forall a. [a] -> Int -> a
!! forall a. Enum a => a -> Int
fromEnum WeekDay
previous_weekday)
  where
    date :: Date
date = forall t. Timeable t => t -> Date
timeGetDate DateTime
t
    time :: TimeOfDay
time = forall t. Timeable t => t -> TimeOfDay
timeGetTimeOfDay DateTime
t
    weekday :: WeekDay
weekday = Date -> WeekDay
getWeekDay Date
date
    previous_weekday :: WeekDay
previous_weekday = if WeekDay
weekday forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound then forall a. Bounded a => a
maxBound else forall a. Enum a => a -> a
pred WeekDay
weekday

ohTimes :: OpeningHours -> [TimeSelector]
ohTimes :: OpeningHours -> [TimeSelector]
ohTimes (OpeningHours [RuleSequence]
rs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RuleSequence -> [TimeSelector] -> [TimeSelector]
set_time_ranges [[] | WeekDay
_ <- forall a. (Ord a, Enum a, Bounded a) => a -> a -> [a]
range WeekDay
Sunday WeekDay
Saturday] (forall a. [a] -> [a]
reverse [RuleSequence]
rs)
  where
    set_time_ranges :: RuleSequence -> [TimeSelector] -> [TimeSelector]
set_time_ranges (RuleSequence RuleType
t SelectorSequence
TwentyFourSeven (Just Bool
o)) = forall a b. (a -> b) -> [a] -> [b]
map (forall {t :: * -> *}.
Foldable t =>
RuleType -> Bool -> TimeSelector -> t TimeSpan -> TimeSelector
integrate RuleType
t Bool
o [TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
min_time TimeOfDay
max_time])
    set_time_ranges (RuleSequence RuleType
t (WeekdaySel WeekdaySelector
wdrs) (Just Bool
o)) = forall a. [WeekDay] -> (a -> a) -> [a] -> [a]
mapDays (WeekdaySelector -> [WeekDay]
combineWeekdays WeekdaySelector
wdrs) (forall {t :: * -> *}.
Foldable t =>
RuleType -> Bool -> TimeSelector -> t TimeSpan -> TimeSelector
integrate RuleType
t Bool
o [TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
min_time TimeOfDay
max_time])
    set_time_ranges (RuleSequence RuleType
t (TimeSel TimeSelector
ts) (Just Bool
o)) = forall a b. (a -> b) -> [a] -> [b]
map (forall {t :: * -> *}.
Foldable t =>
RuleType -> Bool -> TimeSelector -> t TimeSpan -> TimeSelector
integrate RuleType
t Bool
o TimeSelector
ts)
    set_time_ranges (RuleSequence RuleType
t (WeekdayTime WeekdaySelector
wdrs TimeSelector
ts) (Just Bool
o)) = forall a. [WeekDay] -> (a -> a) -> [a] -> [a]
mapDays (WeekdaySelector -> [WeekDay]
combineWeekdays WeekdaySelector
wdrs) (forall {t :: * -> *}.
Foldable t =>
RuleType -> Bool -> TimeSelector -> t TimeSpan -> TimeSelector
integrate RuleType
t Bool
o TimeSelector
ts)
    set_time_ranges RuleSequence
_ = forall a. a -> a
id
    min_time :: TimeOfDay
min_time = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
00 Minutes
00 Seconds
00 NanoSeconds
0
    max_time :: TimeOfDay
max_time = Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay Hours
23 Minutes
59 Seconds
59 NanoSeconds
999999999
    integrate :: RuleType -> Bool -> TimeSelector -> t TimeSpan -> TimeSelector
integrate RuleType
Normal = forall {a} {b}. Bool -> [a] -> b -> [a]
override
    integrate RuleType
Additional = forall {t :: * -> *}.
Foldable t =>
Bool -> TimeSelector -> t TimeSpan -> TimeSelector
combine
    override :: Bool -> [a] -> b -> [a]
override Bool
True = forall a b. a -> b -> a
const
    override Bool
False = \[a]
_ -> forall a b. a -> b -> a
const []
    combine :: Bool -> TimeSelector -> t TimeSpan -> TimeSelector
combine Bool
True = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TimeSpan -> TimeSelector -> TimeSelector
addTimespan
    combine Bool
False = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TimeSpan -> TimeSelector -> TimeSelector
subtractTimespan

timeInSelector :: TimeOfDay -> TimeSelector -> Bool
timeInSelector :: TimeOfDay -> TimeSelector -> Bool
timeInSelector TimeOfDay
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TimeSpan -> Bool
match_t
  where
    match_t :: TimeSpan -> Bool
match_t (Moment TimeOfDay
t') = TimeOfDay
t' forall a. Eq a => a -> a -> Bool
== TimeOfDay
t
    match_t (Span TimeOfDay
t1 TimeOfDay
t2) = TimeOfDay
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t1 Bool -> Bool -> Bool
&& (TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2 Bool -> Bool -> Bool
|| TimeOfDay
t1 forall a. Ord a => a -> a -> Bool
> TimeOfDay
t2)

timeExtendedInSelector :: TimeOfDay -> TimeSelector -> Bool
timeExtendedInSelector :: TimeOfDay -> TimeSelector -> Bool
timeExtendedInSelector TimeOfDay
t = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any TimeSpan -> Bool
match_t
  where
    match_t :: TimeSpan -> Bool
match_t (Moment (TimeOfDay Hours
h' Minutes
m' Seconds
s' NanoSeconds
n')) = TimeOfDay
t forall a. Eq a => a -> a -> Bool
== Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay (Hours
h' forall a. Num a => a -> a -> a
- Hours
24) Minutes
m' Seconds
s' NanoSeconds
n'
    match_t (Span TimeOfDay
t1 TimeOfDay
t2) | TimeOfDay
t1 forall a. Ord a => a -> a -> Bool
> TimeOfDay
t2 = TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2
    match_t (Span TimeOfDay
t1 (TimeOfDay Hours
h' Minutes
m' Seconds
s' NanoSeconds
n')) | Hours
h' forall a. Ord a => a -> a -> Bool
>= Hours
24 = TimeOfDay
t forall a. Ord a => a -> a -> Bool
< Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay (Hours
h' forall a. Num a => a -> a -> a
- Hours
24) Minutes
m' Seconds
s' NanoSeconds
n'
    match_t TimeSpan
_ = Bool
False

addTimespan :: TimeSpan -> TimeSelector -> TimeSelector
addTimespan :: TimeSpan -> TimeSelector -> TimeSelector
addTimespan TimeSpan
ts TimeSelector
sel = TimeSpan -> TimeSelector -> TimeSelector
add_timespan (TimeSpan -> TimeSpan
explicitExtended TimeSpan
ts) (forall a b. (a -> b) -> [a] -> [b]
map TimeSpan -> TimeSpan
explicitExtended TimeSelector
sel)
  where
    add_timespan :: TimeSpan -> TimeSelector -> TimeSelector
add_timespan (Moment TimeOfDay
t) sel :: TimeSelector
sel@(Moment TimeOfDay
t' : TimeSelector
ts) | TimeOfDay
t forall a. Eq a => a -> a -> Bool
== TimeOfDay
t' = TimeSelector
sel
    add_timespan (Moment TimeOfDay
t) (Moment TimeOfDay
t' : TimeSelector
ts) = TimeOfDay -> TimeSpan
Moment TimeOfDay
t' forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
add_timespan (TimeOfDay -> TimeSpan
Moment TimeOfDay
t) TimeSelector
ts
    add_timespan (Moment TimeOfDay
t) sel :: TimeSelector
sel@(Span TimeOfDay
t1 TimeOfDay
t2 : TimeSelector
ts) | TimeOfDay
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t1 Bool -> Bool -> Bool
&& TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2 = TimeSelector
sel
    add_timespan (Moment TimeOfDay
t) (Span TimeOfDay
t1 TimeOfDay
t2 : TimeSelector
ts) = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2 forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
add_timespan (TimeOfDay -> TimeSpan
Moment TimeOfDay
t) TimeSelector
ts
    add_timespan (Span TimeOfDay
t1 TimeOfDay
t2) (Moment TimeOfDay
t : TimeSelector
ts) | TimeOfDay
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t1 Bool -> Bool -> Bool
&& TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2 = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2 forall a. a -> [a] -> [a]
: TimeSelector
ts
    add_timespan (Span TimeOfDay
t1 TimeOfDay
t2) (Moment TimeOfDay
t : TimeSelector
ts) = TimeOfDay -> TimeSpan
Moment TimeOfDay
t forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
add_timespan (TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2) TimeSelector
ts
    add_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) | (TimeOfDay
tb1 forall a. Ord a => a -> a -> Bool
<= TimeOfDay
ta2 Bool -> Bool -> Bool
&& TimeOfDay
tb2 forall a. Ord a => a -> a -> Bool
> TimeOfDay
ta1) Bool -> Bool -> Bool
|| (TimeOfDay
ta1 forall a. Ord a => a -> a -> Bool
<= TimeOfDay
tb2 Bool -> Bool -> Bool
&& TimeOfDay
ta2 forall a. Ord a => a -> a -> Bool
> TimeOfDay
tb1) = -- where overlaps
                                                      TimeOfDay -> TimeOfDay -> TimeSpan
Span (forall a. Ord a => a -> a -> a
min TimeOfDay
ta1 TimeOfDay
tb1) (forall a. Ord a => a -> a -> a
max TimeOfDay
ta2 TimeOfDay
tb2) forall a. a -> [a] -> [a]
: TimeSelector
ts
    add_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
tb1 TimeOfDay
tb2 forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
add_timespan (TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
ta1 TimeOfDay
ta2) TimeSelector
ts
    add_timespan TimeSpan
x [] = [TimeSpan
x]

subtractTimespan :: TimeSpan -> TimeSelector -> TimeSelector
subtractTimespan :: TimeSpan -> TimeSelector -> TimeSelector
subtractTimespan TimeSpan
ts TimeSelector
sel = TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeSpan -> TimeSpan
explicitExtended TimeSpan
ts) (forall a b. (a -> b) -> [a] -> [b]
map TimeSpan -> TimeSpan
explicitExtended TimeSelector
sel)
  where
    subtract_timespan :: TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (Moment TimeOfDay
t) sel :: TimeSelector
sel@(Moment TimeOfDay
t' : TimeSelector
ts) | TimeOfDay
t forall a. Eq a => a -> a -> Bool
== TimeOfDay
t' = TimeSelector
ts
    subtract_timespan (Moment TimeOfDay
t) (Moment TimeOfDay
t' : TimeSelector
ts) = TimeOfDay -> TimeSpan
Moment TimeOfDay
t' forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeOfDay -> TimeSpan
Moment TimeOfDay
t) TimeSelector
ts
    subtract_timespan (Moment TimeOfDay
t) sel :: TimeSelector
sel@(Span TimeOfDay
t1 TimeOfDay
t2 : TimeSelector
ts) | TimeOfDay
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t1 Bool -> Bool -> Bool
&& TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2 = TimeSelector
sel -- don't subtract single moments from time spans
    subtract_timespan (Moment TimeOfDay
t) (Span TimeOfDay
t1 TimeOfDay
t2 : TimeSelector
ts) = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2 forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeOfDay -> TimeSpan
Moment TimeOfDay
t) TimeSelector
ts
    subtract_timespan (Span TimeOfDay
t1 TimeOfDay
t2) (Moment TimeOfDay
t : TimeSelector
ts) | TimeOfDay
t forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t1 Bool -> Bool -> Bool
&& TimeOfDay
t forall a. Ord a => a -> a -> Bool
<= TimeOfDay
t2 = TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2) TimeSelector
ts
    subtract_timespan (Span TimeOfDay
t1 TimeOfDay
t2) (Moment TimeOfDay
t : TimeSelector
ts) = TimeOfDay -> TimeSpan
Moment TimeOfDay
t forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 TimeOfDay
t2) TimeSelector
ts
    subtract_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) | (TimeOfDay
tb1 forall a. Ord a => a -> a -> Bool
< TimeOfDay
ta2 Bool -> Bool -> Bool
&& TimeOfDay
tb2 forall a. Ord a => a -> a -> Bool
> TimeOfDay
ta1) Bool -> Bool -> Bool
|| (TimeOfDay
ta1 forall a. Ord a => a -> a -> Bool
< TimeOfDay
tb2 Bool -> Bool -> Bool
&& TimeOfDay
ta2 forall a. Ord a => a -> a -> Bool
> TimeOfDay
tb1) =
                                                           TimeOfDay -> TimeOfDay -> TimeSpan
Span (forall a. Ord a => a -> a -> a
min TimeOfDay
ta1 TimeOfDay
tb1) (forall a. Ord a => a -> a -> a
max TimeOfDay
ta1 TimeOfDay
tb1) forall a. a -> [a] -> [a]
: TimeOfDay -> TimeOfDay -> TimeSpan
Span (forall a. Ord a => a -> a -> a
min TimeOfDay
ta2 TimeOfDay
tb2) (forall a. Ord a => a -> a -> a
max TimeOfDay
ta2 TimeOfDay
tb2) forall a. a -> [a] -> [a]
: TimeSelector
ts
    subtract_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) | TimeOfDay
ta1 forall a. Eq a => a -> a -> Bool
== TimeOfDay
tb1 Bool -> Bool -> Bool
&& TimeOfDay
ta2 forall a. Eq a => a -> a -> Bool
== TimeOfDay
tb2 = TimeSelector
ts
    subtract_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) | TimeOfDay
ta1 forall a. Eq a => a -> a -> Bool
== TimeOfDay
tb1 = TimeOfDay -> TimeOfDay -> TimeSpan
Span (forall a. Ord a => a -> a -> a
min TimeOfDay
ta2 TimeOfDay
tb2) (forall a. Ord a => a -> a -> a
max TimeOfDay
ta2 TimeOfDay
tb2) forall a. a -> [a] -> [a]
: TimeSelector
ts
    subtract_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) | TimeOfDay
ta2 forall a. Eq a => a -> a -> Bool
== TimeOfDay
tb2 = TimeOfDay -> TimeOfDay -> TimeSpan
Span (forall a. Ord a => a -> a -> a
min TimeOfDay
ta1 TimeOfDay
tb1) (forall a. Ord a => a -> a -> a
max TimeOfDay
ta1 TimeOfDay
tb1) forall a. a -> [a] -> [a]
: TimeSelector
ts
    subtract_timespan (Span TimeOfDay
ta1 TimeOfDay
ta2) (Span TimeOfDay
tb1 TimeOfDay
tb2 : TimeSelector
ts) = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
tb1 TimeOfDay
tb2 forall a. a -> [a] -> [a]
: TimeSpan -> TimeSelector -> TimeSelector
subtract_timespan (TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
ta1 TimeOfDay
ta2) TimeSelector
ts
    subtract_timespan TimeSpan
x [] = []

explicitExtended :: TimeSpan -> TimeSpan
explicitExtended :: TimeSpan -> TimeSpan
explicitExtended (Span TimeOfDay
t1 t2 :: TimeOfDay
t2@(TimeOfDay Hours
h Minutes
m Seconds
s NanoSeconds
n)) | TimeOfDay
t1 forall a. Ord a => a -> a -> Bool
>= TimeOfDay
t2 = TimeOfDay -> TimeOfDay -> TimeSpan
Span TimeOfDay
t1 (Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay (Hours
h forall a. Num a => a -> a -> a
+ Hours
24) Minutes
m Seconds
s NanoSeconds
n)
explicitExtended TimeSpan
other = TimeSpan
other

mapDays :: [WeekDay] -> (a -> a) -> [a] -> [a]
mapDays :: forall a. [WeekDay] -> (a -> a) -> [a] -> [a]
mapDays [WeekDay]
days a -> a
f = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\WeekDay
d a
x -> (if WeekDay
d forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WeekDay]
days then a -> a
f a
x else a
x)) (forall a. (Ord a, Enum a, Bounded a) => a -> a -> [a]
range WeekDay
Sunday WeekDay
Saturday)

combineWeekdays :: WeekdaySelector -> [WeekDay]
combineWeekdays :: WeekdaySelector -> [WeekDay]
combineWeekdays = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. WeekdaySelector -> [WeekDay]
combine
  where
    combine :: WeekdaySelector -> [WeekDay]
combine (SingleDay WeekDay
day : WeekdaySelector
wdrs) = WeekDay
day forall a. a -> [a] -> [a]
: WeekdaySelector -> [WeekDay]
combineWeekdays WeekdaySelector
wdrs
    combine (WdayRange WeekDay
from WeekDay
to : WeekdaySelector
wdrs) = forall a. (Ord a, Enum a, Bounded a) => a -> a -> [a]
range WeekDay
from WeekDay
to forall a. [a] -> [a] -> [a]
++ WeekdaySelector -> [WeekDay]
combineWeekdays WeekdaySelector
wdrs
    combine [] = []

range :: (Ord a, Enum a, Bounded a) => a -> a -> [a]
range :: forall a. (Ord a, Enum a, Bounded a) => a -> a -> [a]
range a
a a
b | a
b forall a. Ord a => a -> a -> Bool
< a
a = [a
a ..] forall a. [a] -> [a] -> [a]
++ [forall a. Bounded a => a
minBound .. a
b]
range a
a a
b = [a
a .. a
b]