{-# LANGUAGE UndecidableInstances #-}

module Blucontrol.Monad.ApplyValue.X (
  ApplyValueXT
, runApplyValueXTIO
, ApplicableValueX
, ConfigX (..)
, XError (..)
) where

import Control.DeepSeq
import Control.Exception.Lifted (SomeException (..), bracket, catch)
import Control.Monad.Base
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Default
import Control.Monad.Reader
import Control.Monad.Except
import Data.Default
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import Data.Word
import GHC.Generics

import Graphics.X11.Xlib.Display (closeDisplay, defaultScreen, openDisplay, rootWindow)
import Graphics.X11.Xlib.Types (Display)

import Blucontrol.Monad.ApplyValue
import Blucontrol.Monad.ApplyValue.X.Internal
import Blucontrol.Value
import Blucontrol.Value.RGB

newtype ApplyValueXT m a = ApplyValueXT { ApplyValueXT m a -> ExceptT XError (ReaderT Display m) a
unApplyValueXT :: ExceptT XError (ReaderT Display m) a }
  deriving (Functor (ApplyValueXT m)
a -> ApplyValueXT m a
Functor (ApplyValueXT m)
-> (forall a. a -> ApplyValueXT m a)
-> (forall a b.
    ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b)
-> (forall a b c.
    (a -> b -> c)
    -> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c)
-> (forall a b.
    ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b)
-> (forall a b.
    ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a)
-> Applicative (ApplyValueXT m)
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a
ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
(a -> b -> c)
-> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c
forall a. a -> ApplyValueXT m a
forall a b.
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a
forall a b.
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
forall a b.
ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
forall a b c.
(a -> b -> c)
-> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c
forall (m :: * -> *). Monad m => Functor (ApplyValueXT m)
forall (m :: * -> *) a. Monad m => a -> ApplyValueXT m a
forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a
forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m a
*> :: ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
liftA2 :: (a -> b -> c)
-> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m c
<*> :: ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
pure :: a -> ApplyValueXT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> ApplyValueXT m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (ApplyValueXT m)
Applicative, a -> ApplyValueXT m b -> ApplyValueXT m a
(a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
(forall a b. (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b)
-> (forall a b. a -> ApplyValueXT m b -> ApplyValueXT m a)
-> Functor (ApplyValueXT m)
forall a b. a -> ApplyValueXT m b -> ApplyValueXT m a
forall a b. (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ApplyValueXT m b -> ApplyValueXT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ApplyValueXT m b -> ApplyValueXT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ApplyValueXT m b -> ApplyValueXT m a
fmap :: (a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ApplyValueXT m a -> ApplyValueXT m b
Functor, Applicative (ApplyValueXT m)
a -> ApplyValueXT m a
Applicative (ApplyValueXT m)
-> (forall a b.
    ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b)
-> (forall a b.
    ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b)
-> (forall a. a -> ApplyValueXT m a)
-> Monad (ApplyValueXT m)
ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
forall a. a -> ApplyValueXT m a
forall a b.
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
forall a b.
ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b
forall (m :: * -> *). Monad m => Applicative (ApplyValueXT m)
forall (m :: * -> *) a. Monad m => a -> ApplyValueXT m a
forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ApplyValueXT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> ApplyValueXT m a
>> :: ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> ApplyValueXT m b -> ApplyValueXT m b
>>= :: ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ApplyValueXT m a -> (a -> ApplyValueXT m b) -> ApplyValueXT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (ApplyValueXT m)
Monad, MonadBase b, MonadBaseControl b, MonadError XError)
  deriving (m a -> ApplyValueXT m a
(forall (m :: * -> *) a. Monad m => m a -> ApplyValueXT m a)
-> MonadTrans ApplyValueXT
forall (m :: * -> *) a. Monad m => m a -> ApplyValueXT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> ApplyValueXT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> ApplyValueXT m a
MonadTrans, MonadTrans ApplyValueXT
m (StT ApplyValueXT a) -> ApplyValueXT m a
MonadTrans ApplyValueXT
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run ApplyValueXT -> m a) -> ApplyValueXT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT ApplyValueXT a) -> ApplyValueXT m a)
-> MonadTransControl ApplyValueXT
(Run ApplyValueXT -> m a) -> ApplyValueXT m a
forall (m :: * -> *) a.
Monad m =>
m (StT ApplyValueXT a) -> ApplyValueXT m a
forall (m :: * -> *) a.
Monad m =>
(Run ApplyValueXT -> m a) -> ApplyValueXT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT ApplyValueXT a) -> ApplyValueXT m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT ApplyValueXT a) -> ApplyValueXT m a
liftWith :: (Run ApplyValueXT -> m a) -> ApplyValueXT m a
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run ApplyValueXT -> m a) -> ApplyValueXT m a
$cp1MonadTransControl :: MonadTrans ApplyValueXT
MonadTransControl) via Stack2T (ExceptT XError) (ReaderT Display)

