Утечка памяти Haskell, работающая с зонированным временем и добавляющая/вычитающая секунды

В настоящее время я работаю над своего рода системой бронирования, которая должна генерировать наличие мест. Таким образом, ключевым требованием является создание различных списков времени в заданном диапазоне.

data TimeslotGenMode
  = Monthly
  | Daily
  | WorkDays
  | Weekends
  | Hourly
  | FiveMinutes
  | Minute
  | TenMinutes
  | FifteenMinutes
  deriving (Eq, Generic, FromJSON, ToJSON, ToSchema)

Таким образом, если какой-либо запрос поступает с параметром «Почасово», мы получим текущее время и рассчитаем все 1-часовые диапазоны, например, между 2 часами назад и 60 часами позже.

Я хочу работать с этим типом данных или что-то вроде этого:

data TimeRange = TimeRange
  { slotStart :: !ZonedTime,
    slotEnd :: !ZonedTime
  }
  deriving (Show, Generic, FromJSON, ToJSON, ToSchema)

makeFieldLabelsNoPrefix ''TimeRange

В моем примере режим «Ежедневно» работает отлично, но режим «Ежечасно» каким-то образом имеет УЖАСНУЮ утечку памяти до такой степени, что он заполняет мою 64 ГБ ОЗУ, а затем происходит сбой.

Я пытался изменить некоторые вещи между ежечасно и ежедневно, а также использовать понимание списка, но это не очень помогает.

availabilityFromMode :: (MonadIO m) => TimeslotGenMode -> m [TimeRange]
availabilityFromMode Daily = do
  now <- liftIO getZonedTime
  timeZone <- liftIO getCurrentTimeZone
  let today = utctDay $ zonedTimeToUTC now

  let advancedRanges =
        map (mkAdvanceRange timeZone . warpNDaysAtMidnight timeZone today) [0 .. daysInAdvanceToShow]
      previousRanges =
        map (mkPreviousRange timeZone . warpNDaysAtMidnight timeZone today) [daysInPastToShow .. 0]

  pure $ previousRanges ++ advancedRanges
  where
    daysInAdvanceToShow = 60
    daysInPastToShow = -2
    mkPreviousRange timeZone moment =
      TimeRange
        { slotStart = addSecondsToZonedTime timeZone moment (-86400),
          slotEnd = moment
        }
    mkAdvanceRange timeZone moment =
      TimeRange
        { slotStart = moment,
          slotEnd = addSecondsToZonedTime timeZone moment 86400
        }
availabilityFromMode Hourly = do
  now <- liftIO getZonedTime
  timeZone <- liftIO getCurrentTimeZone

  let advancedRanges =
        [mkAdvanceRange timeZone . addSecondsToZonedTime timeZone now $ (i * 3600) | i <- [0 .. hoursInAdvanceToShow]]
      previousRanges =
        [mkPreviousRange timeZone . addSecondsToZonedTime timeZone now $ (i * 3600) | i <- [hoursInPastToShow .. 0]]

  pure $ previousRanges ++ advancedRanges
  where
    hoursInAdvanceToShow = 5
    hoursInPastToShow = -4
    mkPreviousRange timeZone moment =
      TimeRange
        { slotStart = addSecondsToZonedTime timeZone moment (-3600),
          slotEnd = moment
        }
    mkAdvanceRange timeZone moment =
      TimeRange
        { slotStart = moment,
          slotEnd = addSecondsToZonedTime timeZone moment 3600
        }
availabilityFromMode _ = pure []

addSecondsToZonedTime :: TimeZone -> ZonedTime -> Pico -> ZonedTime
addSecondsToZonedTime zone x seconds = utcToZonedTime zone (addUTCTime (secondsToNominalDiffTime seconds) (zonedTimeToUTC x))

warpNDaysAtMidnight :: TimeZone -> Day -> Integer -> ZonedTime
warpNDaysAtMidnight timeZone today daysToAdd =
  localTimeToZoned $
    LocalTime
      { localDay = addDays daysToAdd today,
        localTimeOfDay = midnight
      }
  where
    localTimeToZoned = utcToZonedTime timeZone . localTimeToUTC timeZone

Есть идеи, как мне найти и устранить проблему?

Кстати, весь проект можно посмотреть здесь: https://gitlab.com/projekt-dobos/jdb-api