content: {-# LANGUAGE RankNTypes #-}
  module Matterhorn.Draw.MessageInterface
    ( drawMessageInterface
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import           Brick
  import           Brick.Keybindings
  import           Brick.Focus ( withFocusRing )
  import           Brick.Widgets.Border
  import           Brick.Widgets.Border.Style
  import           Brick.Widgets.Center
  import           Brick.Widgets.List ( listElements, listSelectedElement, renderList )
  import           Brick.Widgets.Edit ( editContentsL, renderEditor, getEditContents )
  import           Data.Char ( isSpace, isPunctuation )
  import qualified Data.Foldable as F
  import           Data.List ( intersperse )
  import           Data.Maybe ( fromJust )
  import qualified Data.Sequence as Seq
  import qualified Data.Set as S
  import qualified Data.Text as T
  import           Data.Text.Zipper ( cursorPosition )
  import           Data.Time.Clock ( UTCTime(..) )
  import           Lens.Micro.Platform ( (.~), (^?!), to, view, Lens', Traversal', SimpleGetter )
  
  import           Network.Mattermost.Types ( ChannelId, Type(Direct, Group)
                                            , ServerTime(..), TeamId, idString
                                            )
  
  import           Matterhorn.Constants
  import           Matterhorn.Draw.Buttons
  import           Matterhorn.Draw.Messages
  import           Matterhorn.Draw.ManageAttachments
  import           Matterhorn.Draw.InputPreview
  import           Matterhorn.Draw.Util
  import           Matterhorn.Draw.RichText
  import           Matterhorn.Events.MessageSelect
  import           Matterhorn.Events.UrlSelect
  import           Matterhorn.State.MessageSelect
  import           Matterhorn.Themes
  import           Matterhorn.TimeUtils ( justAfter, justBefore )
  import           Matterhorn.Types
  import           Matterhorn.Types.DirectionalSeq ( emptyDirSeq )
  import           Matterhorn.Types.RichText
  
  
  drawMessageInterface :: ChatState
                       -> HighlightSet
                       -> TeamId
                       -> Bool
                       -> Lens' ChatState (MessageInterface Name i)
                       -> Bool
                       -> Bool
                       -> Widget Name
  drawMessageInterface st hs tId showNewMsgLine which renderReplyIndent focused =
      interfaceContents
      where
      inMsgSelect = st^.which.miMode == MessageSelect
      eName = getName $ st^.which.miEditor.esEditor
      region = MessageInterfaceMessages eName
      previewVpName = MessagePreviewViewport eName
  
      interfaceContents =
          case st^.which.miMode of
              Compose           -> renderMessages False
              MessageSelect     -> renderMessages True
              ShowUrlList       -> drawUrlSelectWindow st hs which
              SaveAttachment {} -> drawSaveAttachmentWindow st which
              ManageAttachments -> drawAttachmentList st which
              BrowseFiles       -> drawFileBrowser st which
  
      renderMessages inMsgSel =
          vBox [ freezeBorders $
                 renderMessageListing st inMsgSel showNewMsgLine tId hs which renderReplyIndent region
               , bottomBorder
               , inputPreview st (which.miEditor) tId previewVpName hs
               , inputArea st (which.miEditor) focused hs
               ]
  
      bottomBorder =
          if inMsgSelect
          then messageSelectBottomBar st tId which
          else hBox [ showAttachmentCount
                    , hBorder
                    , showTypingUsers
                    , showBusy
                    ]
  
      showBusy = case st^.csWorkerIsBusy of
                   Just (Just n) -> hLimit 2 hBorder <+> txt (T.pack $ "*" <> show n)
                   Just Nothing -> hLimit 2 hBorder <+> txt "*"
                   Nothing -> emptyWidget
  
      showTypingUsers =
          let format = renderText' Nothing (myUsername st) hs Nothing
          in case allTypingUsers (st^.which.miEditor.esEphemeral.eesTypingUsers) of
              [] -> emptyWidget
              [uId] | Just un <- usernameForUserId uId st ->
                 format $ "[" <> addUserSigil un <> " is typing]"
              [uId1, uId2] | Just un1 <- usernameForUserId uId1 st
                           , Just un2 <- usernameForUserId uId2 st ->
                 format $ "[" <> addUserSigil un1 <> " and " <> addUserSigil un2 <> " are typing]"
              _ -> format "[several people are typing]"
  
      kc = st^.csResources.crConfiguration.configUserKeysL
      showAttachmentCount =
          let count = length $ listElements $ st^.which.miEditor.esAttachmentList
          in if count == 0
             then emptyWidget
             else hBox [ hLimit 1 hBorder
                       , withDefAttr clientMessageAttr $
                         txt $ "(" <> (T.pack $ show count) <> " attachment" <>
                               (if count == 1 then "" else "s") <> "; "
                       , withDefAttr clientEmphAttr $
                         txt $ ppMaybeBinding (firstActiveBinding kc ShowAttachmentListEvent)
                       , txt " to manage)"
                       ]
  
  messageSelectBottomBar :: ChatState
                         -> TeamId
                         -> Lens' ChatState (MessageInterface Name i)
                         -> Widget Name
  messageSelectBottomBar st tId which =
      case getSelectedMessage which st of
          Nothing -> emptyWidget
          Just postMsg ->
              let optionList = if null usableOptions
                               then txt "(no actions available for this message)"
                               else hBox $ intersperse (txt " ") usableOptions
                  usableOptions = mkOption <$> messageSelectionKeyOptions st tId which postMsg
                  mkOption (k, desc) = withDefAttr messageSelectStatusAttr (txt k) <+>
                                       txt (":" <> desc)
              in hBox [ hLimit 1 hBorder
                      , txt "["
                      , optionList
                      , txt "]"
                      , hBorder
                      ]
  
  messageSelectionKeyOptions :: ChatState
                             -> TeamId
                             -> Lens' ChatState (MessageInterface Name i)
                             -> Message
                             -> [(T.Text, T.Text)]
  messageSelectionKeyOptions st tId which msg =
      let ev = keyEventBindings st (messageSelectKeybindings tId which)
          hasVerb = isJust (findVerbatimChunk (msg^.mText))
          hasURLs = numURLs > 0
          numURLs = Seq.length $ msgURLs msg
          s = if numURLs == 1 then "" else "s"
          openUrlsMsg = "open " <> (T.pack $ show numURLs) <> " URL" <> s
          getUsable (usable, key, label) = if usable then Just (key, label) else Nothing
          options = [ ( not $ isGap msg
                    , ev YankWholeMessageEvent
                    , "yank-all"
                    )
                  , ( isFlaggable msg && not (msg^.mFlagged)
                    , ev FlagMessageEvent
                    , "flag"
                    )
                  , ( isFlaggable msg && msg^.mFlagged
                    , ev FlagMessageEvent
                    , "unflag"
                    )
                  , ( isReplyable msg
                    , ev OpenThreadEvent
                    , "thread"
                    )
                  , ( isPostMessage msg
                    , ev CopyPostLinkEvent
                    , "copy-link"
                    )
                  , ( isPinnable msg && not (msg^.mPinned)
                    , ev PinMessageEvent
                    , "pin"
                    )
                  , ( isPinnable msg && msg^.mPinned
                    , ev PinMessageEvent
                    , "unpin"
                    )
                  , ( isReplyable msg
                    , ev ReplyMessageEvent
                    , "reply"
                    )
                  , ( not $ isGap msg
                    , ev ViewMessageEvent
                    , "view"
                    )
                  , ( not $ isGap msg
                    , ev OpenMessageInExternalEditorEvent
                    , "open"
                    )
                  , ( isGap msg
                    , ev FillGapEvent
                    , "load messages"
                    )
                  , ( isMine st msg && isEditable msg
                    , ev EditMessageEvent
                    , "edit"
                    )
                  , ( isMine st msg && isDeletable msg
                    , ev DeleteMessageEvent
                    , "delete"
                    )
                  , ( hasURLs
                    , ev OpenMessageURLEvent
                    , openUrlsMsg
                    )
                  , ( hasVerb
                    , ev YankMessageEvent
                    , "yank-code"
                    )
                  , ( isReactable msg
                    , ev ReactToMessageEvent
                    , "react"
                    )
                  ]
      in catMaybes $ getUsable <$> options
  
  renderMessageListing :: ChatState
                       -> Bool
                       -> Bool
                       -> TeamId
                       -> HighlightSet
                       -> Lens' ChatState (MessageInterface Name i)
                       -> Bool
                       -> Name
                       -> Widget Name
  renderMessageListing st inMsgSelect showNewMsgLine tId hs which renderReplyIndent region =
      messages
      where
      mcId = st^.(csCurrentChannelId tId)
  
      messages = padTop Max chatText
  
      chatText =
          case mcId of
              Nothing -> fill ' '
              Just cId ->
                  if inMsgSelect
                  then freezeBorders $
                       renderMessagesWithSelect cId (st^.which.miMessageSelect) (buildMessages cId)
                  else cached region $
                       freezeBorders $
                       renderLastMessages st hs (getEditedMessageCutoff cId st) renderReplyIndent region $
                       retrogradeMsgsWithThreadStates $
                       reverseMessages $
                       buildMessages cId
  
      renderMessagesWithSelect cId (MessageSelectState selMsgId) msgs =
          -- In this case, we want to fill the message list with messages
          -- but use the post ID as a cursor. To do this efficiently we
          -- only want to render enough messages to fill the screen.
          --
          -- If the message area is H rows high, this actually renders at
          -- most 2H rows' worth of messages and then does the appropriate
          -- cropping. This way we can simplify the math needed to figure
          -- out how to crop while bounding the number of messages we
          -- render around the cursor.
          --
          -- First, we sanity-check the application state because under
          -- some conditions, the selected message might be gone (e.g.
          -- deleted).
          let (s, (before, after)) = splitDirSeqOn (\(m, _) -> m^.mMessageId == selMsgId) msgsWithStates
              msgsWithStates = chronologicalMsgsWithThreadStates msgs
          in case s of
               Nothing ->
                   renderLastMessages st hs (getEditedMessageCutoff cId st) renderReplyIndent region before
               Just m ->
                   unsafeRenderMessageSelection (m, (before, after))
                       (renderSingleMessage st hs renderReplyIndent Nothing) region
  
      buildMessages cId =
          -- If the message list is empty, add an informative message to
          -- the message listing to make it explicit that this listing is
          -- empty.
          let cutoff = if showNewMsgLine
                       then getNewMessageCutoff cId st
                       else Nothing
              ms = filterMessageListing st (which.miMessages)
          in if F.null ms
             then addMessage (emptyChannelFillerMessage st cId) emptyDirSeq
             else insertTransitions ms
                                    cutoff
                                    (getDateFormat st)
                                    (st ^. timeZone)
  
  insertTransitions :: Messages -> Maybe NewMessageIndicator -> Text -> TimeZoneSeries -> Messages
  insertTransitions ms cutoff = insertDateMarkers $ foldr addMessage ms newMessagesT
      where anyNondeletedNewMessages t =
                isJust $ findLatestUserMessage (not . view mDeleted) (messagesAfter t ms)
            newMessagesT = case cutoff of
                Nothing -> []
                Just Hide -> []
                Just (NewPostsAfterServerTime t)
                    | anyNondeletedNewMessages t -> [newMessagesMsg $ justAfter t]
                    | otherwise -> []
                Just (NewPostsStartingAt t)
                    | anyNondeletedNewMessages (justBefore t) -> [newMessagesMsg $ justBefore t]
                    | otherwise -> []
            newMessagesMsg d = newMessageOfType (T.pack "New Messages")
                               (C NewMessagesTransition) d
  
  -- | Construct a single message to be displayed in the specified channel
  -- when it does not yet have any user messages posted to it.
  emptyChannelFillerMessage :: ChatState -> ChannelId -> Message
  emptyChannelFillerMessage st cId =
      newMessageOfType msg (C Informative) ts
      where
          -- This is a bogus timestamp, but its value does not matter
          -- because it is only used to create a message that will be
          -- shown in a channel with no date transitions (which would
          -- otherwise include this bogus date) or other messages (which
          -- would make for a broken message sorting).
          ts = ServerTime $ UTCTime (toEnum 0) 0
          chan = fromJust $ findChannelById cId (st^.csChannels)
          chanName = mkChannelName st (chan^.ccInfo)
          msg = case chan^.ccInfo.cdType of
              Direct ->
                  let u = chan^.ccInfo.cdDMUserId >>= flip userById st
                  in case u of
                      Nothing -> userMsg Nothing
                      Just _ -> userMsg (Just chanName)
              Group ->
                  groupMsg (chan^.ccInfo.cdDisplayName)
              _ ->
                  chanMsg chanName
          userMsg (Just cn) = "You have not yet sent any direct messages to " <> cn <> "."
          userMsg Nothing   = "You have not yet sent any direct messages to this user."
          groupMsg us = "There are not yet any direct messages in the group " <> us <> "."
          chanMsg cn = "There are not yet any messages in the " <> cn <> " channel."
  
  filterMessageListing :: ChatState -> Traversal' ChatState Messages -> Messages
  filterMessageListing st msgsWhich =
      st ^?! msgsWhich . to (filterMessages isShown)
      where isShown m
              | st^.csResources.crUserPreferences.userPrefShowJoinLeave = True
              | otherwise = not $ isJoinLeave m
  
  inputArea :: ChatState
            -> Lens' ChatState (EditState Name)
            -> Bool
            -> HighlightSet
            -> Widget Name
  inputArea st which focused hs =
      let replyPrompt = "reply> "
          normalPrompt = "> "
          editPrompt = "edit> "
          showReplyPrompt = st^.which.esShowReplyPrompt
          maybeHighlight = if focused
                           then withDefAttr focusedEditorPromptAttr
                           else id
          prompt = maybeHighlight $
                   reportExtent (MessageInputPrompt $ getName editor) $
                   txt $ case st^.which.esEditMode of
              Replying {} ->
                  if showReplyPrompt then replyPrompt else normalPrompt
              Editing {}  ->
                  editPrompt
              NewPost ->
                  normalPrompt
          editor = st^.which.esEditor
          inputBox = renderEditor (drawEditorContents st which hs) True editor
          curContents = getEditContents editor
          multilineContent = length curContents > 1
          multilineHints =
              hBox [ hLimit 1 hBorder
                   , str $ "[" <> (show $ (+1) $ fst $ cursorPosition $
                                          editor^.editContentsL) <>
                           "/" <> (show $ length curContents) <> "]"
                   , hBorderWithLabel $ withDefAttr clientEmphAttr $
                     txt $ "In multi-line mode. Press " <> multiLineToggleKey <>
                           " to finish."
                   ]
  
          replyDisplay = case st^.which.esEditMode of
              Replying msg _ | showReplyPrompt ->
                  let msgWithoutParent = msg & mInReplyToMsg .~ NotAReply
                  in hBox [ replyArrow
                          , addEllipsis $ renderMessage MessageData
                            { mdMessage           = msgWithoutParent
                            , mdUserName          = msgWithoutParent^.mUser.to (printableNameForUserRef st)
                            , mdParentMessage     = Nothing
                            , mdParentUserName    = Nothing
                            , mdHighlightSet      = hs
                            , mdEditThreshold     = Nothing
                            , mdShowOlderEdits    = False
                            , mdRenderReplyParent = True
                            , mdRenderReplyIndent = True
                            , mdIndentBlocks      = False
                            , mdThreadState       = NoThread
                            , mdShowReactions     = True
                            , mdMessageWidthLimit = Nothing
                            , mdMyUsername        = myUsername st
                            , mdMyUserId          = myUserId st
                            , mdWrapNonhighlightedCodeBlocks = True
                            , mdTruncateVerbatimBlocks = Nothing
                            , mdClickableNameTag  = getName editor
                            }
                          ]
              _ -> emptyWidget
  
          kc = st^.csResources.crConfiguration.configUserKeysL
          multiLineToggleKey = ppMaybeBinding $ firstActiveBinding kc ToggleMultiLineEvent
  
          commandBox = case st^.which.esEphemeral.eesMultiline of
              False ->
                  let linesStr = "line" <> if numLines == 1 then "" else "s"
                      numLines = length curContents
                  in vLimit 1 $ hBox $
                     prompt : if multilineContent
                              then [ withDefAttr clientEmphAttr $
                                     str $ "[" <> show numLines <> " " <> linesStr <>
                                           "; Enter: send, " <> T.unpack multiLineToggleKey <>
                                           ": edit, Backspace: cancel] "
                                   , txt $ head curContents
                                   , showCursor (getName editor) (Location (0,0)) $ str " "
                                   ]
                              else [inputBox]
              True -> vLimit multilineHeightLimit inputBox <=> multilineHints
      in replyDisplay <=> commandBox
  
  drawEditorContents :: ChatState
                     -> SimpleGetter ChatState (EditState Name)
                     -> HighlightSet
                     -> [Text]
                     -> Widget Name
  drawEditorContents st editWhich hs =
      let noHighlight = txt . T.unlines
          ms = st^.editWhich.esMisspellings
      in case S.null ms of
          True -> noHighlight
          False -> doHighlightMisspellings hs ms
  
  replyArrow :: Widget a
  replyArrow =
      Widget Fixed Fixed $ do
          ctx <- getContext
          let bs = ctx^.ctxBorderStyleL
          render $ str [' ', bsCornerTL bs, '▸']
  
  -- | Tokens in spell check highlighting.
  data Token =
      Ignore Text
      -- ^ This bit of text is to be ignored for the purposes of
      -- spell-checking.
      | Check Text
      -- ^ This bit of text should be checked against the spell checker's
      -- misspelling list.
      deriving (Show)
  
  -- | This function takes a set of misspellings from the spell
  -- checker, the editor lines, and builds a rendering of the text with
  -- misspellings highlighted.
  --
  -- This function processes each line of text from the editor as follows:
  --
  -- * Tokenize the line based on our rules for what constitutes
  --   whitespace. We do this because we need to check "words" in the
  --   user's input against the list of misspellings returned by the spell
  --   checker. But to do this we need to ignore the same things that
  --   Aspell ignores, and it ignores whitespace and lots of puncutation.
  --   We also do this because once we have identified the misspellings
  --   present in the input, we need to reconstruct the user's input and
  --   that means preserving whitespace so that the input looks as it was
  --   originally typed.
  --
  -- * Once we have a list of tokens -- the whitespace tokens to be
  --   preserved but ignored and the tokens to be checked -- we check
  --   each non-whitespace token for presence in the list of misspellings
  --   reported by the checker.
  --
  -- * Having indicated which tokens correspond to misspelled words, we
  --   then need to coallesce adjacent tokens that are of the same
  --   "misspelling status", i.e., two neighboring tokens (of whitespace
  --   or check type) need to be coallesced if they both correspond to
  --   text that is a misspelling or if they both are NOT a misspelling.
  --   We do this so that the final Brick widget is optimal in that it
  --   uses a minimal number of box cells to display substrings that have
  --   the same attribute.
  --
  -- * Finally we build a widget out of these coallesced tokens and apply
  --   the misspellingAttr attribute to the misspelled tokens.
  --
  -- Note that since we have to come to our own conclusion about which
  -- words are worth checking in the checker's output, sometimes our
  -- algorithm will differ from aspell in what is considered "part of a
  -- word" and what isn't. In particular, Aspell is smart about sometimes
  -- noticing that "'" is an apostrophe and at other times that it is
  -- a single quote as part of a quoted string. As a result there will
  -- be cases where Markdown formatting characters interact poorly
  -- with Aspell's checking to result in misspellings that are *not*
  -- highlighted.
  --
  -- One way to deal with this would be to *not* parse the user's input
  -- as done here, complete with all its Markdown metacharacters, but to
  -- instead 1) parse the input as Markdown, 2) traverse the Markdown AST
  -- and extract the words from the relevant subtrees, and 3) spell-check
  -- those words. The reason we don't do it that way in the first place is
  -- because 1) the user's input might not be valid markdown and 2) even
  -- if we did that, we'd still have to do this tokenization operation to
  -- annotate misspellings and reconstruct the user's raw input.
  doHighlightMisspellings :: HighlightSet -> S.Set Text -> [Text] -> Widget Name
  doHighlightMisspellings hs misspellings contents =
      -- Traverse the input, gathering non-whitespace into tokens and
      -- checking if they appear in the misspelling collection
      let whitelist = S.union (hUserSet hs) (hChannelSet hs)
  
          handleLine t | t == "" = txt " "
          handleLine t =
              -- For annotated tokens, coallesce tokens of the same type
              -- and add attributes for misspellings.
              let mkW (Left tok) =
                      let s = getTokenText tok
                      in if T.null s
                         then emptyWidget
                         else withDefAttr misspellingAttr $ txt $ getTokenText tok
                  mkW (Right tok) =
                      let s = getTokenText tok
                      in if T.null s
                         then emptyWidget
                         else txt s
  
                  go :: Either Token Token -> [Either Token Token] -> [Either Token Token]
                  go lst [] = [lst]
                  go lst (tok:toks) =
                      case (lst, tok) of
                          (Left a, Left b)   -> go (Left $ combineTokens a b) toks
                          (Right a, Right b) -> go (Right $ combineTokens a b) toks
                          _                  -> lst : go tok toks
  
              in hBox $ mkW <$> (go (Right $ Ignore "") $ annotatedTokens t)
  
          combineTokens (Ignore a) (Ignore b) = Ignore $ a <> b
          combineTokens (Check a) (Check b) = Check $ a <> b
          combineTokens (Ignore a) (Check b) = Check $ a <> b
          combineTokens (Check a) (Ignore b) = Check $ a <> b
  
          getTokenText (Ignore a) = a
          getTokenText (Check a) = a
  
          annotatedTokens t =
              -- For every token, check on whether it is a misspelling.
              -- The result is Either Token Token where the Left is a
              -- misspelling and the Right is not.
              checkMisspelling <$> tokenize t (Ignore "")
  
          checkMisspelling t@(Ignore _) = Right t
          checkMisspelling t@(Check s) =
              if s `S.member` whitelist
              then Right t
              else if s `S.member` misspellings
                   then Left t
                   else Right t
  
          ignoreChar c = isSpace c || isPunctuation c || c == '`' || c == '/' ||
                         T.singleton c == userSigil || T.singleton c == normalChannelSigil
  
          tokenize t curTok
              | T.null t = [curTok]
              | ignoreChar $ T.head t =
                  case curTok of
                      Ignore s -> tokenize (T.tail t) (Ignore $ s <> (T.singleton $ T.head t))
                      Check s -> Check s : tokenize (T.tail t) (Ignore $ T.singleton $ T.head t)
              | otherwise =
                  case curTok of
                      Ignore s -> Ignore s : tokenize (T.tail t) (Check $ T.singleton $ T.head t)
                      Check s -> tokenize (T.tail t) (Check $ s <> (T.singleton $ T.head t))
  
      in vBox $ handleLine <$> contents
  
  drawSaveAttachmentWindow :: ChatState
                           -> Lens' ChatState (MessageInterface Name i)
                           -> Widget Name
  drawSaveAttachmentWindow st which =
      center $
      padAll 2 $
      borderWithLabel (withDefAttr clientEmphAttr $ txt "Save Attachment") $
      vBox [ padAll 1 $
             txt "Path: " <+>
             (vLimit editorHeight $
              withFocusRing foc (renderEditor drawEditorTxt) ed)
           , hBox [ padRight Max $
                    padLeft (Pad 1) $
                    drawButton foc (AttachmentPathSaveButton listName) "Save"
                  , padRight (Pad 1) $
                    drawButton foc (AttachmentPathCancelButton listName) "Cancel"
                  ]
           ]
      where
          editorHeight = 1
          listName = getName $ st^.which.miUrlList.ulList
          foc = st^.which.miSaveAttachmentDialog.attachmentPathDialogFocus
          ed = st^.which.miSaveAttachmentDialog.attachmentPathEditor
          drawEditorTxt = txt . T.unlines
  
  drawUrlSelectWindow :: ChatState -> HighlightSet -> Lens' ChatState (MessageInterface Name i) -> Widget Name
  drawUrlSelectWindow st hs which =
      vBox [ renderUrlList st hs which
           , urlSelectBottomBar st which
           , urlSelectInputArea st which
           ]
  
  renderUrlList :: ChatState -> HighlightSet -> Lens' ChatState (MessageInterface Name i) -> Widget Name
  renderUrlList st hs which =
      urlDisplay
      where
          urlDisplay = if F.length urls == 0
                       then str "No links found." <=> fill ' '
                       else renderList renderItem True urls
  
          urls = st^.which.miUrlList.ulList
  
          me = myUsername st
  
          renderItem sel (i, link) =
            let time = link^.linkTime
            in attr sel $ vLimit 2 $
              (vLimit 1 $
               hBox [ let u = maybe "<server>" id (link^.linkUser.to (printableNameForUserRef st))
                      in colorUsername me u u
                    , case link^.linkLabel of
                        Nothing -> emptyWidget
                        Just label ->
                            case Seq.null (unInlines label) of
                                True -> emptyWidget
                                False -> txt ": " <+> renderRichText me hs Nothing False Nothing Nothing
                                                      (Blocks $ Seq.singleton $ Para label)
                    , fill ' '
                    , renderDate st $ withServerTime time
                    , str " "
                    , renderTime st $ withServerTime time
                    ] ) <=>
              (vLimit 1 (clickable (ClickableURLListEntry i (link^.linkTarget)) $ renderLinkTarget (link^.linkTarget)))
  
          renderLinkTarget (LinkPermalink (TeamURLName tName) pId) =
              renderText $ "Team: " <> tName <> ", post " <> idString pId
          renderLinkTarget (LinkURL url) = renderText $ unURL url
          renderLinkTarget (LinkFileId _) = txt " "
  
          attr True = forceAttr urlListSelectedAttr
          attr False = id
  
  urlSelectBottomBar :: ChatState -> Lens' ChatState (MessageInterface Name i) -> Widget Name
  urlSelectBottomBar st which =
      case listSelectedElement $ st^.which.miUrlList.ulList of
          Nothing -> hBorder
          Just (_, (_, link)) ->
              let options = [ ( isFile
                              , ev SaveAttachmentEvent
                              , "save attachment"
                              )
                            ]
                  ev = keyEventBindings st (urlSelectKeybindings which)
                  isFile entry = case entry^.linkTarget of
                      LinkFileId {} -> True
                      _ -> False
                  optionList = hBox $ intersperse (txt " ") usableOptions
                  usableOptions = catMaybes $ mkOption <$> options
                  mkOption (f, k, desc) = if f link
                                          then Just $ withDefAttr urlSelectStatusAttr (txt k) <+>
                                                      txt (":" <> desc)
                                          else Nothing
              in if null usableOptions
                 then hBorder
                 else hBox [ hLimit 1 hBorder
                           , txt "["
                           , txt "Options: "
                           , optionList
                           , txt "]"
                           , hBorder
                           ]
  
  urlSelectInputArea :: ChatState -> Lens' ChatState (MessageInterface Name i) -> Widget Name
  urlSelectInputArea st which =
      let getBinding = keyEventBindings st (urlSelectKeybindings which)
      in hCenter $ hBox [ withDefAttr clientEmphAttr $ txt "Enter"
                        , txt ":open  "
                        , withDefAttr clientEmphAttr $ txt $ getBinding CancelEvent
                        , txt ":close"
                        ]
  