module Data.FuzzyTime.Resolve
  ( resolveZonedTime,
    resolveLocalTime,
    resolveLocalTimeOne,
    resolveLocalTimeOther,
    resolveLocalTimeBoth,
    morning,
    evening,
    resolveTimeOfDay,
    resolveTimeOfDayWithDiff,
    normaliseTimeOfDay,
    resolveDay,
  )
where

import Data.Fixed (Pico, mod')
import Data.FuzzyTime.Types (AmbiguousLocalTime (BothTimeAndDay, OnlyDaySpecified), FuzzyDay (DayInMonth, DiffDays, DiffMonths, DiffWeeks, ExactDay, NextDayOfTheWeek, Now, OnlyDay, Today, Tomorrow, Yesterday), FuzzyLocalTime (FuzzyLocalTime), FuzzyTimeOfDay (AtExact, AtHour, AtMinute, Evening, HoursDiff, Midnight, MinutesDiff, Morning, Noon, SameTime, SecondsDiff), FuzzyZonedTime (ZonedNow), Month, Some (Both, One, Other), dayOfTheWeekNum, daysInMonth, monthNum, numMonth)
import Data.Maybe (fromJust)
import Data.Time (Day, DayOfWeek, LocalTime (LocalTime), TimeOfDay (TimeOfDay), ZonedTime, addDays, fromGregorian, midday, midnight, toGregorian)
import Data.Time.Calendar.WeekDate (toWeekDate)

resolveZonedTime :: ZonedTime -> FuzzyZonedTime -> ZonedTime
resolveZonedTime :: ZonedTime -> FuzzyZonedTime -> ZonedTime
resolveZonedTime ZonedTime
zt FuzzyZonedTime
ZonedNow = ZonedTime
zt

resolveLocalTime :: LocalTime -> FuzzyLocalTime -> AmbiguousLocalTime
resolveLocalTime :: LocalTime -> FuzzyLocalTime -> AmbiguousLocalTime
resolveLocalTime LocalTime
lt (FuzzyLocalTime Some FuzzyDay FuzzyTimeOfDay
sft) =
  case Some FuzzyDay FuzzyTimeOfDay
sft of
    One FuzzyDay
fd -> Day -> AmbiguousLocalTime
OnlyDaySpecified forall a b. (a -> b) -> a -> b
$ LocalTime -> FuzzyDay -> Day
resolveLocalTimeOne LocalTime
lt FuzzyDay
fd
    Other FuzzyTimeOfDay
ftod -> LocalTime -> AmbiguousLocalTime
BothTimeAndDay forall a b. (a -> b) -> a -> b
$ LocalTime -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeOther LocalTime
lt FuzzyTimeOfDay
ftod
    Both FuzzyDay
fd FuzzyTimeOfDay
ftod -> LocalTime -> AmbiguousLocalTime
BothTimeAndDay forall a b. (a -> b) -> a -> b
$ LocalTime -> FuzzyDay -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeBoth LocalTime
lt FuzzyDay
fd FuzzyTimeOfDay
ftod

resolveLocalTimeOne :: LocalTime -> FuzzyDay -> Day
resolveLocalTimeOne :: LocalTime -> FuzzyDay -> Day
resolveLocalTimeOne (LocalTime Day
ld TimeOfDay
_) FuzzyDay
fd = Day -> FuzzyDay -> Day
resolveDay Day
ld FuzzyDay
fd

resolveLocalTimeOther :: LocalTime -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeOther :: LocalTime -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeOther (LocalTime Day
ld TimeOfDay
ltod) FuzzyTimeOfDay
ftod =
  let (Integer
d, TimeOfDay
tod) = TimeOfDay -> FuzzyTimeOfDay -> (Integer, TimeOfDay)
resolveTimeOfDayWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
   in Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Day -> Day
addDays Integer
d Day
ld) TimeOfDay
tod

resolveLocalTimeBoth :: LocalTime -> FuzzyDay -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeBoth :: LocalTime -> FuzzyDay -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeBoth (LocalTime Day
ld TimeOfDay
ltod) FuzzyDay
fd FuzzyTimeOfDay
ftod =
  let withDiff :: (Integer, TimeOfDay)
