{-# Language BangPatterns #-}
module Client.View.Mentions
( mentionsViewLines
) where
import Client.Image.StatusLine
import Client.State
import Client.State.Focus
import Client.State.Window
import qualified Data.Map as Map
import Control.Lens
import Data.Time (UTCTime)
import Graphics.Vty.Image
mentionsViewLines :: ClientState -> [Image]
mentionsViewLines st = addMarkers st entries
where
names = clientWindowNames st ++ repeat '?'
detail = view clientDetailView st
entries = merge
[windowEntries 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 ::
ClientState ->
[MentionLine] ->
[Image]
addMarkers _ [] = []
addMarkers !st (!ml : xs)
= map mlImage (ml:same)
++ minorStatusLineImage (mlFocus ml) st
: addMarkers st rest
where
isSame ml' = mlFocus ml == mlFocus ml'
(same,rest) = span isSame xs
windowEntries ::
Bool ->
Char ->
Focus ->
Window ->
[MentionLine]
windowEntries !detailed name focus w =
[ MentionLine
{ mlTimestamp = view wlTimestamp l
, mlWindowName = name
, mlFocus = focus
, mlImage = if detailed then view wlFullImage l else view wlImage l
}
| let p x = WLImportant == view wlImportance x
, l <- toListOf (winMessages . each . filtered p) w
]
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