{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}

module Data.FuzzyTime.Resolve
  ( -- * Local time
    resolveLocalTimeForwards,
    resolveLocalTimeBackwards,

    -- * Time Of Day
    resolveTimeOfDayForwards,
    resolveTimeOfDayBackwards,
    normaliseTimeOfDay,
    morning,
    evening,

    -- * Day
    resolveDayForwards,
    resolveDayBackwards,

    -- ** Resolution helpers
    nextDayOfMonth,
    previousDayOfMonth,
    nextDayOfMonthOfYear,
    previousDayOfMonthOfYear,
    nextDayOfWeek,
    previousDayOfWeek,
  )
where

import Data.Fixed (Pico, mod')
import Data.FuzzyTime.Types (AmbiguousLocalTime (BothTimeAndDay, OnlyDaySpecified), FuzzyDay (..), FuzzyLocalTime (..), FuzzyTimeOfDay (AtExact, AtHour, AtMinute, Evening, HoursDiff, Midnight, MinutesDiff, Morning, Noon, SameTime, SecondsDiff))
import Data.Time (Day, DayOfWeek, LocalTime (LocalTime), TimeOfDay (TimeOfDay), addDays, midday, midnight, toGregorian)
import Data.Time.Calendar.Month (Month, fromMonthDayValid, fromYearMonthValid, pattern MonthDay)
import Data.Time.Calendar.WeekDate (fromWeekDate, toWeekDate)
import Data.Word (Word8)

resolveLocalTimeForwards :: LocalTime -> FuzzyLocalTime -> Maybe AmbiguousLocalTime
resolveLocalTimeForwards :: LocalTime -> FuzzyLocalTime -> Maybe AmbiguousLocalTime
resolveLocalTimeForwards (LocalTime Day
ld TimeOfDay
ltod) = \case
  FuzzyLocalTimeDay FuzzyDay
fd -> Day -> AmbiguousLocalTime
OnlyDaySpecified (Day -> AmbiguousLocalTime)
-> Maybe Day -> Maybe AmbiguousLocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> FuzzyDay -> Maybe Day
resolveDayForwards Day
ld FuzzyDay
fd
  FuzzyLocalTimeTimeOfDay FuzzyTimeOfDay
ftod -> do
    (Integer
d, TimeOfDay
tod) <- TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayForwardsWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
    AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmbiguousLocalTime -> Maybe AmbiguousLocalTime)
-> AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Day -> Day
addDays Integer
d Day
ld) TimeOfDay
tod
  FuzzyLocalTimeBoth FuzzyDay
fd FuzzyTimeOfDay
ftod -> do
    let withDiff :: Maybe (Integer, TimeOfDay)
withDiff = TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayForwardsWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
        withoutDiff :: Maybe (Integer, TimeOfDay)
withoutDiff = (,) Integer
0 (TimeOfDay -> (Integer, TimeOfDay))
-> Maybe TimeOfDay -> Maybe (Integer, TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayForwards TimeOfDay
ltod FuzzyTimeOfDay
ftod
    (Integer
d, TimeOfDay
tod) <-
      case FuzzyDay
fd of
        FuzzyDay
Now -> Maybe (Integer, TimeOfDay)
withDiff
        FuzzyDay
Today -> Maybe (Integer, TimeOfDay)
withDiff
        FuzzyDay
_ -> Maybe (Integer, TimeOfDay)
withoutDiff
    Day
day <- Integer -> Day -> Day
addDays Integer
d (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> FuzzyDay -> Maybe Day
resolveDayForwards Day
ld FuzzyDay
fd
    AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmbiguousLocalTime -> Maybe AmbiguousLocalTime)
-> AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod

resolveLocalTimeBackwards :: LocalTime -> FuzzyLocalTime -> Maybe AmbiguousLocalTime
resolveLocalTimeBackwards :: LocalTime -> FuzzyLocalTime -> Maybe AmbiguousLocalTime
resolveLocalTimeBackwards (LocalTime Day
ld TimeOfDay
ltod) = \case
  FuzzyLocalTimeDay FuzzyDay
fd -> Day -> AmbiguousLocalTime
OnlyDaySpecified (Day -> AmbiguousLocalTime)
-> Maybe Day -> Maybe AmbiguousLocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> FuzzyDay -> Maybe Day
resolveDayBackwards Day
ld FuzzyDay
fd
  FuzzyLocalTimeTimeOfDay FuzzyTimeOfDay
ftod -> do
    (Integer
d, TimeOfDay
tod) <- TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayBackwardsWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
    AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmbiguousLocalTime -> Maybe AmbiguousLocalTime)
-> AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Day -> Day
addDays Integer
d Day
ld) TimeOfDay
tod
  FuzzyLocalTimeBoth FuzzyDay
fd FuzzyTimeOfDay
ftod -> do
    let withDiff :: Maybe (Integer, TimeOfDay)
withDiff = TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayBackwardsWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
        withoutDiff :: Maybe (Integer, TimeOfDay)
withoutDiff = (,) Integer
0 (TimeOfDay -> (Integer, TimeOfDay))
-> Maybe TimeOfDay -> Maybe (Integer, TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayBackwards TimeOfDay
ltod FuzzyTimeOfDay
ftod
    (Integer
d, TimeOfDay
tod) <-
      case FuzzyDay
fd of
        FuzzyDay
Now -> Maybe (Integer, TimeOfDay)
withDiff
        FuzzyDay
Today -> Maybe (Integer, TimeOfDay)
withDiff
        FuzzyDay
_ -> Maybe (Integer, TimeOfDay)
withoutDiff
    Day
day <- Integer -> Day -> Day
addDays Integer
d (Day -> Day) -> Maybe Day -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> FuzzyDay -> Maybe Day
resolveDayBackwards Day
ld FuzzyDay
fd
    AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AmbiguousLocalTime -> Maybe AmbiguousLocalTime)
-> AmbiguousLocalTime -> Maybe AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod

resolveTimeOfDayForwards :: TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayForwards :: TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayForwards TimeOfDay
tod FuzzyTimeOfDay
ftod = (Integer, TimeOfDay) -> TimeOfDay
forall a b. (a, b) -> b
snd ((Integer, TimeOfDay) -> TimeOfDay)
-> Maybe (Integer, TimeOfDay) -> Maybe TimeOfDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayForwardsWithDiff TimeOfDay
tod FuzzyTimeOfDay
ftod

resolveTimeOfDayBackwards :: TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayBackwards :: TimeOfDay -> FuzzyTimeOfDay -> Maybe TimeOfDay
resolveTimeOfDayBackwards TimeOfDay
tod FuzzyTimeOfDay
ftod = (Integer, TimeOfDay) -> TimeOfDay
forall a b. (a, b) -> b
snd ((Integer, TimeOfDay) -> TimeOfDay)
-> Maybe (Integer, TimeOfDay) -> Maybe TimeOfDay
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayBackwardsWithDiff TimeOfDay
tod FuzzyTimeOfDay
ftod

resolveTimeOfDayForwardsWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayForwardsWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayForwardsWithDiff tod :: TimeOfDay
tod@(TimeOfDay Int
h Int
m Pico
s) FuzzyTimeOfDay
ftod =
  case FuzzyTimeOfDay
ftod of
    FuzzyTimeOfDay
SameTime -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just (Integer
0, TimeOfDay
tod)
    FuzzyTimeOfDay
Noon -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midday
    FuzzyTimeOfDay
Midnight -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midnight
    FuzzyTimeOfDay
Morning -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
morning
    FuzzyTimeOfDay
Evening -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
evening
    AtHour Int
h_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next (TimeOfDay -> (Integer, TimeOfDay))
-> TimeOfDay -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
0 Pico
0
    AtMinute Int
h_ Int
m_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next (TimeOfDay -> (Integer, TimeOfDay))
-> TimeOfDay -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
m_ Pico
0
    AtExact TimeOfDay
tod_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_
    HoursDiff Int
hd -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hd) Int
m Pico
s
    MinutesDiff Int
md -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
md) Pico
s
    SecondsDiff Pico
sd -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h Int
m (Pico
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
sd)
  where
    next :: TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_ = ((TimeOfDay -> Bool) -> a
forall {a}. Num a => (TimeOfDay -> Bool) -> a
skipIf (TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeOfDay
tod_), TimeOfDay
tod_)
    skipIf :: (TimeOfDay -> Bool) -> a
skipIf TimeOfDay -> Bool
p =
      if TimeOfDay -> Bool
p TimeOfDay
tod
        then a
1
        else a
0

resolveTimeOfDayBackwardsWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayBackwardsWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> Maybe (Integer, TimeOfDay)
resolveTimeOfDayBackwardsWithDiff tod :: TimeOfDay
tod@(TimeOfDay Int
h Int
m Pico
s) FuzzyTimeOfDay
ftod =
  case FuzzyTimeOfDay
ftod of
    FuzzyTimeOfDay
SameTime -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just (Integer
0, TimeOfDay
tod)
    FuzzyTimeOfDay
Noon -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
midday
    FuzzyTimeOfDay
Midnight -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
midnight
    FuzzyTimeOfDay
Morning -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
morning
    FuzzyTimeOfDay
Evening -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
evening
    AtHour Int
h_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous (TimeOfDay -> (Integer, TimeOfDay))
-> TimeOfDay -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
0 Pico
0
    AtMinute Int
h_ Int
m_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous (TimeOfDay -> (Integer, TimeOfDay))
-> TimeOfDay -> (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
m_ Pico
0
    AtExact TimeOfDay
tod_ -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> (Integer, TimeOfDay)
forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
tod_
    HoursDiff Int
hd -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hd) Int
m Pico
s
    MinutesDiff Int
md -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
md) Pico
s
    SecondsDiff Pico
sd -> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a. a -> Maybe a
Just ((Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay))
-> (Integer, TimeOfDay) -> Maybe (Integer, TimeOfDay)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h Int
m (Pico
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
sd)
  where
    previous :: TimeOfDay -> (a, TimeOfDay)
previous TimeOfDay
tod_ = ((TimeOfDay -> Bool) -> a
forall {a}. Num a => (TimeOfDay -> Bool) -> a
skipIf (TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeOfDay
tod_), TimeOfDay
tod_)
    skipIf :: (TimeOfDay -> Bool) -> a
skipIf TimeOfDay -> Bool
p =
      if TimeOfDay -> Bool
p TimeOfDay
tod
        then (-a
1)
        else a
0

normaliseTimeOfDay :: Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay :: Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h Int
m Pico
s =
  let s' :: Pico
s' = Pico
s Pico -> Pico -> Pico
forall a. Real a => a -> a -> a
`mod'` Pico
60
      totalM :: Int
totalM = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Pico -> Int
forall b. Integral b => Pico -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
- Pico
s') Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60
      m' :: Int
m' = Int
totalM Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
60
      totalH :: Int
totalH = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
totalM Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m') Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60
      h' :: Int
h' = Int
totalH Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
24
      totalD :: Int
totalD = (Int
totalH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h') Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
24
   in (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalD, Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h' Int
m' Pico
s')

morning :: TimeOfDay
morning :: TimeOfDay
morning = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
6 Int
0 Pico
0

evening :: TimeOfDay
evening :: TimeOfDay
evening = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
18 Int
0 Pico
0

resolveDayForwards :: Day -> FuzzyDay -> Maybe Day
resolveDayForwards :: Day -> FuzzyDay -> Maybe Day
resolveDayForwards Day
d FuzzyDay
fd =
  case FuzzyDay
fd of
    FuzzyDay
Yesterday -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (-Integer
1) Day
d
    FuzzyDay
Now -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
    FuzzyDay
Today -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
    FuzzyDay
Tomorrow -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 Day
d
    OnlyDay Word8
di -> Day -> Word8 -> Maybe Day
nextDayOfMonth Day
d Word8
di
    DayInMonth Word8
mi Word8
di -> Day -> Word8 -> Word8 -> Maybe Day
nextDayOfMonthOfYear Day
d Word8
mi Word8
di
    DiffDays Int16
ds -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ds) Day
d
    DiffWeeks Int16
ws -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ws) Day
d
    DiffMonths Int16
ms -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
30 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ms) Day
d
    DayOfTheWeek DayOfWeek
dow Int16
diff -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
diff) (Day -> DayOfWeek -> Day
nextDayOfWeek Day
d DayOfWeek
dow)
    ExactDay Day
d_ -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d_

resolveDayBackwards :: Day -> FuzzyDay -> Maybe Day
resolveDayBackwards :: Day -> FuzzyDay -> Maybe Day
resolveDayBackwards Day
d FuzzyDay
fd =
  case FuzzyDay
fd of
    FuzzyDay
Yesterday -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (-Integer
1) Day
d
    FuzzyDay
Now -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
    FuzzyDay
Today -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
    FuzzyDay
Tomorrow -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays Integer
1 Day
d
    OnlyDay Word8
di -> Day -> Word8 -> Maybe Day
previousDayOfMonth Day
d Word8
di
    DayInMonth Word8
mi Word8
di -> Day -> Word8 -> Word8 -> Maybe Day
previousDayOfMonthOfYear Day
d Word8
mi Word8
di
    DiffDays Int16
ds -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ds) Day
d
    DiffWeeks Int16
ws -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ws) Day
d
    DiffMonths Int16
ms -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
30 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ms) Day
d
    DayOfTheWeek DayOfWeek
dow Int16
diff -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (Integer
7 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
diff) (Day -> DayOfWeek -> Day
previousDayOfWeek Day
d DayOfWeek
dow)
    ExactDay Day
d_ -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d_

nextDayOfMonth :: Day -> Word8 -> Maybe Day
nextDayOfMonth :: Day -> Word8 -> Maybe Day
nextDayOfMonth = (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Month -> Month) -> Day -> Word8 -> Maybe Day
dayOfMonthHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
nextAfterDay Month -> Month
forall a. Enum a => a -> a
succ

previousDayOfMonth :: Day -> Word8 -> Maybe Day
previousDayOfMonth :: Day -> Word8 -> Maybe Day
previousDayOfMonth = (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Month -> Month) -> Day -> Word8 -> Maybe Day
dayOfMonthHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
previousBeforeDay Month -> Month
forall a. Enum a => a -> a
pred

dayOfMonthHelper ::
  (Day -> Maybe Day -> Maybe Day -> Maybe Day) ->
  (Month -> Month) ->
  Day ->
  Word8 ->
  Maybe Day
dayOfMonthHelper :: (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Month -> Month) -> Day -> Word8 -> Maybe Day
dayOfMonthHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
chooser Month -> Month
changer Day
d Word8
wi =
  let di :: Int
      di :: Int
di = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wi
      MonthDay Month
thisMonth Int
_ = Day
d
      guessThisMonth :: Maybe Day
guessThisMonth = Month -> Int -> Maybe Day
fromMonthDayValid Month
thisMonth (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
wi)
      guessOtherMonth :: Maybe Day
guessOtherMonth = Month -> Int -> Maybe Day
fromMonthDayValid (Month -> Month
changer Month
thisMonth) Int
di
   in Day -> Maybe Day -> Maybe Day -> Maybe Day
chooser Day
d Maybe Day
guessThisMonth Maybe Day
guessOtherMonth

nextDayOfMonthOfYear :: Day -> Word8 -> Word8 -> Maybe Day
nextDayOfMonthOfYear :: Day -> Word8 -> Word8 -> Maybe Day
nextDayOfMonthOfYear = (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Integer -> Integer) -> Day -> Word8 -> Word8 -> Maybe Day
dayOfMonthOfYearHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
nextAfterDay Integer -> Integer
forall a. Enum a => a -> a
succ

previousDayOfMonthOfYear :: Day -> Word8 -> Word8 -> Maybe Day
previousDayOfMonthOfYear :: Day -> Word8 -> Word8 -> Maybe Day
previousDayOfMonthOfYear = (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Integer -> Integer) -> Day -> Word8 -> Word8 -> Maybe Day
dayOfMonthOfYearHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
previousBeforeDay Integer -> Integer
forall a. Enum a => a -> a
pred

dayOfMonthOfYearHelper ::
  (Day -> Maybe Day -> Maybe Day -> Maybe Day) ->
  (Integer -> Integer) ->
  Day ->
  Word8 ->
  Word8 ->
  Maybe Day
dayOfMonthOfYearHelper :: (Day -> Maybe Day -> Maybe Day -> Maybe Day)
-> (Integer -> Integer) -> Day -> Word8 -> Word8 -> Maybe Day
dayOfMonthOfYearHelper Day -> Maybe Day -> Maybe Day -> Maybe Day
chooser Integer -> Integer
changer Day
d Word8
mw Word8
dw =
  let mi :: Int
mi = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
mw
      di :: Int
di = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
dw
      (Integer
y, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
d
      current :: Maybe Day
current =
        Integer -> Int -> Maybe Month
fromYearMonthValid Integer
y Int
mi Maybe Month -> (Month -> Maybe Day) -> Maybe Day
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Month
m ->
          Month -> Int -> Maybe Day
fromMonthDayValid Month
m Int
di
      other :: Maybe Day
other =
        Integer -> Int -> Maybe Month
fromYearMonthValid (Integer -> Integer
changer Integer
y) Int
mi Maybe Month -> (Month -> Maybe Day) -> Maybe Day
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Month
m ->
          Month -> Int -> Maybe Day
fromMonthDayValid Month
m Int
di
   in Day -> Maybe Day -> Maybe Day -> Maybe Day
chooser Day
d Maybe Day
current Maybe Day
other

nextDayOfWeek :: Day -> DayOfWeek -> Day
nextDayOfWeek :: Day -> DayOfWeek -> Day
nextDayOfWeek = (Day -> Day -> Day -> Day)
-> (Day -> Day) -> Day -> DayOfWeek -> Day
dayOfWeekHelper (\Day
d Day
current Day
after -> if Day
current Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
d then Day
current else Day
after) (Integer -> Day -> Day
addDays Integer
7)

previousDayOfWeek :: Day -> DayOfWeek -> Day
previousDayOfWeek :: Day -> DayOfWeek -> Day
previousDayOfWeek = (Day -> Day -> Day -> Day)
-> (Day -> Day) -> Day -> DayOfWeek -> Day
dayOfWeekHelper (\Day
d Day
current Day
before -> if Day
current Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
d then Day
current else Day
before) (Integer -> Day -> Day
addDays (-Integer
7))

dayOfWeekHelper ::
  (Day -> Day -> Day -> Day) ->
  (Day -> Day) ->
  Day ->
  DayOfWeek ->
  Day
dayOfWeekHelper :: (Day -> Day -> Day -> Day)
-> (Day -> Day) -> Day -> DayOfWeek -> Day
dayOfWeekHelper Day -> Day -> Day -> Day
chooser Day -> Day
changer Day
day DayOfWeek
dow =
  let (Integer
y, Int
woy, Int
_) = Day -> (Integer, Int, Int)
toWeekDate Day
day
      currentGuess :: Day
currentGuess = Integer -> Int -> Int -> Day
fromWeekDate Integer
y Int
woy (DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dow)
      otherGuess :: Day
otherGuess = Day -> Day
changer Day
currentGuess
   in Day -> Day -> Day -> Day
chooser Day
day Day
currentGuess Day
otherGuess

nextAfterDay :: Day -> Maybe Day -> Maybe Day -> Maybe Day
nextAfterDay :: Day -> Maybe Day -> Maybe Day -> Maybe Day
nextAfterDay Day
today Maybe Day
beforeGuess Maybe Day
afterGuess =
  case Maybe Day
beforeGuess of
    Just Day
d ->
      if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
today
        then Maybe Day
beforeGuess
        else Maybe Day
afterGuess
    Maybe Day
Nothing -> Maybe Day
afterGuess

previousBeforeDay :: Day -> Maybe Day -> Maybe Day -> Maybe Day
previousBeforeDay :: Day -> Maybe Day -> Maybe Day -> Maybe Day
previousBeforeDay Day
today Maybe Day
afterGuess Maybe Day
beforeGuess =
  case Maybe Day
afterGuess of
    Just Day
d ->
      if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
today
        then Maybe Day
afterGuess
        else Maybe Day
beforeGuess
    Maybe Day
Nothing -> Maybe Day
beforeGuess