instance MonadBaseControl IO m => MonadApplyValue (ApplyValueXT m) where
  type ApplicableValue (ApplyValueXT m) = ApplicableValueX
  applyValue :: ApplicableValue (ApplyValueXT m) -> ApplyValueXT m ()
applyValue ApplicableValue (ApplyValueXT m)
rgb = do
    Display
display <- ExceptT XError (ReaderT Display m) Display
-> ApplyValueXT m Display
forall (m :: * -> *) a.
ExceptT XError (ReaderT Display m) a -> ApplyValueXT m a
ApplyValueXT ExceptT XError (ReaderT Display m) Display
forall r (m :: * -> *). MonadReader r m => m r
ask
    Window
root <- XError -> IO Window -> ApplyValueXT m Window
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadError XError m) =>
XError -> IO a -> m a
liftXIO XError
XErrorRead (IO Window -> ApplyValueXT m Window)
-> IO Window -> ApplyValueXT m Window
forall a b. (a -> b) -> a -> b
$
      Display -> ScreenNumber -> IO Window
rootWindow Display
display (ScreenNumber -> IO Window) -> ScreenNumber -> IO Window
forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
display

    XError -> IO () -> ApplyValueXT m ()
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadError XError m) =>
XError -> IO a -> m a
liftXIO XError
XErrorSetGamma (IO () -> ApplyValueXT m ()) -> IO () -> ApplyValueXT m ()
forall a b. (a -> b) -> a -> b
$ XRRGamma -> Display -> Window -> IO ()
xrrSetGamma (ApplicableValueX -> XRRGamma
unApplicableValueX ApplicableValue (ApplyValueXT m)
ApplicableValueX
rgb) Display
display Window
root

runApplyValueXT :: Display -> ApplyValueXT m a -> m (Either XError a)
runApplyValueXT :: Display -> ApplyValueXT m a -> m (Either XError a)
runApplyValueXT Display
display ApplyValueXT m a
tma = ReaderT Display m (Either XError a)
-> Display -> m (Either XError a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ExceptT XError (ReaderT Display m) a
-> ReaderT Display m (Either XError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ApplyValueXT m a -> ExceptT XError (ReaderT Display m) a
forall (m :: * -> *) a.
ApplyValueXT m a -> ExceptT XError (ReaderT Display m) a
unApplyValueXT ApplyValueXT m a
tma)) Display
display

