{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Matterhorn.Draw.UserListOverlay
  ( drawUserListOverlay
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import qualified Brick.Widgets.List as L
import qualified Data.Text as T
import qualified Graphics.Vty as V

import           Matterhorn.Draw.Util ( userSigilFromInfo )
import           Matterhorn.Draw.ListOverlay ( drawListOverlay, OverlayPosition(..) )
import           Matterhorn.Themes
import           Matterhorn.Types


drawUserListOverlay :: ChatState -> Widget Name
drawUserListOverlay :: ChatState -> Widget Name
drawUserListOverlay ChatState
st =
    let overlay :: Widget Name
overlay = ListOverlayState UserInfo UserSearchScope
-> (UserSearchScope -> Widget Name)
-> (UserSearchScope -> Widget Name)
-> (UserSearchScope -> Widget Name)
-> (Bool -> UserInfo -> Widget Name)
-> Maybe (Widget Name)
-> OverlayPosition
-> Int
-> Widget Name
forall a b.
ListOverlayState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> OverlayPosition
-> Int
-> Widget Name
drawListOverlay (ChatState
stChatState
-> Getting
     (ListOverlayState UserInfo UserSearchScope)
     ChatState
     (ListOverlayState UserInfo UserSearchScope)
-> ListOverlayState UserInfo UserSearchScope
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const (ListOverlayState UserInfo UserSearchScope) TeamState)
-> ChatState
-> Const (ListOverlayState UserInfo UserSearchScope) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (ListOverlayState UserInfo UserSearchScope) TeamState)
 -> ChatState
 -> Const (ListOverlayState UserInfo UserSearchScope) ChatState)
-> ((ListOverlayState UserInfo UserSearchScope
     -> Const
          (ListOverlayState UserInfo UserSearchScope)
          (ListOverlayState UserInfo UserSearchScope))
    -> TeamState
    -> Const (ListOverlayState UserInfo UserSearchScope) TeamState)
-> Getting
     (ListOverlayState UserInfo UserSearchScope)
     ChatState
     (ListOverlayState UserInfo UserSearchScope)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState UserInfo UserSearchScope
 -> Const
      (ListOverlayState UserInfo UserSearchScope)
      (ListOverlayState UserInfo UserSearchScope))
-> TeamState
-> Const (ListOverlayState UserInfo UserSearchScope) TeamState
Lens' TeamState (ListOverlayState UserInfo UserSearchScope)
tsUserListOverlay) UserSearchScope -> Widget Name
userSearchScopeHeader
                                  UserSearchScope -> Widget Name
userSearchScopeNoResults UserSearchScope -> Widget Name
userSearchScopePrompt
                                  (Text -> Bool -> UserInfo -> Widget Name
renderUser (ChatState -> Text
myUsername ChatState
st))
                                  Maybe (Widget Name)
forall a. Maybe a
Nothing
                                  OverlayPosition
OverlayCenter
                                  Int
80
    in Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders Widget Name
overlay

userSearchScopePrompt :: UserSearchScope -> Widget Name
userSearchScopePrompt :: UserSearchScope -> Widget Name
userSearchScopePrompt UserSearchScope
scope =
    Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ case UserSearchScope
scope of
        ChannelMembers ChannelId
_ TeamId
_    -> Text
"Search channel members:"
        ChannelNonMembers ChannelId
_ TeamId
_ -> Text
"Search users:"
        AllUsers Maybe TeamId
Nothing      -> Text
"Search users:"
        AllUsers (Just TeamId
_)     -> Text
"Search team members:"

userSearchScopeNoResults :: UserSearchScope -> Widget Name
userSearchScopeNoResults :: UserSearchScope -> Widget Name
userSearchScopeNoResults UserSearchScope
scope =
    Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ case UserSearchScope
scope of
        ChannelMembers ChannelId
_ TeamId
_    -> Text
"No users in channel."
        ChannelNonMembers ChannelId
_ TeamId
_ -> Text
"All users in your team are already in this channel."
        AllUsers Maybe TeamId
_            -> Text
"No users found."

userSearchScopeHeader :: UserSearchScope -> Widget Name
userSearchScopeHeader :: UserSearchScope -> Widget Name
userSearchScopeHeader UserSearchScope
scope =
    Text -> Widget Name
forall n. Text -> Widget n
txt (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$ case UserSearchScope
scope of
        ChannelMembers {}    -> Text
"Channel Members"
        ChannelNonMembers {} -> Text
"Invite Users to Channel"
        AllUsers Maybe TeamId
Nothing     -> Text
"Users On This Server"
        AllUsers (Just TeamId
_)    -> Text
"Users In My Team"

renderUser :: Text -> Bool -> UserInfo -> Widget Name
renderUser :: Text -> Bool -> UserInfo -> Widget Name
renderUser Text
myUName Bool
foc UserInfo
ui =
    (if Bool
foc then AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
L.listSelectedFocusedAttr else Widget Name -> Widget Name
forall a. a -> a
id) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (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
myUName (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName) (Char -> Text
T.singleton (Char -> Text) -> Char -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo -> Char
userSigilFromInfo UserInfo
ui))
           Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit Int
usernameWidth (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Widget Name
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
myUName (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName) (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName))
           Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
forall n. [Widget n]
extras
    where
        sanitize :: Text -> Text
sanitize = Text -> Text
T.strip (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
T.replace Text
"\t" Text
" "
        usernameWidth :: Int
usernameWidth = Int
20
        extras :: [Widget n]
extras = Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Widget n)
forall n. Maybe (Widget n)
mFullname, Maybe (Widget n)
forall n. Maybe (Widget n)
mNickname, Maybe (Widget n)
forall n. Maybe (Widget n)
mEmail]
        mFullname :: Maybe (Widget n)
mFullname = if (Bool -> Bool
not (Text -> Bool
T.null (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiFirstName)) Bool -> Bool -> Bool
|| Bool -> Bool
not (Text -> Bool
T.null (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiLastName)))
                    then Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (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 -> Text
sanitize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiFirstName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text
sanitize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiLastName)
                    else Maybe (Widget n)
forall a. Maybe a
Nothing
        mNickname :: Maybe (Widget n)
mNickname = case UserInfo
uiUserInfo
-> Getting (Maybe Text) UserInfo (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) UserInfo (Maybe Text)
Lens' UserInfo (Maybe Text)
uiNickName of
                      Just Text
n | Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= (UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName) -> Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (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
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
                      Maybe Text
_ -> Maybe (Widget n)
forall a. Maybe a
Nothing
        mEmail :: Maybe (Widget n)
mEmail = if (Text -> Bool
T.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiEmail)
                 then Maybe (Widget n)
forall a. Maybe a
Nothing
                 else Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ (Attr -> Attr) -> Widget n -> Widget n
forall n. (Attr -> Attr) -> Widget n -> Widget n
modifyDefAttr (Attr -> Text -> Attr
`V.withURL` (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiEmail)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                             AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
urlAttr (Text -> Widget n
forall n. Text -> Widget n
txt (Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UserInfo
uiUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiEmail Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"))