[Fix] Slight refactor of render part (#56)

Changes:
1. Remove button from section builders as it's never needed;
2. Add separate datatype for sender flag instead of plain Bool;
3. Replace plain text with markdown in the Slack section block;
4. Add functions for converting to offset time/back;
5. Unite fields of TimeReferenceToUtcResult for convenience.

Author: YuriRomanowski

src/TzBot/Feedback/Save.hs

@@ -19,7 +19,7 @@ import Data.Time.Zones.All (toTZName)
 import Text.Interpolation.Nyan (int, rmode')
 
 import TzBot.Logger
-import TzBot.Render (TranslationPairs, renderSlackBlocks)
+import TzBot.Render (TranslationPairs, asForOthersS, renderSlackBlocks)
 import TzBot.RunMonad
 import TzBot.Slack (sendMessage)
 import TzBot.Slack.API
@@ -53,22 +53,21 @@ saveFeedbackSlack entry channelId = sendMessage req
     req = do
       -- We always render the translation for other users (not author),
       -- so the author can see how his message is translated for others
-      let forSender = False
-          pmrChannel = channelId
+      let pmrChannel = channelId
           pmrText = "New user feedback"
           pmrBlocks = NE.nonEmpty $
             [ BHeader (Header "Message")
-            , BSection (textSection (PlainText $ feMessageText entry) Nothing)
+            , BSection $ markdownSection (Mrkdwn $ feMessageText entry)
             , BDivider divider
             , BHeader (Header "Time translation")
-            ] <> renderSlackBlocks forSender (feTimeTranslation entry)
+            ] <> renderSlackBlocks asForOthersS (feTimeTranslation entry)
             <>
             [ BDivider divider
             , BHeader (Header "Details")
-            , BSection $ fieldsSection Nothing Nothing $
+            , BSection $ fieldsSection Nothing $
               ("Message timestamp", show $ feMessageTimestamp entry) :|
-              [ ("Sender timezone", PlainText $ cs $ toTZName $ feSenderTimezone entry)
-              , ("User report", PlainText $ feUserReport entry)
+              [ ("Sender timezone", Mrkdwn $ cs $ toTZName $ feSenderTimezone entry)
+              , ("User report", Mrkdwn $ feUserReport entry)
               ]
             ]
       PostMessageReq {..}

src/TzBot/ProcessEvents/Message.hs

@@ -124,7 +124,7 @@ processMessageEvent evt =
 
     let now = meTs evt
         channelId = meChannel evt
-    let sendAction :: Bool -> TranslationPairs -> UserId -> BotM ()
+    let sendAction :: SenderFlag -> TranslationPairs -> UserId -> BotM ()
         sendAction toSender transl userId = do
           let req = PostEphemeralReq
                 { perUser = userId
@@ -133,7 +133,7 @@ processMessageEvent evt =
                 , perText = joinTranslationPairs toSender transl
                 , perBlocks = NE.nonEmpty $
                   renderSlackBlocks toSender (Just transl) <>
-                  [ BSection $ markdownSection (Mrkdwn Fixtures.helpUsage) Nothing
+                  [ BSection $ markdownSection (Mrkdwn Fixtures.helpUsage)
                     | whetherToShowHelpCmd
                   ]
                 }
@@ -152,15 +152,15 @@ processMessageEvent evt =
         let ephemeralMessage = renderAllForOthersTP sender ephemeralTemplate
         logInfo [int||Received message from the DM, sending translation \
                               to the author|]
-        sendAction False ephemeralMessage (uId sender)
+        sendAction asForOthersS ephemeralMessage (uId sender)
       _ -> do
         usersInChannelIds <- getChannelMembersCached channelId
 
         whenJust (renderErrorsForSenderTP ephemeralTemplate) $ \errorsMsg -> do
           logInfo
             [int||Found invalid time references, \
                       sending an ephemeral with them to the message sender|]
-          sendAction True errorsMsg (uId sender)
+          sendAction asForSenderS errorsMsg (uId sender)
 
         let notBotAndSameTimeZone u = not (uIsBot u) && uTz u /= uTz sender
             notSender userId = userId /= uId sender
@@ -172,7 +172,7 @@ processMessageEvent evt =
           then do
             userInChannel <- getUserCached userInChannelId
             let ephemeralMessage = renderAllForOthersTP userInChannel ephemeralTemplate
-            sendAction False ephemeralMessage (uId userInChannel)
+            sendAction asForOthersS ephemeralMessage (uId userInChannel)
             pure True
           else do
             let whenT :: (Monad m) => Bool -> m Bool -> m Bool
@@ -181,7 +181,7 @@ processMessageEvent evt =
               userInChannel <- getUserCached userInChannelId
               whenT (notBotAndSameTimeZone userInChannel) $ do
                 let ephemeralMessage = renderAllForOthersTP userInChannel ephemeralTemplate
-                sendAction False ephemeralMessage (uId userInChannel)
+                sendAction asForOthersS ephemeralMessage (uId userInChannel)
                 pure True
 
         let failedMsg = "Ephemeral sending failed" :: Builder

src/TzBot/Render.hs

@@ -22,6 +22,11 @@ module TzBot.Render
 
     -- * General template
   , renderTemplate
+
+    -- * Flags
+  , SenderFlag
+  , asForSenderS
+  , asForOthersS
   ) where
 
 import Universum
@@ -38,7 +43,7 @@ import Data.Time.Zones.All (TZLabel)
 import Text.Interpolation.Nyan (int, rmode')
 
 import TzBot.Instances ()
-import TzBot.Slack.API (Mrkdwn(Mrkdwn), PlainText(..), User(uTz))
+import TzBot.Slack.API (Mrkdwn(Mrkdwn), User(uTz))
 import TzBot.Slack.API.Block
 import TzBot.TimeReference
 import TzBot.Util
@@ -66,10 +71,20 @@ type TranslationPairs = NE.NonEmpty TranslationPair
 
 newtype Template = Template { unTemplate :: NE.NonEmpty EitherTemplateUnit }
 
-chooseNote :: Bool -> TranslationPair -> Maybe Text
-chooseNote sender = if sender then tuNoteForSender else tuNoteForOthers
+--------
+-- Notes
+-- | Used for choosing between two notes
+newtype SenderFlag = SenderFlag Bool
+
+asForSenderS, asForOthersS :: SenderFlag
+asForSenderS = SenderFlag True
+asForOthersS = SenderFlag False
+
+chooseNote :: SenderFlag -> TranslationPair -> Maybe Text
+chooseNote (SenderFlag sender) = if sender then tuNoteForSender else tuNoteForOthers
 
-concatTranslationPair :: Bool -> TranslationPair -> Builder
+--------
+concatTranslationPair :: SenderFlag -> TranslationPair -> Builder
 concatTranslationPair sender t@TranslationPair {..} = do
   let rightNote = chooseNote sender t
   let note = maybe "" (("\n" <>) . fromText) rightNote
@@ -89,33 +104,31 @@ noRefsFoundMsg = "No time references found."
 
 -- Render text
 renderErrorsForSender :: Template -> Maybe Text
-renderErrorsForSender template = do
-  let sender = True
-  joinTranslationPairs sender <$> renderErrorsForSenderTP template
+renderErrorsForSender template =
+  joinTranslationPairs asForSenderS <$> renderErrorsForSenderTP template
 
 renderAllForOthers :: User -> Template -> Text
-renderAllForOthers user = do
-  let sender = False
-  joinTranslationPairs sender . renderAllForOthersTP user
+renderAllForOthers user =
+  joinTranslationPairs asForOthersS . renderAllForOthersTP user
 
-joinTranslationPairs :: Bool -> TranslationPairs -> Text
+joinTranslationPairs :: SenderFlag -> TranslationPairs -> Text
 joinTranslationPairs sender =
   T.toStrict . toLazyText . fold . NE.toList
     . NE.map ((<> singleton '\n') . concatTranslationPair sender)
 
 -- Render Slack block
-renderSlackBlocks :: Bool -> Maybe TranslationPairs -> [Block]
+renderSlackBlocks :: SenderFlag -> Maybe TranslationPairs -> [Block]
 renderSlackBlocks forSender =
   maybe [noRefsFoundSection]
     (intercalate [BDivider divider] . NE.toList . NE.map mkTranslationBlocks)
   where
-    noRefsFoundSection = BSection $ textSection (PlainText noRefsFoundMsg) Nothing
+    noRefsFoundSection = BSection $ markdownSection $ Mrkdwn noRefsFoundMsg
     mkTranslationBlocks :: TranslationPair -> [Block]
     mkTranslationBlocks timeRef = do
-      let t = (PlainText $ tuTimeRef timeRef, PlainText $ tuTranslation timeRef)
+      let t = (Mrkdwn $ tuTimeRef timeRef, Mrkdwn $ tuTranslation timeRef)
           mbNote = chooseNote forSender timeRef
-          translationBlock = BSection $ fieldsSection Nothing Nothing $ NE.singleton t
-          mkNoteBlock note = BSection $ markdownSection (Mrkdwn note) Nothing
+          translationBlock = BSection $ fieldsSection Nothing $ NE.singleton t
+          mkNoteBlock note = BSection $ markdownSection (Mrkdwn note)
       withMaybe mbNote [translationBlock] $ \note -> [translationBlock, mkNoteBlock note]
 
 renderTemplate :: UTCTime -> User -> NE.NonEmpty TimeReference -> Template
@@ -132,7 +145,7 @@ renderEphemeralMessageTranslationPair
   -> (TimeReference, TimeReferenceToUTCResult)
   -> EitherTemplateUnit
 renderEphemeralMessageTranslationPair now sender (timeRef, result) = case result of
-  TRTUSuccess utcTime _offsetInfo -> do
+  TRTUSuccess (TimeRefSuccess utcTime _offsetInfo) -> do
     let mbSenderTimeZone =
           guard (isNothing $ trLocationRef timeRef)
             $> (uTz sender) :: Maybe TZLabel
@@ -145,7 +158,7 @@ renderEphemeralMessageTranslationPair now sender (timeRef, result) = case result
         [int||#{renderedUserTime} in #{userTzLabel}|]
         Nothing
         Nothing
-  TRTUAmbiguous implicitSenderTimezone tzLabel -> do
+  TRTUAmbiguous (TimeShiftErrorInfo implicitSenderTimezone tzLabel) -> do
     let shownTZ = shownTimezone implicitSenderTimezone tzLabel
     Left $ TranslationPair
       { tuTimeRef = trText timeRef
@@ -159,7 +172,7 @@ renderEphemeralMessageTranslationPair now sender (timeRef, result) = case result
              time, and this particular timestamp can be possible with \
              different offsets._|]
       }
-  TRTUInvalid implicitSenderTimezone tzLabel -> do
+  TRTUInvalid (TimeShiftErrorInfo implicitSenderTimezone tzLabel) -> do
     let shownTZ = shownTimezone implicitSenderTimezone tzLabel
     Left $ TranslationPair
       { tuTimeRef = trText timeRef

src/TzBot/Slack/API/Block.hs

@@ -12,7 +12,6 @@ module TzBot.Slack.API.Block
   , ActionId(..)
   , BlockId(..)
   , Section
-  , textSection
   , markdownSection
   , fieldsSection
   , Divider(..)
@@ -27,7 +26,7 @@ import Data.List.NonEmpty qualified as NE
 import Formatting (Buildable)
 
 import TzBot.Instances ()
-import TzBot.Slack.API.Common (Mrkdwn, PlainText, TextObject(TOMarkdownText, TOPlainText))
+import TzBot.Slack.API.Common (Mrkdwn(..), PlainText)
 import TzBot.Util (SumWrapper(..), TypedWrapper(..), neConcatMap)
 
 newtype ActionId = ActionId { unActionId :: Text }
@@ -51,21 +50,18 @@ data Block
 
 -- | See https://api.slack.com/reference/block-kit/blocks#section
 data Section = Section
-  { sText :: Maybe TextObject
+  { sText :: Maybe Mrkdwn
   , sAccessory :: Maybe Button
-  , sFields :: Maybe (NE.NonEmpty PlainText)
+  , sFields :: Maybe (NE.NonEmpty Mrkdwn)
   } deriving stock (Eq, Show, Generic)
     deriving ToJSON via TypedWrapper Section
 
-textSection :: PlainText -> Maybe Button -> Section
-textSection text mbButton = Section (Just $ TOPlainText text) mbButton Nothing
+markdownSection :: Mrkdwn -> Section
+markdownSection markdown = Section (Just markdown) Nothing Nothing
 
-markdownSection :: Mrkdwn -> Maybe Button -> Section
-markdownSection markdown mbButton = Section (Just $ TOMarkdownText markdown) mbButton Nothing
-
-fieldsSection :: Maybe TextObject -> Maybe Button -> NE.NonEmpty (PlainText, PlainText) -> Section
-fieldsSection mbText mbButton fields =
-  Section mbText mbButton $ Just $ neConcatMap (\(x, y) -> x :| [y]) fields
+fieldsSection :: Maybe Mrkdwn -> NE.NonEmpty (Mrkdwn, Mrkdwn) -> Section
+fieldsSection mbText fields =
+  Section mbText Nothing $ Just $ neConcatMap (\(x, y) -> x :| [y]) fields
 
 -- | See https://api.slack.com/reference/block-kit/blocks#divider
 data Divider = Divider

src/TzBot/Slack/Modal.hs

@@ -10,7 +10,7 @@ import Data.List (singleton)
 
 import TzBot.Feedback.Dialog.Types
 import TzBot.Instances ()
-import TzBot.Render (TranslationPairs, renderSlackBlocks)
+import TzBot.Render (TranslationPairs, asForOthersS, renderSlackBlocks)
 import TzBot.Slack.API
 import TzBot.Slack.Fixtures qualified as Fixtures
 
@@ -64,13 +64,12 @@ mkBlocks :: Text -> Maybe TranslationPairs -> Block -> [Block]
 mkBlocks shownMessageText translatedMessage block =
   -- We always render the translation for other users (not author),
   -- so the author can see how his message is translated for others
-  let forSender = False in
   [ BHeader Header { hText = PlainText "Message text" }
-  , BSection $ textSection (PlainText shownMessageText) Nothing
+  , BSection $ markdownSection (Mrkdwn shownMessageText)
   , BDivider divider
   , BHeader Header { hText = PlainText "Time references" }
   ]
-  <> renderSlackBlocks forSender translatedMessage
+  <> renderSlackBlocks asForOthersS translatedMessage
   <> [ BDivider divider
   , block
   ]

src/TzBot/TimeReference.hs

@@ -84,6 +84,14 @@ utcToUtcLocalTime = utcToLocalTime utc
 utcLocalTimeToUTC :: LocalTime -> UTCTime
 utcLocalTimeToUTC = localTimeToUTC utc
 
+convertUtcToOffsetTime :: Offset -> UTCTime -> LocalTime
+convertUtcToOffsetTime offset utcTime =
+  addLocalTime (offsetToNominalDiffTime offset) (utcToUtcLocalTime utcTime)
+
+convertOffsetTimeToUtc :: Offset -> LocalTime -> UTCTime
+convertOffsetTimeToUtc offset localTime =
+  utcLocalTimeToUTC $ addLocalTime (negate $ offsetToNominalDiffTime offset) localTime
+
 {- | Converts a time reference to a moment in time (expressed in UTC).
 
   If the time reference contains a timezone abbreviation, and if that abbreviation\
@@ -105,29 +113,29 @@ timeReferenceToUTC sendersTZLabel eventTimestamp TimeReference {..} =
       -- In the case of rigid offset we don't need the `modifyLocal` from
       -- from the `tztime` package because there are no timeshifts that
       -- we should take into account. So we just use plain LocalTime.
-      let eventTimeUTC = utcToUtcLocalTime eventTimestamp
-          offsetNominal = offsetToNominalDiffTime offset
-      let refTimeUTC = eventTimeUTC & (
-            addLocalTime offsetNominal
+      let refTimeUTC = eventTimestamp & (
+            convertUtcToOffsetTime offset
             >>> dayTransition
             >>> TZT.atTimeOfDay trTimeOfDay
-            >>> addLocalTime (negate offsetNominal)
+            >>> convertOffsetTimeToUtc offset
             )
-      TRTUSuccess (utcLocalTimeToUTC refTimeUTC) (Right offset)
+      TRTUSuccess $ TimeRefSuccess refTimeUTC (Right offset)
     Right (Left (tzLabel, implicitSenderTimezone)) -> do
       let eventLocalTime = TZT.fromUTC (TZI.fromLabel tzLabel) eventTimestamp
       let eithRefTime = eventLocalTime & TZT.modifyLocalStrict (
             dayTransition >>> TZT.atTimeOfDay trTimeOfDay
             )
       case eithRefTime of
         Left err -> tzErrorToResult implicitSenderTimezone tzLabel err
-        Right refTime -> TRTUSuccess (TZT.toUTC refTime) (Left tzLabel)
+        Right refTime -> TRTUSuccess $ TimeRefSuccess (TZT.toUTC refTime) (Left tzLabel)
 
   where
   tzErrorToResult :: Bool -> TZLabel -> TZT.TZError -> TimeReferenceToUTCResult
   tzErrorToResult implicitSenderTimezone tzLabel = \case
-    TZT.TZOverlap {} -> TRTUAmbiguous implicitSenderTimezone tzLabel
-    TZT.TZGap {}     -> TRTUInvalid implicitSenderTimezone tzLabel
+    TZT.TZOverlap {} -> TRTUAmbiguous $
+      TimeShiftErrorInfo implicitSenderTimezone tzLabel
+    TZT.TZGap {}     -> TRTUInvalid $
+      TimeShiftErrorInfo implicitSenderTimezone tzLabel
 
   -- This doesn't include setting time, only date changes
   dayTransition :: LocalTime -> LocalTime
@@ -209,21 +217,27 @@ chooseBestYear dayOfMonth monthOfYear now = do
       sortedCandidates = NE.sortBy (compare `on` calcWeight) candidates
   NE.head sortedCandidates
 
-type IsImplicitSenderTimezone = Bool
+data TimeRefSuccess = TimeRefSuccess
+  { trsUtcResult      :: UTCTime
+    -- ^ The result of the conversion.
+  , trsEithTzOffset   :: Either TZLabel Offset
+    -- ^ The timezone or offset that this TimeReference is related to.
+    -- When the `TimeReference` does not explicitly mention a timezone/offset,
+    -- we assume it's related to the sender's timezone.
+  } deriving stock (Eq, Show)
+
+data TimeShiftErrorInfo = TimeShiftErrorInfo
+  { tseiIsImplicitSenderTimezone :: Bool
+  , tseiRefTimeZone :: TZLabel
+  } deriving stock (Eq, Show)
 
 data TimeReferenceToUTCResult
-  = TRTUSuccess
+  = TRTUSuccess TimeRefSuccess
     -- ^ Conversion succeeded.
-      UTCTime
-      -- ^ The result of the conversion.
-      (Either TZLabel Offset)
-      -- ^ The timezone or offset that this TimeReference is related to.
-      -- When the `TimeReference` does not explicitly mention a timezone/offset,
-      -- we assume it's related to the sender's timezone.
-  | TRTUAmbiguous IsImplicitSenderTimezone TZLabel
+  | TRTUAmbiguous TimeShiftErrorInfo
   -- ^ The time reference was ambiguous (e.g. due to a time ocurring twice in the same timezone during DST changes).
   -- See [Edge cases & pitfalls](https://github.com/serokell/tzbot/blob/main/docs/pitfalls.md#ambiguous-times).
-  | TRTUInvalid IsImplicitSenderTimezone TZLabel
+  | TRTUInvalid TimeShiftErrorInfo
   -- ^ The time reference was invalid (e.g. due to a time being skipped in a timezone during DST changes).
   -- See [Edge cases & pitfalls](https://github.com/serokell/tzbot/blob/main/docs/pitfalls.md#invalid-times).
   | TRTUInvalidTimeZoneAbbrev TimeZoneAbbreviation