    {-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.DebugEvents
    -- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  allbery.b@gmail.com
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- Module to dump diagnostic information about X11 events received by
    -- @xmonad@.  This is incomplete due to 'Event' being incomplete and not
    -- providing information about a number of events, and enforcing artificial
    -- constraints on others (for example 'ClientMessage'); the @X11@ package
    -- will require a number of changes to fix these problems.
    --
    -----------------------------------------------------------------------------

    module XMonad.Hooks.DebugEvents (debugEventsHook) where

    import           Prelude

    import           XMonad                               hiding (windowEvent
                                                                 ,(-->)
                                                                 )

    import           XMonad.Hooks.DebugKeyEvents                 (debugKeyEvents)
    import           XMonad.Util.DebugWindow                     (debugWindow)

    -- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName)

    import           Control.Exception.Extensible         as E
    import           Control.Monad.State
    import           Control.Monad.Reader
    import           Data.Char                                   (isDigit)
    import           Data.Maybe                                  (fromJust)
    import           Data.List                                   (genericIndex
                                                                 ,genericLength
                                                                 ,unfoldr
                                                                 )
    import           Codec.Binary.UTF8.String
    import           Data.Maybe                                  (fromMaybe)
    import           Data.Monoid
    import           Foreign
    import           Foreign.C.Types
    import           Numeric                                     (showHex)
    import           System.Exit
    import           System.IO
    import           System.Process
    import           Control.Applicative

    -- | Event hook to dump all received events.  You should probably not use this
    --   unconditionally; it will produce massive amounts of output.
    debugEventsHook   :: Event -> X All
    debugEventsHook :: Event -> X All
    debugEventsHook e :: Event
    e =  Event -> X ()
    debugEventsHook' Event
    e X () -> X All -> X All
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> All -> X All
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    -- | Dump an X11 event.  Can't be used directly as a 'handleEventHook'.
    debugEventsHook' :: Event -> X ()

    debugEventsHook' :: Event -> X ()
    debugEventsHook' (ConfigureRequestEvent {ev_window :: Event -> Window
    ev_window       = Window
    w
                                            ,ev_parent :: Event -> Window
    ev_parent       = Window
    p
                                            ,ev_x :: Event -> CInt
    ev_x            = CInt
    x
                                            ,ev_y :: Event -> CInt
    ev_y            = CInt
    y
                                            ,ev_width :: Event -> CInt
    ev_width        = CInt
    wid
                                            ,ev_height :: Event -> CInt
    ev_height       = CInt
    ht
                                            ,ev_border_width :: Event -> CInt
    ev_border_width = CInt
    bw
                                            ,ev_above :: Event -> Window
    ev_above        = Window
    above
                                            ,ev_detail :: Event -> CInt
    ev_detail       = CInt
    place
                                            ,ev_value_mask :: Event -> CULong
    ev_value_mask   = CULong
    msk
                                            }) = do
      String -> Window -> X ()
    windowEvent "ConfigureRequest" Window
    w
      String -> Window -> X ()
    windowEvent "  parent"         Window
    p
    --  mask <- quickFormat msk $ dumpBits wmCRMask
    --  say "  requested parameters" $ concat ['(':show wid
    --                                        ,'x':show ht
    --                                        ,')':if bw == 0 then "" else '+':show bw
    --                                        ,'@':'(':show x
    --                                        ,',':show y
    --                                        ,") mask "
    --                                        ,mask
    --                                        ]
      String
    s <- [CInt] -> Decoder Bool -> X String
    forall i.
    (Storable i, Integral i) =>
    [i] -> Decoder Bool -> X String
    quickFormat [CInt
    x,CInt
    y,CInt
    wid,CInt
    ht,CInt
    bw,Window -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Window
    above,CInt
    place] (Decoder Bool -> X String) -> Decoder Bool -> X String
    forall a b. (a -> b) -> a -> b
    $
           CULong -> [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpListByMask' CULong
    msk [("x"           ,Decoder Bool
    dump32              ,Window
    cARDINAL)
                               ,("y"           ,Decoder Bool
    dump32              ,Window
    cARDINAL)
                               ,("width"       ,Decoder Bool
    dump32              ,Window
    cARDINAL)
                               ,("height"      ,Decoder Bool
    dump32              ,Window
    cARDINAL)
                               ,("border_width",Decoder Bool
    dump32              ,Window
    cARDINAL)
                               ,("sibling"     ,Decoder Bool
    dumpWindow          ,Window
    wINDOW  )
                               ,("detail"      ,[String] -> Decoder Bool
    dumpEnum [String]
    wmPlacement,Window
    cARDINAL)
                               ]
      String -> String -> X ()
    say "  requested" String
    s

    debugEventsHook' (ConfigureEvent        {ev_window :: Event -> Window
    ev_window = Window
    w
                                            ,ev_above :: Event -> Window
    ev_above  = Window
    above
                                            }) = do
      String -> Window -> X ()
    windowEvent "Configure" Window
    w
      -- most of the content is covered by debugWindow
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Window
    above Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Window
    none) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    debugWindow Window
    above X String -> (String -> X ()) -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> String -> X ()
    say "  above"

    debugEventsHook' (MapRequestEvent       {ev_window :: Event -> Window
    ev_window     = Window
    w
                                            ,ev_parent :: Event -> Window
    ev_parent     = Window
    p
                                            }) =
      String -> Window -> X ()
    windowEvent "MapRequest" Window
    w X () -> X () -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      String -> Window -> X ()
    windowEvent "  parent"   Window
    p

    debugEventsHook' e :: Event
    e@(KeyEvent {ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t})
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    keyPress =
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Handle -> String -> IO ()
    hPutStr Handle
    stderr "KeyPress ") X () -> X All -> X All
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      Event -> X All
    debugKeyEvents Event
    e X All -> X () -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    debugEventsHook' (ButtonEvent           {ev_window :: Event -> Window
    ev_window = Window
    w
                                            ,ev_state :: Event -> KeyMask
    ev_state  = KeyMask
    s
                                            ,ev_button :: Event -> EventType
    ev_button = EventType
    b
                                            }) = do
      String -> Window -> X ()
    windowEvent "Button" Window
    w
      KeyMask
    nl <- (XState -> KeyMask) -> X KeyMask
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> KeyMask
    numberlockMask
      let msk :: String
    msk | KeyMask
    s KeyMask -> KeyMask -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0    = ""
              | Bool
    otherwise = "modifiers " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ KeyMask -> KeyMask -> String
    vmask KeyMask
    nl KeyMask
    s
      String -> String -> X ()
    say "  button" (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ EventType -> String
    forall a. Show a => a -> String
    show EventType
    b String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    msk

    debugEventsHook' (DestroyWindowEvent    {ev_window :: Event -> Window
    ev_window = Window
    w
                                            }) =
      String -> Window -> X ()
    windowEvent "DestroyWindow" Window
    w

    debugEventsHook' (UnmapEvent            {ev_window :: Event -> Window
    ev_window = Window
    w
                                            }) =
      String -> Window -> X ()
    windowEvent "Unmap" Window
    w

    debugEventsHook' (MapNotifyEvent        {ev_window :: Event -> Window
    ev_window = Window
    w
                                            }) =
      String -> Window -> X ()
    windowEvent "MapNotify" Window
    w

    {- way too much output; suppressed.

    debugEventsHook' (CrossingEvent         {ev_window    = w
                                            ,ev_subwindow = s
                                            }) =
      windowEvent "Crossing"    w >>
      windowEvent "  subwindow" s
    -}
    debugEventsHook' (CrossingEvent         {}) =
      () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    debugEventsHook' (SelectionRequest      {ev_requestor :: Event -> Window
    ev_requestor = Window
    rw
                                            ,ev_owner :: Event -> Window
    ev_owner     = Window
    ow
                                            ,ev_selection :: Event -> Window
    ev_selection = Window
    a
                                            }) =
      String -> Window -> X ()
    windowEvent "SelectionRequest" Window
    rw X () -> X () -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      String -> Window -> X ()
    windowEvent "  owner"          Window
    ow X () -> X () -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
      String -> Window -> X ()
    atomEvent   "  atom"           Window
    a

    debugEventsHook' (PropertyEvent         {ev_window :: Event -> Window
    ev_window    = Window
    w
                                            ,ev_atom :: Event -> Window
    ev_atom      = Window
    a
                                            ,ev_propstate :: Event -> CInt
    ev_propstate = CInt
    s
                                            }) = do
      String
    a' <- Window -> X String
    atomName Window
    a
      -- too many of these, and they're not real useful
      if String
    a' String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["_NET_WM_USER_TIME"
    --               ,"_NET_WM_WINDOW_OPACITY"
                   ] then () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () else do
      String -> Window -> X ()
    windowEvent "Property on" Window
    w
      String
    s' <- case CInt
    s of
              1 -> String -> X String
    forall (m :: * -> *) a. Monad m => a -> m a
    return "deleted"
              0 -> Window -> String -> Window -> Int -> X String
    dumpProperty Window
    a String
    a' Window
    w (7 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    a')
              _ -> String -> X String
    forall a. HasCallStack => String -> a
    error "Illegal propState; Xlib corrupted?"
      String -> String -> X ()
    say "  atom" (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    a' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s'

    debugEventsHook' (ExposeEvent           {ev_window :: Event -> Window
    ev_window = Window
    w
                                            }) =
      String -> Window -> X ()
    windowEvent "Expose" Window
    w

    debugEventsHook' (ClientMessageEvent    {ev_window :: Event -> Window
    ev_window       = Window
    w
                                            ,ev_message_type :: Event -> Window
    ev_message_type = Window
    a
                                            -- @@@ they did it again!  no ev_format,
                                            --     and ev_data is [CInt]
                                            -- @@@ and get a load of the trainwreck
                                            --     that is setClientMessageEvent!
    --                                        ,ev_format       = b
                                            ,ev_data :: Event -> [CInt]
    ev_data         = [CInt]
    vs'
                                            }) = do
      String -> Window -> X ()
    windowEvent "ClientMessage on" Window
    w
      String
    n <- Window -> X String
    atomName Window
    a
      -- this is a sort of custom property
      -- @@@ this likely won't work as is; type information varies, I think
      (ta :: Window
    ta,b :: Int
    b,l :: Int
    l) <- case String
    -> [(String, (String, Int, Int))] -> Maybe (String, Int, Int)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    n [(String, (String, Int, Int))]
    clientMessages of
                    Nothing        -> (Window, Int, Int) -> X (Window, Int, Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window
    a,32,[CInt] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CInt]
    vs')
                    Just (ta' :: String
    ta',b :: Int
    b,l :: Int
    l) -> do
                      Window
    ta <- String -> X Window
    getAtom String
    ta'
                      (Window, Int, Int) -> X (Window, Int, Int)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window
    ta,Int
    b,Int
    l)
      let wl :: Int
    wl = Int -> Int
    bytes Int
    b
      [CUChar]
    vs <- IO [CUChar] -> X [CUChar]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [CUChar] -> X [CUChar]) -> IO [CUChar] -> X [CUChar]
    forall a b. (a -> b) -> a -> b
    $ Int -> [CUChar] -> [CUChar]
    forall a. Int -> [a] -> [a]
    take (Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    wl) ([CUChar] -> [CUChar]) -> IO [CUChar] -> IO [CUChar]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` [CInt] -> IO [CUChar]
    splitCInt [CInt]
    vs'
      String
    s <- Window
    -> Window
    -> String
    -> Window
    -> Int
    -> [CUChar]
    -> CULong
    -> Int
    -> X String
    dumpProperty' Window
    w Window
    a String
    n Window
    ta Int
    b [CUChar]
    vs 0 (10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    n)
      String -> String -> X ()
    say "  message" (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    n String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s

    debugEventsHook' _                      = () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Emit information about an atom.
    atomName   :: Atom -> X String
    atomName :: Window -> X String
    atomName a :: Window
    a =  (Display -> X String) -> X String
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X String) -> X String)
    -> (Display -> X String) -> X String
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d ->
      IO String -> X String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO String -> X String) -> IO String -> X String
    forall a b. (a -> b) -> a -> b
    $ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe ("(unknown atom " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Window -> String
    forall a. Show a => a -> String
    show Window
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")") (Maybe String -> String) -> IO (Maybe String) -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Display -> Window -> IO (Maybe String)
    getAtomName Display
    d Window
    a

    -- | Emit an atom with respect to the current event.
    atomEvent     :: String -> Atom -> X ()
    atomEvent :: String -> Window -> X ()
    atomEvent l :: String
    l a :: Window
    a =  Window -> X String
    atomName Window
    a X String -> (String -> X ()) -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> String -> X ()
    say String
    l

    -- | Emit a window with respect to the current event.
    windowEvent     :: String -> Window -> X ()
    windowEvent :: String -> Window -> X ()
    windowEvent l :: String
    l w :: Window
    w =  Window -> X String
    debugWindow Window
    w X String -> (String -> X ()) -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> String -> X ()
    say String
    l

    -- | Helper to emit tagged event information.
    say     :: String -> String -> X ()
    say :: String -> String -> X ()
    say l :: String
    l s :: String
    s =  String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    trace (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ' 'Char -> String -> String
    forall a. a -> [a] -> [a]
    :String
    s

    -- | Deconstuct a list of 'CInt's into raw bytes
    splitCInt    :: [CInt] -> IO Raw
    splitCInt :: [CInt] -> IO [CUChar]
    splitCInt vs :: [CInt]
    vs =  IO [CUChar] -> IO [CUChar]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [CUChar] -> IO [CUChar]) -> IO [CUChar] -> IO [CUChar]
    forall a b. (a -> b) -> a -> b
    $ [CInt] -> (Ptr CInt -> IO [CUChar]) -> IO [CUChar]
    forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
    withArray [CInt]
    vs ((Ptr CInt -> IO [CUChar]) -> IO [CUChar])
    -> (Ptr CInt -> IO [CUChar]) -> IO [CUChar]
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr CInt
    p ->
                    Int -> Ptr CUChar -> IO [CUChar]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [CInt] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CInt]
    vs) (Ptr CInt -> Ptr CUChar
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CInt
    p :: Ptr CUChar)

    -- | Specify how to decode some common client messages.
    clientMessages :: [(String,(String,Int,Int))]
    clientMessages :: [(String, (String, Int, Int))]
    clientMessages =  [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))
                      ,("WM_CHANGE_STATE"   ,("WM_STATE"          ,32,2))
                      ,("WM_COMMAND"        ,("STRING"            , 8,0))
                      ,("WM_SAVE_YOURSELF"  ,("STRING"            , 8,0))
                      ]

    #if __GLASGOW_HASKELL__ < 707
    finiteBitSize :: Bits a => a -> Int
    finiteBitSize x = bitSize x
    #endif

    -- | Convert a modifier mask into a useful string
    vmask                 :: KeyMask -> KeyMask -> String
    vmask :: KeyMask -> KeyMask -> String
    vmask numLockMask :: KeyMask
    numLockMask msk :: KeyMask
    msk =  [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                             [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $
                             ([String], KeyMask) -> [String]
    forall a b. (a, b) -> a
    fst     (([String], KeyMask) -> [String])
    -> ([String], KeyMask) -> [String]
    forall a b. (a -> b) -> a -> b
    $
                             ((KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask))
    -> ([String], KeyMask)
    -> [(KeyMask, String)]
    -> ([String], KeyMask)
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (KeyMask, String) -> ([String], KeyMask) -> ([String], KeyMask)
    forall a a. (Num a, Bits a) => (a, a) -> ([a], a) -> ([a], a)
    vmask' ([],KeyMask
    msk) [(KeyMask, String)]
    masks
        where
          masks :: [(KeyMask, String)]
    masks = (KeyMask -> (KeyMask, String)) -> [KeyMask] -> [(KeyMask, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\m :: KeyMask
    m -> (KeyMask
    m,KeyMask -> String
    forall a. Show a => a -> String
    show KeyMask
    m)) [0..Int -> KeyMask
    forall a. Enum a => Int -> a
    toEnum (KeyMask -> Int
    forall b. FiniteBits b => b -> Int
    finiteBitSize KeyMask
    msk Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1)] [(KeyMask, String)] -> [(KeyMask, String)] -> [(KeyMask, String)]
    forall a. [a] -> [a] -> [a]
    ++
                  [(KeyMask
    numLockMask,"num"  )
                  ,(   KeyMask
    lockMask,"lock" )
                  ,(KeyMask
    controlMask,"ctrl" )
                  ,(  KeyMask
    shiftMask,"shift")
                  ,(   KeyMask
    mod5Mask,"mod5" )
                  ,(   KeyMask
    mod4Mask,"mod4" )
                  ,(   KeyMask
    mod3Mask,"mod3" )
                  ,(   KeyMask
    mod2Mask,"mod2" )
                  ,(   KeyMask
    mod1Mask,"mod1" )
                  ]
          vmask' :: (a, a) -> ([a], a) -> ([a], a)
    vmask'   _   a :: ([a], a)
    a@( _,0)                = ([a], a)
    a
          vmask' (m :: a
    m,s :: a
    s)   (ss :: [a]
    ss,v :: a
    v) | a
    v a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a
    m a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    m = (a
    s a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : [a]
    ss,a
    v a -> a -> a
    forall a. Bits a => a -> a -> a
    .&. a -> a
    forall a. Bits a => a -> a
    complement a
    m)
          vmask'   _        r :: ([a], a)
    r                  = ([a], a)
    r

    -- formatting properties.  ick. --

    -- @@@ Document the parser.  Someday.

    type Raw     = [CUChar]

    data Decode = Decode {Decode -> Window
    property :: Atom          -- original property atom
                         ,Decode -> String
    pName    :: String        -- its name
                         ,Decode -> Window
    pType    :: Atom          -- base property type atom
                         ,Decode -> Int
    width    :: Int           -- declared data width
                         ,Decode -> Window
    window   :: Window        -- source window
                         ,Decode -> Int
    indent   :: Int           -- current indent (via local)
                         ,Decode -> Int
    limit    :: Int           -- line length
                         }

    -- the result accumulates here mainly for the benefit of the indenter
    data DecodeState = DecS {DecodeState -> [CUChar]
    value :: Raw           -- unconsumed raw property value
                            ,DecodeState -> String
    accum :: String        -- output accumulator
                            ,DecodeState -> String
    joint :: String        -- separator when adding to accumulator
                            }

    newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)
    #ifndef __HADDOCK__
        deriving (a -> Decoder b -> Decoder a
    (a -> b) -> Decoder a -> Decoder b
    (forall a b. (a -> b) -> Decoder a -> Decoder b)
    -> (forall a b. a -> Decoder b -> Decoder a) -> Functor Decoder
    forall a b. a -> Decoder b -> Decoder a
    forall a b. (a -> b) -> Decoder a -> Decoder b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> Decoder b -> Decoder a
    $c<$ :: forall a b. a -> Decoder b -> Decoder a
    fmap :: (a -> b) -> Decoder a -> Decoder b
    $cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
    Functor
                 ,Functor Decoder
    a -> Decoder a
    Functor Decoder =>
    (forall a. a -> Decoder a)
    -> (forall a b. Decoder (a -> b) -> Decoder a -> Decoder b)
    -> (forall a b c.
        (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c)
    -> (forall a b. Decoder a -> Decoder b -> Decoder b)
    -> (forall a b. Decoder a -> Decoder b -> Decoder a)
    -> Applicative Decoder
    Decoder a -> Decoder b -> Decoder b
    Decoder a -> Decoder b -> Decoder a
    Decoder (a -> b) -> Decoder a -> Decoder b
    (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
    forall a. a -> Decoder a
    forall a b. Decoder a -> Decoder b -> Decoder a
    forall a b. Decoder a -> Decoder b -> Decoder b
    forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
    forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    <* :: Decoder a -> Decoder b -> Decoder a
    $c<* :: forall a b. Decoder a -> Decoder b -> Decoder a
    *> :: Decoder a -> Decoder b -> Decoder b
    $c*> :: forall a b. Decoder a -> Decoder b -> Decoder b
    liftA2 :: (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
    $cliftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
    <*> :: Decoder (a -> b) -> Decoder a -> Decoder b
    $c<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
    pure :: a -> Decoder a
    $cpure :: forall a. a -> Decoder a
    $cp1Applicative :: Functor Decoder
    Applicative
                 ,Applicative Decoder
    a -> Decoder a
    Applicative Decoder =>
    (forall a b. Decoder a -> (a -> Decoder b) -> Decoder b)
    -> (forall a b. Decoder a -> Decoder b -> Decoder b)
    -> (forall a. a -> Decoder a)
    -> Monad Decoder
    Decoder a -> (a -> Decoder b) -> Decoder b
    Decoder a -> Decoder b -> Decoder b
    forall a. a -> Decoder a
    forall a b. Decoder a -> Decoder b -> Decoder b
    forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    return :: a -> Decoder a
    $creturn :: forall a. a -> Decoder a
    >> :: Decoder a -> Decoder b -> Decoder b
    $c>> :: forall a b. Decoder a -> Decoder b -> Decoder b
    >>= :: Decoder a -> (a -> Decoder b) -> Decoder b
    $c>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
    $cp1Monad :: Applicative Decoder
    Monad
                 ,Monad Decoder
    Monad Decoder => (forall a. IO a -> Decoder a) -> MonadIO Decoder
    IO a -> Decoder a
    forall a. IO a -> Decoder a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    liftIO :: IO a -> Decoder a
    $cliftIO :: forall a. IO a -> Decoder a
    $cp1MonadIO :: Monad Decoder
    MonadIO
                 ,MonadState  DecodeState
                 ,MonadReader Decode
                 )
    #endif

    -- | Retrive, parse, and dump a window property.  As all the high-level property
    --   interfaces lose information necessary to decode properties correctly, we
    --   work at the lowest level available.
    dumpProperty          :: Atom -> String -> Window -> Int -> X String
    dumpProperty :: Window -> String -> Window -> Int -> X String
    dumpProperty a :: Window
    a n :: String
    n w :: Window
    w i :: Int
    i  =  do
      Either String (Window, Int, CULong, [CUChar])
    prop <- (Display -> X (Either String (Window, Int, CULong, [CUChar])))
    -> X (Either String (Window, Int, CULong, [CUChar]))
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X (Either String (Window, Int, CULong, [CUChar])))
     -> X (Either String (Window, Int, CULong, [CUChar])))
    -> (Display -> X (Either String (Window, Int, CULong, [CUChar])))
    -> X (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d ->
        IO (Either String (Window, Int, CULong, [CUChar]))
    -> X (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io     (IO (Either String (Window, Int, CULong, [CUChar]))
     -> X (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    -> X (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $
        (Ptr Window -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr Window -> IO (Either String (Window, Int, CULong, [CUChar])))
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> (Ptr Window
        -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \fmtp :: Ptr Window
    fmtp ->
        (Ptr CInt -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CInt -> IO (Either String (Window, Int, CULong, [CUChar])))
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> (Ptr CInt -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \szp :: Ptr CInt
    szp  ->
        (Ptr CULong -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CULong -> IO (Either String (Window, Int, CULong, [CUChar])))
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> (Ptr CULong
        -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \lenp :: Ptr CULong
    lenp ->
        (Ptr CULong -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr CULong -> IO (Either String (Window, Int, CULong, [CUChar])))
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> (Ptr CULong
        -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \ackp :: Ptr CULong
    ackp ->
        (Ptr (Ptr CUChar)
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr (Ptr CUChar)
      -> IO (Either String (Window, Int, CULong, [CUChar])))
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> (Ptr (Ptr CUChar)
        -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ \vsp :: Ptr (Ptr CUChar)
    vsp  -> do
        CInt
    rc   <- Display
    -> Window
    -> Window
    -> CLong
    -> CLong
    -> Bool
    -> Window
    -> Ptr Window
    -> Ptr CInt
    -> Ptr CULong
    -> Ptr CULong
    -> Ptr (Ptr CUChar)
    -> IO CInt
    xGetWindowProperty
                  Display
    d
                  Window
    w
                  Window
    a
                  0
                  CLong
    forall a. Bounded a => a
    maxBound
                  Bool
    False
                  Window
    anyPropertyType
                  Ptr Window
    fmtp
                  Ptr CInt
    szp
                  Ptr CULong
    lenp
                  Ptr CULong
    ackp
                  Ptr (Ptr CUChar)
    vsp
        case CInt
    rc of
          0 -> do
            Window
    fmt <- Window -> Window
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Window -> Window) -> IO Window -> IO Window
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Ptr Window -> IO Window
    forall a. Storable a => Ptr a -> IO a
    peek Ptr Window
    fmtp
            Ptr CUChar
    vs' <-                     Ptr (Ptr CUChar) -> IO (Ptr CUChar)
    forall a. Storable a => Ptr a -> IO a
    peek Ptr (Ptr CUChar)
    vsp
            Int
    sz  <- 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
    szp
            case () of
              () | Window
    fmt Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    none     -> Ptr CUChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree Ptr CUChar
    vs' IO CInt
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. a -> Either a b
    Left   "(property deleted)"   )
                 | Int
    sz Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0          -> Ptr CUChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree Ptr CUChar
    vs' IO CInt
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. a -> Either a b
    Left (String -> Either String (Window, Int, CULong, [CUChar]))
    -> String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. (a -> b) -> a -> b
    $ "(illegal bit size " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                                  Int -> String
    forall a. Show a => a -> String
    show Int
    sz              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                                  ")"                    )
                 | Int
    sz Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` 8 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0 -> Ptr CUChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree Ptr CUChar
    vs' IO CInt
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. a -> Either a b
    Left (String -> Either String (Window, Int, CULong, [CUChar]))
    -> String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. (a -> b) -> a -> b
    $ "(illegal bit size " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                                  Int -> String
    forall a. Show a => a -> String
    show Int
    sz              String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                                                  ")"                    )
                 | Bool
    otherwise       -> do
                     Int
    len <- 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
    lenp
                     -- that's as in "ack! it's fugged!"
                     CULong
    ack <- CULong -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CULong -> CULong) -> IO CULong -> IO CULong
    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
    ackp
                     [CUChar]
    vs <- Int -> Ptr CUChar -> IO [CUChar]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int -> Int
    bytes Int
    sz) Ptr CUChar
    vs'
                     CInt
    _ <- Ptr CUChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree Ptr CUChar
    vs'
                     Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String (Window, Int, CULong, [CUChar])
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ (Window, Int, CULong, [CUChar])
    -> Either String (Window, Int, CULong, [CUChar])
    forall a b. b -> Either a b
    Right (Window
    fmt,Int
    sz,CULong
    ack,[CUChar]
    vs)
          e :: CInt
    e -> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String (Window, Int, CULong, [CUChar])
     -> IO (Either String (Window, Int, CULong, [CUChar])))
    -> Either String (Window, Int, CULong, [CUChar])
    -> IO (Either String (Window, Int, CULong, [CUChar]))
    forall a b. (a -> b) -> a -> b
    $ String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. a -> Either a b
    Left (String -> Either String (Window, Int, CULong, [CUChar]))
    -> String -> Either String (Window, Int, CULong, [CUChar])
    forall a b. (a -> b) -> a -> b
    $ "getWindowProperty failed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CInt -> String
    forall a. Show a => a -> String
    show CInt
    e
      case Either String (Window, Int, CULong, [CUChar])
    prop of
        Left  _               -> String -> X String
    forall (m :: * -> *) a. Monad m => a -> m a
    return ""
        Right (fmt :: Window
    fmt,sz :: Int
    sz,ack :: CULong
    ack,vs :: [CUChar]
    vs) -> Window
    -> Window
    -> String
    -> Window
    -> Int
    -> [CUChar]
    -> CULong
    -> Int
    -> X String
    dumpProperty' Window
    w Window
    a String
    n Window
    fmt Int
    sz [CUChar]
    vs CULong
    ack Int
    i

    -- @@@ am I better off passing in the Decode and DecodeState?
    -- | Parse and dump a property (or a 'ClientMessage').
    dumpProperty'                             :: Window -- source window
                                              -> Atom   -- property id
                                              -> String -- property name
                                              -> Atom   -- property type
                                              -> Int    -- bit width
                                              -> Raw    -- raw value
                                              -> CULong -- size of un-dumped content
                                              -> Int    -- indent for output formatting
                                              -> X String
    dumpProperty' :: Window
    -> Window
    -> String
    -> Window
    -> Int
    -> [CUChar]
    -> CULong
    -> Int
    -> X String
    dumpProperty' w :: Window
    w a :: Window
    a n :: String
    n fmt :: Window
    fmt sz :: Int
    sz vs :: [CUChar]
    vs ack :: CULong
    ack i :: Int
    i =  do
      String
    ptn <- Window -> X String
    atomName Window
    fmt
      let dec :: Decode
    dec  = Decode :: Window -> String -> Window -> Int -> Window -> Int -> Int -> Decode
    Decode {property :: Window
    property = Window
    a
                        ,pName :: String
    pName    = String
    n
                        ,pType :: Window
    pType    = Window
    fmt
                        ,width :: Int
    width    = Int
    sz
                        ,indent :: Int
    indent   = Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    ptn Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 6
                        ,window :: Window
    window   = Window
    w
                        ,limit :: Int
    limit    = 96
                        }
          dec' :: Decode
    dec' = Decode
    dec    {pType :: Window
    pType    = Window
    cARDINAL
                        ,width :: Int
    width    = 8
                        }
          ds :: DecodeState
    ds   = DecS :: [CUChar] -> String -> String -> DecodeState
    DecS   {value :: [CUChar]
    value    = [CUChar]
    vs
                        -- @@@ probably should push this outside, since it doesn't
                        --     make sense for ClientMessage
                        ,accum :: String
    accum    = " (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ptn String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ") "
                        ,joint :: String
    joint    = "= "
                        }
      (_,ds' :: DecodeState
    ds') <- Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
    runDecode Decode
    dec DecodeState
    ds (Decoder Bool -> X (Bool, DecodeState))
    -> Decoder Bool -> X (Bool, DecodeState)
    forall a b. (a -> b) -> a -> b
    $ Window -> String -> Decoder Bool
    dumpProp Window
    a String
    n
      let fin :: Int
    fin = [CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (DecodeState -> [CUChar]
    value DecodeState
    ds')
          len :: Int
    len = [CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CUChar]
    vs
          lost :: String
    lost = if CULong
    ack CULong -> CULong -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then "" else "and " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ CULong -> String
    forall a. Show a => a -> String
    show CULong
    ack String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " lost bytes"
          unk :: String
    unk = case () of
                  () | Int
    fin Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    len -> "undecodeable "
                     | Int
    fin Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0   -> "."
                     | Bool
    otherwise  -> "and remainder (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    fin) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ '/'Char -> String -> String
    forall a. a -> [a] -> [a]
    :Int -> String
    forall a. Show a => a -> String
    show Int
    len String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
      (_,ds'' :: DecodeState
    ds'') <- if Int
    fin Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0
                  then (Bool, DecodeState) -> X (Bool, DecodeState)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True,DecodeState
    ds')
                  else Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
    runDecode Decode
    dec' (String -> DecodeState -> DecodeState
    withJoint' String
    unk DecodeState
    ds' ) (Decoder Bool -> X (Bool, DecodeState))
    -> Decoder Bool -> X (Bool, DecodeState)
    forall a b. (a -> b) -> a -> b
    $ Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dump8
      (_,ds''' :: DecodeState
    ds''') <- if CULong
    ack CULong -> CULong -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0
                   then (Bool, DecodeState) -> X (Bool, DecodeState)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    True,DecodeState
    ds'')
                   else Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
    runDecode Decode
    dec' (String -> DecodeState -> DecodeState
    withJoint' " " DecodeState
    ds'') (Decoder Bool -> X (Bool, DecodeState))
    -> Decoder Bool -> X (Bool, DecodeState)
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    propSimple String
    lost -- @@@
      String -> X String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String) -> String -> X String
    forall a b. (a -> b) -> a -> b
    $ DecodeState -> String
    accum DecodeState
    ds'''

    -- | A simplified version of 'dumpProperty\'', to format random values from
    --   events.
    quickFormat     :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String
    quickFormat :: [i] -> Decoder Bool -> X String
    quickFormat v :: [i]
    v f :: Decoder Bool
    f =  do
      let vl :: Int
    vl = [i] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [i]
    v
      [CUChar]
    vs <- IO [CUChar] -> X [CUChar]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [CUChar] -> X [CUChar]) -> IO [CUChar] -> X [CUChar]
    forall a b. (a -> b) -> a -> b
    $
            Int -> (Ptr CULong -> IO [CUChar]) -> IO [CUChar]
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray Int
    vl ((Ptr CULong -> IO [CUChar]) -> IO [CUChar])
    -> (Ptr CULong -> IO [CUChar]) -> IO [CUChar]
    forall a b. (a -> b) -> a -> b
    $
            \p :: Ptr CULong
    p -> Ptr CULong -> [CULong] -> IO ()
    forall a. Storable a => Ptr a -> [a] -> IO ()
    pokeArray Ptr CULong
    p ((i -> CULong) -> [i] -> [CULong]
    forall a b. (a -> b) -> [a] -> [b]
    map i -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral [i]
    v :: [CULong]) IO () -> IO [CUChar] -> IO [CUChar]
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                  Int -> Ptr CUChar -> IO [CUChar]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray (4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    vl) (Ptr CULong -> Ptr CUChar
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CULong
    p :: Ptr CUChar)
      let dec :: Decode
    dec = Decode :: Window -> String -> Window -> Int -> Window -> Int -> Int -> Decode
    Decode {property :: Window
    property = Window
    none
                       ,pName :: String
    pName    = ""
                       ,pType :: Window
    pType    = Window
    cARDINAL
                       ,width :: Int
    width    = 32
                       ,indent :: Int
    indent   = 0
                       ,window :: Window
    window   = Window
    none
                       ,limit :: Int
    limit    = Int
    forall a. Bounded a => a
    maxBound
                       }
          ds :: DecodeState
    ds  = DecS :: [CUChar] -> String -> String -> DecodeState
    DecS   {value :: [CUChar]
    value    = [CUChar]
    vs
                       ,accum :: String
    accum    = ""
                       ,joint :: String
    joint    = ""
                       }
      (r :: Bool
    r,ds' :: DecodeState
    ds') <- Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
    runDecode Decode
    dec DecodeState
    ds Decoder Bool
    f
      String -> X String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String) -> String -> X String
    forall a b. (a -> b) -> a -> b
    $ DecodeState -> String
    accum DecodeState
    ds' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if Bool
    r then "" else "?"

    -- | Launch a decoding parser, returning success and final state.
    runDecode                 :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState)
    runDecode :: Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
    runDecode c :: Decode
    c s :: DecodeState
    s (Decoder p :: ReaderT Decode (StateT DecodeState X) Bool
    p) =  StateT DecodeState X Bool -> DecodeState -> X (Bool, DecodeState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (ReaderT Decode (StateT DecodeState X) Bool
    -> Decode -> StateT DecodeState X Bool
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT Decode (StateT DecodeState X) Bool
    p Decode
    c) DecodeState
    s

    -- Coerce bit size to bytes.
    bytes   :: Int -> Int
    bytes :: Int -> Int
    bytes w :: Int
    w =  Int
    w Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` 8

    -- | The top level property decoder, for a wide variety of standard ICCCM and
    --   EWMH window properties.  We pass part of the 'ReaderT' as arguments for
    --   pattern matching.
    dumpProp                                              :: Atom -> String -> Decoder Bool

    dumpProp :: Window -> String -> Decoder Bool
    dumpProp _ "CLIPBOARD"                                =  Decoder Bool
    dumpSelection
    dumpProp _ "_NET_SUPPORTED"                           =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_NET_CLIENT_LIST"                         =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpWindow
    dumpProp _ "_NET_CLIENT_LIST_STACKING"                =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpWindow
    dumpProp _ "_NET_NUMBER_OF_DESKTOPS"                  =  Decoder Bool
    dump32
    dumpProp _ "_NET_VIRTUAL_ROOTS"                       =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpWindow
    dumpProp _ "_NET_DESKTOP_GEOMETRY"                    =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dump32
    dumpProp _ "_NET_DESKTOP_VIEWPORT"                    =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("w",Decoder Bool
    dump32)
                                                                      ,("h",Decoder Bool
    dump32)
                                                                      ]
    dumpProp _ "_NET_CURRENT_DESKTOP"                     =  Decoder Bool
    dump32
    dumpProp _ "_NET_DESKTOP_NAMES"                       =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpUTF
    dumpProp _ "_NET_ACTIVE_WINDOW"                       =  Decoder Bool
    dumpActiveWindow
    dumpProp _ "_NET_WORKAREA"                            =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("start"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("x",Decoder Bool
    dump32)
                                                                                 ,("y",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ,("size"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("w",Decoder Bool
    dump32)
                                                                                 ,("h",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ]
    dumpProp _ "_NET_SUPPORTING_WM_CHECK"                 =  Decoder Bool
    dumpWindow
    dumpProp _ "_NET_DESKTOP_LAYOUT"                      =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("orientation"
                                                                       ,[String] -> Decoder Bool
    dumpEnum [String]
    nwmOrientation
                                                                       )
                                                                      ,("size"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("cols",Decoder Bool
    dump32)
                                                                                 ,("rows",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ,("origin"
                                                                       ,[String] -> Decoder Bool
    dumpEnum [String]
    nwmOrigin
                                                                       )
                                                                      ]
    dumpProp _ "_NET_SHOWING_DESKTOP"                     =  Decoder Bool
    dump32
    dumpProp _ "_NET_WM_NAME"                             =  Decoder Bool
    dumpUTF
    dumpProp _ "_NET_WM_VISIBLE_NAME"                     =  Decoder Bool
    dumpUTF
    dumpProp _ "_NET_WM_ICON_NAME"                        =  Decoder Bool
    dumpUTF
    dumpProp _ "_NET_WM_VISIBLE_ICON_NAME"                =  Decoder Bool
    dumpUTF
    dumpProp _ "_NET_WM_DESKTOP"                          =  [(Integer, String)] -> Decoder Bool -> Decoder Bool
    dumpExcept [(0xFFFFFFFF,"all")]
                                                                        Decoder Bool
    dump32
    dumpProp _ "_NET_WM_WINDOW_TYPE"                      =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_NET_WM_STATE"                            =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_NET_WM_ALLOWED_ACTIONS"                  =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_NET_WM_STRUT"                            =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("left gap"  ,Decoder Bool
    dump32)
                                                                      ,("right gap" ,Decoder Bool
    dump32)
                                                                      ,("top gap"   ,Decoder Bool
    dump32)
                                                                      ,("bottom gap",Decoder Bool
    dump32)
                                                                      ]
    dumpProp _ "_NET_WM_STRUT_PARTIAL"                    =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("left gap"    ,Decoder Bool
    dump32)
                                                                      ,("right gap"   ,Decoder Bool
    dump32)
                                                                      ,("top gap"     ,Decoder Bool
    dump32)
                                                                      ,("bottom gap"  ,Decoder Bool
    dump32)
                                                                      ,("left start"  ,Decoder Bool
    dump32)
                                                                      ,("left end"    ,Decoder Bool
    dump32)
                                                                      ,("right start" ,Decoder Bool
    dump32)
                                                                      ,("right end"   ,Decoder Bool
    dump32)
                                                                      ,("top start"   ,Decoder Bool
    dump32)
                                                                      ,("top end"     ,Decoder Bool
    dump32)
                                                                      ,("bottom start",Decoder Bool
    dump32)
                                                                      ,("bottom end"  ,Decoder Bool
    dump32)
                                                                      ]
    dumpProp _ "_NET_WM_ICON_GEOMETRY"                    =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("x",Decoder Bool
    dump32)
                                                                      ,("y",Decoder Bool
    dump32)
                                                                      ,("w",Decoder Bool
    dump32)
                                                                      ,("h",Decoder Bool
    dump32)
                                                                      ]
    -- no, I'm not going to duplicate xprop *completely*!
    dumpProp _ "_NET_WM_ICON"                             =  String -> Decoder Bool
    propSimple "(icon)"
    dumpProp _ "_NET_WM_PID"                              =  Decoder Bool
    dumpPid
    dumpProp _ "_NET_WM_HANDLED_ICONS"                    =  String -> Decoder Bool
    propSimple "(defined)"
    dumpProp _ "_NET_WM_USER_TIME"                        =  [(Integer, String)] -> Decoder Bool -> Decoder Bool
    dumpExcept [(0,"do not map initially")]
                                                                        Decoder Bool
    dumpTime
    dumpProp _ "_NET_FRAME_EXTENTS"                       =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("left"  ,Decoder Bool
    dump32)
                                                                      ,("right" ,Decoder Bool
    dump32)
                                                                      ,("top"   ,Decoder Bool
    dump32)
                                                                      ,("bottom",Decoder Bool
    dump32)
                                                                      ]
    dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER"             =  [(Integer, String)] -> Decoder Bool -> Decoder Bool
    dumpExcept [(0,"illegal value 0")]
                                                                        Decoder Bool
    dump64
    dumpProp _ "_NET_STARTUP_ID"                          =  Decoder Bool
    dumpUTF
    dumpProp _ "WM_PROTOCOLS"                             =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "WM_COLORMAP_WINDOWS"                      =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpWindow
    dumpProp _ "WM_STATE"                                 =  Decoder Bool
    dumpState
    dumpProp _ "WM_LOCALE_NAME"                           =  Decoder Bool
    dumpString
    dumpProp _ "WM_CLIENT_LEADER"                         =  Decoder Bool
    dumpWindow
    dumpProp _ "_NET_WM_WINDOW_OPACITY"                   =  Decoder Bool
    dumpPercent
    dumpProp _ "XdndAware"                                =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_XKLAVIER_TRANSPARENT"                    =  Int -> Decoder Bool
    dumpInteger 32
    dumpProp _ "_XKLAVIER_STATE"                          =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("state"     ,Int -> Decoder Bool
    dumpInteger 32)
                                                                      ,("indicators",Decoder Bool
    dumpXKlInds)
                                                                      ]
    dumpProp _ "_MOTIF_DRAG_RECEIVER_INFO"                =  Decoder Bool
    dumpMotifDragReceiver
    dumpProp _ "_OL_WIN_ATTR"                             =  Decoder Bool
    dumpOLAttrs
    dumpProp _ "_OL_DECOR_ADD"                            =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_OL_DECOR_DEL"                            =  Decoder Bool -> Decoder Bool
    dumpArray Decoder Bool
    dumpAtom
    dumpProp _ "_MOTIF_WM_HINTS"                          =  Decoder Bool
    dumpMwmHints
    dumpProp _ "_MOTIF_WM_INFO"                           =  Decoder Bool
    dumpMwmInfo
    dumpProp _ "_XMONAD_DECORATED_BY"                     =  Decoder Bool
    dumpWindow
    dumpProp _ "_XMONAD_DECORATION_FOR"                   =  Decoder Bool
    dumpWindow
    dumpProp a :: Window
    a _ | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_NAME                           =  Decoder Bool
    dumpString
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    pRIMARY                           =  Decoder Bool
    dumpSelection
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    sECONDARY                         =  Decoder Bool
    dumpSelection
                   -- this is gross
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_TRANSIENT_FOR                  =  do
                     Integer
    root <- Window -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Window -> Integer) -> Decoder Window -> Decoder Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX ((XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot)
                     Window
    w <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    window
                     WMHints {wmh_window_group :: WMHints -> Window
    wmh_window_group = Window
    group} <-
                       X WMHints -> Decoder WMHints
    forall a. X a -> Decoder a
    inX (X WMHints -> Decoder WMHints) -> X WMHints -> Decoder WMHints
    forall a b. (a -> b) -> a -> b
    $ (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display X Display -> (Display -> X WMHints) -> X WMHints
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= IO WMHints -> X WMHints
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO WMHints -> X WMHints)
    -> (Display -> IO WMHints) -> Display -> X WMHints
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Display -> Window -> IO WMHints)
    -> Window -> Display -> IO WMHints
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Display -> Window -> IO WMHints
    getWMHints Window
    w
                     [(Integer, String)] -> Decoder Bool -> Decoder Bool
    dumpExcept [(0   ,"window group " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Window -> String
    forall a. Show a => a -> String
    show Window
    group)
                                ,(Integer
    root,"window group " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Window -> String
    forall a. Show a => a -> String
    show Window
    group)
                                ]
                                Decoder Bool
    dumpWindow
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rESOURCE_MANAGER                  =  Decoder Bool
    dumpString
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_COMMAND                        =  Decoder Bool
    dumpString
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_HINTS                          =  Decoder Bool
    dumpWmHints
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_CLIENT_MACHINE                 =  Decoder Bool
    dumpString
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_ICON_NAME                      =  Decoder Bool
    dumpString
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_ICON_SIZE                      =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("min size"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("w",Decoder Bool
    dump32)
                                                                                 ,("h",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ,("max size"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("w",Decoder Bool
    dump32)
                                                                                 ,("h",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ,("increment"
                                                                       ,[(String, Decoder Bool)] -> Decoder Bool
    dumpList [("w",Decoder Bool
    dump32)
                                                                                 ,("h",Decoder Bool
    dump32)
                                                                                 ]
                                                                       )
                                                                      ]
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_NORMAL_HINTS                   =  Decoder Bool
    (...)
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_ZOOM_HINTS                     =  Decoder Bool
    (...) -- same as previous
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_DEFAULT_MAP                   =  Decoder Bool
    (...) -- XStandardColormap
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_BEST_MAP                      =  Decoder Bool
    (...) -- "
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_RED_MAP                       =  Decoder Bool
    (...) -- "
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_GREEN_MAP                     =  Decoder Bool
    (...) -- "
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_BLUE_MAP                      =  Decoder Bool
    (...) -- "
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    rGB_GRAY_MAP                      =  Decoder Bool
    (...) -- "
                 | Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_CLASS                          =  [(String, Decoder Bool)] -> Decoder Bool
    dumpList [("name" ,Decoder Bool
    dumpString)
                                                                      ,("class",Decoder Bool
    dumpString)
                                                                      ]
    dumpProp _ s :: String
    s | String
    s String -> String -> Bool
    `isCountOf` "WM_S"                   =  Decoder Bool
    dumpSelection
                 | String
    s String -> String -> Bool
    `isCountOf` "_NET_WM_CM_S"           =  Decoder Bool
    dumpSelection
                 | String
    s String -> String -> Bool
    `isCountOf` "_NET_DESKTOP_LAYOUT_S"  =  Decoder Bool
    dumpSelection
                 | String
    s String -> String -> Bool
    `isCountOf` "CUT_BUFFER"             =  Decoder Bool
    dumpString
                 -- and dumpProperties does the rest
                 | Bool
    otherwise                              =  Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- lower level decoders --

    -- alter the current joint
    withJoint   :: String -> Decoder a -> Decoder a
    withJoint :: String -> Decoder a -> Decoder a
    withJoint j :: String
    j =  (((DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((DecodeState -> DecodeState) -> Decoder ())
    -> (DecodeState -> DecodeState) -> Decoder ()
    forall a b. (a -> b) -> a -> b
    $ String -> DecodeState -> DecodeState
    withJoint' String
    j) Decoder () -> Decoder a -> Decoder a
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>)

    withJoint'     :: String -> DecodeState -> DecodeState
    withJoint' :: String -> DecodeState -> DecodeState
    withJoint' j :: String
    j s :: DecodeState
    s =  DecodeState
    s {joint :: String
    joint = String
    j}

    -- lift an X into a Decoder
    inX :: X a -> Decoder a
    inX :: X a -> Decoder a
    inX =  ReaderT Decode (StateT DecodeState X) a -> Decoder a
    forall a. ReaderT Decode (StateT DecodeState X) a -> Decoder a
    Decoder (ReaderT Decode (StateT DecodeState X) a -> Decoder a)
    -> (X a -> ReaderT Decode (StateT DecodeState X) a)
    -> X a
    -> Decoder a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateT DecodeState X a -> ReaderT Decode (StateT DecodeState X) a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (StateT DecodeState X a -> ReaderT Decode (StateT DecodeState X) a)
    -> (X a -> StateT DecodeState X a)
    -> X a
    -> ReaderT Decode (StateT DecodeState X) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X a -> StateT DecodeState X a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    -- flip isPrefixOf, but the remainder must be all digits
    isCountOf         :: String -> String -> Bool
    -- note that \NUL is safe because atom names have to be C strings
    s :: String
    s isCountOf :: String -> String -> Bool
    `isCountOf` pfx :: String
    pfx =  String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null                     (String -> Bool) -> String -> Bool
    forall a b. (a -> b) -> a -> b
    $
                         (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isDigit        (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $
                         ((Char, Char) -> Char) -> [(Char, Char)] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Char, Char) -> Char
    forall a b. (a, b) -> a
    fst                  ([(Char, Char)] -> String) -> [(Char, Char)] -> String
    forall a b. (a -> b) -> a -> b
    $
                         ((Char, Char) -> Bool) -> [(Char, Char)] -> [(Char, Char)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ((Char -> Char -> Bool) -> (Char, Char) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)) ([(Char, Char)] -> [(Char, Char)])
    -> [(Char, Char)] -> [(Char, Char)]
    forall a b. (a -> b) -> a -> b
    $
                         String -> String -> [(Char, Char)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip String
    s                    (String -> [(Char, Char)]) -> String -> [(Char, Char)]
    forall a b. (a -> b) -> a -> b
    $
                         String
    pfx String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Char -> String
    forall a. a -> [a]
    repeat '\NUL'

    -- localize an increased indent
    withIndent   :: Int -> Decoder a -> Decoder a
    withIndent :: Int -> Decoder a -> Decoder a
    withIndent w :: Int
    w =  (Decode -> Decode) -> Decoder a -> Decoder a
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\r :: Decode
    r -> Decode
    r {indent :: Int
    indent = Decode -> Int
    indent Decode
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    w})

    -- dump an array of items.  this dumps the entire property
    dumpArray      :: Decoder Bool -> Decoder Bool
    dumpArray :: Decoder Bool -> Decoder Bool
    dumpArray item :: Decoder Bool
    item =  do
      Int -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a
    withIndent 1 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "[" Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Decoder Bool -> Decoder Bool
    forall a. String -> Decoder a -> Decoder a
    withJoint "" (Decoder Bool -> String -> Decoder Bool
    dumpArray' Decoder Bool
    item "")

    -- step through values as an array, ending on parse error or end of list
    dumpArray'          :: Decoder Bool -> String -> Decoder Bool
    dumpArray' :: Decoder Bool -> String -> Decoder Bool
    dumpArray' item :: Decoder Bool
    item pfx :: String
    pfx =  do
      [CUChar]
    vs <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
      if [CUChar]
    vs [CUChar] -> [CUChar] -> Bool
    forall a. Eq a => a -> a -> Bool
    == []
        then String -> Decoder Bool
    append "]"
        else String -> Decoder Bool
    append String
    pfx Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    whenD Decoder Bool
    item (Decoder Bool -> String -> Decoder Bool
    dumpArray' Decoder Bool
    item ",")

    -- keep parsing until a parse step fails
    -- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when',
    --     which suggests that 'whenX' is *also* the same function... yep.  ISAGN
    whenD     :: Monad m => m Bool -> m Bool -> m Bool
    whenD :: m Bool -> m Bool -> m Bool
    whenD p :: m Bool
    p f :: m Bool
    f =  m Bool
    p m Bool -> (Bool -> m Bool) -> m Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \b :: Bool
    b -> if Bool
    b then m Bool
    f else Bool -> m Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- verify a decoder parameter, else call error reporter
    -- once again, it's more general than I originally wrote
    guardR                  :: (MonadReader r m, Eq v)
                            => (r -> v)                -- value selector
                            -> v                       -- expected value
                            -> (v -> v -> m a)         -- error reporter
                            -> m a                     -- continuation (hush)
                            -> m a
    guardR :: (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR sel :: r -> v
    sel val :: v
    val err :: v -> v -> m a
    err good :: m a
    good =  do
      v
    v <- (r -> v) -> m v
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks r -> v
    sel
      if v
    v v -> v -> Bool
    forall a. Eq a => a -> a -> Bool
    == v
    val then m a
    good else v -> v -> m a
    err v
    v v
    val

    -- this is kinda dumb
    fi       :: Bool -> a -> a -> a
    fi :: Bool -> a -> a -> a
    fi p :: Bool
    p n :: a
    n y :: a
    y =  if Bool
    p then a
    y else a
    n -- flip (if' p), if that existed

    -- verify we have the expected word size
    guardSize      :: Int -> Decoder Bool -> Decoder Bool
    -- see XSync documentation for this insanity
    guardSize :: Int -> Decoder Bool -> Decoder Bool
    guardSize 64 =  (Decode -> Int)
    -> Int
    -> (Int -> Int -> Decoder Bool)
    -> Decoder Bool
    -> Decoder Bool
    forall r (m :: * -> *) v a.
    (MonadReader r m, Eq v) =>
    (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR Decode -> Int
    width 32 Int -> Int -> Decoder Bool
    propSizeErr (Decoder Bool -> Decoder Bool)
    -> (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Decoder Bool -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' 8         Decoder Bool
    propShortErr
    guardSize  w :: Int
    w =  (Decode -> Int)
    -> Int
    -> (Int -> Int -> Decoder Bool)
    -> Decoder Bool
    -> Decoder Bool
    forall r (m :: * -> *) v a.
    (MonadReader r m, Eq v) =>
    (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR Decode -> Int
    width  Int
    w Int -> Int -> Decoder Bool
    propSizeErr (Decoder Bool -> Decoder Bool)
    -> (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Decoder Bool -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' (Int -> Int
    bytes Int
    w) Decoder Bool
    propShortErr

    guardSize'       :: Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' :: Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' l :: Int
    l n :: Decoder a
    n y :: Decoder a
    y =  (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value Decoder [CUChar] -> ([CUChar] -> Decoder a) -> Decoder a
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \vs :: [CUChar]
    vs -> Bool -> Decoder a -> Decoder a -> Decoder a
    forall a. Bool -> a -> a -> a
    fi ([CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CUChar]
    vs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    l) Decoder a
    n Decoder a
    y

    -- verify we have the expected property type
    guardType    :: Atom -> Decoder Bool -> Decoder Bool
    guardType :: Window -> Decoder Bool -> Decoder Bool
    guardType  t :: Window
    t =  (Decode -> Window)
    -> Window
    -> (Window -> Window -> Decoder Bool)
    -> Decoder Bool
    -> Decoder Bool
    forall r (m :: * -> *) v a.
    (MonadReader r m, Eq v) =>
    (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR Decode -> Window
    pType Window
    t Window -> Window -> Decoder Bool
    propTypeErr

    -- dump a structure as a named tuple
    dumpList       :: [(String,Decoder Bool)] -> Decoder Bool
    dumpList :: [(String, Decoder Bool)] -> Decoder Bool
    dumpList proto :: [(String, Decoder Bool)]
    proto =  do
      Window
    a <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    pType
      CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' (CULong
    forall a. Bounded a => a
    maxBound :: CULong) (((String, Decoder Bool) -> (String, Decoder Bool, Window))
    -> [(String, Decoder Bool)] -> [(String, Decoder Bool, Window)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(s :: String
    s,d :: Decoder Bool
    d) -> (String
    s,Decoder Bool
    d,Window
    a)) [(String, Decoder Bool)]
    proto) "("

    -- same but elements have their own distinct types
    dumpList'       :: [(String,Decoder Bool,Atom)] -> Decoder Bool
    dumpList' :: [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpList' proto :: [(String, Decoder Bool, Window)]
    proto =  CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' (CULong
    forall a. Bounded a => a
    maxBound :: CULong) [(String, Decoder Bool, Window)]
    proto "("

    -- same but only dump elements identified by provided mask
    dumpListByMask     :: CULong -> [(String,Decoder Bool)] -> Decoder Bool
    dumpListByMask :: CULong -> [(String, Decoder Bool)] -> Decoder Bool
    dumpListByMask m :: CULong
    m p :: [(String, Decoder Bool)]
    p =  do
      Window
    a <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    pType
      CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' CULong
    m (((String, Decoder Bool) -> (String, Decoder Bool, Window))
    -> [(String, Decoder Bool)] -> [(String, Decoder Bool, Window)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(s :: String
    s,d :: Decoder Bool
    d) -> (String
    s,Decoder Bool
    d,Window
    a)) [(String, Decoder Bool)]
    p) "("

    -- and the previous two combined
    dumpListByMask'     :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
    dumpListByMask' :: CULong -> [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpListByMask' m :: CULong
    m p :: [(String, Decoder Bool, Window)]
    p =  CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' CULong
    m [(String, Decoder Bool, Window)]
    p "("

    dumpList''                    :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
    dumpList'' :: CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' _ []           _   =  String -> Decoder Bool
    append ")" Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    dumpList'' 0 _            _   =  String -> Decoder Bool
    append ")" Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    dumpList'' m :: CULong
    m ((l :: String
    l,p :: Decoder Bool
    p,t :: Window
    t):ps :: [(String, Decoder Bool, Window)]
    ps) sep :: String
    sep = do
      (e :: Bool
    e,sep' :: String
    sep') <- if CULong
    m CULong -> CULong -> CULong
    forall a. Bits a => a -> a -> a
    .&. 1 CULong -> CULong -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0
                  then do
                    -- @@@ ew
                    DecodeState
    st <- Decoder DecodeState
    forall s (m :: * -> *). MonadState s m => m s
    get
                    Bool
    e <- (Decode -> Decode) -> Decoder Bool -> Decoder Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\r :: Decode
    r -> Decode
    r {pType :: Window
    pType = Window
    t}) Decoder Bool
    p
                    [CUChar]
    v' <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
                    DecodeState -> Decoder ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (DecodeState -> Decoder ()) -> DecodeState -> Decoder ()
    forall a b. (a -> b) -> a -> b
    $ DecodeState
    st {value :: [CUChar]
    value = [CUChar]
    v'}
                    (Bool, String) -> Decoder (Bool, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    e,String
    sep)
                  else do
                    let label :: String
    label = String
    sep String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " = "
                    String -> Decoder Bool
    append String
    label
                    Bool
    e <- String -> Decoder Bool -> Decoder Bool
    forall a. String -> Decoder a -> Decoder a
    withJoint "" (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                           (Decode -> Decode) -> Decoder Bool -> Decoder Bool
    forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
    local (\r :: Decode
    r -> Decode
    r {pType :: Window
    pType  = Window
    t
                                          ,indent :: Int
    indent = Decode -> Int
    indent Decode
    r Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    label
                                          })
                                 Decoder Bool
    p
                    (Bool, String) -> Decoder (Bool, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    e,",")
      if Bool
    e then CULong
    -> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
    dumpList'' (CULong
    m CULong -> Int -> CULong
    forall a. Bits a => a -> Int -> a
    `shiftR` 1) [(String, Decoder Bool, Window)]
    ps String
    sep' else Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    e

    -- do the getTextProperty dance, the hard way.
    -- @@@ @COMPOUND_TEXT@ not supported yet.
    dumpString :: Decoder Bool
    dumpString :: Decoder Bool
    dumpString =  do
      Window
    fmt <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    pType
      [Window]
    x <- X [Window] -> Decoder [Window]
    forall a. X a -> Decoder a
    inX (X [Window] -> Decoder [Window]) -> X [Window] -> Decoder [Window]
    forall a b. (a -> b) -> a -> b
    $ (String -> X Window) -> [String] -> X [Window]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM String -> X Window
    getAtom ["COMPOUND_TEXT","UTF8_STRING"]
      case [Window]
    x of
        [cOMPOUND_TEXT :: Window
    cOMPOUND_TEXT,uTF8_STRING :: Window
    uTF8_STRING] -> case () of
          () | Window
    fmt Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    cOMPOUND_TEXT -> Int -> Decoder Bool -> Decoder Bool
    guardSize 16 Decoder Bool
    (...)
             | Window
    fmt Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    sTRING        -> Int -> Decoder Bool -> Decoder Bool
    guardSize  8 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                                         [CUChar]
    vs <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
                                         (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {value :: [CUChar]
    value = []})
                                         let ss :: [String]
    ss = ((String -> Maybe (String, String)) -> String -> [String])
    -> String -> (String -> Maybe (String, String)) -> [String]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (String -> Maybe (String, String)) -> String -> [String]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr ((CUChar -> Char) -> [CUChar] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map CUChar -> Char
    forall a b. (Enum a, Enum b) => a -> b
    twiddle [CUChar]
    vs) ((String -> Maybe (String, String)) -> [String])
    -> (String -> Maybe (String, String)) -> [String]
    forall a b. (a -> b) -> a -> b
    $
                                                  \s :: String
    s -> if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s
                                                        then Maybe (String, String)
    forall a. Maybe a
    Nothing
                                                        else let (w :: String
    w,s'' :: String
    s'') = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '\NUL') String
    s
                                                                 s' :: String
    s'      = if String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s''
                                                                           then String
    s''
                                                                           else String -> String
    forall a. [a] -> [a]
    tail String
    s''
                                                              in (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    w,String
    s')
                                         case [String]
    ss of
                                           [s :: String
    s] -> String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. Show a => a -> String
    show String
    s
                                           ss' :: [String]
    ss' -> let go :: [a] -> String -> Decoder Bool
    go (s :: a
    s:ss'' :: [a]
    ss'') c :: String
    c = String -> Decoder Bool
    append String
    c        Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                                                      String -> Decoder Bool
    append (a -> String
    forall a. Show a => a -> String
    show a
    s) Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
                                                                      [a] -> String -> Decoder Bool
    go [a]
    ss'' ","
                                                      go []       _ = String -> Decoder Bool
    append "]"
                                                   in String -> Decoder Bool
    append "[" Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [String] -> String -> Decoder Bool
    forall a. Show a => [a] -> String -> Decoder Bool
    go [String]
    ss' ""
             | Window
    fmt Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    uTF8_STRING   -> Decoder Bool
    dumpUTF -- duplicate type test instead of code :)
             | Bool
    otherwise            -> (X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    atomName Window
    fmt) Decoder String -> (String -> Decoder Bool) -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                       String -> Decoder Bool
    failure (String -> Decoder Bool)
    -> (String -> String) -> String -> Decoder Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ("unrecognized string type " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++)

    -- show who owns a selection
    dumpSelection :: Decoder Bool
    dumpSelection :: Decoder Bool
    dumpSelection =  do
      -- system selections contain a window ID; others are random
      -- note that the window ID will be the same as the owner, so
      -- we don't really care anyway.  we *do* want the selection owner
      Window
    a <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    property
      Window
    owner <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ (Display -> X Window) -> X Window
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X Window) -> X Window)
    -> (Display -> X Window) -> X Window
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d -> IO Window -> X Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> X Window) -> IO Window -> X Window
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO Window
    xGetSelectionOwner Display
    d Window
    a
      if Window
    owner Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    none
        then String -> Decoder Bool
    append "unowned"
        else do
          String
    w <- X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    debugWindow Window
    owner
          String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "owned by " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    w

    -- for now, not querying Xkb
    dumpXKlInds :: Decoder Bool
    dumpXKlInds :: Decoder Bool
    dumpXKlInds =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    iNTEGER (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                     Maybe EventType
    n <- (Integer -> EventType) -> Maybe Integer -> Maybe EventType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> EventType
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Maybe Integer -> Maybe EventType)
    -> Decoder (Maybe Integer) -> Decoder (Maybe EventType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Int -> Decoder (Maybe Integer)
    getInt' 32
                     case Maybe EventType
    n of
                       Nothing -> Decoder Bool
    propShortErr
                       Just is :: EventType
    is -> String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "indicators " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unwords (EventType -> EventType -> Int -> [String] -> [String]
    dumpInds EventType
    is 1 1 [])
      where
        dumpInds                               :: Word32 -> Word32 -> Int -> [String] -> [String]
        dumpInds :: EventType -> EventType -> Int -> [String] -> [String]
    dumpInds n :: EventType
    n bt :: EventType
    bt c :: Int
    c bs :: [String]
    bs | EventType
    n EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 Bool -> Bool -> Bool
    && Int
    c Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 =  ["none"]
                           | EventType
    n EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0           =  [String]
    bs
                           | EventType
    n EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .&. EventType
    bt EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0    =  EventType -> EventType -> Int -> [String] -> [String]
    dumpInds (EventType
    n EventType -> EventType -> EventType
    forall a. Bits a => a -> a -> a
    .&. EventType -> EventType
    forall a. Bits a => a -> a
    complement EventType
    bt)
                                                          (EventType
    bt EventType -> Int -> EventType
    forall a. Bits a => a -> Int -> a
    `shiftL` 1)
                                                          (Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)
                                                          ((Int -> String
    forall a. Show a => a -> String
    show Int
    c)String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    bs)
                           | Bool
    otherwise        =  EventType -> EventType -> Int -> [String] -> [String]
    dumpInds EventType
    n
                                                          (EventType
    bt EventType -> Int -> EventType
    forall a. Bits a => a -> Int -> a
    `shiftL` 1)
                                                          (Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1)
                                                          [String]
    bs

    -- decode an Atom
    dumpAtom :: Decoder Bool
    dumpAtom :: Decoder Bool
    dumpAtom =
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    aTOM (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
      Maybe Integer
    a <- Int -> Decoder (Maybe Integer)
    getInt' 32
      case Maybe Integer
    a of
        Nothing -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        Just a' :: Integer
    a' -> do
               String
    an <- X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    atomName (Window -> X String) -> Window -> X String
    forall a b. (a -> b) -> a -> b
    $ Integer -> Window
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    a'
               String -> Decoder Bool
    append String
    an

    dumpWindow :: Decoder Bool
    dumpWindow :: Decoder Bool
    dumpWindow =  Int -> Decoder Bool -> Decoder Bool
    guardSize 32 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Window -> Decoder Bool -> Decoder Bool
    guardType Window
    wINDOW (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                    Maybe Integer
    w <- Int -> Decoder (Maybe Integer)
    getInt' 32
                    case Maybe Integer
    w of
                      Nothing -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                      Just w' :: Integer
    w' -> X String -> Decoder String
    forall a. X a -> Decoder a
    inX (Window -> X String
    debugWindow (Integer -> Window
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    w')) Decoder String -> (String -> Decoder Bool) -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Decoder Bool
    append

    -- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list
    dumpActiveWindow :: Decoder Bool
    dumpActiveWindow :: Decoder Bool
    dumpActiveWindow =  Int -> Decoder Bool -> Decoder Bool
    guardSize 32 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                          Window
    t <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    pType
                          Window
    nAW <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ String -> X Window
    getAtom "_NET_ACTIVE_WINDOW"
                          case () of
                            () | Window
    t Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wINDOW -> Decoder Bool
    dumpWindow
                               | Window
    t Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    nAW    -> [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpList' [("source"       ,[String] -> Decoder Bool
    dumpEnum [String]
    awSource,Window
    cARDINAL)
                                                          ,("timestamp"    ,Decoder Bool
    dumpTime         ,Window
    cARDINAL)
                                                          ,("active window",Decoder Bool
    dumpWindow       ,Window
    wINDOW  )
                                                          ]
                            _                -> do
                                         String
    t' <- X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    atomName Window
    t
                                         String -> Decoder Bool
    failure (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ["(bad type "
                                                          ,String
    t'
                                                          ,"; expected WINDOW or _NET_ACTIVE_WINDOW"
                                                          ]
    -- dump a generic CARDINAL value
    dumpInt   :: Int -> Decoder Bool
    dumpInt :: Int -> Decoder Bool
    dumpInt w :: Int
    w =  Int -> Decoder Bool -> Decoder Bool
    guardSize Int
    w (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Window -> Decoder Bool -> Decoder Bool
    guardType Window
    cARDINAL (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> (Integer -> String) -> Decoder Bool
    getInt Int
    w Integer -> String
    forall a. Show a => a -> String
    show

    -- INTEGER is the signed version of CARDINAL
    dumpInteger   :: Int -> Decoder Bool
    dumpInteger :: Int -> Decoder Bool
    dumpInteger w :: Int
    w =  Int -> Decoder Bool -> Decoder Bool
    guardSize Int
    w (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Window -> Decoder Bool -> Decoder Bool
    guardType Window
    iNTEGER (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> (Integer -> String) -> Decoder Bool
    getInt Int
    w (Integer -> String
    forall a. Show a => a -> String
    show (Integer -> String) -> (Integer -> Integer) -> Integer -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Integer -> Integer
    signed Int
    w)

    -- reinterpret an unsigned as a signed
    signed     :: Int -> Integer -> Integer
    signed :: Int -> Integer -> Integer
    signed w :: Int
    w i :: Integer
    i =  Int -> Integer
    forall a. Bits a => Int -> a
    bit (Int
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Integer
    i

    -- and wrappers to keep the parse list in bounds
    dump64 :: Decoder Bool
    dump64 :: Decoder Bool
    dump64 =  Int -> Decoder Bool
    dumpInt 64

    dump32 :: Decoder Bool
    dump32 :: Decoder Bool
    dump32 =  Int -> Decoder Bool
    dumpInt 32

    {- not used in standard properties
    dump16 :: Decoder Bool
    dump16 =  dumpInt 16
    -}

    dump8 :: Decoder Bool
    dump8 :: Decoder Bool
    dump8 =  Int -> Decoder Bool
    dumpInt 8

    -- I am assuming for the moment that this is a single string.
    -- This might be false; consider the way the STRING properties
    -- handle lists.
    dumpUTF :: Decoder Bool
    dumpUTF :: Decoder Bool
    dumpUTF =  do
      Window
    uTF8_STRING <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ String -> X Window
    getAtom "UTF8_STRING"
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    uTF8_STRING (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Decoder Bool -> Decoder Bool
    guardSize 8 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
      [CUChar]
    s <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
      (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {value :: [CUChar]
    value = []})
      String -> Decoder Bool
    append (String -> Decoder Bool)
    -> ([CUChar] -> String) -> [CUChar] -> Decoder Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. Show a => a -> String
    show (String -> String) -> ([CUChar] -> String) -> [CUChar] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Word8] -> String
    decode ([Word8] -> String) -> ([CUChar] -> [Word8]) -> [CUChar] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (CUChar -> Word8) -> [CUChar] -> [Word8]
    forall a b. (a -> b) -> [a] -> [b]
    map CUChar -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ([CUChar] -> Decoder Bool) -> [CUChar] -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [CUChar]
    s
      Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    -- dump an enumerated value using a translation table
    dumpEnum'        :: [String] -> Atom -> Decoder Bool
    dumpEnum' :: [String] -> Window -> Decoder Bool
    dumpEnum' ss :: [String]
    ss fmt :: Window
    fmt =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    fmt (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $
                        Int -> (Integer -> String) -> Decoder Bool
    getInt 32     ((Integer -> String) -> Decoder Bool)
    -> (Integer -> String) -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $
                        \r :: Integer
    r -> case () of
                                () | Integer
    r Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0                 -> "undefined value " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    r
                                   | Integer
    r Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= [String] -> Integer
    forall i a. Num i => [a] -> i
    genericLength [String]
    ss -> "undefined value " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    r
                                   | Bool
    otherwise             -> [String] -> Integer -> String
    forall i a. Integral i => [a] -> i -> a
    genericIndex [String]
    ss Integer
    r

    -- we do not, unlike @xev@, try to ascii-art pixmaps.
    dumpPixmap :: Decoder Bool
    dumpPixmap :: Decoder Bool
    dumpPixmap =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    pIXMAP (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                    Maybe Integer
    p' <- Int -> Decoder (Maybe Integer)
    getInt' 32
                    case Maybe Integer
    p' of
                      Nothing -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                      Just p :: Integer
    p  -> do
                        String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "pixmap " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String -> String
    forall a. (Integral a, Show a) => a -> String -> String
    showHex Integer
    p ""
                        Maybe
      (Window, Position, Position, EventType, EventType, EventType, CInt)
    g' <- X (Maybe
         (Window, Position, Position, EventType, EventType, EventType,
          CInt))
    -> Decoder
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a. X a -> Decoder a
    inX (X (Maybe
          (Window, Position, Position, EventType, EventType, EventType,
           CInt))
     -> Decoder
          (Maybe
             (Window, Position, Position, EventType, EventType, EventType,
              CInt)))
    -> X (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    -> Decoder
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a b. (a -> b) -> a -> b
    $ (Display
     -> X (Maybe
             (Window, Position, Position, EventType, EventType, EventType,
              CInt)))
    -> X (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a. (Display -> X a) -> X a
    withDisplay ((Display
      -> X (Maybe
              (Window, Position, Position, EventType, EventType, EventType,
               CInt)))
     -> X (Maybe
             (Window, Position, Position, EventType, EventType, EventType,
              CInt)))
    -> (Display
        -> X (Maybe
                (Window, Position, Position, EventType, EventType, EventType,
                 CInt)))
    -> X (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d -> IO
      (Maybe
         (Window, Position, Position, EventType, EventType, EventType,
          CInt))
    -> X (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO
       (Maybe
          (Window, Position, Position, EventType, EventType, EventType,
           CInt))
     -> X (Maybe
             (Window, Position, Position, EventType, EventType, EventType,
              CInt)))
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    -> X (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a b. (a -> b) -> a -> b
    $
                                (Window, Position, Position, EventType, EventType, EventType, CInt)
    -> Maybe
         (Window, Position, Position, EventType, EventType, EventType, CInt)
    forall a. a -> Maybe a
    Just ((Window, Position, Position, EventType, EventType, EventType,
      CInt)
     -> Maybe
          (Window, Position, Position, EventType, EventType, EventType,
           CInt))
    -> IO
         (Window, Position, Position, EventType, EventType, EventType, CInt)
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Display
    -> Window
    -> IO
         (Window, Position, Position, EventType, EventType, EventType, CInt)
    getGeometry Display
    d (Integer -> Window
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    p)
                                IO
      (Maybe
         (Window, Position, Position, EventType, EventType, EventType,
          CInt))
    -> (SomeException
        -> IO
             (Maybe
                (Window, Position, Position, EventType, EventType, EventType,
                 CInt)))
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch`
                                \e :: SomeException
    e -> case SomeException -> Maybe ExitCode
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e of
                                        Just x :: ExitCode
    x -> SomeException
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a e. Exception e => e -> a
    throw SomeException
    e IO
      (Maybe
         (Window, Position, Position, EventType, EventType, EventType,
          CInt))
    -> ExitCode
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall a b. a -> b -> a
    `const` (ExitCode
    x ExitCode -> ExitCode -> ExitCode
    forall a. a -> a -> a
    `asTypeOf` ExitCode
    ExitSuccess)
                                        _      -> Maybe
      (Window, Position, Position, EventType, EventType, EventType, CInt)
    -> IO
         (Maybe
            (Window, Position, Position, EventType, EventType, EventType,
             CInt))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (Window, Position, Position, EventType, EventType, EventType, CInt)
    forall a. Maybe a
    Nothing
                        case Maybe
      (Window, Position, Position, EventType, EventType, EventType, CInt)
    g' of
                          Nothing                   -> String -> Decoder Bool
    append " (deleted)"
                          Just (_,x :: Position
    x,y :: Position
    y,wid :: EventType
    wid,ht :: EventType
    ht,bw :: EventType
    bw,dp :: CInt
    dp) ->
                              String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                                         [" ("
                                         ,EventType -> String
    forall a. Show a => a -> String
    show EventType
    wid
                                         ,'x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :EventType -> String
    forall a. Show a => a -> String
    show EventType
    ht
                                         ,'x'Char -> String -> String
    forall a. a -> [a] -> [a]
    :CInt -> String
    forall a. Show a => a -> String
    show CInt
    dp
                                         ,')'Char -> String -> String
    forall a. a -> [a] -> [a]
    :if EventType
    bw EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then "" else '+'Char -> String -> String
    forall a. a -> [a] -> [a]
    :EventType -> String
    forall a. Show a => a -> String
    show EventType
    bw
                                         ,"@("
                                         ,Position -> String
    forall a. Show a => a -> String
    show Position
    x
                                         ,','Char -> String -> String
    forall a. a -> [a] -> [a]
    :Position -> String
    forall a. Show a => a -> String
    show Position
    y
                                         ,")"
                                         ]

    dumpOLAttrs :: Decoder Bool
    dumpOLAttrs :: Decoder Bool
    dumpOLAttrs = do
      Window
    pt <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ String -> X Window
    getAtom "_OL_WIN_ATTR"
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    pt (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe Integer
    msk <- Int -> Decoder (Maybe Integer)
    getInt' 32
        case Maybe Integer
    msk of
          Nothing   -> Decoder Bool
    propShortErr
          Just msk' :: Integer
    msk' -> CULong -> [(String, Decoder Bool)] -> Decoder Bool
    dumpListByMask (Integer -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    msk') [("window type" ,Decoder Bool
    dumpAtom     )
                                                          ,("menu"        ,Decoder Bool
    dump32       ) -- @@@ unk
                                                          ,("pushpin"     ,[String] -> Decoder Bool
    dumpEnum [String]
    bool)
                                                          ,("limited menu",Decoder Bool
    dump32       ) -- @@@ unk
                                                          ]

    dumpMwmHints :: Decoder Bool
    dumpMwmHints :: Decoder Bool
    dumpMwmHints =  do
      Window
    ta <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    property
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    ta (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe Integer
    msk <- Int -> Decoder (Maybe Integer)
    getInt' 32
        case Maybe Integer
    msk of
          Nothing   -> Decoder Bool
    propShortErr
          Just msk' :: Integer
    msk' -> CULong -> [(String, Decoder Bool)] -> Decoder Bool
    dumpListByMask (Integer -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    msk') [("functions"  ,[String] -> Decoder Bool
    dumpBits [String]
    mwmFuncs    )
                                                          ,("decorations",[String] -> Decoder Bool
    dumpBits [String]
    mwmDecos    )
                                                          ,("input mode" ,[String] -> Decoder Bool
    dumpEnum [String]
    mwmInputMode)
                                                          ,("status"     ,[String] -> Decoder Bool
    dumpBits [String]
    mwmState    )
                                                          ]

    dumpMwmInfo :: Decoder Bool
    dumpMwmInfo :: Decoder Bool
    dumpMwmInfo =  do
      Window
    ta <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    property
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    ta (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpList' [("flags" ,[String] -> Decoder Bool
    dumpBits [String]
    mwmHints,Window
    cARDINAL)
                               ,("window",Decoder Bool
    dumpWindow       ,Window
    wINDOW  )
                               ]

    -- the most common case
    dumpEnum    :: [String] -> Decoder Bool
    dumpEnum :: [String] -> Decoder Bool
    dumpEnum ss :: [String]
    ss =  [String] -> Window -> Decoder Bool
    dumpEnum' [String]
    ss Window
    cARDINAL

    -- implement exceptional cases atop a normal dumper
    -- @@@ there's gotta be a better way
    dumpExcept           :: [(Integer,String)] -> Decoder Bool -> Decoder Bool
    dumpExcept :: [(Integer, String)] -> Decoder Bool -> Decoder Bool
    dumpExcept xs :: [(Integer, String)]
    xs item :: Decoder Bool
    item = do
      -- this horror brought to you by reparsing to get the right value for our use
      DecodeState
    sp <- Decoder DecodeState
    forall s (m :: * -> *). MonadState s m => m s
    get
      Bool
    rc <- Decoder Bool
    item
      if Bool -> Bool
    not Bool
    rc then Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False else do
        DecodeState
    that <- Decoder DecodeState
    forall s (m :: * -> *). MonadState s m => m s
    get -- if none match then we just restore the value parse
        [CUChar]
    vs <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
        let w :: Int
    w = ([CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (DecodeState -> [CUChar]
    value DecodeState
    sp) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CUChar]
    vs) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * 8
        -- now we get to reparse again so we get our copy of it
        DecodeState -> Decoder ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put DecodeState
    sp
        Integer
    v <- (Maybe Integer -> Integer)
    -> Decoder (Maybe Integer) -> Decoder Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe Integer -> Integer
    forall a. HasCallStack => Maybe a -> a
    fromJust (Int -> Decoder (Maybe Integer)
    getInt' Int
    w)
        -- and after all that, we can process the exception list
        [(Integer, String)] -> DecodeState -> Integer -> Decoder Bool
    dumpExcept' [(Integer, String)]
    xs DecodeState
    that Integer
    v

    dumpExcept'                                      :: [(Integer,String)]
                                                     -> DecodeState
                                                     -> Integer
                                                     -> Decoder Bool
    dumpExcept' :: [(Integer, String)] -> DecodeState -> Integer -> Decoder Bool
    dumpExcept' []             that :: DecodeState
    that _                =  DecodeState -> Decoder ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put DecodeState
    that Decoder () -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    dumpExcept' ((exc :: Integer
    exc,str :: String
    str):xs :: [(Integer, String)]
    xs) that :: DecodeState
    that val :: Integer
    val | Integer
    exc Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    val =  String -> Decoder Bool
    append String
    str
                                        | Bool
    otherwise  =  [(Integer, String)] -> DecodeState -> Integer -> Decoder Bool
    dumpExcept' [(Integer, String)]
    xs DecodeState
    that Integer
    val

    -- use @ps@ to get process information.
    -- @@@@ assumes a POSIX @ps@, not a BSDish one.
    dumpPid :: Decoder Bool
    dumpPid :: Decoder Bool
    dumpPid =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    cARDINAL (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                 Maybe Integer
    n <- Int -> Decoder (Maybe Integer)
    getInt' 32
                 case Maybe Integer
    n of
                   Nothing   -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                   Just pid' :: Integer
    pid' -> do
                          let pid :: String
    pid = Integer -> String
    forall a. Show a => a -> String
    show Integer
    pid'
                              ps :: CreateProcess
    ps  = (String -> [String] -> CreateProcess
    proc "/bin/ps" ["-fp" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pid]) {std_out :: StdStream
    std_out = StdStream
    CreatePipe}
                          (_,o :: Maybe Handle
    o,_,_) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> Decoder
         (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
     -> Decoder
          (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> Decoder
         (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    forall a b. (a -> b) -> a -> b
    $ CreateProcess
    -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    createProcess CreateProcess
    ps
                          case Maybe Handle
    o of
                            Nothing -> String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "pid " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pid
                            Just p' :: Handle
    p' -> do
                                      [String]
    prc <- IO [String] -> Decoder [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [String] -> Decoder [String])
    -> IO [String] -> Decoder [String]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines (String -> [String]) -> IO String -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Handle -> IO String
    hGetContents Handle
    p'
                                      -- deliberately forcing it
                                      String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ if [String] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    prc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 2
                                               then "pid " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    pid
                                               else [String]
    prc [String] -> Int -> String
    forall a. [a] -> Int -> a
    !! 1

    dumpTime :: Decoder Bool
    dumpTime :: Decoder Bool
    dumpTime =  String -> Decoder Bool
    append "server event # " Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Decoder Bool
    dump32

    dumpState :: Decoder Bool
    dumpState :: Decoder Bool
    dumpState =  do
      Window
    wM_STATE <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ String -> X Window
    getAtom "WM_STATE"
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    wM_STATE (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpList' [("state"      ,[String] -> Decoder Bool
    dumpEnum [String]
    wmState,Window
    cARDINAL)
                                     ,("icon window",Decoder Bool
    dumpWindow      ,Window
    wINDOW  )
                                     ]

    dumpMotifDragReceiver :: Decoder Bool
    dumpMotifDragReceiver :: Decoder Bool
    dumpMotifDragReceiver =  do
      Window
    ta <- X Window -> Decoder Window
    forall a. X a -> Decoder a
    inX (X Window -> Decoder Window) -> X Window -> Decoder Window
    forall a b. (a -> b) -> a -> b
    $ String -> X Window
    getAtom "_MOTIF_DRAG_RECEIVER_INFO"
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    ta (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpList' [("endian"    ,Decoder Bool
    dumpMotifEndian,Window
    cARDINAL)
                               ,("version"   ,Decoder Bool
    dump8          ,Window
    cARDINAL)
                               ,("style"     ,Decoder Bool
    dumpMDropStyle ,Window
    cARDINAL) -- @@@ dummy
                               ]

    dumpMDropStyle :: Decoder Bool
    dumpMDropStyle :: Decoder Bool
    dumpMDropStyle =  do
      Maybe Integer
    d <- Int -> Decoder (Maybe Integer)
    getInt' 8
      Int -> Decoder Bool -> Decoder Bool
    pad 1 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ case Maybe Integer
    d of
                Nothing             -> Decoder Bool
    propShortErr
                Just ps :: Integer
    ps | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0   -> Int -> Decoder Bool -> Decoder Bool
    pad 12 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "none"
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1   -> Int -> Decoder Bool -> Decoder Bool
    pad 12 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "drop only"
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 2   ->          String -> Decoder Bool
    append "prefer preregister " Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Decoder Bool
    dumpMDPrereg
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 3   ->          String -> Decoder Bool
    append "preregister "        Decoder Bool -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Decoder Bool
    dumpMDPrereg
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 4   -> Int -> Decoder Bool -> Decoder Bool
    pad 12 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "prefer dynamic"
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 5   -> Int -> Decoder Bool -> Decoder Bool
    pad 12 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "dynamic"
                        | Integer
    ps Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == 6   -> Int -> Decoder Bool -> Decoder Bool
    pad 12 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append "prefer receiver"
                        | Bool
    otherwise -> String -> Decoder Bool
    failure (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "unknown drop style " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    ps

    dumpMDPrereg :: Decoder Bool
    dumpMDPrereg :: Decoder Bool
    dumpMDPrereg =  do
      -- this is a bit ugly; we pretend to be extending the above dumpList'
      String -> Decoder Bool
    append ","
      String -> Decoder Bool
    append "proxy window = "
      Int -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a
    withIndent 15 Decoder Bool
    dumpWindow
      String -> Decoder Bool
    append ","
      String -> Decoder Bool
    append "drop sites = "
      Maybe Integer
    dsc' <- Int -> Decoder (Maybe Integer)
    getInt' 16
      case Maybe Integer
    dsc' of
        Nothing  -> Decoder Bool
    propShortErr
        Just dsc :: Integer
    dsc -> do
          Int -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a
    withIndent 13 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Decoder Bool
    append (Integer -> String
    forall a. Show a => a -> String
    show Integer
    dsc)
          Int -> Decoder Bool -> Decoder Bool
    pad 2 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
            String -> Decoder Bool
    append ","
            String -> Decoder Bool
    append "total size = "
            Int -> Decoder Bool -> Decoder Bool
    forall a. Int -> Decoder a -> Decoder a
    withIndent 13 Decoder Bool
    dump32
            Int -> Decoder Bool
    dumpMDBlocks (Int -> Decoder Bool) -> Int -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    dsc

    dumpMDBlocks   :: Int -> Decoder Bool
    dumpMDBlocks :: Int -> Decoder Bool
    dumpMDBlocks _ =  String -> Decoder Bool
    propSimple "(drop site info)" -- @@@ maybe later if needed

    dumpMotifEndian :: Decoder Bool
    dumpMotifEndian :: Decoder Bool
    dumpMotifEndian =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    cARDINAL (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Int -> Decoder Bool -> Decoder Bool
    guardSize 8 (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
      String
    c <- (CUChar -> Char) -> [CUChar] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map CUChar -> Char
    forall a b. (Enum a, Enum b) => a -> b
    twiddle ([CUChar] -> String) -> Decoder [CUChar] -> Decoder String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Int -> Decoder [CUChar]
    eat 1
      case String
    c of
        ['l'] -> String -> Decoder Bool
    append "little"
        ['B'] -> String -> Decoder Bool
    append "big"
        _     -> String -> Decoder Bool
    failure "bad endian flag"

    pad     :: Int -> Decoder Bool -> Decoder Bool
    pad :: Int -> Decoder Bool -> Decoder Bool
    pad n :: Int
    n p :: Decoder Bool
    p =  do
      [CUChar]
    vs <- (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
      if [CUChar] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [CUChar]
    vs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    n
        then Decoder Bool
    propShortErr
        else (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {value :: [CUChar]
    value = Int -> [CUChar] -> [CUChar]
    forall a. Int -> [a] -> [a]
    drop Int
    n [CUChar]
    vs}) Decoder () -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Decoder Bool
    p

    dumpPercent :: Decoder Bool
    dumpPercent :: Decoder Bool
    dumpPercent =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    cARDINAL (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                     Maybe Integer
    n <- Int -> Decoder (Maybe Integer)
    getInt' 32
                     case Maybe Integer
    n of
                       Nothing -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                       Just n' :: Integer
    n' ->
                           let pct :: Double
    pct = 100 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Integer -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n' Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / EventType -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (EventType
    forall a. Bounded a => a
    maxBound :: Word32)
                               pct :: Double
                            in String -> Decoder Bool
    append (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ Integer -> String
    forall a. Show a => a -> String
    show (Double -> Integer
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    pct :: Integer) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "%"

    dumpWmHints :: Decoder Bool
    dumpWmHints :: Decoder Bool
    dumpWmHints =
      Window -> Decoder Bool -> Decoder Bool
    guardType Window
    wM_HINTS (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
      Maybe Integer
    msk <- Int -> Decoder (Maybe Integer)
    getInt' 32
      case Maybe Integer
    msk of
        Nothing   -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        Just msk' :: Integer
    msk' -> CULong -> [(String, Decoder Bool, Window)] -> Decoder Bool
    dumpListByMask' (Integer -> CULong
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    msk')
                                     [("input"        ,[String] -> Decoder Bool
    dumpEnum [String]
    bool   ,Window
    cARDINAL)
                                     ,("initial_state",[String] -> Decoder Bool
    dumpEnum [String]
    wmState,Window
    cARDINAL)
                                     ,("icon_pixmap"  ,Decoder Bool
    dumpPixmap      ,Window
    pIXMAP  )
                                     ,("icon_window"  ,Decoder Bool
    dumpWindow      ,Window
    wINDOW  )
                                     ,("icon_x"       ,Decoder Bool
    dump32          ,Window
    cARDINAL)
                                     ,("icon_y"       ,Decoder Bool
    dump32          ,Window
    cARDINAL)
                                     ,("icon_mask"    ,Decoder Bool
    dumpPixmap      ,Window
    pIXMAP  )
                                     ,("window_group" ,Decoder Bool
    dumpWindow      ,Window
    wINDOW  )
                                     ]

    dumpBits    :: [String] -> Decoder Bool
    dumpBits :: [String] -> Decoder Bool
    dumpBits bs :: [String]
    bs =  Window -> Decoder Bool -> Decoder Bool
    guardType Window
    cARDINAL (Decoder Bool -> Decoder Bool) -> Decoder Bool -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ do
                     Maybe Integer
    n <- Int -> Decoder (Maybe Integer)
    getInt' 32
                     case Maybe Integer
    n of
                       Nothing -> Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                       Just n' :: Integer
    n' -> [String] -> Int -> Int -> String -> Decoder Bool
    dumpBits' [String]
    bs 1 (Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    n') ""

    dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool
    dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool
    dumpBits' []     _ n :: Int
    n p :: String
    p = if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 0 then Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True else String -> Decoder Bool
    append (String
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    n)
    dumpBits' (s :: String
    s:ss :: [String]
    ss) b :: Int
    b n :: Int
    n p :: String
    p = do
      String
    p' <- if Int
    n Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    b Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0
            then String -> Decoder Bool
    append (String
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s) Decoder Bool -> Decoder String -> Decoder String
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Decoder String
    forall (m :: * -> *) a. Monad m => a -> m a
    return "|"
            else String -> Decoder String
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    p
      [String] -> Int -> Int -> String -> Decoder Bool
    dumpBits' [String]
    ss (Int
    b Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` 1) (Int
    n Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int -> Int
    forall a. Bits a => a -> a
    complement Int
    b) String
    p'

    -- enum definitions --

    mwmFuncs :: [String]
    mwmFuncs :: [String]
    mwmFuncs =  ["all except"
                ,"resize"
                ,"move"
                ,"minimize"
                ,"maximize"
                ,"close"
                ]

    mwmDecos :: [String]
    mwmDecos :: [String]
    mwmDecos =  ["all except"
                ,"border"
                ,"resize handle"
                ,"title"
                ,"menu button"
                ,"maximize button"
                ,"minimize button"
                ]

    mwmInputMode :: [String]
    mwmInputMode :: [String]
    mwmInputMode =  ["modeless"
                    ,"application modal"
                    ,"system model"
                    ,"full application modal"
                    ]

    mwmState :: [String]
    mwmState :: [String]
    mwmState =  ["tearoff window"
                ]

    mwmHints :: [String]
    mwmHints :: [String]
    mwmHints =  ["standard startup"
                ,"custom startup"
                ]

    awSource :: [String]
    awSource :: [String]
    awSource =  ["unspecified"
                ,"application"
                ,"pager/task list"
                ]

    {- eventually...
    wmHintsFlags :: [String]
    wmHintsFlags =  ["Input"
                    ,"State"
                    ,"IconPixmap"
                    ,"IconWindow"
                    ,"IconX"
                    ,"IconY"
                    ,"IconMask"
                    ,"WindowGroup"
                    ]

    wmCRMask :: [String]
    wmCRMask =  ["X"
                ,"Y"
                ,"Width"
                ,"Height"
                ,"BorderWidth"
                ,"Sibling"
                ,"StackMode"
                ]
    -}

    wmPlacement :: [String]
    wmPlacement :: [String]
    wmPlacement =  ["Above"
                   ,"Below"
                   ,"TopIf"
                   ,"BottomIf"
                   ,"Opposite"
                   ]

    bool :: [String]
    bool :: [String]
    bool =  ["False","True"]

    nwmOrientation :: [String]
    nwmOrientation :: [String]
    nwmOrientation =  Maybe String -> [String] -> [String]
    nwmEnum (String -> Maybe String
    forall a. a -> Maybe a
    Just "ORIENTATION") ["HORZ","VERT"]

    nwmOrigin :: [String]
    nwmOrigin :: [String]
    nwmOrigin =  Maybe String -> [String] -> [String]
    nwmEnum Maybe String
    forall a. Maybe a
    Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"]

    wmState :: [String]
    wmState :: [String]
    wmState =  ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"]

    nwmEnum                  :: Maybe String
                             -> [String]
                             -> [String]
    nwmEnum :: Maybe String -> [String] -> [String]
    nwmEnum Nothing       vs :: [String]
    vs =  (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ( "_NET_WM_"                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) [String]
    vs
    nwmEnum (Just prefix :: String
    prefix) vs :: [String]
    vs =  (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (("_NET_WM_" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "_") String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) [String]
    vs

    -- and the lowest level coercions --

    -- parse and return an integral value
    getInt'    :: Int -> Decoder (Maybe Integer)
    -- see XSync documentation for this insanity
    getInt' :: Int -> Decoder (Maybe Integer)
    getInt' 64 =  (Decode -> Int)
    -> Int
    -> (Int -> Int -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    forall r (m :: * -> *) v a.
    (MonadReader r m, Eq v) =>
    (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR Decode -> Int
    width 32 (\a :: Int
    a e :: Int
    e -> Int -> Int -> Decoder Bool
    propSizeErr Int
    a Int
    e Decoder Bool -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Integer -> Decoder (Maybe Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Integer
    forall a. Maybe a
    Nothing) (Decoder (Maybe Integer) -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall a b. (a -> b) -> a -> b
    $
                  Int
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    forall a. Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' 8 (Decoder Bool
    propShortErr Decoder Bool -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Integer -> Decoder (Maybe Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Integer
    forall a. Maybe a
    Nothing) (Decoder (Maybe Integer) -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall a b. (a -> b) -> a -> b
    $ do
                    Integer
    lo <- Int -> Decoder Integer
    inhale 32
                    Integer
    hi <- Int -> Decoder Integer
    inhale 32
                    Maybe Integer -> Decoder (Maybe Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Integer -> Decoder (Maybe Integer))
    -> Maybe Integer -> Decoder (Maybe Integer)
    forall a b. (a -> b) -> a -> b
    $ Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ Integer
    lo Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    hi Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * (EventType -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (EventType
    forall a. Bounded a => a
    maxBound :: Word32) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + 1)
    getInt' w :: Int
    w  =  (Decode -> Int)
    -> Int
    -> (Int -> Int -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    forall r (m :: * -> *) v a.
    (MonadReader r m, Eq v) =>
    (r -> v) -> v -> (v -> v -> m a) -> m a -> m a
    guardR Decode -> Int
    width Int
    w  (\a :: Int
    a e :: Int
    e -> Int -> Int -> Decoder Bool
    propSizeErr Int
    a Int
    e Decoder Bool -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Integer -> Decoder (Maybe Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Integer
    forall a. Maybe a
    Nothing) (Decoder (Maybe Integer) -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall a b. (a -> b) -> a -> b
    $
                  Int
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    -> Decoder (Maybe Integer)
    forall a. Int -> Decoder a -> Decoder a -> Decoder a
    guardSize' (Int -> Int
    bytes Int
    w) (Decoder Bool
    propShortErr Decoder Bool -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe Integer -> Decoder (Maybe Integer)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Integer
    forall a. Maybe a
    Nothing)       (Decoder (Maybe Integer) -> Decoder (Maybe Integer))
    -> Decoder (Maybe Integer) -> Decoder (Maybe Integer)
    forall a b. (a -> b) -> a -> b
    $
                  Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Integer -> Maybe Integer)
    -> Decoder Integer -> Decoder (Maybe Integer)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Int -> Decoder Integer
    inhale Int
    w

    -- parse an integral value and feed it to a show-er of some kind
    getInt     :: Int -> (Integer -> String) -> Decoder Bool
    getInt :: Int -> (Integer -> String) -> Decoder Bool
    getInt w :: Int
    w f :: Integer -> String
    f =  Int -> Decoder (Maybe Integer)
    getInt' Int
    w Decoder (Maybe Integer)
    -> (Maybe Integer -> Decoder Bool) -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Decoder Bool
    -> (Integer -> Decoder Bool) -> Maybe Integer -> Decoder Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False) (String -> Decoder Bool
    append (String -> Decoder Bool)
    -> (Integer -> String) -> Integer -> Decoder Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> String
    f)

    -- bottommost level:  parse an integral value out of the stream.
    -- Not much in the way of error checking; it is assumed you used
    -- the appropriate guards.
    -- @@@@@@@@@ evil beyond evil.  there *has* to be a better way
    inhale    :: Int -> Decoder Integer
    inhale :: Int -> Decoder Integer
    inhale  8 =  do
                   [CUChar]
    x <- Int -> Decoder [CUChar]
    eat 1
                   case [CUChar]
    x of
                     [b :: CUChar
    b] -> Integer -> Decoder Integer
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Decoder Integer) -> Integer -> Decoder Integer
    forall a b. (a -> b) -> a -> b
    $ CUChar -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CUChar
    b
    inhale 16 =  do
                   [CUChar]
    x <- Int -> Decoder [CUChar]
    eat 2
                   case [CUChar]
    x of
                     [b0 :: CUChar
    b0,b1 :: CUChar
    b1] -> IO Integer -> Decoder Integer
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Integer -> Decoder Integer) -> IO Integer -> Decoder Integer
    forall a b. (a -> b) -> a -> b
    $ Int -> (Ptr CUChar -> IO Integer) -> IO Integer
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray 2 ((Ptr CUChar -> IO Integer) -> IO Integer)
    -> (Ptr CUChar -> IO Integer) -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr CUChar
    p -> do
                                  Ptr CUChar -> [CUChar] -> IO ()
    forall a. Storable a => Ptr a -> [a] -> IO ()
    pokeArray Ptr CUChar
    p [CUChar
    b0,CUChar
    b1]
                                  [v :: Word16
    v] <- Int -> Ptr Word16 -> IO [Word16]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray 1 (Ptr CUChar -> Ptr Word16
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CUChar
    p :: Ptr Word16)
                                  Integer -> IO Integer
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> IO Integer) -> Integer -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ Word16 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word16
    v
    inhale 32 =  do
                   [CUChar]
    x <- Int -> Decoder [CUChar]
    eat 4
                   case [CUChar]
    x of
                     [b0 :: CUChar
    b0,b1 :: CUChar
    b1,b2 :: CUChar
    b2,b3 :: CUChar
    b3] -> IO Integer -> Decoder Integer
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Integer -> Decoder Integer) -> IO Integer -> Decoder Integer
    forall a b. (a -> b) -> a -> b
    $ Int -> (Ptr CUChar -> IO Integer) -> IO Integer
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
    allocaArray 4 ((Ptr CUChar -> IO Integer) -> IO Integer)
    -> (Ptr CUChar -> IO Integer) -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ \p :: Ptr CUChar
    p -> do
                                        Ptr CUChar -> [CUChar] -> IO ()
    forall a. Storable a => Ptr a -> [a] -> IO ()
    pokeArray Ptr CUChar
    p [CUChar
    b0,CUChar
    b1,CUChar
    b2,CUChar
    b3]
                                        [v :: EventType
    v] <- Int -> Ptr EventType -> IO [EventType]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray 1 (Ptr CUChar -> Ptr EventType
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CUChar
    p :: Ptr Word32)
                                        Integer -> IO Integer
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> IO Integer) -> Integer -> IO Integer
    forall a b. (a -> b) -> a -> b
    $ EventType -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral EventType
    v
    inhale  b :: Int
    b =  String -> Decoder Integer
    forall a. HasCallStack => String -> a
    error (String -> Decoder Integer) -> String -> Decoder Integer
    forall a b. (a -> b) -> a -> b
    $ "inhale " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    b

    eat   :: Int -> Decoder Raw
    eat :: Int -> Decoder [CUChar]
    eat n :: Int
    n =  do
      (bs :: [CUChar]
    bs,rest :: [CUChar]
    rest) <- Int -> [CUChar] -> ([CUChar], [CUChar])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    n ([CUChar] -> ([CUChar], [CUChar]))
    -> Decoder [CUChar] -> Decoder ([CUChar], [CUChar])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (DecodeState -> [CUChar]) -> Decoder [CUChar]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> [CUChar]
    value
      (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {value :: [CUChar]
    value = [CUChar]
    rest})
      [CUChar] -> Decoder [CUChar]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CUChar]
    bs

    -- actually do formatting type stuffs
    -- sorta stubbed for the moment
    -- eventually we should do indentation foo here
    append :: String -> Decoder Bool
    append :: String -> Decoder Bool
    append =  Bool -> String -> Decoder Bool
    append' Bool
    True

    -- and the same but for errors
    failure :: String -> Decoder Bool
    failure :: String -> Decoder Bool
    failure =  Bool -> String -> Decoder Bool
    append' Bool
    False

    -- common appender
    append'     :: Bool -> String -> Decoder Bool
    append' :: Bool -> String -> Decoder Bool
    append' b :: Bool
    b s :: String
    s =  do
      String
    j <- (DecodeState -> String) -> Decoder String
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets DecodeState -> String
    joint
      (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {accum :: String
    accum = DecodeState -> String
    accum DecodeState
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    j String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s})
      Bool -> Decoder Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b

    -- consume all and output a constant string
    propSimple   :: String -> Decoder Bool
    propSimple :: String -> Decoder Bool
    propSimple s :: String
    s =  (DecodeState -> DecodeState) -> Decoder ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (\r :: DecodeState
    r -> DecodeState
    r {value :: [CUChar]
    value = []}) Decoder () -> Decoder Bool -> Decoder Bool
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> Decoder Bool
    append String
    s

    -- report various errors
    propShortErr :: Decoder Bool
    propShortErr :: Decoder Bool
    propShortErr =  String -> Decoder Bool
    failure "(property ended prematurely)"

    propSizeErr     :: Int -> Int -> Decoder Bool
    propSizeErr :: Int -> Int -> Decoder Bool
    propSizeErr e :: Int
    e a :: Int
    a =  String -> Decoder Bool
    failure (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "(bad bit width " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 Int -> String
    forall a. Show a => a -> String
    show Int
    a            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 "; expected "     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 Int -> String
    forall a. Show a => a -> String
    show Int
    e            String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                 ")"

    propTypeErr     :: Atom -> Atom -> Decoder Bool
    propTypeErr :: Window -> Window -> Decoder Bool
    propTypeErr a :: Window
    a e :: Window
    e =  do
      String
    e' <- X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    atomName Window
    e
      String
    a' <- X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String) -> X String -> Decoder String
    forall a b. (a -> b) -> a -> b
    $ Window -> X String
    atomName Window
    a
      String -> Decoder Bool
    failure (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "(bad type " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++"; expected " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    e' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"

    -- for stubs
    (...) :: Decoder Bool
    ... :: Decoder Bool
    (...) =  do
      String
    fmt <- (Decode -> Window) -> Decoder Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks Decode -> Window
    pType Decoder Window -> (Window -> Decoder String) -> Decoder String
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= X String -> Decoder String
    forall a. X a -> Decoder a
    inX (X String -> Decoder String)
    -> (Window -> X String) -> Window -> Decoder String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> X String
    atomName
      String -> Decoder Bool
    propSimple (String -> Decoder Bool) -> String -> Decoder Bool
    forall a b. (a -> b) -> a -> b
    $ "(unimplemented type " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fmt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"

    -- you like fi, I like this
    twiddle :: (Enum a, Enum b) => a -> b
    twiddle :: a -> b
    twiddle =  Int -> b
    forall a. Enum a => Int -> a
    toEnum (Int -> b) -> (a -> Int) -> a -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Int
    forall a. Enum a => a -> Int
    fromEnum