module Draw.ViewMessage ( drawViewMessage ) where import Prelude () import Prelude.MH import Brick import Brick.Widgets.Border import Brick.Widgets.Center import Lens.Micro.Platform ( to ) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Foldable as F import Draw.Main import Draw.Messages ( nameForUserRef ) import Markdown import Themes import Types drawViewMessage :: ChatState -> [Widget Name] drawViewMessage st = (viewMessageBox st) : (drawMain False st) maxWidth :: Int maxWidth = 78 maxHeight :: Int maxHeight = 25 viewMessageBox :: ChatState -> Widget Name viewMessageBox st = let body = case st^.csViewedMessage of Nothing -> str "BUG: no message to show, please report!" Just msg -> let hs = getHighlightSet st parent = case msg^.mInReplyToMsg of NotAReply -> Nothing InReplyTo pId -> getMessageForPostId st pId reactionsBody = reactionsText st msg msgW = renderMessage $ MessageData { mdEditThreshold = Nothing , mdShowOlderEdits = False , mdMessage = msg , mdIsBot = isBotMessage msg , mdUserName = msg^.mUser.to (nameForUserRef st) , mdParentMessage = parent , mdParentUserName = parent >>= (^.mUser.to (nameForUserRef st)) , mdRenderReplyParent = True , mdHighlightSet = hs , mdIndentBlocks = True , mdThreadState = NoThread , mdShowReactions = False } in cached ViewMessageArea $ msgW <=> reactionsBody in centerLayer $ Widget Fixed Fixed $ do ctx <- getContext let width = min (maxWidth + 2) (ctx^.availWidthL) height = min maxHeight (ctx^.availHeightL) render $ vLimit height $ hLimit width $ borderWithLabel (withDefAttr clientEmphAttr $ str "View Message") $ viewport ViewMessageArea Both $ body reactionsText :: ChatState -> Message -> Widget Name reactionsText st m = hLimit maxWidth body where body = case null reacList of True -> emptyWidget False -> padTop (Pad 1) $ vBox $ (hBorderWithLabel (withDefAttr clientEmphAttr $ txt "Reactions")) : (mkEntry <$> reacList) reacList = M.toList (m^.mReactions) mkEntry (reactionName, userIdSet) = let count = str $ "(" <> show (S.size userIdSet) <> ")" name = withDefAttr emojiAttr $ txt $ ":" <> reactionName <> ":" usernameList = usernameText userIdSet in (name <+> (padLeft (Pad 1) count)) <=> (padLeft (Pad 2) usernameList) hs = getHighlightSet st usernameText uids = renderText' hs $ T.intercalate ", " $ fmap (userSigil <>) $ catMaybes (lookupUsername <$> F.toList uids) lookupUsername uid = usernameForUserId uid st