{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.Messages
Description : Chat message view
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module returns the chat messages for the currently focused
window in message view and gathers metadata entries into single
lines.

-}
module Client.View.Messages
  ( chatMessageImages
  ) where

import           Client.Configuration
import           Client.Image.LineWrap
import           Client.Image.Message
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.Message
import           Client.State
import           Client.State.Focus
import           Client.State.Network
import           Client.State.Window
import           Control.Lens
import           Control.Monad
import           Data.List
import           Graphics.Vty.Attributes
import           Irc.Identifier
import           Irc.Message
import           Irc.UserInfo


chatMessageImages :: Focus -> Int -> ClientState -> [Image']
chatMessageImages :: Focus -> Int -> ClientState -> [Image']
chatMessageImages Focus
focus Int
w ClientState
st =
  case Getting (First Window) ClientState Window
-> ClientState -> Maybe Window
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map Focus Window -> Const (First Window) (Map Focus Window))
-> ClientState -> Const (First Window) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window -> Const (First Window) (Map Focus Window))
 -> ClientState -> Const (First Window) ClientState)
-> ((Window -> Const (First Window) Window)
    -> Map Focus Window -> Const (First Window) (Map Focus Window))
-> Getting (First Window) ClientState Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus) ClientState
st of
    Maybe Window
Nothing  -> []
    Just Window
win ->
      let msgs :: [WindowLine]
msgs     = Getting (Endo [WindowLine]) WindowLines WindowLine
-> WindowLines -> [WindowLine]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting (Endo [WindowLine]) WindowLines WindowLine
forall s t a b. Each s t a b => Traversal s t a b
each (Getting WindowLines Window WindowLines -> Window -> WindowLines
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLines Window WindowLines
Lens' Window WindowLines
winMessages Window
win)
          hideMeta :: Bool
hideMeta = Getting Bool Window Bool -> Window -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Window Bool
Lens' Window Bool
winHideMeta Window
win in
      if ClientState -> Bool
clientIsFiltered ClientState
st
        then Bool -> [WindowLine] -> [Image']
windowLineProcessor Bool
hideMeta (ClientState -> (WindowLine -> Text) -> [WindowLine] -> [WindowLine]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Getting Text WindowLine Text -> WindowLine -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text WindowLine Text
Getter WindowLine Text
wlText) [WindowLine]
msgs)
        else
          case Getting (Maybe Int) Window (Maybe Int) -> Window -> Maybe Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Int) Window (Maybe Int)
Lens' Window (Maybe Int)
winMarker Window
win of
            Maybe Int
