    {-# 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 "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 :: Int -> Display -> Atom -> Atom -> IO (Maybe (ForeignPtr a, Int))
    rawGetWindowPropertyBytes bits :: Int
    bits d :: Display
    d atom :: Atom
    atom w :: Atom
    w =
      (Ptr Atom -> IO (Maybe (ForeignPtr a, Int)))
    -> IO (Maybe (ForeignPtr a, Int))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr Atom -> IO (Maybe (ForeignPtr a, Int)))
     -> IO (Maybe (ForeignPtr a, Int)))
    -> (Ptr Atom -> IO (Maybe (ForeignPtr a, Int)))
    -> IO (Maybe (ForeignPtr a, Int))
    forall a b. (a -> b) -> a -> b
    $ \actual_type_return :: Ptr Atom
    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
    $ \actual_format_return :: 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
    $ \nitems_return :: 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
    $ \bytes_after_return :: 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
    $ \prop_return :: 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
    -> Atom
    -> Atom
    -> CLong
    -> CLong
    -> Bool
    -> Atom
    -> Ptr Atom
    -> Ptr CInt
    -> Ptr CULong
    -> Ptr CULong
    -> Ptr (Ptr CUChar)
    -> IO CInt
    safeXGetWindowProperty
                    Display
    d
                    Atom
    w
                    Atom
    atom
                    0
                    0xFFFFFFFF
                    Bool
    False
                    Atom
    anyPropertyType
                    Ptr Atom
    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 (-1) Either SafeX11Exception CInt
    ret CInt -> CInt -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0
                  then Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
    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 (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 (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 prop_ptr :: Ptr CUChar
    prop_ptr nitems :: Int
    nitems actual_format :: Int
    actual_format
          | Int
    actual_format Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 = Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
    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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (ForeignPtr a, Int) -> IO (Maybe (ForeignPtr a, Int))
    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 (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
    showList :: [SafeX11Exception] -> ShowS
    $cshowList :: [SafeX11Exception] -> ShowS
    show :: SafeX11Exception -> String
    $cshow :: SafeX11Exception -> String
    showsPrec :: Int -> SafeX11Exception -> ShowS
    $cshowsPrec :: Int -> SafeX11Exception -> ShowS
    Show, SafeX11Exception -> SafeX11Exception -> Bool
    (SafeX11Exception -> SafeX11Exception -> Bool)
    -> (SafeX11Exception -> SafeX11Exception -> Bool)
    -> Eq SafeX11Exception
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SafeX11Exception -> SafeX11Exception -> Bool
    $c/= :: SafeX11Exception -> SafeX11Exception -> Bool
    == :: SafeX11Exception -> SafeX11Exception -> Bool
    $c== :: 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 :: XErrorHandler -> IO a -> IO a
    withErrorHandler new_handler :: XErrorHandler
    new_handler action :: IO a
    action = do
        FunPtr CXErrorHandler
    handler <- CXErrorHandler -> IO (FunPtr CXErrorHandler)
    mkXErrorHandler (\d :: Display
    d e :: XErrorEventPtr
    e -> XErrorHandler
    new_handler Display
    d XErrorEventPtr
    e IO () -> IO CInt -> IO CInt
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> CInt -> IO CInt
    forall (m :: * -> *) a. Monad m => a -> m a
    return 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 (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 _ xerrptr :: 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 "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 500000 IO a
    action)
          (\e :: 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 "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 (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 (m :: * -> *) a. Monad m => a -> m a
    return ()

    postX11RequestSync :: IO a -> IO (Either SafeX11Exception a)
    postX11RequestSync :: IO a -> IO (Either SafeX11Exception a)
    postX11RequestSync action :: IO a
    action = do
      let postAndWait :: IO (Either SafeX11Exception a)
    postAndWait = do
            Chan (Either SafeX11Exception a)
    responseChannel <- 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 :: forall a. IO a -> Chan (Either SafeX11Exception a) -> IORequest
    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 :: a -> IO a -> IO a
    postX11RequestSyncDef def :: a
    def action :: 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 :: Int -> Display -> Atom -> Atom -> IO (Maybe [a])
    rawGetWindowProperty bits :: Int
    bits d :: Display
    d atom :: Atom
    atom w :: Atom
    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 :: ForeignPtr a
    ptr, count :: 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 -> Atom -> Atom -> IO (Maybe (ForeignPtr a, Int))
    forall a.
    Storable a =>
    Int -> Display -> Atom -> Atom -> IO (Maybe (ForeignPtr a, Int))
    rawGetWindowPropertyBytes Int
    bits Display
    d Atom
    atom Atom
    w
        IO [a] -> MaybeT IO [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 -> Atom -> Atom -> IO (Maybe [CChar])
    getWindowProperty8 = Int -> Display -> Atom -> Atom -> IO (Maybe [CChar])
    forall a.
    Storable a =>
    Int -> Display -> Atom -> Atom -> IO (Maybe [a])
    rawGetWindowProperty 8

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

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

    getWMHints :: Display -> Window -> IO WMHints
    getWMHints :: Display -> Atom -> IO WMHints
    getWMHints dpy :: Display
    dpy w :: Atom
    w = do
        Ptr WMHints
    p <- Display -> Atom -> IO (Ptr WMHints)
    safeXGetWMHints Display
    dpy Atom
    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 (m :: * -> *) a. Monad m => a -> m a
    return (WMHints -> IO WMHints) -> WMHints -> IO WMHints
    forall a b. (a -> b) -> a -> b
    $ CLong
    -> Bool
    -> CInt
    -> Atom
    -> Atom
    -> CInt
    -> CInt
    -> Atom
    -> Atom
    -> WMHints
    WMHints 0 Bool
    False 0 0 0 0 0 0 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 (m :: * -> *) a. Monad m => a -> m a
    return WMHints
    x

    safeGetGeometry :: Display -> Drawable ->
            IO (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
    safeGetGeometry :: Display
    -> Atom
    -> IO
         (Atom, Position, Position, Dimension, Dimension, Dimension, CInt)
    safeGetGeometry display :: Display
    display d :: Atom
    d =
            (IO CInt -> IO ())
    -> (Ptr Atom
        -> Ptr Position
        -> Ptr Position
        -> Ptr Dimension
        -> Ptr Dimension
        -> Ptr Dimension
        -> Ptr CInt
        -> IO CInt)
    -> IO
         (Atom, 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 "getGeometry") ((Ptr Atom
      -> Ptr Position
      -> Ptr Position
      -> Ptr Dimension
      -> Ptr Dimension
      -> Ptr Dimension
      -> Ptr CInt
      -> IO CInt)
     -> IO
          (Atom, Position, Position, Dimension, Dimension, Dimension, CInt))
    -> (Ptr Atom
        -> Ptr Position
        -> Ptr Position
        -> Ptr Dimension
        -> Ptr Dimension
        -> Ptr Dimension
        -> Ptr CInt
        -> IO CInt)
    -> IO
         (Atom, Position, Position, Dimension, Dimension, Dimension, CInt)
    forall a b. (a -> b) -> a -> b
    $
                    Display
    -> Atom
    -> Ptr Atom
    -> Ptr Position
    -> Ptr Position
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr Dimension
    -> Ptr CInt
    -> IO CInt
    xGetGeometry Display
    display Atom
    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 :: (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 check :: IO r -> IO ()
    check fn :: 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
    $ \ a_return :: 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
    $ \ b_return :: 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
    $ \ c_return :: 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
    $ \ d_return :: 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
    $ \ e_return :: 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
    $ \ f_return :: 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
    $ \ g_return :: 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 (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