module Matterhorn.Draw.Autocomplete
  ( autocompleteLayer
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.List ( renderList, listElementsL, listSelectedFocusedAttr
                                    , listSelectedElement
                                    )
import qualified Data.Text as T

import           Network.Mattermost.Types ( User(..), Channel(..) )

import           Matterhorn.Constants ( normalChannelSigil )
import           Matterhorn.Draw.Util
import           Matterhorn.Themes
import           Matterhorn.Types
import           Matterhorn.Types.Common ( sanitizeUserText )


autocompleteLayer :: ChatState -> Widget Name
autocompleteLayer :: ChatState -> Widget Name
autocompleteLayer ChatState
st =
    case ChatState
stChatState
-> Getting
     (Maybe AutocompleteState) ChatState (Maybe AutocompleteState)
-> Maybe AutocompleteState
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Maybe AutocompleteState) TeamState)
-> ChatState -> Const (Maybe AutocompleteState) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe AutocompleteState) TeamState)
 -> ChatState -> Const (Maybe AutocompleteState) ChatState)
-> ((Maybe AutocompleteState
     -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
    -> TeamState -> Const (Maybe AutocompleteState) TeamState)
-> Getting
     (Maybe AutocompleteState) ChatState (Maybe AutocompleteState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
-> TeamState -> Const (Maybe AutocompleteState) TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
 -> TeamState -> Const (Maybe AutocompleteState) TeamState)
-> ((Maybe AutocompleteState
     -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
    -> ChatEditState -> Const (Maybe AutocompleteState) ChatEditState)
-> (Maybe AutocompleteState
    -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
-> TeamState
-> Const (Maybe AutocompleteState) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState
 -> Const (Maybe AutocompleteState) (Maybe AutocompleteState))
-> ChatEditState -> Const (Maybe AutocompleteState) ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete of
        Maybe AutocompleteState
Nothing ->
            Widget Name
forall n. Widget n
emptyWidget
        Just AutocompleteState
ac ->
            ChatState -> AutocompleteState -> Widget Name
renderAutocompleteBox ChatState
st AutocompleteState
ac

userNotInChannelMarker :: T.Text
userNotInChannelMarker :: Text
userNotInChannelMarker = Text
"*"

elementTypeLabel :: AutocompletionType -> Text
elementTypeLabel :: AutocompletionType -> Text
elementTypeLabel AutocompletionType
ACUsers = Text
"Users"
elementTypeLabel AutocompletionType
ACChannels = Text
"Channels"
elementTypeLabel AutocompletionType
ACCodeBlockLanguage = Text
"Languages"
elementTypeLabel AutocompletionType
ACEmoji = Text
"Emoji"
elementTypeLabel AutocompletionType
ACCommands = Text
"Commands"

renderAutocompleteBox :: ChatState -> AutocompleteState -> Widget Name
renderAutocompleteBox :: ChatState -> AutocompleteState -> Widget Name
renderAutocompleteBox ChatState
st AutocompleteState
ac =
    let matchList :: List Name AutocompleteAlternative
matchList = AutocompleteState -> List Name AutocompleteAlternative
_acCompletionList AutocompleteState
ac
        maxListHeight :: Int
maxListHeight = Int
5
        visibleHeight :: Int
visibleHeight = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxListHeight Int
numResults
        numResults :: Int
numResults = Vector AutocompleteAlternative -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector AutocompleteAlternative
elements
        elements :: Vector AutocompleteAlternative
elements = List Name AutocompleteAlternative
matchListList Name AutocompleteAlternative
-> Getting
     (Vector AutocompleteAlternative)
     (List Name AutocompleteAlternative)
     (Vector AutocompleteAlternative)
-> Vector AutocompleteAlternative
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector AutocompleteAlternative)
  (List Name AutocompleteAlternative)
  (Vector AutocompleteAlternative)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL
        label :: Widget n
label = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientMessageAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ AutocompletionType -> Text
elementTypeLabel (AutocompleteState
acAutocompleteState
-> Getting AutocompletionType AutocompleteState AutocompletionType
-> AutocompletionType
forall s a. s -> Getting a s a -> a
^.Getting AutocompletionType AutocompleteState AutocompletionType
Lens' AutocompleteState AutocompletionType
acType) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
numResults) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text
" match" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
numResults Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Text
"es") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                     Text
" (Tab/Shift-Tab to select)"

        selElem :: Maybe AutocompleteAlternative