data ConfigX = ConfigX { ConfigX -> Maybe Text
hostName :: Maybe T.Text
                       , ConfigX -> Int
displayServer :: Int
                       , ConfigX -> Maybe Int
screen :: Maybe Int
                       }
  deriving (ConfigX -> ConfigX -> Bool
(ConfigX -> ConfigX -> Bool)
-> (ConfigX -> ConfigX -> Bool) -> Eq ConfigX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigX -> ConfigX -> Bool
$c/= :: ConfigX -> ConfigX -> Bool
== :: ConfigX -> ConfigX -> Bool
$c== :: ConfigX -> ConfigX -> Bool
Eq, (forall x. ConfigX -> Rep ConfigX x)
-> (forall x. Rep ConfigX x -> ConfigX) -> Generic ConfigX
forall x. Rep ConfigX x -> ConfigX
forall x. ConfigX -> Rep ConfigX x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigX x -> ConfigX
$cfrom :: forall x. ConfigX -> Rep ConfigX x
Generic, Eq ConfigX
Eq ConfigX
-> (ConfigX -> ConfigX -> Ordering)
-> (ConfigX -> ConfigX -> Bool)
-> (ConfigX -> ConfigX -> Bool)
-> (ConfigX -> ConfigX -> Bool)
-> (ConfigX -> ConfigX -> Bool)
-> (ConfigX -> ConfigX -> ConfigX)
-> (ConfigX -> ConfigX -> ConfigX)
-> Ord ConfigX
ConfigX -> ConfigX -> Bool
ConfigX -> ConfigX -> Ordering
ConfigX -> ConfigX -> ConfigX
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 :: ConfigX -> ConfigX -> ConfigX
$cmin :: ConfigX -> ConfigX -> ConfigX
max :: ConfigX -> ConfigX -> ConfigX
$cmax :: ConfigX -> ConfigX -> ConfigX
>= :: ConfigX -> ConfigX -> Bool
$c>= :: ConfigX -> ConfigX -> Bool
> :: ConfigX -> ConfigX -> Bool
$c> :: ConfigX -> ConfigX -> Bool
<= :: ConfigX -> ConfigX -> Bool
$c<= :: ConfigX -> ConfigX -> Bool
< :: ConfigX -> ConfigX -> Bool
$c< :: ConfigX -> ConfigX -> Bool
compare :: ConfigX -> ConfigX -> Ordering
$ccompare :: ConfigX -> ConfigX -> Ordering
$cp1Ord :: Eq ConfigX
Ord, ReadPrec [ConfigX]
ReadPrec ConfigX
Int -> ReadS ConfigX
ReadS [ConfigX]
(Int -> ReadS ConfigX)
-> ReadS [ConfigX]
-> ReadPrec ConfigX
-> ReadPrec [ConfigX]
-> Read ConfigX
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigX]
$creadListPrec :: ReadPrec [ConfigX]
readPrec :: ReadPrec ConfigX
$creadPrec :: ReadPrec ConfigX
readList :: ReadS [ConfigX]
$creadList :: ReadS [ConfigX]
readsPrec :: Int -> ReadS ConfigX
$creadsPrec :: Int -> ReadS ConfigX
Read, Int -> ConfigX -> ShowS
[ConfigX] -> ShowS
ConfigX -> String
(Int -> ConfigX -> ShowS)
-> (ConfigX -> String) -> ([ConfigX] -> ShowS) -> Show ConfigX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigX] -> ShowS
$cshowList :: [ConfigX] -> ShowS
show :: ConfigX -> String
$cshow :: ConfigX -> String
showsPrec :: Int -> ConfigX -> ShowS
$cshowsPrec :: Int -> ConfigX -> ShowS
Show)

instance NFData ConfigX

instance Default ConfigX where
  def :: ConfigX
def = ConfigX :: Maybe Text -> Int -> Maybe Int -> ConfigX
ConfigX { hostName :: Maybe Text
hostName = Maybe Text
forall a. Maybe a
Nothing
                , displayServer :: Int
displayServer = Int
0
                , screen :: Maybe Int
screen = Maybe Int
forall a. Maybe a
Nothing
                }

