-- |The data type 'Selection' enumerates the different types of basic clipboards that X11 operates on.
-- Internal.
module Helic.Data.Selection where

-- |This type enumerates the different types of basic clipboards that X11 operates on.
data Selection =
  -- |Usually the target of explicit copy commands (ctrl-c).
  Clipboard
  |
  -- |Stores the cursor selection.
  Primary
  |
  -- |Only used in exotic situations.
  Secondary
  deriving stock (Selection -> Selection -> Bool
(Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool) -> Eq Selection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Selection -> Selection -> Bool
$c/= :: Selection -> Selection -> Bool
== :: Selection -> Selection -> Bool
$c== :: Selection -> Selection -> Bool
Eq, Int -> Selection -> ShowS
[Selection] -> ShowS
Selection -> String
(Int -> Selection -> ShowS)
-> (Selection -> String)
-> ([Selection] -> ShowS)
-> Show Selection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Selection] -> ShowS
$cshowList :: [Selection] -> ShowS
show :: Selection -> String
$cshow :: Selection -> String
showsPrec :: Int -> Selection -> ShowS
$cshowsPrec :: Int -> Selection -> ShowS
Show, Eq Selection
Eq Selection
-> (Selection -> Selection -> Ordering)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Bool)
-> (Selection -> Selection -> Selection)
-> (Selection -> Selection -> Selection)
-> Ord Selection
Selection -> Selection -> Bool
Selection -> Selection -> Ordering
Selection -> Selection -> Selection
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Selection -> Selection -> Selection
$cmin :: Selection -> Selection -> Selection
max :: Selection -> Selection -> Selection
$cmax :: Selection -> Selection -> Selection
>= :: Selection -> Selection -> Bool
$c>= :: Selection -> Selection -> Bool
> :: Selection -> Selection -> Bool
$c> :: Selection -> Selection -> Bool
<= :: Selection -> Selection -> Bool
$c<= :: Selection -> Selection -> Bool
< :: Selection -> Selection -> Bool
$c< :: Selection -> Selection -> Bool
compare :: Selection -> Selection -> Ordering
$ccompare :: Selection -> Selection -> Ordering
$cp1Ord :: Eq Selection
Ord, Int -> Selection
Selection -> Int
Selection -> [Selection]
Selection -> Selection
Selection -> Selection -> [Selection]
Selection -> Selection -> Selection -> [Selection]
(Selection -> Selection)
-> (Selection -> Selection)
-> (Int -> Selection)
-> (Selection -> Int)
-> (Selection -> [Selection])
-> (Selection -> Selection -> [Selection])
-> (Selection -> Selection -> [Selection])
-> (Selection -> Selection -> Selection -> [Selection])
-> Enum Selection
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Selection -> Selection -> Selection -> [Selection]
$cenumFromThenTo :: Selection -> Selection -> Selection -> [Selection]
enumFromTo :: Selection -> Selection -> [Selection]
$cenumFromTo :: Selection -> Selection -> [Selection]
enumFromThen :: Selection -> Selection -> [Selection]
$cenumFromThen :: Selection -> Selection -> [Selection]
enumFrom :: Selection -> [Selection]
$cenumFrom :: Selection -> [Selection]
fromEnum :: Selection -> Int
$cfromEnum :: Selection -> Int
toEnum :: Int -> Selection
$ctoEnum :: Int -> Selection
pred :: Selection -> Selection
$cpred :: Selection -> Selection
succ :: Selection -> Selection
$csucc :: Selection -> Selection
Enum, Selection
Selection -> Selection -> Bounded Selection
forall a. a -> a -> Bounded a
maxBound :: Selection
$cmaxBound :: Selection
minBound :: Selection
$cminBound :: Selection
Bounded)

-- |Convert a 'Selection' into the string that X11 uses to identify it.
toXString :: Selection -> Text
toXString :: Selection -> Text
toXString = \case
  Selection
Clipboard -> Text
"CLIPBOARD"
  Selection
Primary -> Text
"PRIMARY"
  Selection
Secondary -> Text
"SECONDARY"