{-# options_haddock prune #-}

-- |X11Config Data Type, Internal
module Helic.Data.X11Config where

import Helic.Json (json, unaryJson)

newtype DisplayId =
  DisplayId { DisplayId -> Text
unDisplayId :: Text }
  deriving stock (DisplayId -> DisplayId -> Bool
(DisplayId -> DisplayId -> Bool)
-> (DisplayId -> DisplayId -> Bool) -> Eq DisplayId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisplayId -> DisplayId -> Bool
$c/= :: DisplayId -> DisplayId -> Bool
== :: DisplayId -> DisplayId -> Bool
$c== :: DisplayId -> DisplayId -> Bool
Eq, Int -> DisplayId -> ShowS
[DisplayId] -> ShowS
DisplayId -> String
(Int -> DisplayId -> ShowS)
-> (DisplayId -> String)
-> ([DisplayId] -> ShowS)
-> Show DisplayId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisplayId] -> ShowS
$cshowList :: [DisplayId] -> ShowS
show :: DisplayId -> String
$cshow :: DisplayId -> String
showsPrec :: Int -> DisplayId -> ShowS
$cshowsPrec :: Int -> DisplayId -> ShowS
Show, (forall x. DisplayId -> Rep DisplayId x)
-> (forall x. Rep DisplayId x -> DisplayId) -> Generic DisplayId
forall x. Rep DisplayId x -> DisplayId
forall x. DisplayId -> Rep DisplayId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisplayId x -> DisplayId
$cfrom :: forall x. DisplayId -> Rep DisplayId x
Generic)
  deriving newtype (String -> DisplayId
(String -> DisplayId) -> IsString DisplayId
forall a. (String -> a) -> IsString a
fromString :: String -> DisplayId
$cfromString :: String -> DisplayId
IsString)

json ''DisplayId

data X11Config =
  X11Config {
    X11Config -> Maybe DisplayId
display :: Maybe DisplayId
  }
  deriving stock (X11Config -> X11Config -> Bool
(X11Config -> X11Config -> Bool)
-> (X11Config -> X11Config -> Bool) -> Eq X11Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: X11Config -> X11Config -> Bool
$c/= :: X11Config -> X11Config -> Bool
== :: X11Config -> X11Config -> Bool
$c== :: X11Config -> X11Config -> Bool
Eq, Int -> X11Config -> ShowS
[X11Config] -> ShowS
X11Config -> String
(Int -> X11Config -> ShowS)
-> (X11Config -> String)
-> ([X11Config] -> ShowS)
-> Show X11Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [X11Config] -> ShowS
$cshowList :: [X11Config] -> ShowS
show :: X11Config -> String
$cshow :: X11Config -> String
showsPrec :: Int -> X11Config -> ShowS
$cshowsPrec :: Int -> X11Config -> ShowS
Show, (forall x. X11Config -> Rep X11Config x)
-> (forall x. Rep X11Config x -> X11Config) -> Generic X11Config
forall x. Rep X11Config x -> X11Config
forall x. X11Config -> Rep X11Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep X11Config x -> X11Config
$cfrom :: forall x. X11Config -> Rep X11Config x
Generic)
  deriving anyclass (X11Config
X11Config -> Default X11Config
forall a. a -> Default a
def :: X11Config
$cdef :: X11Config
Default)

unaryJson ''X11Config