withDiff = TimeOfDay -> FuzzyTimeOfDay -> (Integer, TimeOfDay)
resolveTimeOfDayWithDiff TimeOfDay
ltod FuzzyTimeOfDay
ftod
      withoutDiff :: (Integer, TimeOfDay)
withoutDiff = (Integer
0, TimeOfDay -> FuzzyTimeOfDay -> TimeOfDay
resolveTimeOfDay TimeOfDay
ltod FuzzyTimeOfDay
ftod)
      (Integer
d, TimeOfDay
tod) =
        case FuzzyDay
fd of
          FuzzyDay
Now -> (Integer, TimeOfDay)
withDiff
          FuzzyDay
Today -> (Integer, TimeOfDay)
withDiff
          FuzzyDay
_ -> (Integer, TimeOfDay)
withoutDiff
   in Day -> TimeOfDay -> LocalTime
LocalTime (Integer -> Day -> Day
addDays Integer
d forall a b. (a -> b) -> a -> b
$ Day -> FuzzyDay -> Day
resolveDay Day
ld FuzzyDay
fd) TimeOfDay
tod

resolveTimeOfDay :: TimeOfDay -> FuzzyTimeOfDay -> TimeOfDay
resolveTimeOfDay :: TimeOfDay -> FuzzyTimeOfDay -> TimeOfDay
resolveTimeOfDay TimeOfDay
tod FuzzyTimeOfDay
ftod = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ TimeOfDay -> FuzzyTimeOfDay -> (Integer, TimeOfDay)
resolveTimeOfDayWithDiff TimeOfDay
tod FuzzyTimeOfDay
ftod

resolveTimeOfDayWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> (Integer, TimeOfDay)
resolveTimeOfDayWithDiff :: TimeOfDay -> FuzzyTimeOfDay -> (Integer, TimeOfDay)
resolveTimeOfDayWithDiff tod :: TimeOfDay
tod@(TimeOfDay Int
h Int
m Pico
s) FuzzyTimeOfDay
ftod =
  case FuzzyTimeOfDay
ftod of
    FuzzyTimeOfDay
SameTime -> (Integer
0, TimeOfDay
tod)
    FuzzyTimeOfDay
Noon -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midday
    FuzzyTimeOfDay
Midnight -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midnight
    FuzzyTimeOfDay
Morning -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
morning
    FuzzyTimeOfDay
Evening -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
evening
    AtHour Int
h_ -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
0 Pico
0
    AtMinute Int
h_ Int
m_ -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h_ Int
m_ Pico
0
    AtExact TimeOfDay
tod_ -> forall {a}. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_
    HoursDiff Int
hd -> Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay (Int
h forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hd) Int
m Pico
s
    MinutesDiff Int
md -> Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h (Int
m forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
md) Pico
s
    SecondsDiff Pico
