{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, FlexibleInstances,
  InterruptibleFFI, ExistentialQuantification, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Information.SafeX11
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------
module System.Taffybar.Information.SafeX11
  ( module Graphics.X11.Xlib
  , module Graphics.X11.Xlib.Extras
  , module System.Taffybar.Information.SafeX11
  )
  where

import Control.Concurrent
import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe (MaybeT(..))
import Data.Either.Combinators
import Data.Typeable
import Foreign hiding (void)
import Foreign.C.Types
import GHC.ForeignPtr
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
       hiding (rawGetWindowProperty, getWindowProperty8,
               getWindowProperty16, getWindowProperty32,
               xGetWMHints, getWMHints, refreshKeyboardMapping)
import Prelude
import System.IO.Unsafe
import System.Log.Logger
import System.Timeout
import Text.Printf

logHere :: Priority -> String -> IO ()
logHere :: Priority -> String -> IO ()
logHere = String -> Priority -> String -> IO ()
logM String
"System.Taffybar.Information.SafeX11"

foreign import ccall safe "XlibExtras.h XGetWMHints"
    safeXGetWMHints :: Display -> Window -> IO (Ptr WMHints)

foreign import ccall interruptible "XlibExtras.h XGetWindowProperty"
               safeXGetWindowProperty ::
               Display ->
                 Window ->
                   Atom ->
                     CLong ->
                       CLong ->
                         Bool ->
                           Atom ->
                             Ptr Atom ->
                               Ptr CInt ->
                                 Ptr CULong ->
                                   Ptr CULong ->
                                     Ptr (Ptr CUChar) -> IO Status

rawGetWindowPropertyBytes
  :: Storable a
  => Int -> Display -> Atom -> Window -> IO (Maybe (ForeignPtr a, Int))
rawGetWindowPropertyBytes :: forall a.
Storable a =>
Int
-> Display -> Window -> Window -> IO (Maybe (ForeignPtr a, Int))
rawGetWindowPropertyBytes Int
bits Display
d Window
atom Window
w =
  (Ptr Window -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Window -> IO (Maybe (ForeignPtr a, Int)))
 -> IO (Maybe (ForeignPtr a, Int)))
-> (Ptr Window -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr Window
actual_type_return ->
    (Ptr CInt -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (ForeignPtr a, Int)))
 -> IO (Maybe (ForeignPtr a, Int)))
-> (Ptr CInt -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
actual_format_return ->
      (Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
 -> IO (Maybe (ForeignPtr a, Int)))
-> (Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
nitems_return ->
        (Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
 -> IO (Maybe (ForeignPtr a, Int)))
-> (Ptr CULong -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CULong
bytes_after_return ->
          (Ptr (Ptr CUChar) -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CUChar) -> IO (Maybe (ForeignPtr a, Int)))
 -> IO (Maybe (ForeignPtr a, Int)))
-> (Ptr (Ptr CUChar) -> IO (Maybe (ForeignPtr a, Int)))
-> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CUChar)
prop_return -> do
            Either SafeX11Exception CInt
ret <- IO CInt -> IO (Either SafeX11Exception CInt)
forall a. IO a -> IO (Either SafeX11Exception a)
postX11RequestSync (IO CInt -> IO (Either SafeX11Exception CInt))
-> IO CInt -> IO (Either SafeX11Exception CInt)
forall a b. (a -> b) -> a -> b
$
              Display
-> Window
-> Window
-> CLong
-> CLong
-> Bool
-> Window
-> Ptr Window
-> Ptr CInt
-> Ptr CULong
-> Ptr CULong
-> Ptr (Ptr CUChar)
-> IO CInt
safeXGetWindowProperty
                Display
d
                Window
w
                Window
atom
                CLong
0
                CLong
0xFFFFFFFF
                Bool
False
                Window
anyPropertyType
                Ptr Window
actual_type_return
                Ptr CInt
actual_format_return
                Ptr CULong
nitems_return
                Ptr CULong
bytes_after_return
                Ptr (Ptr CUChar)
prop_return
            if CInt -> Either SafeX11Exception CInt -> CInt
forall b a. b -> Either a b -> b
fromRight (-CInt
1) Either SafeX11Exception CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
              then Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForeignPtr a, Int)
forall a. Maybe a
Nothing
              else do
                Ptr CUChar
prop_ptr <- Ptr (Ptr CUChar) -> IO (Ptr CUChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CUChar)
prop_return
                Int
