Haskell处理ZonedTime时的内存泄漏问题排查与修复咨询

问题说明 #

开发预订系统时，Daily模式生成时段完全正常，但Hourly模式会出现严重内存泄漏，占满64GB内存后崩溃。核心代码如上所示，需求为Hourly模式生成过去2小时至未来60小时的1小时时段范围。

根源分析 #

1. 惰性求值导致闭包累积：Hourly模式的列表推导式中，每个时段都基于原始now计算时间偏移，大量未求值的闭包（包含now、timeZone等引用）被保留在列表中，GC无法及时回收，最终导致内存爆炸。而Daily模式基于轻量的Day类型计算，中间对象简洁，GC压力小。
2. 不必要的高精度类型开销：addSecondsToZonedTime使用Pico（高精度浮点数）传递秒数，多次转换会产生冗余内存开销；Daily模式用固定整数秒数，转换效率更高。
3. 参数与需求不匹配：当前代码中hoursInAdvanceToShow=5、hoursInPastToShow=-4，和需求的“过去2小时、未来60小时”不符，虽不是泄漏根源，但会导致生成时段数量错误。

修复方案 #

方案1：重构时段生成逻辑，避免闭包冗余 #

改为从基准整点开始，通过迭代生成连续时段，减少重复计算和闭包引用：

availabilityFromMode Hourly = do
  now <- liftIO getZonedTime
  tz <- liftIO getCurrentTimeZone
  
  -- 计算过去2小时的整点作为起始点
  let nowUTC = zonedTimeToUTC now
      nowLocal = utcToLocalTime tz nowUTC
      -- 回退到当前小时的整点，再减2小时
      startLocal = nowLocal { localTimeOfDay = TimeOfDay (todHour (localTimeOfDay nowLocal) - 2) 0 0 }
      startUTC = localTimeToUTC tz startLocal
      startZoned = utcToZonedTime tz startUTC
  
  -- 生成62个连续时段（2小时过去 + 60小时未来）
  let ranges = take 62 $ iterate nextHour (mkHourSlot startZoned)
  pure ranges
  where
    -- 生成下一个时段
    nextHour (TimeRange _ end) = mkHourSlot end
    -- 创建单个小时时段
    mkHourSlot start = TimeRange
      { slotStart = start,
        slotEnd = addSecs start 3600
      }
    -- 优化时间偏移函数，用Integer代替Pico
    addSecs :: ZonedTime -> Integer -> ZonedTime
    addSecs zt secs =
      let utc = zonedTimeToUTC zt
          newUTC = addUTCTime (fromIntegral secs :: NominalDiffTime) utc
      in utcToZonedTime (zonedTimeZone zt) newUTC

方案2：强制严格求值，清除惰性闭包 #

如果保留原有结构，通过force强制列表元素完全求值，避免闭包累积：

import Control.DeepSeq (force)

availabilityFromMode Hourly = do
  now <- liftIO getZonedTime
  tz <- liftIO getCurrentTimeZone

  -- 修正参数匹配需求：过去2小时到未来60小时
  let advancedRanges = [mkAdvance tz $ addSecs now (i * 3600) | i <- [0..60]]
      previousRanges = [mkPrevious tz $ addSecs now (i * 3600) | i <- [-2..0]]
      allRanges = previousRanges ++ advancedRanges
  
  pure $ force allRanges  -- 强制严格求值，避免惰性闭包
  where
    mkPrevious tz moment = TimeRange (addSecs moment (-3600)) moment
    mkAdvance tz moment = TimeRange moment (addSecs moment 3600)
    addSecs zt secs =
      let utc = zonedTimeToUTC zt
          newUTC = addUTCTime (fromIntegral secs :: NominalDiffTime) utc
      in utcToZonedTime (zonedTimeZone zt) newUTC

方案3：优化时间转换函数 #

将addSecondsToZonedTime的参数从Pico改为Integer，消除高精度浮点数的开销：

addSecondsToZonedTime :: TimeZone -> ZonedTime -> Integer -> ZonedTime
addSecondsToZonedTime zone zt seconds =
  let utc = zonedTimeToUTC zt
      diff = fromIntegral seconds :: NominalDiffTime
  in utcToZonedTime zone (addUTCTime diff utc)

验证方法 #

1. 用GHC profiling工具分析：编译时加ghc -prof -fprof-auto -rtsopts，运行时加+RTS -h -i0.1生成堆快照，用hp2ps转换为图片查看内存占用趋势。
2. 对比修复前后的内存使用，确认泄漏是否消失。

内容的提问来源于stack exchange，提问作者Josep Bigorra