selElem = (Int, AutocompleteAlternative) -> AutocompleteAlternative
forall a b. (a, b) -> b
snd ((Int, AutocompleteAlternative) -> AutocompleteAlternative)
-> Maybe (Int, AutocompleteAlternative)
-> Maybe AutocompleteAlternative
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List Name AutocompleteAlternative
-> Maybe (Int, AutocompleteAlternative)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List Name AutocompleteAlternative
matchList
        curChan :: ClientChannel
curChan = ChatState
stChatState
-> Getting ClientChannel ChatState ClientChannel -> ClientChannel
forall s a. s -> Getting a s a -> a
^.Getting ClientChannel ChatState ClientChannel
Lens' ChatState ClientChannel
csCurrentChannel
        footer :: Widget Name
footer = case ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor ClientChannel
curChan (AutocompleteAlternative -> Maybe (Widget Name))
-> Maybe AutocompleteAlternative -> Maybe (Widget Name)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe AutocompleteAlternative
selElem of
            Just Widget Name
w -> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
w
            Maybe (Widget Name)
_ -> Widget Name
forall n. Widget n
hBorder
        curUser :: Text
curUser = ChatState -> Text
myUsername ChatState
st

    in if Int
numResults Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then Widget Name
forall n. Widget n
emptyWidget
       else Size -> Size -> RenderM Name (Result Name) -> Widget Name
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM Name (Result Name) -> Widget Name)
-> RenderM Name (Result Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
           Context
ctx <- RenderM Name Context
forall n. RenderM n Context
getContext
           let rowOffset :: Int
rowOffset = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
editorOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
visibleHeight
               editorOffset :: Int
editorOffset = if ChatState
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const Bool TeamState)
-> ChatState -> Const Bool ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Bool TeamState)
 -> ChatState -> Const Bool ChatState)
-> ((Bool -> Const Bool Bool) -> TeamState -> Const Bool TeamState)
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Const Bool ChatEditState)
-> TeamState -> Const Bool TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Const Bool ChatEditState)
 -> TeamState -> Const Bool TeamState)
-> ((Bool -> Const Bool Bool)
    -> ChatEditState -> Const Bool ChatEditState)
-> (Bool -> Const Bool Bool)
-> TeamState
-> Const Bool TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> ChatEditState -> Const Bool ChatEditState
Lens' ChatEditState EphemeralEditState
cedEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> ChatEditState -> Const Bool ChatEditState)
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> ChatEditState
-> Const Bool ChatEditState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline
                              then Int
multilineHeightLimit
                              else Int
0
           Widget Name -> RenderM Name (Result Name)
forall n. Widget n -> RenderM n (Result n)
render (Widget Name -> RenderM Name (Result Name))
-> Widget Name -> RenderM Name (Result Name)
forall a b. (a -> b) -> a -> b
$ Location -> Widget Name -> Widget Name
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
0, Int
rowOffset)) (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
vBox [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hBorderWithLabel Widget Name
forall n. Widget n
label
                         , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
visibleHeight (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                           (Bool -> AutocompleteAlternative -> Widget Name)
-> Bool -> List Name AutocompleteAlternative -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList (Text -> Bool -> AutocompleteAlternative -> Widget Name
renderAutocompleteAlternative Text
curUser) Bool
True List Name AutocompleteAlternative
matchList
                         , Widget Name
footer
                         ]

renderAutocompleteFooterFor :: ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor :: ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor ClientChannel
_ (SpecialMention SpecialMention
MentionChannel) = Maybe (Widget Name)
forall a. Maybe a
Nothing
renderAutocompleteFooterFor ClientChannel
_ (SpecialMention SpecialMention
MentionAll) = Maybe (Widget Name)
forall a. Maybe a
Nothing
renderAutocompleteFooterFor ClientChannel
ch (UserCompletion User
_ Bool
False) =
    Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"("
                , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
userNotInChannelMarker)
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
": not a member of "
                , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelNameAttr (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ClientChannel
chClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdName)
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
                ]
