{-# LANGUAGE TemplateHaskell #-}
module Client.State.Focus
(
Focus(..)
, Subfocus(..)
, focusNetwork
, _ChannelFocus
, _NetworkFocus
, _Unfocused
) where
import Control.Lens
import Data.Monoid ((<>))
import Data.Text (Text)
import Irc.Identifier
data Focus
= Unfocused
| NetworkFocus !Text
| ChannelFocus !Text !Identifier
deriving (Eq,Show)
makePrisms ''Focus
-- | Subfocus view
data Subfocus
= FocusMessages -- ^ Show messages
| FocusInfo -- ^ Show channel metadata
| FocusUsers -- ^ Show channel user list
| FocusMasks !Char -- ^ Show channel mask list for given mode
| FocusWindows -- ^ Show client windows
| FocusPalette -- ^ Show current palette
| FocusMentions -- ^ Show all mentions
| FocusHelp (Maybe Text) -- ^ Show help window with optional command
deriving (Eq,Show)
-- | Unfocused first, followed by focuses sorted by network.
-- Within the same network the network focus comes first and
-- then the channels are ordered by channel identifier
instance Ord Focus where
compare Unfocused Unfocused = EQ
compare (NetworkFocus x) (NetworkFocus y ) = compare x y
compare (ChannelFocus x1 x2) (ChannelFocus y1 y2) = compare x1 y1 <> compare x2 y2
compare Unfocused _ = LT
compare _ Unfocused = GT
compare (NetworkFocus x ) (ChannelFocus y _) = compare x y <> LT
compare (ChannelFocus x _) (NetworkFocus y ) = compare x y <> GT
-- | Return the network associated with the current focus
focusNetwork :: Focus -> Maybe Text {- ^ network -}
focusNetwork Unfocused = Nothing
focusNetwork (NetworkFocus network) = Just network
focusNetwork (ChannelFocus network _) = Just network