module Chiasma.Data.WindowSelection where

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

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

instance CmdArgs WindowSelection where
  cmdArgs :: WindowSelection -> [Text]
cmdArgs = \case
    WindowSelection
All -> [Item [Text]
"-a"]
    InSession Target
target -> Target -> [Text]
forall a. CmdArgs a => a -> [Text]
cmdArgs Target
target

instance Default WindowSelection where
  def :: WindowSelection
def =
    Target -> WindowSelection
InSession Target
Current