renderAutocompleteFooterFor ClientChannel
_ (ChannelCompletion Bool
False Channel
ch) =
    Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"("
                , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
userNotInChannelMarker)
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
": you are not a member of "
                , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelNameAttr (Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserText -> Text
sanitizeUserText (Channel -> UserText
channelName Channel
ch))
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
                ]
renderAutocompleteFooterFor ClientChannel
_ (CommandCompletion CompletionSource
src Text
_ Text
_ Text
_) =
    case CompletionSource
src of
        CompletionSource
Server ->
            Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
Just (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text
"("
                        , AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Text -> Widget Name
forall n. Text -> Widget n
txt Text
serverCommandMarker)
                        , Text -> Widget Name
forall n. Text -> Widget n
txt Text
": command provided by the server)"
                        ]
        CompletionSource
Client -> Maybe (Widget Name)
forall a. Maybe a
Nothing
renderAutocompleteFooterFor ClientChannel
_ AutocompleteAlternative
_ =
    Maybe (Widget Name)
forall a. Maybe a
Nothing

serverCommandMarker :: Text
serverCommandMarker :: Text
serverCommandMarker = Text
"*"

renderAutocompleteAlternative :: Text -> Bool -> AutocompleteAlternative -> Widget Name
renderAutocompleteAlternative :: Text -> Bool -> AutocompleteAlternative -> Widget Name
renderAutocompleteAlternative Text
_ Bool
sel (EmojiCompletion Text
e) =
    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
$ Bool -> Text -> Widget Name
renderEmojiCompletion Bool
sel Text
e
renderAutocompleteAlternative Text
_ Bool
sel (SpecialMention SpecialMention
m) =
    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
$ SpecialMention -> Bool -> Widget Name
renderSpecialMention SpecialMention
m Bool
sel
renderAutocompleteAlternative Text
curUser Bool
sel (UserCompletion User
u Bool
inChan) =
    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
$ Text -> User -> Bool -> Bool -> Widget Name
renderUserCompletion Text
curUser User
u Bool
inChan Bool
sel
renderAutocompleteAlternative Text
_ Bool
sel (ChannelCompletion Bool
inChan Channel
c) =
    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
$ Channel -> Bool -> Bool -> Widget Name
renderChannelCompletion Channel
c Bool
inChan Bool
sel
renderAutocompleteAlternative Text
_ Bool
_ (SyntaxCompletion Text
t) =
    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
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
t
renderAutocompleteAlternative Text
_ Bool
_ (CommandCompletion CompletionSource
src Text
n Text
args Text
desc) =
    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
$ CompletionSource -> Text -> Text -> Text -> Widget Name
renderCommandCompletion CompletionSource
src Text
n Text
args Text
desc

renderSpecialMention :: SpecialMention -> Bool -> Widget Name
renderSpecialMention :: SpecialMention -> Bool -> Widget Name
renderSpecialMention SpecialMention
m Bool
sel =
    let usernameWidth :: Int
usernameWidth = Int
18
        padTo :: Int -> Widget n -> Widget n
padTo Int
n Widget n
a = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n
a Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
fill Char
' ')
        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
        t :: Text
t = AutocompleteAlternative -> Text
autocompleteAlternativeReplacement (AutocompleteAlternative -> Text)
-> AutocompleteAlternative -> Text
forall a b. (a -> b) -> a -> b
$ SpecialMention -> AutocompleteAlternative
SpecialMention SpecialMention
m
        desc :: Text
desc = case SpecialMention
m of
            SpecialMention
