{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module Matterhorn.Draw.PostListWindow where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Center
import           Control.Monad.Trans.Reader ( withReaderT )
import qualified Data.Text as T
import           Lens.Micro.Platform ( (%~), to )

import           Network.Mattermost.Lenses
import           Network.Mattermost.Types

import           Matterhorn.Draw.Messages
import           Matterhorn.Draw.Util
import           Matterhorn.Themes
import           Matterhorn.Types


hLimitWithPadding :: Int -> Widget n -> Widget n
hLimitWithPadding :: forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
pad Widget n
contents = Widget
  { hSize :: Size
hSize  = Size
Fixed
  , vSize :: Size
vSize  = (forall n. Widget n -> Size
vSize Widget n
contents)
  , render :: RenderM n (Result n)
render =
      forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (forall a b. a -> (a -> b) -> b
& forall n. Lens' (Context n) Int
availWidthL  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\ Int
n -> Int
n forall a. Num a => a -> a -> a
- (Int
2 forall a. Num a => a -> a -> a
* Int
pad))) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
cropToContext Widget n
contents
  }

drawPostListWindow :: PostListContents -> ChatState -> TeamId -> Widget Name
drawPostListWindow :: PostListContents -> ChatState -> TeamId -> Widget Name
drawPostListWindow PostListContents
contents ChatState
st TeamId
tId = forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$ PostListContents -> ChatState -> TeamId -> Widget Name
drawPostsBox PostListContents
contents ChatState
st TeamId
tId

-- | Draw a PostListWindow as a floating window on top of whatever
-- is rendered beneath it
drawPostsBox :: PostListContents -> ChatState -> TeamId -> Widget Name
drawPostsBox :: PostListContents -> ChatState -> TeamId -> Widget Name
drawPostsBox PostListContents
contents ChatState
st TeamId
tId =
  forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimitWithPadding Int
10 forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n -> Widget n
borderWithLabel forall {n}. Widget n
contentHeader forall a b. (a -> b) -> a -> b
$
    forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) Widget Name
messageListContents
  where -- The 'window title' of the window
        hs :: HighlightSet
hs = ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId
        contentHeader :: Widget n
contentHeader = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
channelListHeaderAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ case PostListContents
contents of
          PostListContents
PostListFlagged -> Text
"Flagged posts"
          PostListPinned ChannelId
cId ->
              let cName :: Text
cName = case ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) of
                      Maybe ClientChannel
Nothing -> Text
"<UNKNOWN>"
                      Just ClientChannel
cc -> ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st (ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfo)
              in Text
"Posts pinned in " forall a. Semigroup a => a -> a -> a
<> Text
cName
          PostListSearch Text
terms Bool
searching -> Text
"Search results" forall a. Semigroup a => a -> a -> a
<> if Bool
searching
            then Text
": " forall a. Semigroup a => a -> a -> a
<> Text
terms
            else Text
" (" forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) DirectionalSeq Chronological Message
entries forall a. Semigroup a => a -> a -> a
<> Text
"): " forall a. Semigroup a => a -> a -> a
<> Text
terms

        entries :: DirectionalSeq Chronological Message
entries = forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages Message -> Bool
knownChannel forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (DirectionalSeq Chronological Message)
postListPosts
        messages :: DirectionalSeq Chronological Message
messages = DirectionalSeq Chronological Message
-> Text -> TimeZoneSeries -> DirectionalSeq Chronological Message
insertDateMarkers
                     DirectionalSeq Chronological Message
entries
                     (ChatState -> Text
getDateFormat ChatState
st)
                     (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState TimeZoneSeries
timeZone)

        knownChannel :: Message -> Bool
knownChannel Message
msg =
            case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe ChannelId)
mChannelId of
                Just ChannelId
cId | Maybe ClientChannel
Nothing <- ChatState
stforall s a. s -> Getting (First a) s a -> Maybe a
^?Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL(ChannelId
cId) -> Bool
False
                Maybe ChannelId
_ -> Bool
True

        -- The overall contents, with a sensible default even if there
        -- are no messages
        messageListContents :: Widget Name
messageListContents
          | forall (t :: * -> *) a. Foldable t => t a -> Bool
null DirectionalSeq Chronological Message
messages =
            forall n. Int -> Widget n -> Widget n
padTopBottom Int
1 forall a b. (a -> b) -> a -> b
$
            forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$
            forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
            forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ case PostListContents
contents of
              PostListContents
PostListFlagged -> String
"You have no flagged messages."
              PostListPinned ChannelId
_ -> String
"This channel has no pinned messages."
              PostListSearch Text
_ Bool
searching ->
                if Bool
searching
                  then String
"Searching ..."
                  else String
"No search results found"
          | Bool
otherwise = forall n. [Widget n] -> Widget n
vBox [Widget Name]
renderedMessageList

        -- The render-message function we're using
        renderMessageForWindow :: Message -> ThreadState -> Name -> Widget Name
renderMessageForWindow Message
msg ThreadState
tState Name
tag =
          let renderedMsg :: Widget Name
renderedMsg = ChatState
-> HighlightSet
-> Bool
-> Maybe ServerTime
-> Message
-> ThreadState
-> Name
-> Widget Name
renderSingleMessage ChatState
st HighlightSet
hs Bool
True forall a. Maybe a
Nothing Message
msg ThreadState
tState Name
tag
          in case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost of
            -- We should factor out some of the channel name logic at
            -- some point, but we can do that later
            Just Post
post
              | Just ClientChannel
chan <- ChatState
stforall s a. s -> Getting (First a) s a -> Maybe a
^?Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL(Post
postforall s a. s -> Getting a s a -> a
^.Lens' Post ChannelId
postChannelIdL) ->
                 case ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType of
                  Type
Direct
                    | Just UserInfo
u <- forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> ChatState -> Maybe UserInfo
userById ChatState
st forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId ->
                        (forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
channelNameAttr (forall n. Text -> Widget n
txt (Text -> Text
addUserSigil forall a b. (a -> b) -> a -> b
$ UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Text
uiName)) forall n. Widget n -> Widget n -> Widget n
<=>
                          (forall n. String -> Widget n
str String
"  " forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
renderedMsg))
                  Type
_ -> (forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
channelNameAttr (forall n. Text -> Widget n
txt (ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st))) forall n. Widget n -> Widget n -> Widget n
<=>
                         (forall n. String -> Widget n
str String
"  " forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
renderedMsg))
            Maybe Post
_ | CP ClientPostType
_ <- Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message MessageType
mType -> forall n. String -> Widget n
str String
"[BUG: unknown channel]"
              | Bool
otherwise -> Widget Name
renderedMsg

        -- The full message list, rendered with the current selection
        renderedMessageList :: [Widget Name]
renderedMessageList =
          let (Maybe (Message, ThreadState)
s, (DirectionalSeq
  (ReverseDirection Chronological) (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after)) = forall d a.
SeqDirection d =>
(a -> Bool)
-> DirectionalSeq d a
-> (Maybe a,
    (DirectionalSeq (ReverseDirection d) a, DirectionalSeq d a))
splitDirSeqOn forall {b}. (Message, b) -> Bool
matchesMessage DirectionalSeq Chronological (Message, ThreadState)
messagesWithStates
              matchesMessage :: (Message, b) -> Bool
matchesMessage (Message
m, b
_) = Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe MessageId)
mMessageId forall a. Eq a => a -> a -> Bool
== (PostId -> MessageId
MessagePostId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState PostListWindowState
tsPostListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' PostListWindowState (Maybe PostId)
postListSelected)
              messagesWithStates :: DirectionalSeq Chronological (Message, ThreadState)
messagesWithStates = (, ThreadState
InThreadShowParent) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirectionalSeq Chronological Message
messages
              tag :: Name
tag = Name
PostList
          in case Maybe (Message, ThreadState)
s of
            Maybe (Message, ThreadState)
Nothing ->
                forall a b. (a -> b) -> [a] -> [b]
map (\(Message
m, ThreadState
tst) -> Message -> ThreadState -> Name -> Widget Name
renderMessageForWindow Message
m ThreadState
tst Name
tag) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList DirectionalSeq Chronological (Message, ThreadState)
messagesWithStates)
            Just (Message, ThreadState)
curMsg ->
              [forall dir1 dir2.
(SeqDirection dir1, SeqDirection dir2) =>
((Message, ThreadState),
 (DirectionalSeq dir1 (Message, ThreadState),
  DirectionalSeq dir2 (Message, ThreadState)))
-> (Message -> ThreadState -> Name -> Widget Name)
-> Name
-> Widget Name
unsafeRenderMessageSelection ((Message, ThreadState)
curMsg, (DirectionalSeq Retrograde (Message, ThreadState)
before, DirectionalSeq Chronological (Message, ThreadState)
after)) Message -> ThreadState -> Name -> Widget Name
renderMessageForWindow Name
tag]