content: {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE MultiWayIf #-}
  module Matterhorn.Draw.Messages
    ( MessageData(..)
    , renderMessage
    , printableNameForUserRef
    , renderSingleMessage
    , unsafeRenderMessageSelection
    , renderLastMessages
    , addEllipsis
    , mkClickableInline
    )
  where
  
  import           Brick
  import           Brick.Widgets.Border
  import           Control.Monad.Trans.Reader ( withReaderT )
  import qualified Data.Foldable as F
  import qualified Data.Map.Strict as Map
  import qualified Data.Sequence as S
  import           Data.Sequence ( ViewL(..)
                                 , ViewR(..)
                                 , (|>)
                                 , viewl
                                 , viewr)
  import qualified Data.Set as Set
  import qualified Data.Text as T
  import           Data.Maybe ( fromJust )
  import qualified Graphics.Vty as V
  import           Lens.Micro.Platform ( (.~), to )
  import           Network.Mattermost.Lenses ( postEditAtL, postCreateAtL )
  import           Network.Mattermost.Types ( ServerTime(..), UserId, userUsername, userId, postId )
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import           Matterhorn.Draw.Util
  import           Matterhorn.Draw.RichText
  import           Matterhorn.Themes
  import           Matterhorn.Types
  import           Matterhorn.Types.RichText
  import           Matterhorn.Types.DirectionalSeq
  
  -- | A bundled structure that includes all the information necessary
  -- to render a given message
  data MessageData =
      MessageData { mdEditThreshold :: Maybe ServerTime
                  -- ^ If specified, any messages edited before this point
                  -- in time are not indicated as edited.
                  , mdShowOlderEdits :: Bool
                  -- ^ Indicates whether "edited" markers should be shown
                  -- for old messages (i.e., ignore the mdEditThreshold
                  -- value).
                  , mdShowReactions :: Bool
                  -- ^ Whether to render reactions.
                  , mdMessage :: Message
                  -- ^ The message to render.
                  , mdUserName :: Maybe Text
                  -- ^ The username of the message's author, if any. This
                  -- is passed here rather than obtaining from the message
                  -- because we need to do lookups in the ChatState to
                  -- compute this, and we don't pass the ChatState into
                  -- renderMessage.
                  , mdParentMessage :: Maybe Message
                  -- ^ The parent message of this message, if any.
                  , mdParentUserName :: Maybe Text
                  -- ^ The author of the parent message, if any.
                  , mdThreadState :: ThreadState
                  -- ^ The thread state of this message.
                  , mdRenderReplyParent :: Bool
                  -- ^ Whether to render the parent message.
                  , mdRenderReplyIndent :: Bool
                  -- ^ Whether to render reply indent decorations
                  , mdHighlightSet :: HighlightSet
                  -- ^ The highlight set to use to highlight usernames,
                  -- channel names, etc.
                  , mdIndentBlocks :: Bool
                  -- ^ Whether to indent the message underneath the
                  -- author's name (True) or just display it to the right
                  -- of the author's name (False).
                  , mdTruncateVerbatimBlocks :: Maybe Int
                  -- ^ At what height to truncate long verbatim/code blocks.
                  , mdMessageWidthLimit :: Maybe Int
                  -- ^ A width override to use to wrap non-code blocks
                  -- and code blocks without syntax highlighting. If
                  -- unspecified, all blocks in the message will be
                  -- wrapped and truncated at the width specified by the
                  -- rendering context. If specified, all non-code blocks
                  -- will be wrapped at this width and highlighted code
                  -- blocks will be rendered using the context's width.
                  , mdMyUsername :: Text
                  -- ^ The username of the user running Matterhorn.
                  , mdMyUserId :: UserId
                  -- ^ The user ID of the user running Matterhorn.
                  , mdWrapNonhighlightedCodeBlocks :: Bool
                  -- ^ Whether to wrap text in non-highlighted code
                  -- blocks.
                  , mdClickableNameTag :: Name
                  -- ^ Used to namespace clickable extents produced by
                  -- rendering this message
                  }
  
  maxMessageHeight :: Int
  maxMessageHeight = 200
  
  botUserLabel :: T.Text
  botUserLabel = "[BOT]"
  
  pinIndicator :: T.Text
  pinIndicator = "[PIN]"
  
  -- | printableNameForUserRef converts the UserRef into a printable name,
  -- based on the current known user data.
  printableNameForUserRef :: ChatState -> UserRef -> Maybe Text
  printableNameForUserRef st uref =
      case uref of
          NoUser -> Nothing
          UserOverride _ t -> Just t
          UserI _ uId -> displayNameForUserId uId st
  
  -- | renderSingleMessage is the main message drawing function.
  renderSingleMessage :: ChatState
                      -- ^ The application state
                      -> HighlightSet
                      -- ^ The highlight set to use when rendering this
                      -- message
                      -> Bool
                      -- ^ Whether to render reply indentations
                      -> Maybe ServerTime
                      -- ^ This specifies an "indicator boundary". Showing
                      -- various indicators (e.g. "edited") is not
                      -- typically done for messages that are older than
                      -- this boundary value.
                      -> Message
                      -- ^ The message to render
                      -> ThreadState
                      -- ^ The thread state in which to render the message
                      -> Name
                      -- ^ Clickable name tag
                      -> Widget Name
  renderSingleMessage st hs renderReplyIndent ind m threadState tag =
    renderChatMessage st hs ind threadState tag
                      (withBrackets . renderTime st . withServerTime)
                      renderReplyIndent m
  
  renderChatMessage :: ChatState
                    -- ^ The application state
                    -> HighlightSet
                    -- ^ The highlight set to use when rendering this
                    -- message
                    -> Maybe ServerTime
                    -- ^ This specifies an "indicator boundary". Showing
                    -- various indicators (e.g. "edited") is not typically
                    -- done for messages that are older than this boundary
                    -- value.
                    -> ThreadState
                    -- ^ The thread state in which to render the message
                    -> Name
                    -- ^ The UI region in which the message is being
                    -- rendered (for tagging clickable extents)
                    -> (ServerTime -> Widget Name)
                    -- ^ A function to render server times
                    -> Bool
                    -- ^ Whether to render reply indentations
                    -> Message
                    -- ^ The message to render
                    -> Widget Name
  renderChatMessage st hs ind threadState clickableNameTag renderTimeFunc renderReplyIndent msg =
      let showOlderEdits = configShowOlderEdits config
          showTimestamp = configShowMessageTimestamps config
          config = st^.csResources.crConfiguration
          parent = case msg^.mInReplyToMsg of
            NotAReply -> Nothing
            InReplyTo pId -> getMessageForPostId st pId
          m = renderMessage MessageData
                { mdMessage           = msg
                , mdUserName          = msg^.mUser.to (printableNameForUserRef st)
                , mdParentMessage     = parent
                , mdParentUserName    = parent >>= (^.mUser.to (printableNameForUserRef st))
                , mdEditThreshold     = ind
                , mdHighlightSet      = hs
                , mdShowOlderEdits    = showOlderEdits
                , mdRenderReplyParent = True
                , mdRenderReplyIndent = renderReplyIndent
                , mdIndentBlocks      = True
                , mdThreadState       = threadState
                , mdShowReactions     = True
                , mdMessageWidthLimit = Nothing
                , mdMyUsername        = userUsername $ myUser st
                , mdMyUserId          = userId $ myUser st
                , mdWrapNonhighlightedCodeBlocks = True
                , mdTruncateVerbatimBlocks = st^.csVerbatimTruncateSetting
                , mdClickableNameTag  = clickableNameTag
                }
          fullMsg =
            case msg^.mUser of
              NoUser
                | isGap msg -> withDefAttr gapMessageAttr m
                | otherwise ->
                  case msg^.mType of
                      C DateTransition ->
                          withDefAttr dateTransitionAttr (hBorderWithLabel m)
                      C NewMessagesTransition ->
                          withDefAttr newMessageTransitionAttr (hBorderWithLabel m)
                      C Error ->
                          withDefAttr errorMessageAttr m
                      _ ->
                          withDefAttr clientMessageAttr m
              _ | isJoinLeave msg -> withDefAttr clientMessageAttr m
                | otherwise -> m
          maybeRenderTime w =
              if showTimestamp
              then let maybePadTime = if threadState == InThreadShowParent
                                      then (txt " " <=>) else id
                   in hBox [maybePadTime $ renderTimeFunc (msg^.mDate), txt " ", w]
              else w
          maybeRenderTimeWith f = if isTransition msg then id else f
      in maybeRenderTimeWith maybeRenderTime fullMsg
  
  -- | Render a selected message with focus, including the messages
  -- before and the messages after it. The foldable parameters exist
  -- because (depending on the situation) we might use either of the
  -- message list types for the 'before' and 'after' (i.e. the
  -- chronological or retrograde message sequences).
  unsafeRenderMessageSelection :: (SeqDirection dir1, SeqDirection dir2)
                               => ( (Message, ThreadState)
                                  , ( DirectionalSeq dir1 (Message, ThreadState)
                                    , DirectionalSeq dir2 (Message, ThreadState)
                                    )
                                  )
                               -- ^ The message to render, the messages
                               -- before it, and after it, respectively
                               -> (Message -> ThreadState -> Name -> Widget Name)
                               -- ^ A per-message rendering function to
                               -- use
                               -> Name
                               -- ^ Clickable name tag
                               -> Widget Name
  unsafeRenderMessageSelection ((curMsg, curThreadState), (before, after)) doMsgRender tag =
    Widget Greedy Greedy $ do
      ctx <- getContext
      curMsgResult <- withReaderT relaxHeight $ render $
                      forceAttrAllowStyle messageSelectAttr $
                      padRight Max $ doMsgRender curMsg curThreadState tag
  
      let targetHeight = ctx^.availHeightL
          upperHeight = targetHeight `div` 2
          lowerHeight = targetHeight - upperHeight
  
      lowerHalfResults <- renderMessageSeq targetHeight (render1 doMsgRender) vLimit tag after
      upperHalfResults <- renderMessageSeq targetHeight (render1 doMsgRender) cropTopTo tag before
  
      let upperHalfResultsHeight = sum $ (V.imageHeight . image) <$> upperHalfResults
          lowerHalfResultsHeight = sum $ (V.imageHeight . image) <$> lowerHalfResults
          curHeight = V.imageHeight $ curMsgResult^.imageL
          uncropped = vBox $ fmap resultToWidget $
                             (reverse upperHalfResults) <> (curMsgResult : lowerHalfResults)
  
          cropTop h w = Widget Fixed Fixed $ do
              result <- withReaderT relaxHeight $ render w
              render $ cropTopTo h $ resultToWidget result
          cropBottom h w = Widget Fixed Fixed $ do
              result <- withReaderT relaxHeight $ render w
              render $ cropBottomTo h $ resultToWidget result
  
          lowerHalf = vBox $ fmap resultToWidget lowerHalfResults
          upperHalf = vBox $ fmap resultToWidget $ reverse upperHalfResults
  
      render $ if | lowerHalfResultsHeight < (lowerHeight - curHeight) ->
                      cropTop targetHeight uncropped
                  | upperHalfResultsHeight < upperHeight ->
                      vLimit targetHeight uncropped
                  | otherwise ->
                      cropTop upperHeight upperHalf <=> (resultToWidget curMsgResult) <=>
                         (if curHeight < lowerHeight
                           then cropBottom (lowerHeight - curHeight) lowerHalf
                           else cropBottom lowerHeight lowerHalf)
  
  renderMessageSeq :: (SeqDirection dir)
                   => Int
                   -> (Message -> ThreadState -> Name -> Widget Name)
                   -> (Int -> Widget Name -> Widget Name)
                   -> Name
                   -> DirectionalSeq dir (Message, ThreadState)
                   -> RenderM Name [Result Name]
  renderMessageSeq remainingHeight renderFunc limitFunc tag ms
      | messagesLength ms == 0 = return []
      | otherwise = do
          let (m, threadState) = fromJust $ messagesHead ms
              maybeCache = case m^.mMessageId of
                  Nothing -> id
                  Just i -> cached (RenderedMessage i)
          result <- render $ limitFunc remainingHeight $ maybeCache $ renderFunc m threadState tag
          rest <- renderMessageSeq (remainingHeight - (V.imageHeight $ result^.imageL)) renderFunc limitFunc tag (messagesDrop 1 ms)
          return $ result : rest
  
  renderLastMessages :: ChatState
                     -> HighlightSet
                     -> Maybe ServerTime
                     -> Bool
                     -> Name
                     -> DirectionalSeq Retrograde (Message, ThreadState)
                     -> Widget Name
  renderLastMessages st hs editCutoff renderReplyIndent tag msgs =
      Widget Greedy Greedy $ do
          ctx <- getContext
          let targetHeight = ctx^.availHeightL
              doMsgRender = renderSingleMessage st hs renderReplyIndent editCutoff
  
              newMessagesTransitions = filterMessages (isNewMessagesTransition . fst) msgs
              newMessageTransition = fst <$> (listToMaybe $ F.toList newMessagesTransitions)
  
              isBelow m transition = m^.mDate > transition^.mDate
  
              go :: Int -> DirectionalSeq Retrograde (Message, ThreadState) -> RenderM Name [Result Name]
              go _ ms | messagesLength ms == 0 = return []
              go remainingHeight ms = do
                  let (m, threadState) = fromJust $ messagesHead ms
                      newMessagesAbove = maybe False (isBelow m) newMessageTransition
  
                  result <- render $ render1 doMsgRender m threadState tag
  
                  croppedResult <- render $ cropTopTo remainingHeight $ resultToWidget result
  
                  -- If the new message fills the window, check whether
                  -- there is still a "New Messages" transition that is
                  -- not displayed. If there is, then we need to replace
                  -- the top line of the new image with a "New Messages"
                  -- indicator.
                  if V.imageHeight (result^.imageL) >= remainingHeight
                  then do
                      single <- if newMessagesAbove
                                then render $
                                        vBox [ withDefAttr newMessageTransitionAttr $ hBorderWithLabel (txt "New Messages ↑")
                                             , cropTopBy 1 $ resultToWidget croppedResult
                                             ]
                                else do
                                    return croppedResult
                      return [single]
                  else do
                      let unusedHeight = remainingHeight - V.imageHeight (result^.imageL)
                      rest <- go unusedHeight $ messagesDrop 1 ms
                      return $ result : rest
  
          results <- go targetHeight msgs
          render $ vBox $ resultToWidget <$> reverse results
  
  relaxHeight :: Context n -> Context n
  relaxHeight c = c & availHeightL .~ (max maxMessageHeight (c^.availHeightL))
  
  render1 :: (Message -> ThreadState -> Name -> Widget Name)
          -> Message
          -> ThreadState
          -> Name
          -> Widget Name
  render1 doMsgRender msg threadState tag = case msg^.mDeleted of
      True -> emptyWidget
      False ->
          Widget Greedy Fixed $ do
              withReaderT relaxHeight $
                  render $ padRight Max $
                  doMsgRender msg threadState tag
  
  -- | This performs rendering of the specified message according to
  -- settings in MessageData.
  renderMessage :: MessageData -> Widget Name
  renderMessage md@MessageData { mdMessage = msg, .. } =
      let msgUsr = case mdUserName of
            Just u -> if omittedUsernameType (msg^.mType)
                      then Nothing
                      else Just u
            Nothing -> Nothing
  
          botAuthorElem = if isBotMessage msg
                          then txt botUserLabel
                          else emptyWidget
  
          mId = msg^.mMessageId
  
          clickableAuthor un = case mId of
              Nothing -> id
              -- We use the index (-1) since indexes for clickable
              -- usernames elsewhere in this message start at 0.
              Just i -> clickable (ClickableUsername (Just i) mdClickableNameTag (-1) un)
  
          nameElems = case msgUsr of
            Just un
              | isEmote msg ->
                  [ withDefAttr pinnedMessageIndicatorAttr $ txt $ if msg^.mPinned then pinIndicator else ""
                  , txt $ (if msg^.mFlagged then "[!] " else "") <> "*"
                  , clickableAuthor un $ colorUsername mdMyUsername un un
                  , botAuthorElem
                  , txt " "
                  ]
              | otherwise ->
                  [ withDefAttr pinnedMessageIndicatorAttr $ txt $ if msg^.mPinned then pinIndicator <> " " else ""
                  , clickableAuthor un $ colorUsername mdMyUsername un un
                  , botAuthorElem
                  , txt $ (if msg^.mFlagged then "[!]" else "") <> ": "
                  ]
            Nothing -> []
  
          -- Use the editing threshold to determine whether to append an
          -- editing indication to this message.
          maybeAugment bs = case msg^.mOriginalPost of
              Nothing -> bs
              Just p ->
                  if p^.postEditAtL > p^.postCreateAtL
                  then case mdEditThreshold of
                      Just cutoff | p^.postEditAtL >= cutoff ->
                          addEditSentinel (EEditSentinel True) bs
                      _ -> if mdShowOlderEdits
                           then addEditSentinel (EEditSentinel False) bs
                           else bs
                  else bs
  
          augmentedText = unBlocks $ maybeAugment $ msg^.mText
          msgWidget =
              vBox $ (renderBlocks mdHighlightSet mdMessageWidthLimit nameElems augmentedText . viewl) augmentedText :
                     catMaybes [msgAtch, messageReactions md]
  
          replyIndent = Widget Fixed Fixed $ do
              ctx <- getContext
              w <- case mdRenderReplyIndent of
                  True -> do
                      -- NB: The amount subtracted here must be the total
                      -- padding added below (pad 1 + vBorder)
                      w <- render $ hLimit (ctx^.availWidthL - 2) msgWidget
                      return $ vLimit (V.imageHeight $ w^.imageL) $
                          padRight (Pad 1) vBorder <+> resultToWidget w
                  False ->
                      return msgWidget
              render w
  
          msgAtch = if S.null (msg^.mAttachments)
            then Nothing
            else Just $ withDefAttr clientMessageAttr $ vBox
                   [ padLeft (Pad 2) $ clickable (ClickableAttachmentInMessage mdClickableNameTag (a^.attachmentFileId)) $
                                       txt ("[attached: `" <> a^.attachmentName <> "`]")
                   | a <- toList (msg^.mAttachments)
                   ]
  
          withParent p =
              case mdThreadState of
                  NoThread           -> msgWidget
                  InThreadShowParent -> p <=> replyIndent
                  InThread           -> replyIndent
  
      in freezeBorders $
         if not mdRenderReplyParent
         then msgWidget
         else case msg^.mInReplyToMsg of
            NotAReply -> msgWidget
            InReplyTo _ ->
                case mdParentMessage of
                    Nothing -> withParent (str "[loading...]")
                    Just pm ->
                        let parentMsg = renderMessage md
                              { mdShowOlderEdits    = False
                              , mdMessage           = pm
                              , mdUserName          = mdParentUserName
                              , mdParentMessage     = Nothing
                              , mdRenderReplyParent = False
                              , mdIndentBlocks      = False
                              }
                        in withParent (addEllipsis $ forceAttrAllowStyle replyParentAttr parentMsg)
  
      where
          renderBlocks :: HighlightSet -> Maybe Int -> [Widget Name] -> Seq Block
                       -> ViewL Block -> Widget Name
          renderBlocks hs w nameElems bs xs | length xs > 1   = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs (Blockquote {} :< _) = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs (CodeBlock {} :< _)  = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs (HTMLBlock {} :< _)  = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs (List {} :< _)       = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs (Para inlns :< _)
              | F.any isBreak (unInlines inlns)               = multiLnLayout hs w nameElems bs
          renderBlocks hs w nameElems bs _                    = nameNextToMessage hs w nameElems bs
  
          multiLnLayout hs w nameElems bs =
              if mdIndentBlocks
                 then vBox [ hBox nameElems
                           , hBox [txt "  ", renderRichText mdMyUsername hs ((subtract 2) <$> w)
                                                   mdWrapNonhighlightedCodeBlocks
                                                   mdTruncateVerbatimBlocks
                                                   (Just (mkClickableInline (msg^.mMessageId) mdClickableNameTag)) (Blocks bs)]
                           ]
                 else nameNextToMessage hs w nameElems bs
  
          nameNextToMessage hs w nameElems bs =
              Widget Fixed Fixed $ do
                  nameResult <- render $ hBox nameElems
                  let newW = subtract (V.imageWidth (nameResult^.imageL)) <$> w
                  render $ hBox [ resultToWidget nameResult
                                , renderRichText mdMyUsername hs newW
                                    mdWrapNonhighlightedCodeBlocks
                                    mdTruncateVerbatimBlocks
                                    (Just (mkClickableInline (msg^.mMessageId) mdClickableNameTag)) (Blocks bs)
                                ]
  
          isBreak i = i `elem` [ELineBreak, ESoftBreak]
  
  mkClickableInline :: Maybe MessageId -> Name -> Int -> Inline -> Maybe Name
  mkClickableInline mmId scope i (EHyperlink u _) = do
      return $ ClickableURL mmId scope i $ LinkURL u
  mkClickableInline mmId scope i (EUser name) =
      return $ ClickableUsername mmId scope i name
  mkClickableInline mmId scope i (EPermalink teamUrlName pId _) =
      return $ ClickableURL mmId scope i $ LinkPermalink teamUrlName pId
  mkClickableInline _ _ _ _ =
      Nothing
  
  messageReactions :: MessageData -> Maybe (Widget Name)
  messageReactions MessageData { mdMessage = msg, .. } =
      if Map.null (msg^.mReactions) || (not mdShowReactions)
      then Nothing
      else let renderR e us lst =
                   let n = Set.size us
                       mine = isMyReaction us
                       content = if | n == 1    -> "[" <> e <> "]"
                                    | otherwise -> "[" <> e <> " " <> T.pack (show n) <> "]"
                       w = makeReactionWidget mine e us content
                   in padRight (Pad 1) w : lst
               nonEmptyReactions = Map.filter (not . Set.null) $ msg^.mReactions
               isMyReaction = Set.member mdMyUserId
               makeReactionWidget mine e us t =
                   let w = withDefAttr attr $ txt t
                       attr = if mine then myReactionAttr else reactionAttr
                   in maybe w (flip clickable w) $ makeName e us
               hasAnyReactions = not $ null nonEmptyReactions
               makeName e us = do
                   pid <- postId <$> msg^.mOriginalPost
                   Just $ ClickableReaction pid mdClickableNameTag e us
               reactionWidget = Widget Fixed Fixed $ do
                   ctx <- getContext
                   let lineW = ctx^.availWidthL
                   reacs <- mapM render $ Map.foldrWithKey renderR [] nonEmptyReactions
                   let reacLines :: [Result n] -> Int -> [Result n] -> [[Result n]]
                       reacLines l _ []     = if null l then [] else [l]
                       reacLines l w (r:rs) =
                           let rW = V.imageWidth $ r^.imageL
                           in if rW <= w
                              then reacLines (l <> [r]) (w - rW) rs
                              else if rW > lineW
                                   then l : [r] : reacLines [] lineW rs
                                   else l : reacLines [] lineW (r:rs)
  
                   render $ vBox $ hBox <$> (fmap (fmap resultToWidget)) (reacLines [] lineW reacs)
           in if hasAnyReactions
              then Just $ txt "   " <+> reactionWidget
              else Nothing
  
  -- Add the edit sentinel to the end of the last block in the sequence.
  -- If the last block is a paragraph, append it to that paragraph.
  -- Otherwise, append a new block so it appears beneath the last
  -- block-level element.
  addEditSentinel :: Inline -> Blocks -> Blocks
  addEditSentinel d (Blocks bs) =
      case viewr bs of
          EmptyR -> Blocks bs
          (rest :> b) -> Blocks rest <> appendEditSentinel d b
  
  appendEditSentinel :: Inline -> Block -> Blocks
  appendEditSentinel sentinel b =
      let s = Para (Inlines $ S.singleton sentinel)
      in Blocks $ case b of
          Para is -> S.singleton $ Para (Inlines $ unInlines is |> ESpace |> sentinel)
          _ -> S.fromList [b, s]
  
  omittedUsernameType :: MessageType -> Bool
  omittedUsernameType = \case
      CP Join        -> True
      CP Leave       -> True
      CP TopicChange -> True
      _              -> False
  
  addEllipsis :: Widget a -> Widget a
  addEllipsis w = Widget (hSize w) (vSize w) $ do
      ctx <- getContext
      let aw = ctx^.availWidthL
      result <- render w
      let withEllipsis = (hLimit (aw - 3) $ vLimit 1 $ (resultToWidget result)) <+>
                         str "..."
      if (V.imageHeight (result^.imageL) > 1) || (V.imageWidth (result^.imageL) == aw) then
          render withEllipsis else
          return result
  