{-# 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
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)
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
" "