{-# Language BangPatterns #-}
module Client.View.Mentions
( mentionsViewLines
) where
import Client.Image.Palette
import Client.State
import Client.State.Focus
import Client.State.Window
import qualified Data.Map as Map
import Control.Lens
import Data.Text (Text)
import Data.Time (UTCTime)
import Irc.Identifier (idText)
import Graphics.Vty.Image
mentionsViewLines :: ClientState -> [Image]
mentionsViewLines st = addMarkers pal entries
where
pal = clientPalette st
names = clientWindowNames st ++ repeat '?'
detail = view clientDetailView st
entries = merge
[windowEntries detail n net (idText chan) v
| (n,(ChannelFocus net chan, v))
<- names `zip` Map.toList (view clientWindows st) ]
data MentionLine = MentionLine
{ mlTimestamp :: UTCTime
, mlWindowName :: Char
, mlNetwork :: Text
, mlChannel :: Text
, mlImage :: Image
}
addMarkers ::
Palette ->
[MentionLine] ->
[Image]
addMarkers _ [] = []
addMarkers !pal (!ml : xs) =
mlImage ml : map mlImage same ++ windowMarker : addMarkers pal rest
where
isSame ml' = mlWindowName ml == mlWindowName ml'
&& mlNetwork ml == mlNetwork ml'
&& mlChannel ml == mlChannel ml'
(same,rest) = span isSame xs
windowMarker = char (view palWindowName pal) (mlWindowName ml) <|>
char defAttr ':' <|>
text' (view palLabel pal) (mlNetwork ml) <|>
char defAttr ':' <|>
text' (view palLabel pal) (mlChannel ml)
windowEntries ::
Bool ->
Char ->
Text ->
Text ->
Window ->
[MentionLine]
windowEntries !detailed name net chan w =
[ MentionLine
{ mlTimestamp = view wlTimestamp l
, mlWindowName = name
, mlNetwork = net
, mlChannel = chan
, mlImage = if detailed then view wlFullImage l else view wlImage l
}
| l <- view winMessages w
, WLImportant == view wlImportance l
]
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