data XError = XErrorCloseDisplay
            | XErrorOpenDisplay
            | XErrorRead
            | XErrorSetGamma
  deriving (XError
XError -> XError -> Bounded XError
forall a. a -> a -> Bounded a
maxBound :: XError
$cmaxBound :: XError
minBound :: XError
$cminBound :: XError
Bounded, Int -> XError
XError -> Int
XError -> [XError]
XError -> XError
XError -> XError -> [XError]
XError -> XError -> XError -> [XError]
(XError -> XError)
-> (XError -> XError)
-> (Int -> XError)
-> (XError -> Int)
-> (XError -> [XError])
-> (XError -> XError -> [XError])
-> (XError -> XError -> [XError])
-> (XError -> XError -> XError -> [XError])
-> Enum XError
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 :: XError -> XError -> XError -> [XError]
$cenumFromThenTo :: XError -> XError -> XError -> [XError]
enumFromTo :: XError -> XError -> [XError]
$cenumFromTo :: XError -> XError -> [XError]
enumFromThen :: XError -> XError -> [XError]
$cenumFromThen :: XError -> XError -> [XError]
enumFrom :: XError -> [XError]
$cenumFrom :: XError -> [XError]
fromEnum :: XError -> Int
$cfromEnum :: XError -> Int
toEnum :: Int -> XError
$ctoEnum :: Int -> XError
pred :: XError -> XError
$cpred :: XError -> XError
succ :: XError -> XError
$csucc :: XError -> XError
Enum, XError -> XError -> Bool
(XError -> XError -> Bool)
-> (XError -> XError -> Bool) -> Eq XError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XError -> XError -> Bool
$c/= :: XError -> XError -> Bool
== :: XError -> XError -> Bool
$c== :: XError -> XError -> Bool
Eq, (forall x. XError -> Rep XError x)
-> (forall x. Rep XError x -> XError) -> Generic XError
forall x. Rep XError x -> XError
forall x. XError -> Rep XError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XError x -> XError
$cfrom :: forall x. XError -> Rep XError x
Generic, Eq XError
Eq XError
-> (XError -> XError -> Ordering)
-> (XError -> XError -> Bool)
-> (XError -> XError -> Bool)
-> (XError -> XError -> Bool)
-> (XError -> XError -> Bool)
-> (XError -> XError -> XError)
-> (XError -> XError -> XError)
-> Ord XError
XError -> XError -> Bool
XError -> XError -> Ordering
XError -> XError -> XError
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 :: XError -> XError -> XError
$cmin :: XError -> XError -> XError
max :: XError -> XError -> XError
$cmax :: XError -> XError -> XError
>= :: XError -> XError -> Bool
$c>= :: XError -> XError -> Bool
> :: XError -> XError -> Bool
$c> :: XError -> XError -> Bool
<= :: XError -> XError -> Bool
$c<= :: XError -> XError -> Bool
< :: XError -> XError -> Bool
$c< :: XError -> XError -> Bool
compare :: XError -> XError -> Ordering
$ccompare :: XError -> XError -> Ordering
$cp1Ord :: Eq XError
Ord, ReadPrec [XError]
ReadPrec XError
Int -> ReadS XError
ReadS [XError]
(Int -> ReadS XError)
-> ReadS [XError]
-> ReadPrec XError
-> ReadPrec [XError]
-> Read XError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XError]
$creadListPrec :: ReadPrec [XError]
readPrec :: ReadPrec XError
$creadPrec :: ReadPrec XError
readList :: ReadS [XError]
$creadList :: ReadS [XError]
readsPrec :: Int -> ReadS XError
$creadsPrec :: Int -> ReadS XError
Read, Int -> XError -> ShowS
[XError] -> ShowS
XError -> String
(Int -> XError -> ShowS)
-> (XError -> String) -> ([XError] -> ShowS) -> Show XError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XError] -> ShowS
$cshowList :: [XError] -> ShowS
show :: XError -> String
$cshow :: XError -> String
showsPrec :: Int -> XError -> ShowS
$cshowsPrec :: Int -> XError -> ShowS
Show)

instance NFData XError

liftXIO :: (MonadBaseControl IO m, MonadError XError m) => XError -> IO a -> m a
liftXIO :: XError -> IO a -> m a
liftXIO XError
xError = (m a -> (SomeException -> m a) -> m a)
-> (SomeException -> m a) -> m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
catch SomeException -> m a
throwXError (m a -> m a) -> (IO a -> m a) -> IO a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
  where throwXError :: SomeException -> m a
throwXError (SomeException e
_) = XError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError XError
xError

runApplyValueXTIO :: MonadBaseControl IO m => ConfigX -> ApplyValueXT m a -> m (Either XError a)
runApplyValueXTIO :: ConfigX -> ApplyValueXT m a -> m (Either XError a)
runApplyValueXTIO !ConfigX
conf ApplyValueXT m a
tma = ExceptT XError m a -> m (Either XError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT XError m a -> m (Either XError a))
-> ExceptT XError m a -> m (Either XError a)
forall a b. (a -> b) -> a -> b
$ ExceptT XError m Display
-> (Display -> ExceptT XError m ())
-> (Display -> ExceptT XError m a)
-> ExceptT XError m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket ExceptT XError m Display
open Display -> ExceptT XError m ()
forall (m :: * -> *).
(MonadBaseControl IO m, MonadError XError m) =>
Display -> m ()
close Display -> ExceptT XError m a
run
  where open :: ExceptT XError m Display
