{-# 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 (Focus -> Focus -> Bool
(Focus -> Focus -> Bool) -> (Focus -> Focus -> Bool) -> Eq Focus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Focus -> Focus -> Bool
== :: Focus -> Focus -> Bool
$c/= :: Focus -> Focus -> Bool
/= :: Focus -> Focus -> Bool
Eq,Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> String
(Int -> Focus -> ShowS)
-> (Focus -> String) -> ([Focus] -> ShowS) -> Show Focus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Focus -> ShowS
showsPrec :: Int -> Focus -> ShowS
$cshow :: Focus -> String
show :: Focus -> String
$cshowList :: [Focus] -> ShowS
showList :: [Focus] -> ShowS
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 (Subfocus -> Subfocus -> Bool
(Subfocus -> Subfocus -> Bool)
-> (Subfocus -> Subfocus -> Bool) -> Eq Subfocus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Subfocus -> Subfocus -> Bool
== :: Subfocus -> Subfocus -> Bool
$c/= :: Subfocus -> Subfocus -> Bool
/= :: Subfocus -> Subfocus -> Bool
Eq,Int -> Subfocus -> ShowS
[Subfocus] -> ShowS
Subfocus -> String
(Int -> Subfocus -> ShowS)
-> (Subfocus -> String) -> ([Subfocus] -> ShowS) -> Show Subfocus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Subfocus -> ShowS
showsPrec :: Int -> Subfocus -> ShowS
$cshow :: Subfocus -> String
show :: Subfocus -> String
$cshowList :: [Subfocus] -> ShowS
showList :: [Subfocus] -> ShowS
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 :: Focus -> Focus -> Ordering
compare Focus
Unfocused            Focus
Unfocused            = Ordering
EQ
  compare (NetworkFocus Text
x)     (NetworkFocus Text
y    ) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
x Text
y
  compare (ChannelFocus Text
x1 Identifier
x2) (ChannelFocus Text
y1 Identifier
y2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
x1 Text
y1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Identifier -> Identifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Identifier
x2 Identifier
y2

  compare Focus
Unfocused Focus
_         = Ordering
LT
  compare Focus
_         Focus
Unfocused = Ordering
GT

  compare (NetworkFocus Text
x  ) (ChannelFocus Text
y Identifier
_) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
x Text
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
LT
  compare (ChannelFocus Text
x Identifier
_) (NetworkFocus Text
y  ) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
x Text
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Ordering
GT

-- | Return the network associated with the current focus
focusNetwork :: Focus -> Maybe Text {- ^ network -}
focusNetwork :: Focus -> Maybe Text
focusNetwork Focus
Unfocused = Maybe Text
forall a. Maybe a
Nothing
focusNetwork (NetworkFocus Text
network) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
network
focusNetwork (ChannelFocus Text
network Identifier
_) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
network

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

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

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

-- | Filter argument for 'FocusWindows'
data WindowsFilter
  = AllWindows     -- ^ no filter
  | NetworkWindows -- ^ only network windows
  | ChannelWindows -- ^ only channel windows
  | UserWindows    -- ^ only user windows
  deriving (WindowsFilter -> WindowsFilter -> Bool
(WindowsFilter -> WindowsFilter -> Bool)
-> (WindowsFilter -> WindowsFilter -> Bool) -> Eq WindowsFilter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WindowsFilter -> WindowsFilter -> Bool
== :: WindowsFilter -> WindowsFilter -> Bool
$c/= :: WindowsFilter -> WindowsFilter -> Bool
/= :: WindowsFilter -> WindowsFilter -> Bool
Eq, Int -> WindowsFilter -> ShowS
[WindowsFilter] -> ShowS
WindowsFilter -> String
(Int -> WindowsFilter -> ShowS)
-> (WindowsFilter -> String)
-> ([WindowsFilter] -> ShowS)
-> Show WindowsFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowsFilter -> ShowS
showsPrec :: Int -> WindowsFilter -> ShowS
$cshow :: WindowsFilter -> String
show :: WindowsFilter -> String
$cshowList :: [WindowsFilter] -> ShowS
showList :: [WindowsFilter] -> ShowS
Show)