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 = ListWindowState (Bool, Text) ()
-> (() -> Widget Name)
-> (() -> Widget Name)
-> (() -> Widget Name)
-> (Bool -> (Bool, Text) -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
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
stChatState
-> Getting
     (ListWindowState (Bool, Text) ())
     ChatState
     (ListWindowState (Bool, Text) ())
-> ListWindowState (Bool, Text) ()
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (ListWindowState (Bool, Text) ()) TeamState)
 -> ChatState -> Const (ListWindowState (Bool, Text) ()) ChatState)
-> ((ListWindowState (Bool, Text) ()
     -> Const
          (ListWindowState (Bool, Text) ())
          (ListWindowState (Bool, Text) ()))
    -> TeamState -> Const (ListWindowState (Bool, Text) ()) TeamState)
-> Getting
     (ListWindowState (Bool, Text) ())
     ChatState
     (ListWindowState (Bool, Text) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState (Bool, Text) ()
 -> Const
      (ListWindowState (Bool, Text) ())
      (ListWindowState (Bool, Text) ()))
-> TeamState -> Const (ListWindowState (Bool, Text) ()) TeamState
Lens' TeamState (ListWindowState (Bool, Text) ())
tsReactionEmojiListWindow)
                                  (Widget Name -> () -> Widget Name
forall a b. a -> b -> a
const (Widget Name -> () -> Widget Name)
-> Widget Name -> () -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Search Emoji")
                                  (Widget Name -> () -> Widget Name
forall a b. a -> b -> a
const (Widget Name -> () -> Widget Name)
-> Widget Name -> () -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"No matching emoji found.")
                                  (Widget Name -> () -> Widget Name
forall a b. a -> b -> a
const (Widget Name -> () -> Widget Name)
-> Widget Name -> () -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Search emoji:")
                                  Bool -> (Bool, Text) -> Widget Name
renderEmoji
                                  Maybe (Widget Name)
forall a. Maybe a
Nothing
                                  WindowPosition
WindowCenter
                                  Int
80
    in Widget Name -> Widget Name
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 AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
listSelectedFocusedAttr
                     else Widget n -> Widget n
forall a. a -> a
id
    in Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable ((Bool, Text) -> Name
ClickableReactionEmojiListWindowEntry (Bool
mine, Text
e)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Widget Name -> Widget Name
forall n. Widget n -> Widget n
maybeForce (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ if Bool
mine then Text -> Widget Name
forall n. Text -> Widget n
txt Text
" * " else Text -> Widget Name
forall n. Text -> Widget n
txt Text
"   "
            , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
emojiAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
            ]