actual_format <- CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
actual_format_return
                Int
nitems <- CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULong -> Int) -> IO CULong -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr CULong -> IO CULong
forall a. Storable a => Ptr a -> IO a
peek Ptr CULong
nitems_return
                Ptr CUChar -> Int -> Int -> IO (Maybe (ForeignPtr a, Int))
getprop Ptr CUChar
prop_ptr Int
nitems Int
actual_format
  where
    getprop :: Ptr CUChar -> Int -> Int -> IO (Maybe (ForeignPtr a, Int))
getprop Ptr CUChar
prop_ptr Int
nitems Int
actual_format
      | Int
actual_format Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForeignPtr a, Int)
forall a. Maybe a
Nothing -- Property not found
      | Int
actual_format Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
bits = Ptr CUChar -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr CUChar
prop_ptr IO CInt
-> IO (Maybe (ForeignPtr a, Int)) -> IO (Maybe (ForeignPtr a, Int))
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ForeignPtr a, Int)
forall a. Maybe a
Nothing
      | Bool
otherwise = do
        ForeignPtr a
ptr <- Ptr a -> IO () -> IO (ForeignPtr a)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newConcForeignPtr (Ptr CUChar -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
prop_ptr) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr CUChar -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr CUChar
prop_ptr)
        Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int)))
-> Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
forall a b. (a -> b) -> a -> b
$ (ForeignPtr a, Int) -> Maybe (ForeignPtr a, Int)
forall a. a -> Maybe a
Just (ForeignPtr a
ptr, Int
nitems)

data SafeX11Exception = SafeX11Exception deriving (Int -> SafeX11Exception -> ShowS
[SafeX11Exception] -> ShowS
SafeX11Exception -> String
(Int -> SafeX11Exception -> ShowS)
-> (SafeX11Exception -> String)
-> ([SafeX11Exception] -> ShowS)
-> Show SafeX11Exception
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeX11Exception -> ShowS
showsPrec :: Int -> SafeX11Exception -> ShowS
$cshow :: SafeX11Exception -> String
show :: SafeX11Exception -> String
$cshowList :: [SafeX11Exception] -> ShowS
showList :: [SafeX11Exception] -> ShowS
Show, SafeX11Exception -> SafeX11Exception -> Bool
(SafeX11Exception -> SafeX11Exception -> Bool)
-> (SafeX11Exception -> SafeX11Exception -> Bool)
-> Eq SafeX11Exception
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeX11Exception -> SafeX11Exception -> Bool
== :: SafeX11Exception -> SafeX11Exception -> Bool
$c/= :: SafeX11Exception -> SafeX11Exception -> Bool
/= :: SafeX11Exception -> SafeX11Exception -> Bool
Eq, Typeable)

instance Exception SafeX11Exception

data IORequest = forall a. IORequest
  { ()
ioAction :: IO a
  , ()
ioResponse :: Chan (Either SafeX11Exception a)
  }