Nothing -> Bool -> [WindowLine] -> [Image']
windowLineProcessor Bool
hideMeta [WindowLine]
msgs
            Just Int
n  ->
              Bool -> [WindowLine] -> [Image']
windowLineProcessor Bool
hideMeta [WindowLine]
l [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
              [Image'
marker] [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++
              Bool -> [WindowLine] -> [Image']
windowLineProcessor Bool
hideMeta [WindowLine]
r
              where
                ([WindowLine]
l,[WindowLine]
r) = Int -> [WindowLine] -> ([WindowLine], [WindowLine])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [WindowLine]
msgs

  where
    palette :: Palette
palette = ClientState -> Palette
clientPalette ClientState
st
    marker :: Image'
marker = Attr -> String -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palLineMarker Palette
palette) (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
w Char
'-')
    windowLineProcessor :: Bool -> [WindowLine] -> [Image']
windowLineProcessor Bool
hideMeta
      | Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientDetailView ClientState
st =
          (Image' -> [Image']) -> [Image'] -> [Image']
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Image'] -> [Image']
forall a. [a] -> [a]
reverse ([Image'] -> [Image'])
-> (Image' -> [Image']) -> Image' -> [Image']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Image' -> [Image']
fullLineWrap Int
w) ([Image'] -> [Image'])
-> ([WindowLine] -> [Image']) -> [WindowLine] -> [Image']
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
          if Bool
hideMeta
            then ClientState -> [WindowLine] -> [Image']
detailedImagesWithoutMetadata ClientState
st
            else (WindowLine -> Image') -> [WindowLine] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
Lens' WindowLine Image'
wlFullImage)

      | Bool
otherwise = ClientState -> Int -> Bool -> [WindowLine] -> [Image']
windowLinesToImages ClientState
st Int
w Bool
hideMeta ([WindowLine] -> [Image'])
-> ([WindowLine] -> [WindowLine]) -> [WindowLine] -> [Image']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Bool) -> [WindowLine] -> [WindowLine]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (WindowLine -> Bool) -> WindowLine -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowLine -> Bool
isNoisy)

    isNoisy :: WindowLine -> Bool
isNoisy WindowLine
msg =
      case Getting IrcSummary WindowLine IrcSummary
-> WindowLine -> IrcSummary
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IrcSummary WindowLine IrcSummary
Lens' WindowLine IrcSummary
wlSummary WindowLine
msg of
        ReplySummary ReplyCode
code -> IrcMsg -> Bool
squelchIrcMsg (Text -> ReplyCode -> [Text] -> IrcMsg
Reply Text
"" ReplyCode
code [])
        IrcSummary
_                 -> Bool
False

detailedImagesWithoutMetadata :: ClientState -> [WindowLine] -> [Image']
detailedImagesWithoutMetadata :: ClientState -> [WindowLine] -> [Image']
detailedImagesWithoutMetadata ClientState
st [WindowLine]
wwls =
  case ClientState
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
gatherMetadataLines ClientState
st [WindowLine]
wwls of
    ([], [])   -> []
    ([], WindowLine
w:[WindowLine]
ws) -> Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
Lens' WindowLine Image'
wlFullImage WindowLine
w
                Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: ClientState -> [WindowLine] -> [Image']
detailedImagesWithoutMetadata ClientState
st [WindowLine]
ws
    ((Image', Identifier, Maybe Identifier)
_:[(Image', Identifier, Maybe Identifier)]
_, [WindowLine]
wls) -> ClientState -> [WindowLine] -> [Image']
detailedImagesWithoutMetadata ClientState
st [WindowLine]
wls


windowLinesToImages ::
  ClientState  {- ^ client state  -} ->
  Int          {- ^ draw width    -} ->
  Bool         {- ^ hide metadata -} ->
  [WindowLine] {- ^ window lines  -} ->
  [Image']     {- ^ image lines   -}
windowLinesToImages :: ClientState -> Int -> Bool -> [WindowLine] -> [Image']
windowLinesToImages ClientState
st Int
w Bool
hideMeta [WindowLine]
wwls =
  case ClientState
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
gatherMetadataLines ClientState
st [WindowLine]
wwls of
    ([], [])   -> []
    ([], WindowLine
wl:[WindowLine]
wls) -> Palette -> Int -> PaddingMode -> WindowLine -> [Image']
drawWindowLine Palette
palette Int
w PaddingMode
padAmt WindowLine
wl
                [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ ClientState -> Int -> Bool -> [WindowLine] -> [Image']
windowLinesToImages ClientState
st Int
w Bool
hideMeta [WindowLine]
wls
    ((Image'
img,Identifier
who,Maybe Identifier
mbnext):[(Image', Identifier, Maybe Identifier)]
mds, [WindowLine]
wls)

      | Bool
hideMeta -> ClientState -> Int -> Bool -> [WindowLine] -> [Image']
windowLinesToImages ClientState
st Int
w Bool
hideMeta [WindowLine]
wls

      | Bool
otherwise ->
         Image' -> Image' -> [Image']
wrap
           Image'
metaPad
           ([Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat
              (Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse Image'
" "
                 (Image' -> Maybe Identifier -> MetadataState
startMetadata Image'
img Maybe Identifier
mbnext Identifier
who [(Image', Identifier, Maybe Identifier)]
mds Palette
palette)))
      [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ ClientState -> Int -> Bool -> [WindowLine] -> [Image']
windowLinesToImages ClientState
st Int
w Bool
hideMeta [WindowLine]
wls

  where
    palette :: Palette
palette = ClientState -> Palette
clientPalette ClientState
st
    config :: Configuration
config  = Getting Configuration ClientState Configuration
-> ClientState -> Configuration
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Configuration ClientState Configuration
Lens' ClientState Configuration
clientConfig ClientState
st
    padAmt :: PaddingMode
padAmt  = Getting PaddingMode Configuration PaddingMode
-> Configuration -> PaddingMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PaddingMode Configuration PaddingMode
Lens' Configuration PaddingMode
configNickPadding Configuration
config

    padNick :: Image' -> Image'
padNick  = PaddingMode -> Image' -> Image'
nickPad PaddingMode
padAmt
    metaPad :: Image'
metaPad  = Image'
"      " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image' -> Image'
padNick Image'
""

    wrap :: Image' -> Image' -> [Image']
wrap Image'
pfx Image'
body = [Image'] -> [Image']
forall a. [a] -> [a]
reverse (Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
w Image'
pfx Image'
body)

------------------------------------------------------------------------

type MetadataState =
  Identifier                             {- ^ current nick -} ->
  [(Image',Identifier,Maybe Identifier)] {- ^ metadata     -} ->
  Palette                                {- ^ palette      -} ->
  [Image']

startMetadata ::
  Image'           {- ^ metadata image           -} ->
  Maybe Identifier {- ^ possible nick transition -} ->
  MetadataState
startMetadata :: Image' -> Maybe Identifier -> MetadataState
startMetadata Image'
img Maybe Identifier
mbnext Identifier
who [(Image', Identifier, Maybe Identifier)]
mds Palette
palette =
  let acc :: Image'
acc = Palette -> Identifier -> Image'
quietIdentifier Palette
palette Identifier
who Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img
  in Image' -> Maybe Identifier -> MetadataState
transitionMetadata Image'
acc Maybe Identifier
mbnext Identifier
who [(Image', Identifier, Maybe Identifier)]
mds Palette
palette

transitionMetadata ::
  Image'           {- ^ image accumulator        -} ->
  Maybe Identifier {- ^ possible nick transition -} ->
  MetadataState
transitionMetadata :: Image' -> Maybe Identifier -> MetadataState
transitionMetadata Image'
acc Maybe Identifier
mbwho Identifier
who [(Image', Identifier, Maybe Identifier)]
mds Palette
palette =
  case Maybe Identifier
mbwho of
    Maybe Identifier
Nothing   -> Image' -> MetadataState
continueMetadata Image'
acc Identifier
who [(Image', Identifier, Maybe Identifier)]
mds Palette
palette
    Just Identifier
who' ->
      let acc' :: Image'
acc' = Image'
acc Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Palette -> Identifier -> Image'
quietIdentifier Palette
palette Identifier
who'
      in Image' -> MetadataState
continueMetadata Image'
acc' Identifier
who' [(Image', Identifier, Maybe Identifier)]
mds Palette
palette

continueMetadata :: Image' -> MetadataState
continueMetadata :: Image' -> MetadataState
continueMetadata Image'
acc Identifier
_ [] Palette
_ = [Image'
acc]
continueMetadata Image'
acc Identifier
who1 ((Image'
img, Identifier
who2, Maybe Identifier
mbwho3):[(Image', Identifier, Maybe Identifier)]
mds) Palette
palette
  | Identifier
who1 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
"" -- empty identifiers don't coallese
  , Identifier
who1 Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
who2
  , let acc' :: Image'
acc' = Image'
acc Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
img
  = Image' -> Maybe Identifier -> MetadataState
transitionMetadata Image'
acc' Maybe Identifier
mbwho3 Identifier
who2 [(Image', Identifier, Maybe Identifier)]
mds Palette
palette

  | Bool
otherwise    = Image'
acc Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: Image' -> Maybe Identifier -> MetadataState
startMetadata Image'
img Maybe Identifier
mbwho3 Identifier
who2 [(Image', Identifier, Maybe Identifier)]
mds Palette
palette

------------------------------------------------------------------------

gatherMetadataLines ::
  ClientState ->
  [WindowLine] ->
  ( [(Image', Identifier, Maybe Identifier)] , [ WindowLine ] )
  -- ^ metadata entries are reversed
gatherMetadataLines :: ClientState
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
gatherMetadataLines ClientState
st = [(Image', Identifier, Maybe Identifier)]
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
go []
  where
    go :: [(Image', Identifier, Maybe Identifier)]
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
go [(Image', Identifier, Maybe Identifier)]
acc [WindowLine]
ws
      | Just (Image'
img, [WindowLine]
ws') <- ClientState -> [WindowLine] -> Maybe (Image', [WindowLine])
bulkMetadata ClientState
st [WindowLine]
ws =
          [(Image', Identifier, Maybe Identifier)]
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
go ((Image'
img, Identifier
"", Maybe Identifier
forall a. Maybe a
Nothing) (Image', Identifier, Maybe Identifier)
-> [(Image', Identifier, Maybe Identifier)]
-> [(Image', Identifier, Maybe Identifier)]
forall a. a -> [a] -> [a]
: [(Image', Identifier, Maybe Identifier)]
acc) [WindowLine]
ws'
    go [(Image', Identifier, Maybe Identifier)]
acc (WindowLine
w:[WindowLine]
ws)
      | Just (Image'
img,Identifier
who,Maybe Identifier
mbnext) <- ClientState
-> WindowLine -> Maybe (Image', Identifier, Maybe Identifier)
metadataWindowLine ClientState
st WindowLine
w =
          [(Image', Identifier, Maybe Identifier)]
-> [WindowLine]
-> ([(Image', Identifier, Maybe Identifier)], [WindowLine])
go ((Image'
img,Identifier
who,Maybe Identifier
mbnext) (Image', Identifier, Maybe Identifier)
-> [(Image', Identifier, Maybe Identifier)]
-> [(Image', Identifier, Maybe Identifier)]
forall a. a -> [a] -> [a]
: [(Image', Identifier, Maybe Identifier)]
acc) [WindowLine]
ws

    go [(Image', Identifier, Maybe Identifier)]
acc [WindowLine]
ws = ([(Image', Identifier, Maybe Identifier)]
acc,[WindowLine]
ws)


-- | Classify window lines for metadata coalesence
metadataWindowLine ::
  ClientState ->
  WindowLine ->
  Maybe (Image', Identifier, Maybe Identifier)
        {- ^ Image, incoming identifier, outgoing identifier if changed -}
metadataWindowLine :: ClientState
-> WindowLine -> Maybe (Image', Identifier, Maybe Identifier)
metadataWindowLine ClientState
st WindowLine
wl =
  case Getting IrcSummary WindowLine IrcSummary
-> WindowLine -> IrcSummary
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IrcSummary WindowLine IrcSummary
Lens' WindowLine IrcSummary
wlSummary WindowLine
wl of
    ChatSummary UserInfo
who -> (Image'
ignoreImage, UserInfo -> Identifier
userNick UserInfo
who, Maybe Identifier
forall a. Maybe a
Nothing) (Image', Identifier, Maybe Identifier)
-> Maybe () -> Maybe (Image', Identifier, Maybe Identifier)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (UserInfo -> ClientState -> Bool
identIgnored UserInfo
who ClientState
st)
    IrcSummary
summary         -> IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg IrcSummary
summary

bulkMetadata ::
  ClientState ->
  [WindowLine] ->
  Maybe (Image', [WindowLine])
bulkMetadata :: ClientState -> [WindowLine] -> Maybe (Image', [WindowLine])
bulkMetadata ClientState
st [WindowLine]
wls
  | ([WindowLine]
quits, [WindowLine]
wls') <- (WindowLine -> Bool)
-> [WindowLine] -> ([WindowLine], [WindowLine])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span WindowLine -> Bool
isMassQuit [WindowLine]
wls
  , let n :: Int
n = [WindowLine] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WindowLine]
quits
  , Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10
  = (Image', [WindowLine]) -> Maybe (Image', [WindowLine])
forall a. a -> Maybe a
Just (Attr -> String -> Image'
string (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palMeta Palette
pal) (String
"(split:" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")") Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
          Attr -> Char -> Image'
char (Attr -> Color -> Attr
withForeColor Attr
defAttr Color
red) Char
'X', [WindowLine]
wls')
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

bulkMetadata ClientState
_ [WindowLine]
_ = Maybe (Image', [WindowLine])
forall a. Maybe a
Nothing

isMassQuit :: WindowLine -> Bool
isMassQuit :: WindowLine -> Bool
isMassQuit WindowLine
wl
  | QuitSummary Identifier
_ QuitKind
MassQuit <- Getting IrcSummary WindowLine IrcSummary
-> WindowLine -> IrcSummary
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IrcSummary WindowLine IrcSummary
Lens' WindowLine IrcSummary
wlSummary WindowLine
wl = Bool
True
  | Bool
otherwise = Bool
False