open = XError -> IO Display -> ExceptT XError m Display
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadError XError m) =>
XError -> IO a -> m a
liftXIO XError
XErrorOpenDisplay (IO Display -> ExceptT XError m Display)
-> IO Display -> ExceptT XError m Display
forall a b. (a -> b) -> a -> b
$ String -> IO Display
openDisplay (String -> IO Display) -> String -> IO Display
forall a b. (a -> b) -> a -> b
$ ConfigX -> String
showDisplay ConfigX
conf
        close :: Display -> m ()
close Display
display = XError -> IO () -> m ()
forall (m :: * -> *) a.
(MonadBaseControl IO m, MonadError XError m) =>
XError -> IO a -> m a
liftXIO XError
XErrorCloseDisplay (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Display -> IO ()
closeDisplay Display
display
        run :: Display -> ExceptT XError m a
run Display
display = m (StT (ExceptT XError) a) -> ExceptT XError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT (ExceptT XError) a) -> ExceptT XError m a)
-> m (StT (ExceptT XError) a) -> ExceptT XError m a
forall a b. (a -> b) -> a -> b
$ Display -> ApplyValueXT m a -> m (Either XError a)
forall (m :: * -> *) a.
Display -> ApplyValueXT m a -> m (Either XError a)
runApplyValueXT Display
display ApplyValueXT m a
tma

showDisplay :: ConfigX -> String
showDisplay :: ConfigX -> String
showDisplay ConfigX { Maybe Text
hostName :: Maybe Text
hostName :: ConfigX -> Maybe Text
hostName, Int
displayServer :: Int
displayServer :: ConfigX -> Int
displayServer, Maybe Int
screen :: Maybe Int
screen :: ConfigX -> Maybe Int
screen } = Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$
  [ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
hostName
  , Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
displayServer)
  , Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Int -> Text) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) Maybe Int
screen
  ]

