I am currently working on a sort of reservation system that needs to generate availabilities. A key requirement is thus to generate different lists of times in a given range.
data TimeslotGenMode
= Monthly
| Daily
| WorkDays
| Weekends
| Hourly
| FiveMinutes
| Minute
| TenMinutes
| FifteenMinutes
deriving (Eq, Generic, FromJSON, ToJSON, ToSchema)
So if some request comes in with "Hourly" then we will get current time, and calculate all 1 hour ranges between 2 hours ago and 60 hours later, for example.
I want to work with this data type or something like this:
data TimeRange = TimeRange
{ slotStart :: !ZonedTime,
slotEnd :: !ZonedTime
}
deriving (Show, Generic, FromJSON, ToJSON, ToSchema)
makeFieldLabelsNoPrefix ''TimeRange
In my example, the "Daily" mode works perfectly fine, but the "Hourly" somehow has a TERRIBLE memory leak, to the point that it fills my 64GB RAM and then proceeds to crash.
I tried to change some things betweeen hourly and daily, also to using a list comprehension but it's not really helping.
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
Any idea how I could go about finding and fixing the problem ?
btw see the entire project here: https://gitlab.com/projekt-dobos/jdb-api
i
is inferred to be of type Pico
(i.e. fixed-point number with 1e-12 precision).
addSecondsToZonedTime :: TimeZone -> ZonedTime -> Pico -> ZonedTime
so when you do
[mkAdvanceRange timeZone . addSecondsToZonedTime timeZone now $ (i * 3600) | i <- [0 .. hoursInAdvanceToShow]]
it makes the list comprehension go in steps of 1e-12, which means your range is 5 trillion elements long.