[#82] Remind time contexts and apply to time references

Problem: Sometimes, context of a time reference can be spread over one
sentence, several different sentences or even several different messages.

Solution: Parse contexts alone, remind them and apply to context-free time
references when encountered; track a context during thread evolution.

src/TzBot/BotMain.hs

@@ -92,8 +92,12 @@ run opts = do
       managed $ withTzCacheDefault defaultMessageInfoCachingTime
     bsReportEntries <-
       managed $ withTzCacheDefault cCacheReportDialog
-    -- auto-acknowledge received messages
+
+    let defaultConversationStateCachingTime = hour 12
+    bsConversationStateCache <-
+      managed $ withTzCacheDefault defaultConversationStateCachingTime
     (bsLogNamespace, bsLogContext, bsLogEnv) <- managed $ withLogger cLogLevel
+    -- auto-acknowledge received messages
     liftIO $ runSocketMode sCfg $ handler gracefulShutdownContainer BotState {..}
 
 withFeedbackConfig :: BotConfig -> (FeedbackConfig -> IO a) -> IO a

src/TzBot/ProcessEvents/Common.hs

@@ -4,7 +4,7 @@
 
 module TzBot.ProcessEvents.Common
   ( openModalCommon
-  , getTimeReferencesFromMessage
+  , getTimeReferencesAndNewStateFromMessage
 
     -- * exported for tests
   , ignoreCodeBlocksManually
@@ -18,15 +18,17 @@ import Data.Text qualified as T
 import Fmt (listF)
 import Text.Interpolation.Nyan (int, rmode')
 
+import TzBot.Cache qualified as Cache
 import TzBot.Feedback.Dialog (insertDialogEntry)
 import TzBot.Feedback.Dialog.Types
 import TzBot.Logger
 import TzBot.Parser (parseTimeRefs)
 import TzBot.Render (TranslationPairs, asForModalM, renderAllTP, renderTemplate)
-import TzBot.Slack (BotM, getUserCached, startModal)
+import TzBot.Slack (BotM, BotState(bsMessageCache), getUserCached, startModal)
 import TzBot.Slack.API
 import TzBot.Slack.API.MessageBlock
   (UnknownBlockElementLevel2Error(ubeType), extractPieces, splitExtractErrors)
+import TzBot.TimeContext
 import TzBot.TimeReference (TimeReference)
 import TzBot.Util (WithUnknown(unUnknown))
 
@@ -45,7 +47,9 @@ openModalCommon
 openModalCommon message channelId whoTriggeredId triggerId mkModalFunc = do
   let msgText = mText message
       msgTimestamp = mTs message
-  mbTimeRefs <- nonEmpty <$> getTimeReferencesFromMessage message
+  mbTimeRefs <- fmap (nonEmpty . fst) $
+    asks bsMessageCache >>= Cache.fetchWithCache msgId \_ ->
+      getTimeReferencesAndNewStateFromMessage emptyTimeContext message
   sender <- getUserCached $ mUser message
   translationPairs <- fmap join $ forM mbTimeRefs $ \neTimeRefs -> do
       whoTriggered <- getUserCached whoTriggeredId
@@ -66,14 +70,22 @@ openModalCommon message channelId whoTriggeredId triggerId mkModalFunc = do
   insertDialogEntry guid metadata
   let modal = mkModalFunc msgText translationPairs guid
   startModal $ OpenViewReq modal triggerId
+  where
+    msgId = mMessageId message
 
 -- | Extract separate text pieces from the Slack message that can contain
 -- the whole time reference and try to find time references inside them.
-getTimeReferencesFromMessage
-  :: Message
-  -> BotM [TimeReference]
-getTimeReferencesFromMessage message =
-  concatMap parseTimeRefs <$> getTextPiecesFromMessage message
+-- Old context (date, timezone, offset, etc.) is used for processing
+-- and new one is produced.
+getTimeReferencesAndNewStateFromMessage
+  :: TimeContext
+  -> Message
+  -> BotM ([TimeReference], TimeContext)
+getTimeReferencesAndNewStateFromMessage oldState message = do
+  pieces <- getTextPiecesFromMessage message
+  pure $
+    first concat $
+      runState (mapM parseTimeRefs pieces) oldState
 
 -- | Extract separate text pieces from the Slack message that can contain
 -- the whole time reference. The main way is analyzing the message's block

src/TzBot/ProcessEvents/Message.hs

@@ -19,12 +19,13 @@ import UnliftIO qualified
 import TzBot.Cache qualified as Cache
 import TzBot.Config (Config(..))
 import TzBot.Logger
-import TzBot.ProcessEvents.Common (getTimeReferencesFromMessage)
+import TzBot.ProcessEvents.Common
 import TzBot.Render
 import TzBot.Slack
 import TzBot.Slack.API
 import TzBot.Slack.Events
 import TzBot.Slack.Fixtures qualified as Fixtures
+import TzBot.TimeContext
 import TzBot.TimeReference (TimeReference(..))
 import TzBot.Util (whenT, withMaybe)
 
@@ -80,19 +81,16 @@ processMessageEvent evt =
   katipAddContext (MessageContext msgId) $
   whenJustM (filterMessageTypeWithLog evt) $ \mEventType ->
   whenJustM (withSenderNotBot evt) $ \sender -> do
-    timeRefs <- getTimeReferencesFromMessage msg
-    processMessageEvent' evt mEventType sender timeRefs
+    processMessageEvent' evt mEventType sender
   where
-  msg = meMessage evt
   msgId = mMessageId $ meMessage evt
 
 processMessageEvent'
   :: MessageEvent
   -> MessageEventType
   -> User
-  -> [TimeReference]
   -> BotM ()
-processMessageEvent' evt mEventType sender timeRefs =
+processMessageEvent' evt mEventType sender =
   case meChannelType evt of
     Just CTDirectChannel -> handleDirectMessage
     _ -> case mEventType of
@@ -155,25 +153,52 @@ processMessageEvent' evt mEventType sender timeRefs =
           }
     sendEphemeralMessage req
 
+  -- threadId is the same as its parent's messageId,
+  -- so use messageId if there's no thread yet
+  getMessageThreadId :: ThreadId
+  getMessageThreadId = fromMaybe (ThreadId $ unMessageId msgId) mbThreadId
+
   handleMessageChanged :: BotM ()
   handleMessageChanged = katipAddNamespaceText "edit" do
     messageRefsCache <- asks bsMessageCache
-    mbMessageRefs <- Cache.lookup msgId messageRefsCache
+    convStateCache <- asks bsConversationStateCache
+    mbMessageRefsAndState <- Cache.lookup msgId messageRefsCache
     -- if not found or expired, just ignore this message
     -- it's too old or just didn't contain any time refs
-    whenJust mbMessageRefs $ \oldRefs -> do
-      let newRefsFound = not $ all (`elem` oldRefs) timeRefs
+    whenJust mbMessageRefsAndState $ \(oldRefs, stateBefore) -> do
+      (newRefs, stateAfter) <-
+        getTimeReferencesAndNewStateFromMessage stateBefore msg
+      mbConversationState <- Cache.lookup getMessageThreadId convStateCache
+      -- If the conversation state was defined after processing this
+      -- message, we should update it.
+      whenJust mbConversationState \(lastMsgId, _conversationState) ->
+        when (lastMsgId == msgId) $
+          Cache.insert getMessageThreadId (msgId, stateAfter) convStateCache
+
+      let newRefsFound = not $ all (`elem` oldRefs) newRefs
       -- no new references found, ignoring
-      when newRefsFound $ withNonEmptyTimeRefs timeRefs \neTimeRefs -> do
-        Cache.insert msgId timeRefs messageRefsCache
+      when newRefsFound $ withNonEmptyTimeRefs newRefs \neTimeRefs -> do
+        -- This cache always keeps only "before" state in order to correctly
+        -- translate further edits.
+        Cache.insert msgId (newRefs, stateBefore) messageRefsCache
         permalink <- getMessagePermalinkCached channelId msgId
         handleChannelMessageCommon (Just permalink) neTimeRefs
 
   handleNewMessage :: BotM ()
   handleNewMessage = do
-    withNonEmptyTimeRefs timeRefs $ \neTimeRefs -> do
+    convStateCache <- asks bsConversationStateCache
+    conversationState <-
+      fmap (fromMaybe emptyTimeContext . fmap snd . join) $
+        traverse (\t -> Cache.lookup t convStateCache) mbThreadId
+    (timeRefs, newState) <-
+      getTimeReferencesAndNewStateFromMessage conversationState msg
+    when (not $ null timeRefs) $
       -- save message only if time references are present
-      asks bsMessageCache >>= Cache.insert msgId timeRefs
+      asks bsMessageCache >>= Cache.insert msgId (timeRefs, newState)
+    Cache.insert getMessageThreadId (msgId, newState) convStateCache
+    asks bsMessageCache >>= Cache.insert msgId (timeRefs, conversationState)
+
+    withNonEmptyTimeRefs timeRefs $ \neTimeRefs -> do
       handleChannelMessageCommon Nothing neTimeRefs
 
   handleChannelMessageCommon :: Maybe Text -> NonEmpty TimeReference -> BotM ()
@@ -195,8 +220,9 @@ processMessageEvent' evt mEventType sender timeRefs =
     ephemeralsMailing channelId sendActionLocal
 
   handleDirectMessage :: BotM ()
-  handleDirectMessage =
-    when (mEventType /= METMessageEdited) $
+  handleDirectMessage = when (mEventType /= METMessageEdited) $ do
+    (timeRefs, _stateAfter) <-
+      getTimeReferencesAndNewStateFromMessage emptyTimeContext msg
     withNonEmptyTimeRefs timeRefs $ \neTimeRefs -> do
     -- According to
     -- https://forums.slackcommunity.com/s/question/0D53a00008vsItQCAU

src/TzBot/RunMonad.hs

@@ -17,6 +17,7 @@ import TzBot.Cache (TzCache)
 import TzBot.Config.Types (BotConfig)
 import TzBot.Feedback.Dialog.Types (ReportDialogEntry, ReportDialogId)
 import TzBot.Slack.API
+import TzBot.TimeContext (TimeContext)
 import TzBot.TimeReference
 import TzBot.Util (postfixFields)
 
@@ -32,8 +33,13 @@ data BotState = BotState
   , bsUserInfoCache  :: TzCache UserId User
   , bsConversationMembersCache :: TzCache ChannelId (S.Set UserId)
   , bsReportEntries  :: TzCache ReportDialogId ReportDialogEntry
-  , bsMessageCache   :: TzCache MessageId [TimeReference]
+  , bsMessageCache   :: TzCache MessageId ([TimeReference], TimeContext)
+    -- ^ Used for keeping relevant time references and conversation state
+    -- that was _before_ this message, i.e. applied to time refs of this message.
   , bsMessageLinkCache :: TzCache MessageId Text
+  , bsConversationStateCache :: TzCache ThreadId (MessageId, TimeContext)
+    -- ^ State of a thread: current state and ID of a message which is origin
+    -- of that state
   , bsLogNamespace   :: K.Namespace
   , bsLogContext     :: K.LogContexts
   , bsLogEnv         :: K.LogEnv

src/TzBot/Slack/API.hs

@@ -194,7 +194,7 @@ instance FromJSON ChannelType where
 
 newtype ThreadId = ThreadId { unThreadId :: Text }
   deriving stock (Eq, Show)
-  deriving newtype (ToHttpApiData, FromJSON, ToJSON, Buildable)
+  deriving newtype (ToHttpApiData, FromJSON, ToJSON, Buildable, Hashable)
 
 newtype MessageId = MessageId { unMessageId :: Text }
   deriving stock (Eq, Show, Ord)

src/TzBot/TimeContext.hs

@@ -0,0 +1,23 @@
+
+-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+module TzBot.TimeContext where
+
+import Universum hiding (many, toList, try)
+
+import Control.Lens.TH (makeLensesWith)
+import TzBot.Instances ()
+import TzBot.TimeReference
+import TzBot.Util
+
+data TimeContext = TimeContext
+  { tcCurrentDateRef :: Maybe DateReference
+  , tcCurrentLocRef :: Maybe LocationReference
+  } deriving stock (Show, Eq, Generic)
+
+emptyTimeContext :: TimeContext
+emptyTimeContext = TimeContext Nothing Nothing
+
+makeLensesWith postfixFields ''TimeContext

tzbot.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.7.
+-- This file has been generated from package.yaml by hpack version 0.35.1.
 --
 -- see: https://github.com/sol/hpack
 
@@ -54,6 +54,7 @@ library
       TzBot.Slack.Events.ViewPayload
       TzBot.Slack.Fixtures
       TzBot.Slack.Modal
+      TzBot.TimeContext
       TzBot.TimeReference
       TzBot.Util
   other-modules: