{-# LANGUAGE RankNTypes #-}
module Matterhorn.Draw.Autocomplete
  ( drawAutocompleteLayers
  )
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           Lens.Micro.Platform ( SimpleGetter, Lens' )

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

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

drawAutocompleteLayers :: ChatState -> [Widget Name]
drawAutocompleteLayers :: ChatState -> [Widget Name]
drawAutocompleteLayers ChatState
st =
    [Maybe (Widget Name)] -> [Widget Name]
forall a. [Maybe a] -> [a]
catMaybes [ do
                    TeamId
tId <- ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                    ChannelId
cId <- ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
                    Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ ChatState -> SimpleGetter ChatState (EditState Name) -> Widget Name
autocompleteLayer ChatState
st (ChannelId -> Lens' ChatState (EditState Name)
channelEditor(ChannelId
cId))
              , do
                    TeamId
tId <- ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                    Maybe ThreadInterface -> Maybe ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Maybe ThreadInterface -> Maybe ())
-> Maybe ThreadInterface -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> Maybe ThreadInterface
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
 -> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
     -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
    -> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
 -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
                    let ti :: Lens' ChatState ThreadInterface
                        ti :: Lens' ChatState ThreadInterface
ti = HasCallStack => TeamId -> Lens' ChatState ThreadInterface
TeamId -> Lens' ChatState ThreadInterface
unsafeThreadInterface(TeamId
tId)
                        ed :: SimpleGetter ChatState (EditState Name)
                        ed :: SimpleGetter ChatState (EditState Name)
ed = (ThreadInterface -> Const r ThreadInterface)
-> ChatState -> Const r ChatState
Lens' ChatState ThreadInterface
ti((ThreadInterface -> Const r ThreadInterface)
 -> ChatState -> Const r ChatState)
-> ((EditState Name -> Const r (EditState Name))
    -> ThreadInterface -> Const r ThreadInterface)
-> (EditState Name -> Const r (EditState Name))
-> ChatState
-> Const r ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EditState Name -> Const r (EditState Name))
-> ThreadInterface -> Const r ThreadInterface
forall n i (f :: * -> *).
Functor f =>
(EditState n -> f (EditState n))
-> MessageInterface n i -> f (MessageInterface n i)
miEditor
                    Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ ChatState -> SimpleGetter ChatState (EditState Name) -> Widget Name
autocompleteLayer ChatState
st Getting r ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
ed
              ]

autocompleteLayer :: ChatState -> SimpleGetter ChatState (EditState Name) -> Widget Name
autocompleteLayer :: ChatState -> SimpleGetter ChatState (EditState Name) -> Widget Name
autocompleteLayer ChatState
st SimpleGetter ChatState (EditState Name)
which =
    case ChatState
stChatState
-> Getting
     (Maybe (AutocompleteState Name))
     ChatState
     (Maybe (AutocompleteState Name))
-> Maybe (AutocompleteState Name)
forall s a. s -> Getting a s a -> a
^.Getting (Maybe (AutocompleteState Name)) ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
whichGetting (Maybe (AutocompleteState Name)) ChatState (EditState Name)
-> ((Maybe (AutocompleteState Name)
     -> Const
          (Maybe (AutocompleteState Name)) (Maybe (AutocompleteState Name)))
    -> EditState Name
    -> Const (Maybe (AutocompleteState Name)) (EditState Name))
-> Getting
     (Maybe (AutocompleteState Name))
     ChatState
     (Maybe (AutocompleteState Name))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe (AutocompleteState Name)
 -> Const
      (Maybe (AutocompleteState Name)) (Maybe (AutocompleteState Name)))
-> EditState Name
-> Const (Maybe (AutocompleteState Name)) (EditState Name)
forall n (f :: * -> *).
Functor f =>
(Maybe (AutocompleteState n) -> f (Maybe (AutocompleteState n)))
-> EditState n -> f (EditState n)
esAutocomplete of
        Maybe (AutocompleteState Name)
Nothing ->
            Widget Name
forall n. Widget n
emptyWidget
        Just AutocompleteState Name
ac ->
            Widget Name -> Maybe (Widget Name) -> Widget Name
forall a. a -> Maybe a -> a
fromMaybe Widget Name
forall n. Widget n
emptyWidget (Maybe (Widget Name) -> Widget Name)
-> Maybe (Widget Name) -> Widget Name
forall a b. (a -> b) -> a -> b
$ do
                TeamId