newtype ApplicableValueX = ApplicableValueX { ApplicableValueX -> XRRGamma
unApplicableValueX :: XRRGamma }
  deriving (ApplicableValueX -> ApplicableValueX -> Bool
(ApplicableValueX -> ApplicableValueX -> Bool)
-> (ApplicableValueX -> ApplicableValueX -> Bool)
-> Eq ApplicableValueX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicableValueX -> ApplicableValueX -> Bool
$c/= :: ApplicableValueX -> ApplicableValueX -> Bool
== :: ApplicableValueX -> ApplicableValueX -> Bool
$c== :: ApplicableValueX -> ApplicableValueX -> Bool
Eq, (forall x. ApplicableValueX -> Rep ApplicableValueX x)
-> (forall x. Rep ApplicableValueX x -> ApplicableValueX)
-> Generic ApplicableValueX
forall x. Rep ApplicableValueX x -> ApplicableValueX
forall x. ApplicableValueX -> Rep ApplicableValueX x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplicableValueX x -> ApplicableValueX
$cfrom :: forall x. ApplicableValueX -> Rep ApplicableValueX x
Generic, Eq ApplicableValueX
Eq ApplicableValueX
-> (ApplicableValueX -> ApplicableValueX -> Ordering)
-> (ApplicableValueX -> ApplicableValueX -> Bool)
-> (ApplicableValueX -> ApplicableValueX -> Bool)
-> (ApplicableValueX -> ApplicableValueX -> Bool)
-> (ApplicableValueX -> ApplicableValueX -> Bool)
-> (ApplicableValueX -> ApplicableValueX -> ApplicableValueX)
-> (ApplicableValueX -> ApplicableValueX -> ApplicableValueX)
-> Ord ApplicableValueX
ApplicableValueX -> ApplicableValueX -> Bool
ApplicableValueX -> ApplicableValueX -> Ordering
ApplicableValueX -> ApplicableValueX -> ApplicableValueX
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 :: ApplicableValueX -> ApplicableValueX -> ApplicableValueX
$cmin :: ApplicableValueX -> ApplicableValueX -> ApplicableValueX
max :: ApplicableValueX -> ApplicableValueX -> ApplicableValueX
$cmax :: ApplicableValueX -> ApplicableValueX -> ApplicableValueX
>= :: ApplicableValueX -> ApplicableValueX -> Bool
$c>= :: ApplicableValueX -> ApplicableValueX -> Bool
> :: ApplicableValueX -> ApplicableValueX -> Bool
$c> :: ApplicableValueX -> ApplicableValueX -> Bool
<= :: ApplicableValueX -> ApplicableValueX -> Bool
$c<= :: ApplicableValueX -> ApplicableValueX -> Bool
< :: ApplicableValueX -> ApplicableValueX -> Bool
$c< :: ApplicableValueX -> ApplicableValueX -> Bool
compare :: ApplicableValueX -> ApplicableValueX -> Ordering
$ccompare :: ApplicableValueX -> ApplicableValueX -> Ordering
$cp1Ord :: Eq ApplicableValueX
Ord, ReadPrec [ApplicableValueX]
ReadPrec ApplicableValueX
Int -> ReadS ApplicableValueX
ReadS [ApplicableValueX]
(Int -> ReadS ApplicableValueX)
-> ReadS [ApplicableValueX]
-> ReadPrec ApplicableValueX
-> ReadPrec [ApplicableValueX]
-> Read ApplicableValueX
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicableValueX]
$creadListPrec :: ReadPrec [ApplicableValueX]
readPrec :: ReadPrec ApplicableValueX
$creadPrec :: ReadPrec ApplicableValueX
readList :: ReadS [ApplicableValueX]
$creadList :: ReadS [ApplicableValueX]
readsPrec :: Int -> ReadS ApplicableValueX
$creadsPrec :: Int -> ReadS ApplicableValueX
Read, Int -> ApplicableValueX -> ShowS
[ApplicableValueX] -> ShowS
ApplicableValueX -> String
(Int -> ApplicableValueX -> ShowS)
-> (ApplicableValueX -> String)
-> ([ApplicableValueX] -> ShowS)
-> Show ApplicableValueX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicableValueX] -> ShowS
$cshowList :: [ApplicableValueX] -> ShowS
show :: ApplicableValueX -> String
$cshow :: ApplicableValueX -> String
showsPrec :: Int -> ApplicableValueX -> ShowS
$cshowsPrec :: Int -> ApplicableValueX -> ShowS
Show)

instance NFData ApplicableValueX

instance CompatibleValues (RGB Word8) ApplicableValueX where
  convertValue :: RGB Word8 -> ApplicableValueX
convertValue RGB { Word8
red :: forall a. RGB a -> a
red :: Word8
red, Word8
green :: forall a. RGB a -> a
green :: Word8
green, Word8
blue :: forall a. RGB a -> a
blue :: Word8
blue } = XRRGamma -> ApplicableValueX
ApplicableValueX XRRGamma :: Float -> Float -> Float -> XRRGamma
XRRGamma { Float
xrr_gamma_red :: Float
xrr_gamma_red :: Float
xrr_gamma_red, Float
xrr_gamma_green :: Float
xrr_gamma_green :: Float
xrr_gamma_green, Float
xrr_gamma_blue :: Float
xrr_gamma_blue :: Float
xrr_gamma_blue }
    where xrr_gamma_red :: Float
xrr_gamma_red = Word8 -> Float
word8ToFloat Word8
red
          xrr_gamma_green :: Float
xrr_gamma_green = Word8 -> Float
word8ToFloat Word8
green
          xrr_gamma_blue :: Float
xrr_gamma_blue = Word8 -> Float
word8ToFloat Word8
blue
          word8ToFloat :: Word8 -> Float
word8ToFloat = (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bounded Word8 => Word8
forall a. Bounded a => a
maxBound @Word8)) (Float -> Float) -> (Word8 -> Float) -> Word8 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral