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