tId <- ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
                let mcId :: Maybe ChannelId
mcId = ChatState
stChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
                    mCurChan :: Maybe ClientChannel
mCurChan = do
                        ChannelId
cId <- Maybe ChannelId
mcId
                        ChatState
stChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
                Widget Name -> Maybe (Widget Name)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget Name -> Maybe (Widget Name))
-> Widget Name -> Maybe (Widget Name)
forall a b. (a -> b) -> a -> b
$ ChatState
-> TeamId
-> Maybe ClientChannel
-> SimpleGetter ChatState (EditState Name)
-> AutocompleteState Name
-> Widget Name
renderAutocompleteBox ChatState
st TeamId
tId Maybe ClientChannel
mCurChan Getting r ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
which AutocompleteState Name
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
                      -> TeamId
                      -> Maybe ClientChannel
                      -> SimpleGetter ChatState (EditState Name)
                      -> AutocompleteState Name
                      -> Widget Name
renderAutocompleteBox :: ChatState
-> TeamId
-> Maybe ClientChannel
-> SimpleGetter ChatState (EditState Name)
-> AutocompleteState Name
-> Widget Name
renderAutocompleteBox ChatState
st TeamId
tId Maybe ClientChannel
mCurChan SimpleGetter ChatState (EditState Name)
which AutocompleteState Name
ac =
    let matchList :: List Name AutocompleteAlternative
matchList = AutocompleteState Name -> List Name AutocompleteAlternative
forall n. AutocompleteState n -> List n AutocompleteAlternative
_acCompletionList AutocompleteState Name
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 a. Vector a -> 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 (f :: * -> *).
Functor f =>
(t1 e1 -> f (t2 e2))
-> GenericList n t1 e1 -> f (GenericList n t2 e2)
listElementsL
        editorName :: Name
editorName = Editor Text Name -> Name
forall a n. Named a n => a -> n
getName (Editor Text Name -> Name) -> Editor Text Name -> Name
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.Getting (Editor Text Name) ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
whichGetting (Editor Text Name) ChatState (EditState Name)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> EditState Name -> Const (Editor Text Name) (EditState Name))
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> EditState Name -> Const (Editor Text Name) (EditState Name)
forall n (f :: * -> *).
Functor f =>
(Editor Text n -> f (Editor Text n))
-> EditState n -> f (EditState n)
esEditor
        isMultiline :: Bool
isMultiline = ChatState
stChatState -> Getting Bool ChatState Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool ChatState (EditState Name)
SimpleGetter ChatState (EditState Name)
whichGetting Bool ChatState (EditState Name)
-> ((Bool -> Const Bool Bool)
    -> EditState Name -> Const Bool (EditState Name))
-> Getting Bool ChatState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EphemeralEditState -> Const Bool EphemeralEditState)
-> EditState Name -> Const Bool (EditState Name)
forall n (f :: * -> *).
Functor f =>
(EphemeralEditState -> f EphemeralEditState)
-> EditState n -> f (EditState n)
esEphemeral((EphemeralEditState -> Const Bool EphemeralEditState)
 -> EditState Name -> Const Bool (EditState Name))
-> ((Bool -> Const Bool Bool)
    -> EphemeralEditState -> Const Bool EphemeralEditState)
-> (Bool -> Const Bool Bool)
-> EditState Name
-> Const Bool (EditState Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Bool Bool)
-> EphemeralEditState -> Const Bool EphemeralEditState
Lens' EphemeralEditState Bool
eesMultiline
        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 Name
acAutocompleteState Name
-> Getting
     AutocompletionType (AutocompleteState Name) AutocompletionType
-> AutocompletionType
forall s a. s -> Getting a s a -> a
^.Getting
  AutocompletionType (AutocompleteState Name) AutocompletionType
forall n (f :: * -> *).
Functor f =>
(AutocompletionType -> f AutocompletionType)
-> AutocompleteState n -> f (AutocompleteState n)
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 :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List Name AutocompleteAlternative
matchList
        footer :: Widget Name
footer = case Maybe ClientChannel
mCurChan of
            Maybe ClientChannel
Nothing ->
                Widget Name
forall n. Widget n
hBorder
            Just ClientChannel
curChan ->
                case ChatState
-> ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor ChatState
st 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
        cfg :: Config
