module Chiasma.Data.Views where

import Control.Lens (makeClassy)
import Prettyprinter (Doc)
import Prettyprinter.Render.Terminal (AnsiStyle)

import Chiasma.Data.Ident (Ident)
import Chiasma.Data.TmuxId (PaneId, SessionId, WindowId)
import Chiasma.Data.View (View)

data ViewsError =
  NoSuchSession Ident
  |
  NoSuchWindow Ident
  |
  NoSuchPane Ident
  |
  NoPaneId Ident
  deriving stock (ViewsError -> ViewsError -> Bool
(ViewsError -> ViewsError -> Bool)
-> (ViewsError -> ViewsError -> Bool) -> Eq ViewsError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViewsError -> ViewsError -> Bool
== :: ViewsError -> ViewsError -> Bool
$c/= :: ViewsError -> ViewsError -> Bool
/= :: ViewsError -> ViewsError -> Bool
Eq, Int -> ViewsError -> ShowS
[ViewsError] -> ShowS
ViewsError -> String
(Int -> ViewsError -> ShowS)
-> (ViewsError -> String)
-> ([ViewsError] -> ShowS)
-> Show ViewsError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewsError -> ShowS
showsPrec :: Int -> ViewsError -> ShowS
$cshow :: ViewsError -> String
show :: ViewsError -> String
$cshowList :: [ViewsError] -> ShowS
showList :: [ViewsError] -> ShowS
Show)

data Views =
  Views {
    Views -> [View SessionId]
_sessions :: [View SessionId],
    Views -> [View WindowId]
_windows :: [View WindowId],
    Views -> [View PaneId]
_panes :: [View PaneId],
    Views -> [Doc AnsiStyle]
_log :: [Doc AnsiStyle]
  }
  deriving stock (Int -> Views -> ShowS
[Views] -> ShowS
Views -> String
(Int -> Views -> ShowS)
-> (Views -> String) -> ([Views] -> ShowS) -> Show Views
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Views -> ShowS
showsPrec :: Int -> Views -> ShowS
$cshow :: Views -> String
show :: Views -> String
$cshowList :: [Views] -> ShowS
showList :: [Views] -> ShowS
Show, (forall x. Views -> Rep Views x)
-> (forall x. Rep Views x -> Views) -> Generic Views
forall x. Rep Views x -> Views
forall x. Views -> Rep Views x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Views -> Rep Views x
from :: forall x. Views -> Rep Views x
$cto :: forall x. Rep Views x -> Views
to :: forall x. Rep Views x -> Views
Generic)
  deriving anyclass (Views
Views -> Default Views
forall a. a -> Default a
$cdef :: Views
def :: Views
Default)

makeClassy ''Views

instance Eq Views where
  (Views [View SessionId]
sa [View WindowId]
wa [View PaneId]
pa [Doc AnsiStyle]
_) == :: Views -> Views -> Bool
== (Views [View SessionId]
sb [View WindowId]
wb [View PaneId]
pb [Doc AnsiStyle]
_) =
    ([View SessionId]
sa [View SessionId] -> [View SessionId] -> Bool
forall a. Eq a => a -> a -> Bool
== [View SessionId]
sb) Bool -> Bool -> Bool
&& ([View WindowId]
wa [View WindowId] -> [View WindowId] -> Bool
forall a. Eq a => a -> a -> Bool
== [View WindowId]
wb) Bool -> Bool -> Bool
&& ([View PaneId]
pa [View PaneId] -> [View PaneId] -> Bool
forall a. Eq a => a -> a -> Bool
== [View PaneId]
pb)