packages feed

hlwm (empty) → 0.1.0.0

raw patch · 7 files changed

+692/−0 lines, 7 filesdep +X11dep +basedep +hlwmsetup-changed

Dependencies added: X11, base, hlwm, lens, monads-tf, stm, transformers, unix

Files

+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2015, Hans-Peter Deifel+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice,+   this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/HerbstClient.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE LambdaCase,TemplateHaskell, MultiWayIf #-}++-- | A complete re-implementation of the official herbstclient program+module Main where++import HLWM.IPC+import System.Console.GetOpt+import Data.List+import System.Environment+import System.Exit+import System.IO++data HCOptions = HCOpt {+  newline :: Bool,+  print0  :: Bool,+  lastArg :: Bool,+  idle    :: Bool,+  wait    :: Bool,+  count   :: Int,+  quiet   :: Bool,+  version :: Bool,+  help    :: Bool+}++defOpts :: HCOptions+defOpts = HCOpt {+  newline  = True,+  print0   = False,+  lastArg  = False,+  idle     = False,+  wait     = False,+  count    = 1,+  quiet    = False,+  version  = False,+  help     = False+}++options :: [OptDescr (HCOptions -> HCOptions)]+options =+  [ Option ['n'] ["no-newline"] (NoArg $ \o -> o { newline = False })+    "Do not print a newline if output does not end with a newline."+  , Option ['0'] ["print0"] (NoArg $ \o -> o { print0 = True })+    "Use the null character as delimiter between the output of hooks."+  , Option ['l'] ["last-arg"] (NoArg $ \o -> o { lastArg = True })+    "Print only the last argument of a hook."+  , Option ['i'] ["idle"] (NoArg $ \o -> o { idle = True })+    "Wait for hooks instead of executing commands."+  , Option ['w'] ["wait"] (NoArg $ \o -> o { wait = True })+    "Same as --idle but exit after first --count hooks."+  , Option ['c'] ["count"] (ReqArg (\a o -> o { count = read a }) "COUNT")+    "Let --wait exit after COUNT hooks were received and printed. The default of COUNT is 1."+  , Option ['q'] ["quiet"] (NoArg $ \o -> o { quiet = True })+    "Do not print error messages if herbstclient cannot connect to the running herbstluftwm instance."+  , Option ['v'] ["version"] (NoArg $ \o -> o { version = True })+    "Print the herbstclient version. To get the herbstluftwm version, use 'herbstclient version'."+  , Option ['h'] ["help"] (NoArg $ \o -> o { help = True }) "Print this help."+  ]++usage :: String -> String+usage name = "Usage: " ++ name ++ " [OPTION...] files..."++hcOpts :: [String] -> IO (HCOptions, [String])+hcOpts argv = do+  case getOpt Permute options argv of+   (o,n,[]  ) -> return (foldl (flip id) defOpts o, n)+   (_,_,errs) -> ioError (userError (concat errs))++putStrMaybeLn :: String -> IO ()+putStrMaybeLn str+  | "\n" `isSuffixOf` str = putStr str+  | otherwise = putStrLn str++helpString :: String -> String+helpString name = unlines $+  [ "Usage: " ++ name ++ " [OPTION...] files..."+  , "       " ++ name ++ " [OPTIONS] [--wait|--idle] [FILTER ...]"+  , "Send a COMMAND with optional arguments ARGS to a running herbstluftwm instance."+  , ""+  , usageInfo "Options:" options+  , "See the man page (herbstclient(1)) for more details."+  ]++data Wait = Infinite+          | Wait Int++newtype NullPolicy = Null Bool+newtype NLPolicy = NL Bool+newtype Quiet = Quiet Bool+newtype LastArg = LastArg Bool++withQConnection :: Quiet -> a -> (HerbstConnection -> IO a) -> IO a+withQConnection q x f = withConnection f >>= \case+  Nothing -> case q of+    Quiet True  -> return x+    Quiet False -> hPutStrLn stderr "Could not connect to server" >> return x+  Just y -> return y++waitForHooks :: Wait -> NullPolicy -> Quiet -> LastArg -> IO ()+waitForHooks w nl q la = withQConnection q () (doWait w)+  where doWait (Wait 0) _ = return () -- TODO handle negative values+        doWait w' con = do+          h <- nextHook con+          case la of+           LastArg True  | not (null h) -> putStr (last h)+           _                            -> putStr $ unwords h+          case nl of+           Null True  -> putStr "\0"+           Null False -> putStr "\n"+          case w' of+           Infinite -> doWait Infinite con+           Wait x   -> doWait (Wait (x-1)) con++send :: [String] -> NLPolicy -> Quiet -> IO ExitCode+send args nl q = withQConnection q (ExitFailure 1)$ \con -> do+  (stat, ret) <- sendCommand con args+  case nl of+   NL False -> putStr ret+   NL True  -> if null ret || last ret == '\n'+               then putStr ret else putStrLn ret+  return $ if stat == 0 then ExitSuccess else ExitFailure stat++main :: IO ()+main = do+  name <- getProgName+  (opts, args) <- getArgs >>= hcOpts+  if | help opts -> putStr $ helpString name+     | version opts -> putStrLn "A friendly haskell implementation of herbstclient"+     | idle opts -> waitForHooks Infinite (Null (print0 opts))+                                  (Quiet (quiet opts)) (LastArg (lastArg opts))+     | wait opts -> waitForHooks (Wait (count opts)) (Null (print0 opts))+                                  (Quiet (quiet opts)) (LastArg (lastArg opts))+     | otherwise  -> send args (NL (newline opts)) (Quiet (quiet opts))+                     >>= exitWith
+ hlwm.cabal view
@@ -0,0 +1,43 @@+name:                hlwm+version:             0.1.0.0+synopsis:            Bindings to the herbstluftwm window manager+description:         A client-side IPC implementation for herbstluftwm.+license:             BSD2+license-file:        LICENSE+author:              Hans-Peter Deifel+maintainer:          <hpd@hpdeifel.de>+category:            System+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:               git+  location:           https://git.cs.fau.de/?p=lu03pevi/hlwm-haskell++flag examples+  description:         Build example programs+  default:             False++library+  hs-source-dirs:      src+  other-extensions:    RecordWildCards, LambdaCase, MultiWayIf, TupleSections+  build-depends:       base >=4.7 && <4.8, X11 >=1.6 && <1.7, transformers, monads-tf, stm,+                       unix+  build-tools:         hsc2hs+  default-language:    Haskell2010+  exposed-modules:     HLWM.IPC,+                       HLWM.IPC.Internal+  other-modules:       Graphics.X11.Xlib.Herbst+  ghc-options:         -Wall++executable hherbstclient+  hs-source-dirs:      examples+  main-is:             HerbstClient.hs+  other-extensions:    RecordWildCards, LambdaCase, MultiWayIf, TupleSections+  build-depends:       base >=4.7 && <4.8, X11 >=1.6 && <1.7, transformers, monads-tf, lens, stm,+                       unix, hlwm+  build-tools:         hsc2hs+  default-language:    Haskell2010+  ghc-options:         -Wall -threaded+  if !flag(examples)+    buildable: False
+ src/Graphics/X11/Xlib/Herbst.hsc view
@@ -0,0 +1,79 @@+module Graphics.X11.Xlib.Herbst where++#include <X11/Xlib.h>+#include <X11/Xutil.h>++import Graphics.X11.Xlib.Extras+import Graphics.X11.Xlib+import System.Environment++import Foreign+import Foreign.C++-- FIXME Some functions shouldn't return IO () but IO Bool or something+-- or throw an exception if the X-functions doesn't return success++setClassHint :: Display -> Window -> ClassHint -> IO ()+setClassHint d w ch = allocaBytes (#{size XClassHint}) $ \p ->+  withCString (resName ch) $ \resName' ->+  withCString (resClass ch) $ \resClass' -> do+    #{poke XClassHint, res_name  } p $ resName'+    #{poke XClassHint, res_class } p $ resClass'+    xSetClassHint d w p+++foreign import ccall unsafe "X11/Xlib.h XSetClassHint"+  xSetClassHint :: Display -> Window -> Ptr ClassHint -> IO ()++utf8TextListToTextProperty :: Display -> [String] -> IO TextProperty+utf8TextListToTextProperty d strs =+  allocaBytes (#{size XTextProperty}) $ \p -> do+    cstrs <- mapM newCString strs+    let len = fromIntegral $ length strs++    withArray cstrs $ \array ->+      xUtf8TextListToTextProperty d array len uTF8StringStyle p++    mapM_ free cstrs++    peek p++newtype ICCEncodingStyle = ICCEncodingStyle CInt+#{enum ICCEncodingStyle, ICCEncodingStyle,+  stringStyle = XStringStyle,+  compoundTextStyle = XCompoundTextStyle,+  textStyle = XTextStyle,+  stdICCTextStyle = XStdICCTextStyle,+  uTF8StringStyle = XUTF8StringStyle+}++foreign import ccall unsafe "X11/Xlib.h Xutf8TextListToTextProperty"+  xUtf8TextListToTextProperty :: Display -> Ptr (CString) -> CInt -> ICCEncodingStyle -> (Ptr TextProperty) -> IO ()++utf8TextPropertyToTextList :: Display -> TextProperty -> IO [String]+utf8TextPropertyToTextList d tp =+  alloca $ \intPtr ->+  alloca $ \tpPtr ->+  alloca $ \ptrPtr -> do+    poke tpPtr tp+    xUtf8TextPropertyToTextList d tpPtr ptrPtr intPtr+    strArr <- peek ptrPtr+    num <- peek intPtr+    cstrs <- peekArray (fromIntegral num) strArr+    strs <- mapM peekCString cstrs+    freeStringList strArr+    return strs++foreign import ccall unsafe "X11/Xlib.h Xutf8TextPropertyToTextList"+  xUtf8TextPropertyToTextList :: Display -> Ptr TextProperty -> (Ptr (Ptr CString)) -> (Ptr CInt) -> IO ()++openDefaultDisplay :: IO Display+openDefaultDisplay = getEnv "DISPLAY" >>= openDisplay++setTextProperty' :: Display -> Window -> TextProperty -> Atom -> IO ()+setTextProperty' d w tp a = allocaBytes (sizeOf tp) $ \p -> do+  poke p tp+  xSetTextProperty d w p a++foreign import ccall unsafe "X11/Xlib.h XSetTextProperty"+        xSetTextProperty :: Display -> Window -> Ptr TextProperty -> Atom -> IO ()
+ src/HLWM/IPC.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE LambdaCase, RecordWildCards, ScopedTypeVariables #-}++-- | An IPC client implementation for the <http://herbstluftwm.org herbstluftwm>+-- window manager.+--+-- See <http://herbstluftwm.org/herbstluftwm.html herbstluftwm(1)> and+-- <http://herbstluftwm.org/herbstclient.html herbstclient(1)> for what this is+-- all about.+--+-- == Examples+-- Sending a command to herbstluftwm:+--+-- >>> withConnection (\con -> sendCommand con ["echo", "foo"])+-- Just (0,"foo\n")+--+-- Printing 2 hooks:+--+-- >>> withConnection (\con -> replicateM_ 2 $ unwords <$> nextHook con >>= putStrLn)+-- focus_changed 0x340004c IPC.hs - emacs+-- focus_changed 0x3200073 ROXTerm+-- Just ()+--+-- Although 'sendCommand' is synchronous, you can use it with forkIO or the+-- <http://hackage.haskell.org/package/async async> library:+--+-- > withConnection $ \con -> do+-- >   var <- newEmptyMVar+-- >   forkIO $ sendCommand con ["echo","foo"] >>= putMVar var+-- >   -- do some stuff ...+-- >   -- finally read output+-- >   output <- takeMVar var++module HLWM.IPC+       ( -- * Connection+         HerbstConnection+       , connect+       , disconnect+       , withConnection+         -- * Commands and Hooks+       , sendCommand+       , nextHook+       ) where++import HLWM.IPC.Internal (HerbstEvent(..))+import qualified HLWM.IPC.Internal as IPC++import Control.Concurrent.STM+import Control.Concurrent+import Control.Monad+import Control.Applicative+import Data.Maybe+import Control.Exception+import System.Posix.Types (Fd(..))+import Graphics.X11.Xlib++-- | Opaque type representing the connection to the herbstluftwm server+--+-- See 'connect' and 'disconnect'.+data HerbstConnection = HerbstConnection {+  connection :: IPC.HerbstConnection,+  commandLock :: Lock,+  eventChan :: TChan HerbstEvent,+  controlChan :: TChan Message,+  dieVar :: TMVar ()+}++-- | Connect to the herbstluftwm server.+--+-- Be sure to call 'disconnect' if you don't need the connection anymore, to+-- free any allocated resources. When in doubt, call 'withConnection'.+--+-- Note that there must not be more than one connection open at any time!+connect :: IO (Maybe HerbstConnection)+connect = IPC.connect >>= \case+  Nothing -> return Nothing+  Just connection -> do+    commandLock <- newEmptyTMVarIO+    eventChan <- newBroadcastTChanIO+    controlChan <- newTChanIO+    dieVar <- newEmptyTMVarIO+    void $ forkIO $ xThread connection eventChan controlChan dieVar+    return $ Just $ HerbstConnection {..}++-- | Close connection to the herbstluftwm server.+--+-- After calling this function, the 'HerbstConnection' is no longer valid and+-- must not be used anymore.+disconnect :: HerbstConnection -> IO ()+disconnect HerbstConnection{..} = do+  atomically $ do+    lock commandLock+    writeTChan controlChan Die+  atomically $ takeTMVar dieVar+  IPC.disconnect connection++-- | Execute an action with a newly established 'HerbstConnection'.+--+-- Connects to the herbstluftwm server, passes the connection on to the supplied+-- action and closes the connection again after the action has finished.+withConnection :: (HerbstConnection -> IO a) -> IO (Maybe a)+withConnection f =+  bracket connect (maybe (return ()) disconnect)+                  (maybe (return Nothing) (fmap Just . f))++-- | Execute a command in the herbstluftwm server.+--+-- Send a command consisting of a list of Strings to the server and wait for the+-- response. Herbstluftwm interprets this list as a command followed by a number+-- of arguments. Returns a tuple of the exit status and output of the called+-- command.+sendCommand :: HerbstConnection -> [String] -> IO (Int, String)+sendCommand client args = do+  events <- atomically $ do+    lock (commandLock client)+    dupTChan (eventChan client) <*+      writeTChan (controlChan client) (HerbstCmd args)+  res <- readBoth events Nothing Nothing+  atomically $ unlock (commandLock client)+  return res++  where readBoth _ (Just s) (Just o) = return (o,s)+        readBoth events a b = atomically (readTChan events) >>= \case+          OutputEvent o | isNothing a -> readBoth events (Just o) b+          StatusEvent s | isNothing b -> readBoth events a (Just s)+          _ -> readBoth events a b++-- | Wait for a hook event from the server and return it.+--+-- A hook is just an arbitrary list of strings generated by herbstluftwm or its+-- clients.+nextHook :: HerbstConnection -> IO [String]+nextHook client = do+  chan <- atomically $ dupTChan (eventChan client)++  let loop = atomically (readTChan chan) >>= \case+        HookEvent res -> return res+        _             -> loop++  loop++data Message = HerbstCmd [String]+             | Die++xThread :: IPC.HerbstConnection -> TChan HerbstEvent -> TChan Message+        -> TMVar () -> IO ()+xThread con events msgs dieVar = do+  (waitForFd, disconnectFd) <- threadWaitReadSTM (connectionFd con)++  let loop = disconnectFd >> xThread con events msgs dieVar++  atomically ((Just <$> readTChan msgs) `orElse` (waitForFd >> return Nothing)) >>= \case+    Just Die -> do+      disconnectFd+      atomically $ putTMVar dieVar () -- notify caller that we died+    Just (HerbstCmd args) -> IPC.asyncSendCommand con args >> loop+    Nothing ->+      let loop2 = IPC.tryRecvEvent con >>= \case+            Just ev -> atomically (writeTChan events ev) >> loop2+            Nothing -> loop+      in loop2++type Lock = TMVar ()++lock :: TMVar () -> STM ()+lock l = putTMVar l ()++unlock :: TMVar () -> STM ()+unlock l = takeTMVar l >> return ()++connectionFd :: IPC.HerbstConnection -> Fd+connectionFd = Fd . connectionNumber . IPC.display
+ src/HLWM/IPC/Internal.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE RecordWildCards, LambdaCase, MultiWayIf, TupleSections, BangPatterns, ScopedTypeVariables, Rank2Types #-}++-- | Internal herbluftwm IPC implementation+--+-- This is an internal module. Use only with extreme caution.+--+-- == On event handling+--+-- There is a single function 'recvEvent', that returns all events received by+-- herbstluftwm in order. The high-level functions 'sendCommand' and 'nextHook'+-- work by calling 'recvEvent' until they get the event they expected and+-- discarding all other events received in the meantime. This means that it is+-- not possible to call 'nextHook' and 'sendCommand' concurrently in different+-- threads. Also, when calling 'asyncSendCommand' and then 'nextHook', the+-- output of the command will likely be thrown away.+--+-- See "HLWM.IPC" for an interface that allows concurrent calling+-- of 'nextHook' and 'sendCommand'.++module HLWM.IPC.Internal+       ( -- * Connection+         HerbstConnection(..)+       , connect+       , disconnect+       , withConnection+         -- * High level interface+       , sendCommand+       , nextHook+         -- * Event handling+       , recvEvent+       , tryRecvEvent+       , HerbstEvent(..)+       , asyncSendCommand+       ) where++import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras+import Graphics.X11.Xlib.Herbst+import Control.Applicative+import Foreign.C.String+import Data.Bits+import Data.Maybe+import Control.Exception++-- | Opaque type representing the connection to the herbstluftwm server+--+-- See 'connect' and 'disconnect'.+data HerbstConnection = HerbstConnection {+  display :: Display,+  atomArgs :: Atom,+  atomOutput :: Atom,+  atomStatus :: Atom,+  root :: Window,+  hooksWin :: Window,+  clientWin :: Window+}++herbstIPCArgsAtom :: String+herbstIPCArgsAtom = "_HERBST_IPC_ARGS"++herbstIPCOutputAtom :: String+herbstIPCOutputAtom = "_HERBST_IPC_OUTPUT"++herbstIPCStatusAtom :: String+herbstIPCStatusAtom = "_HERBST_IPC_EXIT_STATUS"++herbstIPCClass :: String+herbstIPCClass = "HERBST_IPC_CLASS"++herbstHookWinIdAtom :: String+herbstHookWinIdAtom = "__HERBST_HOOK_WIN_ID"++-- | Connect to the herbstluftwm server.+--+-- Be sure to call 'disconnect' if you don't need the connection anymore, to+-- free any allocated resources. When in doubt, call 'withConnection'.+connect :: IO (Maybe HerbstConnection)+connect = do+  display <- openDefaultDisplay++  let root = defaultRootWindow display+  atomArgs <- internAtom display herbstIPCArgsAtom False+  atomOutput <- internAtom display herbstIPCOutputAtom False+  atomStatus <- internAtom display herbstIPCStatusAtom False+++  clientWin <- createClientWindow display root+  findHookWindow display root >>= \case+    Just hooksWin -> flush display >> (return $ Just $ HerbstConnection {..})+    Nothing -> do+      destroyClientWindow display clientWin+      closeDisplay display+      return Nothing+++-- | Close connection to the herbstluftwm server.+--+-- After calling this function, the 'HerbstConnection' is no longer valid and+-- must not be used anymore.+disconnect :: HerbstConnection -> IO ()+disconnect con = do+  destroyClientWindow (display con) (clientWin con)+  closeDisplay (display con)++createClientWindow :: Display -> Window -> IO Window+createClientWindow display root = do+  grabServer display++  win <- createSimpleWindow display root 42 42 42 42 0 0 0++  setClassHint display win $+    (ClassHint herbstIPCClass herbstIPCClass)++  selectInput display win propertyChangeMask++  ungrabServer display++  return win++destroyClientWindow :: Display -> Window -> IO ()+destroyClientWindow d win = destroyWindow d win++findHookWindow :: Display -> Window -> IO (Maybe Window)+findHookWindow display root = do+  atom <- internAtom display herbstHookWinIdAtom False+  getWindowProperty32 display atom root >>= \case+    Just (winid:_) -> do+      let win = fromIntegral winid+          inputMask = structureNotifyMask .|. propertyChangeMask++      selectInput display win inputMask++      return $ Just win+    _ -> return Nothing++-- | Send a command to the server, but don't wait for the response.+--+-- Like 'sendCommand', but it's the callers responsibility to manually receive+-- the output of the command with 'recvEvent'.+--+-- Note, that it is not possible to relate asynchronous command calls with+-- responses returned by 'recvEvent', apart from the order in which they are+-- received.+asyncSendCommand :: HerbstConnection -> [String] -> IO ()+asyncSendCommand con args = do+  textProp <- utf8TextListToTextProperty (display con) args+  setTextProperty' (display con) (clientWin con) textProp (atomArgs con)+  flush (display con)++-- | The type of events generated by herbstluftwm.+data HerbstEvent = HookEvent [String]+                 | StatusEvent Int+                 | OutputEvent String++-- | Read a HerbstEvent, if one is pending+tryRecvEvent :: HerbstConnection -> IO (Maybe HerbstEvent)+tryRecvEvent con = do+  pending (display con) >>= \case+    0 -> return Nothing+    _ -> Just <$> recvEvent con++-- | Wait for the next HerbstEvent in the queue and return it.+recvEvent :: HerbstConnection -> IO HerbstEvent+recvEvent con = allocaXEvent eventLoop+  where eventLoop :: XEventPtr -> IO HerbstEvent+        eventLoop event = do+          nextEvent (display con) event+          getEvent event >>= \case+            PropertyEvent{..}+              | ev_window == (clientWin con) && ev_atom == (atomOutput con) ->+                  readOutput >>= cont event OutputEvent+              | ev_window == (clientWin con) && ev_atom == (atomStatus con) ->+                  readStatus >>= cont event StatusEvent+              | ev_window == (hooksWin con) && ev_propstate /= propertyDelete ->+                  readHook ev_atom >>= cont event HookEvent+            _ -> eventLoop event++        cont :: XEventPtr -> (a -> HerbstEvent) -> Maybe a -> IO HerbstEvent+        cont event f = maybe (eventLoop event) (return . f)++        readOutput :: IO (Maybe String)+        readOutput = do+          tp <- getTextProperty (display con) (clientWin con) (atomOutput con)+          utf8str <- internAtom (display con) "UTF8_STRING" False+          if tp_encoding tp == sTRING || tp_encoding tp == utf8str+            then Just <$> peekCString (tp_value tp)+            else return Nothing++        readStatus :: IO (Maybe Int)+        readStatus = fmap (fromIntegral . head) <$>+          getWindowProperty32 (display con) (atomStatus con) (clientWin con)++        readHook :: Atom -> IO (Maybe [String])+        readHook atom = do+          prop <- getTextProperty (display con) (hooksWin con) atom+          Just <$> utf8TextPropertyToTextList (display con) prop++recvCommandOutput :: HerbstConnection -> IO (Int, String)+recvCommandOutput con = readBoth Nothing Nothing+  where readBoth (Just s) (Just o) = return (o,s)+        readBoth a b = recvEvent con >>= \case+          OutputEvent o | isNothing a -> readBoth (Just o) b+          StatusEvent s | isNothing b -> readBoth a (Just s)+          _ -> readBoth a b++-- | Execute a command in the herbstluftwm server.+--+-- Send a command consisting of a list of Strings to the server and wait for the+-- response. Herbstluftwm interprets this list as a command followed by a number+-- of arguments. Returns a tuple of the exit status and output of the called+-- command.+--+-- __Warning:__ This discards any events received from the server that are not+-- the response to the command. In particular, any hook events received while+-- waiting for the response will be thrown away.+sendCommand :: HerbstConnection -> [String] -> IO (Int, String)+sendCommand con args = do+  asyncSendCommand con args+  recvCommandOutput con++-- | Wait for a hook event from the server and return it.+--+-- A hook is just an arbitrary list of strings generated by herbstluftwm or its+-- clients.+--+-- __Warning:__ This discards any events received from the server that are not+-- hook events. In particular, any responses to commands called by+-- 'asyncSendCommand' received while waiting for the hook will be thrown away.+nextHook :: HerbstConnection -> IO [String]+nextHook con = recvEvent con >>= \case+  HookEvent r -> return r+  _           -> nextHook con++-- | Execute an action with a newly established 'HerbstConnection'.+--+-- Connects to the herbstluftwm server, passes the connection on to the supplied+-- action and closes the connection again after the action has finished.+withConnection :: (HerbstConnection -> IO a) -> IO (Maybe a)+withConnection f =+  bracket connect (maybe (return ()) disconnect)+                  (maybe (return Nothing) (fmap Just . f))