{-# LANGUAGE MultiParamTypeClasses, StandaloneDeriving, FlexibleInstances,
  InterruptibleFFI, ExistentialQuantification, DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-----------------------------------------------------------------------------
-- |
-- 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
  , getWMHints
  , getWindowProperty8
  , getWindowProperty16
  , getWindowProperty32
  , postX11RequestSyncDef
  , rawGetWindowPropertyBytes
  , safeGetGeometry
  )
  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 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
            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 fromRight (-1) ret /= 0
              then return Nothing
              else do
                prop_ptr <- peek prop_return
                actual_format <- fromIntegral `fmap` peek actual_format_return
                nitems <- fromIntegral `fmap` peek nitems_return
                getprop prop_ptr nitems 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
        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)
        return $ Just (ptr, 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
    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)
    original <- _xSetErrorHandler handler
    res <- action
    _ <- _xSetErrorHandler original
    return 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
          ee <- XErrorEventPtr -> IO ErrorEvent
getErrorEvent XErrorEventPtr
xerrptr
          logHere WARNING $
                  printf "Handling X11 error with error handler: %s" $ show ee

handleX11Requests :: IO ()
handleX11Requests :: IO ()
handleX11Requests = do
  IORequest {ioAction = action, ioResponse = responseChannel} <-
    Chan IORequest -> IO IORequest
forall a. Chan a -> IO a
readChan Chan IORequest
requestQueue
  res <-
    catch
      (maybe (Left SafeX11Exception) Right <$> timeout 500000 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)
  writeChan responseChannel res
  handleX11Requests
  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
        responseChannel <- IO (Chan (Either SafeX11Exception a))
forall a. IO (Chan a)
forall {a}. IO (Chan (Either SafeX11Exception a))
newChan :: IO (Chan (Either SafeX11Exception a))
        writeChan
          requestQueue
          IORequest {ioAction = action, ioResponse = responseChannel}
        readChan responseChannel
  currentTID <- IO ThreadId
myThreadId
  if currentTID == x11Thread
    then Right <$> action
    else 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
    (ptr, 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
    lift $ withForeignPtr ptr $ peekArray 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
    p <- Display -> Window -> IO (Ptr WMHints)
safeXGetWMHints Display
dpy Window
w
    if p == nullPtr
        then return $ WMHints 0 False 0 0 0 0 0 0 0
        else do x <- peek p; _ <- xFree p; return 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 <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
a_return
        b <- peek b_return
        c <- peek c_return
        d <- peek d_return
        e <- peek e_return
        f <- peek f_return
        g <- peek g_return
        return (a,b,c,d,e,f,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