{-# Language BangPatterns #-}
module Client.View.Mentions
( mentionsViewLines
) where
import Client.Configuration (PaddingMode, configNickPadding)
import Client.Message
import Client.Image.Message
import Client.Image.PackedImage
import Client.Image.Palette (Palette)
import Client.Image.StatusLine
import Client.State
import Client.State.Focus
import Client.State.Window
import Control.Lens
import qualified Data.Map as Map
import Data.Time (UTCTime)
import ContextFilter (filterContext)
mentionsViewLines :: Int -> ClientState -> [Image']
mentionsViewLines w st = addMarkers w st entries
where
names = clientWindowNames st ++ repeat '?'
detail = view clientDetailView st
padAmt = view (clientConfig . configNickPadding) st
palette = clientPalette st
filt =
case clientMatcher st of
Nothing -> filter (\x -> WLImportant == view wlImportance x)
Just (Matcher b a p) -> filterContext b a (views wlText p)
entries = merge
[windowEntries filt palette w padAmt detail n focus v
| (n,(focus, v))
<- names `zip` Map.toList (view clientWindows st) ]
data MentionLine = MentionLine
{ mlTimestamp :: UTCTime
, mlWindowName :: Char
, mlFocus :: Focus
, mlImage :: [Image']
}
addMarkers ::
Int ->
ClientState ->
[MentionLine] ->
[Image']
addMarkers _ _ [] = []
addMarkers w !st (!ml : xs)
= minorStatusLineImage (mlFocus ml) w False st
: concatMap mlImage (ml:same)
++ addMarkers w st rest
where
isSame ml' = mlFocus ml == mlFocus ml'
(same,rest) = span isSame xs
windowEntries ::
([WindowLine] -> [WindowLine])
->
Palette ->
Int ->
PaddingMode ->
Bool ->
Char ->
Focus ->
Window ->
[MentionLine]
windowEntries filt palette w padAmt detailed name focus win =
[ MentionLine
{ mlTimestamp = views wlTimestamp unpackUTCTime l
, mlWindowName = name
, mlFocus = focus
, mlImage = case metadataImg (view wlSummary l) of
_ | detailed -> [view wlFullImage l]
Just (img, _, _) -> [img]
Nothing -> drawWindowLine palette w padAmt l
}
| l <- filt $ prefilt $ toListOf (winMessages . each) win
]
where
prefilt
| detailed = id
| otherwise = filter isChat
isChat msg =
case view wlSummary msg of
ChatSummary{} -> True
_ -> False
merge :: [[MentionLine]] -> [MentionLine]
merge [] = []
merge [x] = x
merge xss = merge (merge2s xss)
merge2s :: [[MentionLine]] -> [[MentionLine]]
merge2s (x:y:z) = merge2 x y : merge2s z
merge2s xs = xs
merge2 :: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [] ys = ys
merge2 xs [] = xs
merge2 xxs@(x:xs) yys@(y:ys)
| mlTimestamp x >= mlTimestamp y = x : merge2 xs yys
| otherwise = y : merge2 xxs ys