packages feed

glirc-2.41: src/Client/State/Focus.hs

{-# LANGUAGE CPP, TemplateHaskell #-}

{-|
Module      : Client.State.Focus
Description : Types for representing the current window being displayed
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

The client has a primary message window whose contents are determined
by a 'Focus'. In order to provide different views of channels
the 'Subfocus' breaks down channel focus into different subviews.
-}

module Client.State.Focus
  ( -- * Types
    Focus(..)
  , Subfocus(..)
  , WindowsFilter(..)

  -- * Focus operations
  , parseFocus
  , focusNetwork
  , actualFocus
  , isPrefixOfFocus

  -- * Focus Prisms
  , _ChannelFocus
  , _NetworkFocus
  , _Unfocused
  ) where

import           Control.Lens (makePrisms, (<&>))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Irc.Identifier (Identifier, idPrefix, mkId)

-- | Currently focused window
data Focus
 = Unfocused                      -- ^ No network
 | NetworkFocus !Text             -- ^ Network
 | ChannelFocus !Text !Identifier -- ^ Network Channel/Nick
  deriving (Eq,Show)

makePrisms ''Focus

-- | Subfocus view
data Subfocus
  = FocusMessages    -- ^ Show messages
  | FocusInfo  !Text !Identifier       -- ^ Show channel metadata
  | FocusUsers !Text !Identifier       -- ^ Show channel user list
  | FocusMasks !Text !Identifier !Char -- ^ Show channel mask list for given mode
  | FocusWindows WindowsFilter -- ^ Show client windows
  | FocusPalette     -- ^ Show current palette
  | FocusMentions    -- ^ Show all mentions
  | FocusDigraphs    -- ^ Show all digraphs
  | FocusKeyMap      -- ^ Show key bindings
  | FocusHelp        -- ^ Show help window
  | FocusRtsStats    -- ^ Show GHC RTS statistics
  | FocusIgnoreList  -- ^ Show ignored masks
  | FocusCert        -- ^ Show rendered certificate
  | FocusChanList !Text (Maybe Int) (Maybe Int) -- ^ Show channel list
  | FocusWho !Text -- ^ Show last reply to a WHO query
  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

-- | Returns what focus a subfocus is actually for.
actualFocus :: Subfocus -> Focus -> Focus
actualFocus sf = case sf of
  FocusInfo  net chan   -> const (ChannelFocus net chan)
  FocusUsers net chan   -> const (ChannelFocus net chan)
  FocusMasks net chan _ -> const (ChannelFocus net chan)
  FocusChanList net _ _ -> const (NetworkFocus net)
  FocusWho net          -> const (NetworkFocus net)
  _ -> id

-- | Parses a single focus name given a default network.
parseFocus ::
  Maybe Text {- ^ default network    -} ->
  String {- ^ @[network:]target@ -} ->
  Maybe Focus
parseFocus mbNet x =
  case break (==':') x of
    ("*","")     -> pure Unfocused
    (net,_:"")   -> pure (NetworkFocus (Text.pack net))
    (net,_:chan) -> pure (ChannelFocus (Text.pack net) (mkId (Text.pack chan)))
    (chan,"")    -> mbNet <&> \net ->
                    ChannelFocus net (mkId (Text.pack chan))

isPrefixOfFocus :: String -> Focus -> Bool
isPrefixOfFocus prefix focus = case break (==':') prefix of
  ("","")  -> True
  ("*","") -> focus == Unfocused
  (chan,"") -> case focus of 
    ChannelFocus _    chanF -> idPrefix (mkId $ Text.pack chan) chanF
    NetworkFocus netF       -> Text.isPrefixOf (Text.pack chan) netF
    Unfocused               -> False
  (net,_:chan) -> case focus of
    ChannelFocus netF chanF -> netF == Text.pack net && idPrefix (mkId $ Text.pack chan) chanF
    _ -> False

-- | Filter argument for 'FocusWindows'
data WindowsFilter
  = AllWindows     -- ^ no filter
  | NetworkWindows -- ^ only network windows
  | ChannelWindows -- ^ only channel windows
  | UserWindows    -- ^ only user windows
  deriving (Eq, Show)