module Chiasma.Data.PaneSelection where

import Chiasma.Class.CmdArgs (CmdArgs (cmdArgs))
import Chiasma.Data.Target (Target (Current))

data PaneSelection =
  All
  |
  InSession Target
  |
  InWindow Target
  deriving stock (PaneSelection -> PaneSelection -> Bool
(PaneSelection -> PaneSelection -> Bool)
-> (PaneSelection -> PaneSelection -> Bool) -> Eq PaneSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PaneSelection -> PaneSelection -> Bool
$c/= :: PaneSelection -> PaneSelection -> Bool
== :: PaneSelection -> PaneSelection -> Bool
$c== :: PaneSelection -> PaneSelection -> Bool
Eq, Int -> PaneSelection -> ShowS
[PaneSelection] -> ShowS
PaneSelection -> String
(Int -> PaneSelection -> ShowS)
-> (PaneSelection -> String)
-> ([PaneSelection] -> ShowS)
-> Show PaneSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaneSelection] -> ShowS
$cshowList :: [PaneSelection] -> ShowS
show :: PaneSelection -> String
$cshow :: PaneSelection -> String
showsPrec :: Int -> PaneSelection -> ShowS
$cshowsPrec :: Int -> PaneSelection -> ShowS
Show)

instance CmdArgs PaneSelection where
  cmdArgs :: PaneSelection -> [Text]
cmdArgs = \case
    PaneSelection
All -> [Item [Text]
"-a"]
    InSession Target
target -> [Item [Text]
"-s"] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Target -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs Target
target
    InWindow Target
target -> Target -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs Target
target

instance Default PaneSelection where
  def :: PaneSelection
def =
    Target -> PaneSelection
InWindow Target
Current