{-# Language MultiParamTypeClasses, BangPatterns, TemplateHaskell #-}
module Client.State.Window
(
Window(..)
, winMessages
, winUnread
, winTotal
, winMention
, winMarker
, WindowLine(..)
, wlSummary
, wlText
, wlImage
, wlFullImage
, wlImportance
, wlTimestamp
, WindowLineImportance(..)
, emptyWindow
, addToWindow
, windowSeen
, windowActivate
, windowDeactivate
) 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
, _winMarker :: !(Maybe Int)
, _winUnread :: !Int
, _winTotal :: !Int
, _winMention :: !WindowLineImportance
}
data ActivityLevel = NoActivity | NormalActivity | HighActivity
deriving (Eq, Ord, Read, Show)
data WindowLineImportance
= WLBoring
| WLNormal
| WLImportant
deriving (Eq, Ord, Show, Read)
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
, _winMarker = Nothing
, _winUnread = 0
, _winTotal = 0
, _winMention = WLBoring
}
-- | 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
, _winMarker = do i <- view winMarker win; return $! i+1
, _winUnread = if view wlImportance msg == WLBoring
then view winUnread win
else view winUnread win + 1
, _winMention = max (view winMention win) (view wlImportance msg)
}
-- | Update the window clearing the unread count and important flag.
windowSeen :: Window -> Window
windowSeen = set winUnread 0
. set winMention WLBoring
-- | Update the window when it first becomes active. If only /boring/
-- messages have been added since last time the marker will be hidden.
windowActivate :: Window -> Window
windowActivate win
| view winUnread win == 0 = set winMarker Nothing win
| otherwise = win
-- | Update the window when it becomes inactive. This resets the activity
-- marker to the bottom of the window.
windowDeactivate :: Window -> Window
windowDeactivate = set winMarker (Just 0)
instance Each WindowLines WindowLines WindowLine WindowLine where
each _ Nil = pure Nil
each f (x :- xs) = (:-) <$> f x <*> each f xs