Остановить утенка от выбора первого интервала после данного отрезка времени

Question

Предположим, что сегодняшняя дата - 23 июля 2019 года (фактически это дата исходного сообщения). Если бы мы с Даклингом обработали фразу типа "с января по февраль", утенок связал бы это со следующим годом: с января 2020 года по февраль 2020 года. Это связано с тем, что временной сегмент с января по февраль 2019 года уже в прошлом и следующем методе выбирается первый интервал после указанного временного сегмента.

Метод, который делает это следующим образом:

runTimeIntervalsPredicate
  :: TimeIntervalType -> Predicate
  -> Predicate -> SeriesPredicate
runTimeIntervalsPredicate intervalType pred1 pred2 = timeSeqMap True f pred1
  where
    -- Pick the first interval *after* the given time segment
    f thisSegment ctx = case runPredicate pred2 thisSegment ctx of
      (_, firstFuture:_) -> Just $
        timeInterval intervalType thisSegment firstFuture
      _ -> Nothing

Несмотря на то, что я вмешался в код Утка, чтобы приспособить его к потребностям платформы, я не очень беглый Хаскеллер, и это привело меня к остроумию.

Итак, вопрос здесь: как мне остановить этот сдвиг в сторону будущего диапазона дат?

Приложение: runPredicate тоже метод и выглядит так

runPredicate :: Predicate -> SeriesPredicate
runPredicate EmptyPredicate{} = \_ _ -> ([], [])
runPredicate (SeriesPredicate (NoShow p)) = p
runPredicate TimeDatePredicate{..}
  -- This should not happen by construction, but if it does then
  -- empty time series should be ok
  | isNothing tdHour && isJust tdAMPM = \_ _ -> ([], [])
runPredicate TimeDatePredicate{..} =
  foldr1 runCompose toCompose
  where
  -- runComposePredicate performs best when the first predicate is of
  -- smaller grain, that's why we order by grain here
  toCompose = catMaybes
    [ runSecondPredicate <$> tdSecond
    , runMinutePredicate <$> tdMinute
    , uncurry (runHourPredicate tdAMPM) <$> tdHour
    , runDayOfTheWeekPredicate <$> tdDayOfTheWeek
    , runDayOfTheMonthPredicate <$> tdDayOfTheMonth
    , runMonthPredicate <$> tdMonth
    , runYearPredicate <$> tdYear
    ]
runPredicate (IntersectPredicate pred1 pred2) =
  runIntersectPredicate pred1 pred2
runPredicate (TimeIntervalsPredicate ty pred1 pred2) =
  runTimeIntervalsPredicate ty pred1 pred2
runPredicate (ReplaceIntersectPredicate pred1 pred2 pred3) =
  runReplaceIntersectPredicate pred1 pred2 pred3

Должен также опубликовал timeSeqMap метод

-- | Applies `f` to each interval yielded by `g`.
-- | Intervals including "now" are in the future.
timeSeqMap
  :: Bool
     -- Given an interval and range, compute a single new interval
  -> (TimeObject -> TimeContext -> Maybe TimeObject)
     -- First-layer series generator
  -> Predicate
     -- Series generator for values that come from `f`
  -> SeriesPredicate