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

import Data.Fixed
import Data.FuzzyTime.Types
import Data.Maybe
import Data.Time
import Data.Time.Calendar.WeekDate

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 (Day -> AmbiguousLocalTime) -> Day -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> FuzzyDay -> Day
resolveLocalTimeOne LocalTime
lt FuzzyDay
fd
    Other FuzzyTimeOfDay
ftod -> LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> FuzzyTimeOfDay -> LocalTime
resolveLocalTimeOther LocalTime
lt FuzzyTimeOfDay
ftod
    Both FuzzyDay
fd FuzzyTimeOfDay
ftod -> LocalTime -> AmbiguousLocalTime
BothTimeAndDay (LocalTime -> AmbiguousLocalTime)
-> LocalTime -> AmbiguousLocalTime
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 (Day -> Day) -> Day -> Day
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 = (Integer, TimeOfDay) -> TimeOfDay
forall a b. (a, b) -> b
snd ((Integer, TimeOfDay) -> TimeOfDay)
-> (Integer, TimeOfDay) -> TimeOfDay
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 -> TimeOfDay -> (Integer, TimeOfDay)
forall a. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midday
    FuzzyTimeOfDay
Midnight -> TimeOfDay -> (Integer, TimeOfDay)
forall a. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
midnight
    FuzzyTimeOfDay
Morning -> TimeOfDay -> (Integer, TimeOfDay)
forall a. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
morning
    FuzzyTimeOfDay
Evening -> TimeOfDay -> (Integer, TimeOfDay)
forall a. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
evening
    AtHour Int
h_ -> 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_ -> 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_ -> TimeOfDay -> (Integer, TimeOfDay)
forall a. Num a => TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_
    HoursDiff Int
hd -> Int -> Int -> Pico -> (Integer, TimeOfDay)
normaliseTimeOfDay (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
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 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ Pico
sd)
  where
    next :: TimeOfDay -> (a, TimeOfDay)
next TimeOfDay
tod_ = ((TimeOfDay -> Bool) -> a
forall p. Num p => (TimeOfDay -> Bool) -> p
skipIf (TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
>= TimeOfDay
tod_), TimeOfDay
tod_)
    skipIf :: (TimeOfDay -> Bool) -> p
skipIf TimeOfDay -> Bool
p =
      if TimeOfDay -> Bool
p TimeOfDay
tod
        then p
1
        else p
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 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

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 (Int16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
ds) Day
d
    DiffWeeks Int16
ws -> 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 -> 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
    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 Integer -> Integer -> Integer
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 Int -> Int -> Bool
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' Day -> Day -> Bool
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_ (Int -> [(Month, Int)] -> [(Month, Int)]
forall a. Int -> [a] -> [a]
drop (Int
m_ Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(Month, Int)] -> [(Month, Int)])
-> [(Month, Int)] -> [(Month, Int)]
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 = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Month -> [(Month, Int)] -> Maybe Int
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 Int -> Int -> Bool
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' Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d
                      then Day
d'
                      else Integer -> Day
go (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)
              else Integer -> Day
go (Integer
y Integer -> Integer -> Integer
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 = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int
down Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i_
      diff' :: Integer
diff' =
        if Integer
diff Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0
          then Integer
diff Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
7
          else Integer
diff
   in Integer -> Day -> Day
addDays Integer
diff' Day
d