MentionChannel -> Text
"Notifies all users in this channel"
            SpecialMention
MentionAll     -> Text
"Mentions all users in this channel"
    in 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
$
       [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget Name
forall n. Text -> Widget n
txt Text
"  "
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTo Int
usernameWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (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
t
            , Text -> Widget Name
forall n. Text -> Widget n
txt Text
desc
            ]

renderEmojiCompletion :: Bool -> T.Text -> Widget Name
renderEmojiCompletion :: Bool -> Text -> Widget Name
renderEmojiCompletion Bool
sel 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 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
padLeft (Int -> Padding
Pad Int
2) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       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
$
       AutocompleteAlternative -> Text
autocompleteAlternativeReplacement (AutocompleteAlternative -> Text)
-> AutocompleteAlternative -> Text
forall a b. (a -> b) -> a -> b
$ Text -> AutocompleteAlternative
EmojiCompletion Text
e

renderUserCompletion :: Text -> User -> Bool -> Bool -> Widget Name
renderUserCompletion :: Text -> User -> Bool -> Bool -> Widget Name
renderUserCompletion Text
curUser User
u Bool
inChan Bool
selected =
    let usernameWidth :: Int
usernameWidth = Int
18
        fullNameWidth :: Int
fullNameWidth = Int
25
        padTo :: Int -> Widget n -> Widget n
padTo Int
n Widget n
a = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n
a Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
fill Char
' ')
        username :: Text
username = User -> Text
userUsername User
u
        fullName :: Text
fullName = (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userFirstName User
u) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userLastName User
u)
        nickname :: Text
nickname = UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ User -> UserText
userNickname User
u
        maybeForce :: Widget n -> Widget n
maybeForce = if Bool
selected
                     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
        memberDisplay :: Widget n
memberDisplay = if Bool
inChan
                        then Text -> Widget n
forall n. Text -> Widget n
txt Text
"  "
                        else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                             Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
userNotInChannelMarker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    in 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
$
       [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Widget Name
forall n. Widget n
memberDisplay
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTo Int
usernameWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Widget Name
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
curUser Text
username (Text
"@" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
username)
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTo Int
fullNameWidth (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
fullName
            , Text -> Widget Name
forall n. Text -> Widget n
txt Text
nickname
            ]

renderChannelCompletion :: Channel -> Bool -> Bool -> Widget Name
renderChannelCompletion :: Channel -> Bool -> Bool -> Widget Name
renderChannelCompletion Channel
c Bool
inChan Bool
selected =
    let urlNameWidth :: Int
urlNameWidth = Int
30
        displayNameWidth :: Int
displayNameWidth = Int
30
        padTo :: Int -> Widget n -> Widget n
padTo Int
n Widget n
a = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n
a Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
fill Char
' ')
        maybeForce :: Widget n -> Widget n
maybeForce = if Bool
selected
                     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
        memberDisplay :: Widget n
memberDisplay = if Bool
inChan
                        then Text -> Widget n
forall n. Text -> Widget n
txt Text
"  "
                        else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                             Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Text
userNotInChannelMarker Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    in 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
$
       [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Widget Name
forall n. Widget n
memberDisplay
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTo Int
urlNameWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
              AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelNameAttr (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
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
c)
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padTo Int
displayNameWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
              AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelNameAttr (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
$ UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelDisplayName Channel
c
            , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (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
$ UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelPurpose Channel
c
            ]

renderCommandCompletion :: CompletionSource -> Text -> Text -> Text -> Widget Name
renderCommandCompletion :: CompletionSource -> Text -> Text -> Text -> Widget Name
renderCommandCompletion CompletionSource
src Text
name Text
args Text
desc =
    (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
srcTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
    AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientMessageAttr
        (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
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
T.null Text
args then Text
"" else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
args) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
    (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
desc)
    where
        srcTxt :: Text
srcTxt = case CompletionSource
src of
            CompletionSource
Server -> Text
serverCommandMarker
            CompletionSource
Client -> Text
" "