{-# Language MultiParamTypeClasses, BangPatterns, TemplateHaskell #-}
module Client.State.Window
(
Window(..)
, winMessages
, winUnread
, winTotal
, winMention
, WindowLine(..)
, wlSummary
, wlText
, wlImage
, wlFullImage
, wlImportance
, wlTimestamp
, WindowLineImportance(..)
, emptyWindow
, addToWindow
, windowSeen
) where
import Client.Image.PackedImage
import Client.Message
import Control.Lens
import Data.Text (Text)
import Data.Time (UTCTime)
import Graphics.Vty.Image (Image)
data WindowLine = WindowLine
{ _wlSummary :: !IrcSummary
, _wlText :: {-# UNPACK #-} !Text
, _wlImage' :: !Image'
, _wlFullImage' :: !Image'
, _wlImportance :: !WindowLineImportance
, _wlTimestamp :: {-# UNPACK #-} !UTCTime
}
data WindowLines
= {-# UNPACK #-} !WindowLine :- WindowLines
| Nil
data Window = Window
{ _winMessages :: !WindowLines
, _winUnread :: !Int
, _winTotal :: !Int
, _winMention :: !Bool
}
data WindowLineImportance
= WLBoring
| WLNormal
| WLImportant
deriving (Eq, Show)
makeLenses ''Window
makeLenses ''WindowLine
-- | Lens for the '_wlImage' field viewed in unpacked form.
wlImage :: Lens' WindowLine Image
wlImage = wlImage' . _Image'
{-# INLINE wlImage #-}
-- | Lens for the '_wlFullImage' field viewed in unpacked form.
wlFullImage :: Lens' WindowLine Image
wlFullImage = wlFullImage' . _Image'
{-# INLINE wlFullImage #-}
-- | A window with no messages
emptyWindow :: Window
emptyWindow = Window
{ _winMessages = Nil
, _winUnread = 0
, _winTotal = 0
, _winMention = False
}
-- | Adds a given line to a window as the newest message. Window's
-- unread count will be updated according to the given importance.
addToWindow :: WindowLine -> Window -> Window
addToWindow !msg !win = Window
{ _winMessages = msg :- view winMessages win
, _winTotal = view winTotal win + 1
, _winUnread = view winUnread win
+ (if view wlImportance msg == WLBoring then 0 else 1)
, _winMention = view winMention win
|| view wlImportance msg == WLImportant
}
-- | Update the window clearing the unread count and important flag.
windowSeen :: Window -> Window
windowSeen = set winUnread 0
. set winMention False
instance Each WindowLines WindowLines WindowLine WindowLine where
each _ Nil = pure Nil
each f (x :- xs) = (:-) <$> f x <*> each f xs