{-# NOINLINE requestQueue #-}
requestQueue :: Chan IORequest
requestQueue :: Chan IORequest
requestQueue = IO (Chan IORequest) -> Chan IORequest
forall a. IO a -> a
unsafePerformIO IO (Chan IORequest)
forall a. IO (Chan a)
newChan

{-# NOINLINE x11Thread #-}
x11Thread :: ThreadId
x11Thread :: ThreadId
x11Thread = IO ThreadId -> ThreadId
forall a. IO a -> a
unsafePerformIO (IO ThreadId -> ThreadId) -> IO ThreadId -> ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO IO ()
startHandlingX11Requests

withErrorHandler :: XErrorHandler -> IO a -> IO a
withErrorHandler :: forall a. XErrorHandler -> IO a -> IO a
withErrorHandler XErrorHandler
new_handler IO a
action = do
    FunPtr CXErrorHandler
handler <- CXErrorHandler -> IO (FunPtr CXErrorHandler)
mkXErrorHandler (\Display
d XErrorEventPtr
e -> XErrorHandler
new_handler Display
d XErrorEventPtr
e IO () -> IO CInt -> IO CInt
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
0)
    FunPtr CXErrorHandler
original <- FunPtr CXErrorHandler -> IO (FunPtr CXErrorHandler)
_xSetErrorHandler FunPtr CXErrorHandler
handler
    a
res <- IO a
action
    FunPtr CXErrorHandler
_ <- FunPtr CXErrorHandler -> IO (FunPtr CXErrorHandler)
_xSetErrorHandler FunPtr CXErrorHandler
original
    a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

deriving instance Show ErrorEvent

startHandlingX11Requests :: IO ()
startHandlingX11Requests :: IO ()
startHandlingX11Requests =
  XErrorHandler -> IO () -> IO ()
forall a. XErrorHandler -> IO a -> IO a
withErrorHandler XErrorHandler
forall {p}. p -> XErrorEventPtr -> IO ()
handleError IO ()
handleX11Requests
  where handleError :: p -> XErrorEventPtr -> IO ()
handleError p
_ XErrorEventPtr
xerrptr = do
          ErrorEvent
ee <- XErrorEventPtr -> IO ErrorEvent
getErrorEvent XErrorEventPtr
xerrptr
          Priority -> String -> IO ()
logHere Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                  String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Handling X11 error with error handler: %s" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ErrorEvent -> String
forall a. Show a => a -> String
show ErrorEvent
ee

handleX11Requests :: IO ()
handleX11Requests :: IO ()
handleX11Requests = do
  IORequest {ioAction :: ()
ioAction = IO a
action, ioResponse :: ()
ioResponse = Chan (Either SafeX11Exception a)
responseChannel} <-
    Chan IORequest -> IO IORequest
forall a. Chan a -> IO a
readChan Chan IORequest
requestQueue
  Either SafeX11Exception a
res <-
    IO (Either SafeX11Exception a)
-> (IOException -> IO (Either SafeX11Exception a))
-> IO (Either SafeX11Exception a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
      (Either SafeX11Exception a
-> (a -> Either SafeX11Exception a)
-> Maybe a
-> Either SafeX11Exception a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (SafeX11Exception -> Either SafeX11Exception a
forall a b. a -> Either a b
Left SafeX11Exception
SafeX11Exception) a -> Either SafeX11Exception a
forall a b. b -> Either a b
Right (Maybe a -> Either SafeX11Exception a)
-> IO (Maybe a) -> IO (Either SafeX11Exception a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
500000 IO a
action)
      (\IOException
e -> do
         Priority -> String -> IO ()
logHere Priority
WARNING (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall r. PrintfType r => String -> r
printf String
"Handling X11 error with catch: %s" ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                 IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException)
         Either SafeX11Exception a -> IO (Either SafeX11Exception a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either SafeX11Exception a -> IO (Either SafeX11Exception a))
-> Either SafeX11Exception a -> IO (Either SafeX11Exception a)
forall a b. (a -> b) -> a -> b
$ SafeX11Exception -> Either SafeX11Exception a
forall a b. a -> Either a b
Left SafeX11Exception
SafeX11Exception)
  Chan (Either SafeX11Exception a)
-> Either SafeX11Exception a -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan (Either SafeX11Exception a)
responseChannel Either SafeX11Exception a
res
  IO ()
handleX11Requests
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

postX11RequestSync :: IO a -> IO (Either SafeX11Exception a)
postX11RequestSync :: forall a. IO a -> IO (Either SafeX11Exception a)
postX11RequestSync IO a
action = do
  let postAndWait :: IO (Either SafeX11Exception a)
postAndWait = do
        Chan (Either SafeX11Exception a)
responseChannel <- IO (Chan (Either SafeX11Exception a))
forall a. IO (Chan a)
forall {a}. IO (Chan (Either SafeX11Exception a))
newChan :: IO (Chan (Either SafeX11Exception a))
        Chan IORequest -> IORequest -> IO ()
forall a. Chan a -> a -> IO ()
writeChan
          Chan IORequest
requestQueue
          IORequest {ioAction :: IO a
ioAction = IO a
action, ioResponse :: Chan (Either SafeX11Exception a)
ioResponse = Chan (Either SafeX11Exception a)
responseChannel}
        Chan (Either SafeX11Exception a) -> IO (Either SafeX11Exception a)
forall a. Chan a -> IO a
readChan Chan (Either SafeX11Exception a)
responseChannel
  ThreadId
currentTID <- IO ThreadId
myThreadId
  if ThreadId
currentTID ThreadId -> ThreadId -> Bool
forall a. Eq a => a -> a -> Bool
== ThreadId
x11Thread
    then a -> Either SafeX11Exception a
forall a b. b -> Either a b
Right (a -> Either SafeX11Exception a)
-> IO a -> IO (Either SafeX11Exception a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action
    else IO (Either SafeX11Exception a)
postAndWait

postX11RequestSyncDef :: a -> IO a -> IO a
postX11RequestSyncDef :: forall a. a -> IO a -> IO a
postX11RequestSyncDef a
def IO a
action =
  a -> Either SafeX11Exception a -> a
forall b a. b -> Either a b -> b
fromRight a
def (Either SafeX11Exception a -> a)
-> IO (Either SafeX11Exception a) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO (Either SafeX11Exception a)
forall a. IO a -> IO (Either SafeX11Exception a)
postX11RequestSync IO a
action

rawGetWindowProperty ::
  Storable a
  => Int -> Display -> Atom -> Window -> IO (Maybe [a])
rawGetWindowProperty :: forall a.
Storable a =>
Int -> Display -> Window -> Window -> IO (Maybe [a])
rawGetWindowProperty Int
bits Display
d Window
atom Window
w =
  MaybeT IO [a] -> IO (Maybe [a])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [a] -> IO (Maybe [a]))
-> MaybeT IO [a] -> IO (Maybe [a])
forall a b. (a -> b) -> a -> b
$ do
    (ForeignPtr a
ptr, Int
count) <- IO (Maybe (ForeignPtr a, Int)) -> MaybeT IO (ForeignPtr a, Int)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe (ForeignPtr a, Int)) -> MaybeT IO (ForeignPtr a, Int))
-> IO (Maybe (ForeignPtr a, Int)) -> MaybeT IO (ForeignPtr a, Int)
forall a b. (a -> b) -> a -> b
$ Int
-> Display -> Window -> Window -> IO (Maybe (ForeignPtr a, Int))
forall a.
Storable a =>
Int
-> Display -> Window -> Window -> IO (Maybe (ForeignPtr a, Int))
rawGetWindowPropertyBytes Int
bits Display
d Window
atom Window
w
    IO [a] -> MaybeT IO [a]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [a] -> MaybeT IO [a]) -> IO [a] -> MaybeT IO [a]
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> (Ptr a -> IO [a]) -> IO [a]
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr a
ptr ((Ptr a -> IO [a]) -> IO [a]) -> (Ptr a -> IO [a]) -> IO [a]
forall a b. (a -> b) -> a -> b
$ Int -> Ptr a -> IO [a]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
count

getWindowProperty8 :: Display -> Atom -> Window -> IO (Maybe [CChar])
getWindowProperty8 :: Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 = Int -> Display -> Window -> Window -> IO (Maybe [CChar])
forall a.
Storable a =>
Int -> Display -> Window -> Window -> IO (Maybe [a])
rawGetWindowProperty Int
8

getWindowProperty16 :: Display -> Atom -> Window -> IO (Maybe [CShort])
getWindowProperty16 :: Display -> Window -> Window -> IO (Maybe [CShort])
getWindowProperty16 = Int -> Display -> Window -> Window -> IO (Maybe [CShort])
forall a.
Storable a =>
Int -> Display -> Window -> Window -> IO (Maybe [a])
rawGetWindowProperty Int
16

getWindowProperty32 :: Display -> Atom -> Window -> IO (Maybe [CLong])
getWindowProperty32 :: Display -> Window -> Window -> IO (Maybe [CLong])
getWindowProperty32 = Int -> Display -> Window -> Window -> IO (Maybe [CLong])
forall a.
Storable a =>
Int -> Display -> Window -> Window -> IO (Maybe [a])
rawGetWindowProperty Int
32

getWMHints :: Display -> Window -> IO WMHints
getWMHints :: Display -> Window -> IO WMHints
getWMHints Display
dpy Window
w = do
    Ptr WMHints
p <- Display -> Window -> IO (Ptr WMHints)
safeXGetWMHints Display
dpy Window
w
    if Ptr WMHints
p Ptr WMHints -> Ptr WMHints -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr WMHints
forall a. Ptr a
nullPtr
        then WMHints -> IO WMHints
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (WMHints -> IO WMHints) -> WMHints -> IO WMHints
forall a b. (a -> b) -> a -> b
$ CLong
-> Bool
-> CInt
-> Window
-> Window
-> CInt
-> CInt
-> Window
-> Window
-> WMHints
WMHints CLong
0 Bool
False CInt
0 Window
0 Window
0 CInt
0 CInt
0 Window
0 Window
0
        else do WMHints
x <- Ptr WMHints -> IO WMHints
forall a. Storable a => Ptr a -> IO a
peek Ptr WMHints
p; CInt
_ <- Ptr WMHints -> IO CInt
forall a. Ptr a -> IO CInt
xFree Ptr WMHints
p; WMHints -> IO WMHints
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return WMHints
x

safeGetGeometry :: Display -> Drawable ->
        IO (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
safeGetGeometry :: Display
-> Window
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
safeGetGeometry Display
display Window
d =
        (IO CInt -> IO ())
-> (Ptr Window
    -> Ptr Position
    -> Ptr Position
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr CInt
    -> IO CInt)
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
forall a b c d e f g r.
(Storable a, Storable b, Storable c, Storable d, Storable e,
 Storable f, Storable g) =>
(IO r -> IO ())
-> (Ptr a
    -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r)
-> IO (a, b, c, d, e, f, g)
outParameters7 (String -> IO CInt -> IO ()
throwIfZero String
"getGeometry") ((Ptr Window
  -> Ptr Position
  -> Ptr Position
  -> Ptr Dimension
  -> Ptr Dimension
  -> Ptr Dimension
  -> Ptr CInt
  -> IO CInt)
 -> IO
      (Window, Position, Position, Dimension, Dimension, Dimension,
       CInt))
-> (Ptr Window
    -> Ptr Position
    -> Ptr Position
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr CInt
    -> IO CInt)
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
forall a b. (a -> b) -> a -> b
$
                Display
-> Window
-> Ptr Window
-> Ptr Position
-> Ptr Position
-> Ptr Dimension
-> Ptr Dimension
-> Ptr Dimension
-> Ptr CInt
-> IO CInt
xGetGeometry Display
display Window
d

outParameters7 :: (Storable a, Storable b, Storable c, Storable d, Storable e, Storable f, Storable g) =>
        (IO r -> IO ()) -> (Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r) ->
        IO (a,b,c,d,e,f,g)
outParameters7 :: forall a b c d e f g r.
(Storable a, Storable b, Storable c, Storable d, Storable e,
 Storable f, Storable g) =>
(IO r -> IO ())
-> (Ptr a
    -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r)
-> IO (a, b, c, d, e, f, g)
outParameters7 IO r -> IO ()
check Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r
fn =
        (Ptr a -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr a -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr a -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr a
a_return ->
        (Ptr b -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr b -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr b -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr b
b_return ->
        (Ptr c -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr c -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr c -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr c
c_return ->
        (Ptr d -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr d -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr d -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr d
d_return ->
        (Ptr e -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr e -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr e -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr e
e_return ->
        (Ptr f -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr f -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr f -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr f
f_return ->
        (Ptr g -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr g -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g))
-> (Ptr g -> IO (a, b, c, d, e, f, g)) -> IO (a, b, c, d, e, f, g)
forall a b. (a -> b) -> a -> b
$ \ Ptr g
g_return -> do
        IO r -> IO ()
check (Ptr a -> Ptr b -> Ptr c -> Ptr d -> Ptr e -> Ptr f -> Ptr g -> IO r
fn Ptr a
a_return Ptr b
b_return Ptr c
c_return Ptr d
d_return Ptr e
e_return Ptr f
f_return Ptr g
g_return)
        a
a <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
a_return
        b
b <- Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
peek Ptr b
b_return
        c
c <- Ptr c -> IO c
forall a. Storable a => Ptr a -> IO a
peek Ptr c
c_return
        d
d <- Ptr d -> IO d
forall a. Storable a => Ptr a -> IO a
peek Ptr d
d_return
        e
e <- Ptr e -> IO e
forall a. Storable a => Ptr a -> IO a
peek Ptr e
e_return
        f
f <- Ptr f -> IO f
forall a. Storable a => Ptr a -> IO a
peek Ptr f
f_return
        g
g <- Ptr g -> IO g
forall a. Storable a => Ptr a -> IO a
peek Ptr g
g_return
        (a, b, c, d, e, f, g) -> IO (a, b, c, d, e, f, g)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b,c
c,d
d,e
e,f
f,g
g)

foreign import ccall safe "HsXlib.h XGetGeometry"
        xGetGeometry :: Display -> Drawable ->
                Ptr Window -> Ptr Position -> Ptr Position -> Ptr Dimension ->
                Ptr Dimension -> Ptr Dimension -> Ptr CInt -> IO Status