sd -> Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay Int
h Int
m (Pico
s forall a. Num a => a -> a -> a
+ Pico
sd)
  where
    next :: TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_ = (forall {a}. Num a => (TimeOfDay -> Bool) -> a
skipIf (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 forall a. Real a => a -> a -> a
`mod'` Pico
60
      totalM :: Int
totalM = Int
m forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (Pico
s forall a. Num a => a -> a -> a
- Pico
s') forall a. Integral a => a -> a -> a
`div` Int
60
      m' :: Int
m' = Int
totalM forall a. Integral a => a -> a -> a
`mod` Int
60
      totalH :: Int
totalH = Int
h forall a. Num a => a -> a -> a
+ (Int
totalM forall a. Num a => a -> a -> a
- Int
m') forall a. Integral a => a -> a -> a
`div` Int
60
      h' :: Int
h' = Int
totalH forall a. Integral a => a -> a -> a
`mod` Int
24
      totalD :: Int
totalD = (Int
totalH forall a. Num a => a -> a -> a
- Int
h') forall a. Integral a => a -> a -> a
`div` Int
24
   in (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

resolveDay :: Day -> FuzzyDay -> Day
resolveDay :: Day -> FuzzyDay -> Day
resolveDay Day
d FuzzyDay
fd =
  case FuzzyDay
fd of
    FuzzyDay
Yesterday -> Integer -> Day -> Day
addDays (-Integer
1) Day
d
    FuzzyDay
Now -> Day
d
    FuzzyDay
Today -> Day
d
    FuzzyDay
Tomorrow -> Integer -> Day -> Day
addDays Integer
1 Day
d
    OnlyDay Int
di -> Day -> Int -> Day
nextDayOnDay Day
d Int
di
    DayInMonth Int
mi Int
di -> Day -> Int -> Int -> Day
nextDayOndayInMonth Day
d Int
mi Int
di
    DiffDays Int16
ds -> Integer -> Day -> Day
addDays (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ds) Day
d
    DiffWeeks Int16
ws -> Integer -> Day -> Day
addDays (Integer
7 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ws) Day
d
    DiffMonths Int16
ms -> Integer -> Day -> Day
addDays (Integer
30 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ms) Day
d
    NextDayOfTheWeek DayOfWeek
dow -> Day -> DayOfWeek -> Day
nextDayOfTheWeek Day
d DayOfWeek
dow
    ExactDay Day
d_ -> Day
d_

nextDayOnDay :: Day -> Int -> Day
nextDayOnDay :: Day -> Int -> Day
nextDayOnDay Day
d Int
di =
  let (Integer
y_, Int
m_, Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
d
      go :: Integer -> [(Month, Int)] -> Day
      go :: Integer -> [(Month, Int)] -> Day
go Integer
y [] =
        let y' :: Integer
y' = Integer
y forall a. Num a => a -> a -> a
+ Integer
1
         in Integer -> [(Month, Int)] -> Day
go Integer
y' (Integer -> [(Month, Int)]
daysInMonth Integer
y')
      go Integer
y ((Month
month, Int
mds) : [(Month, Int)]
rest) =
        if Int
mds forall a. Ord a => a -> a -> Bool
>= Int
di
          then
            let d' :: Day
d' = Integer -> Int -> Int -> Day
fromGregorian Integer
y (Month -> Int
monthNum Month
month) Int
di
             in if Day
d' forall a. Ord a => a -> a -> Bool
>= Day
d
                  then Day
d'
                  else Integer -> [(Month, Int)] -> Day
go Integer
y [(Month, Int)]
rest
          else Integer -> [(Month, Int)] -> Day
go Integer
y [(Month, Int)]
rest
   in Integer -> [(Month, Int)] -> Day
go Integer
y_ (forall a. Int -> [a] -> [a]
drop (Int
m_ forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ Integer -> [(Month, Int)]
daysInMonth Integer
y_)

nextDayOndayInMonth :: Day -> Int -> Int -> Day
nextDayOndayInMonth :: Day -> Int -> Int -> Day
nextDayOndayInMonth Day
d Int
mi Int
di =
  let (Integer
y_, Int
_, Int
_) = Day -> (Integer, Int, Int)
toGregorian Day
d
      go :: Integer -> Day
go Integer
y =
        let mds :: Int
mds = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Int -> Month
numMonth Int
mi) (Integer -> [(Month, Int)]
daysInMonth Integer
y)
         in if Int
mds forall a. Ord a => a -> a -> Bool
>= Int
di
              then
                let d' :: Day
d' = Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
mi Int
di
                 in if Day
d' forall a. Ord a => a -> a -> Bool
>= Day
d
                      then Day
d'
                      else Integer -> Day
go (Integer
y forall a. Num a => a -> a -> a
+ Integer
1)
              else Integer -> Day
go (Integer
y forall a. Num a => a -> a -> a
+ Integer
1)
   in Integer -> Day
go Integer
y_

nextDayOfTheWeek :: Day -> DayOfWeek -> Day
nextDayOfTheWeek :: Day -> DayOfWeek -> Day
nextDayOfTheWeek Day
d DayOfWeek
dow =
  let (Integer
_, Int
_, Int
i_) = Day -> (Integer, Int, Int)
toWeekDate Day
d
      down :: Int
down = DayOfWeek -> Int
dayOfTheWeekNum DayOfWeek
dow
      diff :: Integer
diff = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
down forall a. Num a => a -> a -> a
- Int
i_
      diff' :: Integer
diff' =
        if Integer
diff forall a. Ord a => a -> a -> Bool
<= Integer
0
          then Integer
diff forall a. Num a => a -> a -> a
+ Integer
7
          else Integer
diff
   in Integer -> Day -> Day
addDays Integer
diff' Day
d