module Matterhorn.Draw.ReactionEmojiListWindow
  ( drawReactionEmojiListWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.List ( listSelectedFocusedAttr )
import qualified Data.Text as T

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Draw.ListWindow ( drawListWindow, WindowPosition(..) )
import           Matterhorn.Types
import           Matterhorn.Themes


drawReactionEmojiListWindow :: ChatState -> TeamId -> Widget Name
drawReactionEmojiListWindow :: ChatState -> TeamId -> Widget Name
drawReactionEmojiListWindow ChatState
st TeamId
tId =
    let window :: Widget Name
window = forall a b.
ListWindowState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
drawListWindow (ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState (Bool, Text) ())
tsReactionEmojiListWindow)
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Search Emoji")
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"No matching emoji found.")
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Search emoji:")
                                  Bool -> (Bool, Text) -> Widget Name
renderEmoji
                                  forall a. Maybe a
Nothing
                                  WindowPosition
WindowCenter
                                  Int
80
    in forall n. Widget n -> Widget n
joinBorders Widget Name
window

renderEmoji :: Bool -> (Bool, T.Text) -> Widget Name
renderEmoji :: Bool -> (Bool, Text) -> Widget Name
renderEmoji Bool
sel (Bool
mine, Text
e) =
    let maybeForce :: Widget n -> Widget n
maybeForce = if Bool
sel
                     then forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
listSelectedFocusedAttr
                     else forall a. a -> a
id
    in forall n. Ord n => n -> Widget n -> Widget n
clickable ((Bool, Text) -> Name
ClickableReactionEmojiListWindowEntry (Bool
mine, Text
e)) forall a b. (a -> b) -> a -> b
$
       forall n. Widget n -> Widget n
maybeForce forall a b. (a -> b) -> a -> b
$
       forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$
       forall n. [Widget n] -> Widget n
hBox [ if Bool
mine then forall n. Text -> Widget n
txt Text
" * " else forall n. Text -> Widget n
txt Text
"   "
            , forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
emojiAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
":" forall a. Semigroup a => a -> a -> a
<> Text
e forall a. Semigroup a => a -> a -> a
<> Text
":"
            ]