cfg = ChatState
stChatState -> Getting Config ChatState Config -> Config
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const Config ChatResources)
-> ChatState -> Const Config ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const Config ChatResources)
 -> ChatState -> Const Config ChatState)
-> ((Config -> Const Config Config)
    -> ChatResources -> Const Config ChatResources)
-> Getting Config ChatState Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const Config Config)
-> ChatResources -> Const Config ChatResources
Lens' ChatResources Config
crConfiguration
        showingChanList :: Bool
showingChanList = Config -> Bool
configShowChannelList Config
cfg
        maybeLimit :: Widget n -> Widget n
maybeLimit = (Widget n -> Widget n)
-> Maybe (Widget n -> Widget n) -> Widget n -> Widget n
forall a. a -> Maybe a -> a
fromMaybe Widget n -> Widget n
forall a. a -> a
id (Maybe (Widget n -> Widget n) -> Widget n -> Widget n)
-> Maybe (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ do
            let sub :: Int
sub = if Bool
showingChanList
                      then ChatState -> Int
channelListWidth ChatState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      else Int
0
                threadNarrow :: Bool
threadNarrow = Bool
threadShowing Bool -> Bool -> Bool
&& (Config
cfgConfig
-> Getting ThreadOrientation Config ThreadOrientation
-> ThreadOrientation
forall s a. s -> Getting a s a -> a
^.Getting ThreadOrientation Config ThreadOrientation
Lens' Config ThreadOrientation
configThreadOrientationL ThreadOrientation -> [ThreadOrientation] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ThreadOrientation
ThreadLeft, ThreadOrientation
ThreadRight])
                threadShowing :: Bool
threadShowing = Maybe ThreadInterface -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ThreadInterface -> Bool) -> Maybe ThreadInterface -> Bool
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> Maybe ThreadInterface
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
 -> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
     -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
    -> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
 -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface

            if Bool
threadNarrow Bool -> Bool -> Bool
|| Int
sub Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
               then (Widget n -> Widget n) -> Maybe (Widget n -> Widget n)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Widget n -> Widget n) -> Maybe (Widget n -> Widget n))
-> (Widget n -> Widget n) -> Maybe (Widget n -> Widget n)
forall a b. (a -> b) -> a -> b
$ \Widget n
w -> Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
                   Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
                   let adjusted :: Int
adjusted = Context n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sub
                       lim :: Int
lim = if Bool
threadNarrow
                             then (Int
adjusted Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                             else Int
adjusted
                   Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
lim Widget n
w
               else Maybe (Widget n -> Widget n)
forall a. Maybe a
Nothing

        -- The top left corner of the editor area is given by the
        -- prompt, or by the editor position if multiline is enabled (in
        -- which case no prompt is drawn).
        editorTop :: Name
editorTop = if Bool
isMultiline
                    then Name
editorName
                    else Name -> Name
MessageInputPrompt Name
editorName

    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
           let verticalOffset :: Int
verticalOffset = -Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
visibleHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
           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
$ Name -> Location -> Widget Name -> Widget Name
forall n. Ord n => n -> Location -> Widget n -> Widget n
relativeTo Name
editorTop ((Int, Int) -> Location
Location (Int
0, Int
verticalOffset)) (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
maybeLimit (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 :: ChatState -> ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor :: ChatState
-> ClientChannel -> AutocompleteAlternative -> Maybe (Widget Name)
renderAutocompleteFooterFor ChatState
_ ClientChannel
_ (SpecialMention SpecialMention
MentionChannel) = Maybe (Widget Name)
forall a. Maybe a
Nothing
renderAutocompleteFooterFor ChatState
_ ClientChannel
_ (SpecialMention SpecialMention
MentionAll) = Maybe (Widget Name)
forall a. Maybe a
Nothing
renderAutocompleteFooterFor ChatState
st 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
$ ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st (ClientChannel
chClientChannel
-> Getting ChannelInfo ClientChannel ChannelInfo -> ChannelInfo
forall s a. s -> Getting a s a -> a
^.Getting ChannelInfo ClientChannel ChannelInfo
Lens' ClientChannel ChannelInfo
ccInfo))
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
                ]
renderAutocompleteFooterFor ChatState
_ 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
<> Channel -> Text
preferredChannelName Channel
ch)
                , Text -> Widget Name
forall n. Text -> Widget n
txt Text
")"
                ]
renderAutocompleteFooterFor ChatState
_ 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 ChatState
_ 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
" "