{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}
module XMonad.Hooks.DebugEvents (debugEventsHook) where
import Prelude
import XMonad hiding (windowEvent
,(-->)
)
import XMonad.Prelude hiding (fi, bool)
import XMonad.Hooks.DebugKeyEvents (debugKeyEvents)
import XMonad.Util.DebugWindow (debugWindow)
import Control.Exception as E
import Control.Monad.Fail
import Control.Monad.State
import Control.Monad.Reader
import Codec.Binary.UTF8.String
import Foreign
import Foreign.C.Types
import Numeric (showHex)
import System.Exit
import System.IO
import System.Process
debugEventsHook :: Event -> X All
debugEventsHook :: Event -> X All
debugEventsHook Event
e = Event -> X ()
debugEventsHook' Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
debugEventsHook' :: Event -> X ()
debugEventsHook' :: Event -> X ()
debugEventsHook' ConfigureRequestEvent{ev_window :: Event -> Word32
ev_window = Word32
w
,ev_parent :: Event -> Word32
ev_parent = Word32
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 -> Word32
ev_above = Word32
above
,ev_detail :: Event -> CInt
ev_detail = CInt
place
,ev_value_mask :: Event -> CULong
ev_value_mask = CULong
msk
} = do
String -> Word32 -> X ()
windowEvent String
"ConfigureRequest" Word32
w
String -> Word32 -> X ()
windowEvent String
" parent" Word32
p
String
s <- forall i.
(Storable i, Integral i) =>
[i] -> Decoder Bool -> X String
quickFormat [CInt
x,CInt
y,CInt
wid,CInt
ht,CInt
bw,forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
above,CInt
place] forall a b. (a -> b) -> a -> b
$
CULong -> [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpListByMask' CULong
msk [(String
"x" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"y" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"width" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"height" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"border_width",Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"sibling" ,Decoder Bool
dumpWindow ,Word32
wINDOW )
,(String
"detail" ,[String] -> Decoder Bool
dumpEnum [String]
wmPlacement,Word32
cARDINAL)
]
String -> String -> X ()
say String
" requested" String
s
debugEventsHook' ConfigureEvent {ev_window :: Event -> Word32
ev_window = Word32
w
,ev_above :: Event -> Word32
ev_above = Word32
above
} = do
String -> Word32 -> X ()
windowEvent String
"Configure" Word32
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
above forall a. Eq a => a -> a -> Bool
/= Word32
none) forall a b. (a -> b) -> a -> b
$ Word32 -> X String
debugWindow Word32
above forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> X ()
say String
" above"
debugEventsHook' MapRequestEvent {ev_window :: Event -> Word32
ev_window = Word32
w
,ev_parent :: Event -> Word32
ev_parent = Word32
p
} =
String -> Word32 -> X ()
windowEvent String
"MapRequest" Word32
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Word32 -> X ()
windowEvent String
" parent" Word32
p
debugEventsHook' e :: Event
e@KeyEvent {ev_event_type :: Event -> Word32
ev_event_type = Word32
t}
| Word32
t forall a. Eq a => a -> a -> Bool
== Word32
keyPress =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Handle -> String -> IO ()
hPutStr Handle
stderr String
"KeyPress ") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Event -> X All
debugKeyEvents Event
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) a. Monad m => a -> m a
return ()
debugEventsHook' ButtonEvent {ev_window :: Event -> Word32
ev_window = Word32
w
,ev_state :: Event -> KeyMask
ev_state = KeyMask
s
,ev_button :: Event -> Word32
ev_button = Word32
b
} = do
String -> Word32 -> X ()
windowEvent String
"Button" Word32
w
KeyMask
nl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> KeyMask
numberlockMask
let msk :: String
msk | KeyMask
s forall a. Eq a => a -> a -> Bool
== KeyMask
0 = String
""
| Bool
otherwise = String
"modifiers " forall a. [a] -> [a] -> [a]
++ KeyMask -> KeyMask -> String
keymaskToString KeyMask
nl KeyMask
s
String -> String -> X ()
say String
" button" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Word32
b forall a. [a] -> [a] -> [a]
++ String
msk
debugEventsHook' DestroyWindowEvent {ev_window :: Event -> Word32
ev_window = Word32
w
} =
String -> Word32 -> X ()
windowEvent String
"DestroyWindow" Word32
w
debugEventsHook' UnmapEvent {ev_window :: Event -> Word32
ev_window = Word32
w
} =
String -> Word32 -> X ()
windowEvent String
"Unmap" Word32
w
debugEventsHook' MapNotifyEvent {ev_window :: Event -> Word32
ev_window = Word32
w
} =
String -> Word32 -> X ()
windowEvent String
"MapNotify" Word32
w
debugEventsHook' CrossingEvent {} =
forall (m :: * -> *) a. Monad m => a -> m a
return ()
debugEventsHook' SelectionRequest {ev_requestor :: Event -> Word32
ev_requestor = Word32
rw
,ev_owner :: Event -> Word32
ev_owner = Word32
ow
,ev_selection :: Event -> Word32
ev_selection = Word32
a
} =
String -> Word32 -> X ()
windowEvent String
"SelectionRequest" Word32
rw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Word32 -> X ()
windowEvent String
" owner" Word32
ow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Word32 -> X ()
atomEvent String
" atom" Word32
a
debugEventsHook' PropertyEvent {ev_window :: Event -> Word32
ev_window = Word32
w
,ev_atom :: Event -> Word32
ev_atom = Word32
a
,ev_propstate :: Event -> CInt
ev_propstate = CInt
s
} = do
String
a' <- Word32 -> X String
atomName Word32
a
if String
a' forall a. Eq a => a -> a -> Bool
== String
"_NET_WM_USER_TIME" then forall (m :: * -> *) a. Monad m => a -> m a
return () else do
String -> Word32 -> X ()
windowEvent String
"Property on" Word32
w
String
s' <- case CInt
s of
CInt
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"deleted"
CInt
0 -> Word32 -> String -> Word32 -> Int -> X String
dumpProperty Word32
a String
a' Word32
w (Int
7 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a')
CInt
_ -> forall a. HasCallStack => String -> a
error String
"Illegal propState; Xlib corrupted?"
String -> String -> X ()
say String
" atom" forall a b. (a -> b) -> a -> b
$ String
a' forall a. [a] -> [a] -> [a]
++ String
s'
debugEventsHook' ExposeEvent {ev_window :: Event -> Word32
ev_window = Word32
w
} =
String -> Word32 -> X ()
windowEvent String
"Expose" Word32
w
debugEventsHook' ClientMessageEvent {ev_window :: Event -> Word32
ev_window = Word32
w
,ev_message_type :: Event -> Word32
ev_message_type = Word32
a
,ev_data :: Event -> [CInt]
ev_data = [CInt]
vs'
} = do
String -> Word32 -> X ()
windowEvent String
"ClientMessage on" Word32
w
String
n <- Word32 -> X String
atomName Word32
a
(Word32
ta,Int
b,Int
l) <- case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [(String, (String, Int, Int))]
clientMessages of
Maybe (String, Int, Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
a,Int
32,forall (t :: * -> *) a. Foldable t => t a -> Int
length [CInt]
vs')
Just (String
ta',Int
b,Int
l) -> do
Word32
ta <- String -> X Word32
getAtom String
ta'
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
ta,Int
b,Int
l)
let wl :: Int
wl = Int -> Int
bytes Int
b
[CUChar]
vs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (Int
l forall a. Num a => a -> a -> a
* Int
wl) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CInt] -> IO [CUChar]
splitCInt [CInt]
vs'
String
s <- Word32
-> Word32
-> String
-> Word32
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Word32
w Word32
a String
n Word32
ta Int
b [CUChar]
vs CULong
0 (Int
10 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
n)
String -> String -> X ()
say String
" message" forall a b. (a -> b) -> a -> b
$ String
n forall a. [a] -> [a] -> [a]
++ String
s
debugEventsHook' Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
atomName :: Atom -> X String
atomName :: Word32 -> X String
atomName Word32
a = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (String
"(unknown atom " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
a forall a. [a] -> [a] -> [a]
++ String
")") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Word32 -> IO (Maybe String)
getAtomName Display
d Word32
a
atomEvent :: String -> Atom -> X ()
atomEvent :: String -> Word32 -> X ()
atomEvent String
l Word32
a = Word32 -> X String
atomName Word32
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> X ()
say String
l
windowEvent :: String -> Window -> X ()
windowEvent :: String -> Word32 -> X ()
windowEvent String
l Word32
w = Word32 -> X String
debugWindow Word32
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> String -> X ()
say String
l
say :: String -> String -> X ()
say :: String -> String -> X ()
say String
l String
s = forall (m :: * -> *). MonadIO m => String -> m ()
trace forall a b. (a -> b) -> a -> b
$ String
l forall a. [a] -> [a] -> [a]
++ Char
' 'forall a. a -> [a] -> [a]
:String
s
splitCInt :: [CInt] -> IO Raw
splitCInt :: [CInt] -> IO [CUChar]
splitCInt [CInt]
vs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray [CInt]
vs forall a b. (a -> b) -> a -> b
$ \Ptr CInt
p ->
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
4 forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [CInt]
vs) (forall a b. Ptr a -> Ptr b
castPtr Ptr CInt
p :: Ptr CUChar)
clientMessages :: [(String,(String,Int,Int))]
clientMessages :: [(String, (String, Int, Int))]
clientMessages = [(String
"_NET_ACTIVE_WINDOW",(String
"_NET_ACTIVE_WINDOW",Int
32,Int
1))
,(String
"WM_CHANGE_STATE" ,(String
"WM_STATE" ,Int
32,Int
2))
,(String
"WM_COMMAND" ,(String
"STRING" , Int
8,Int
0))
,(String
"WM_SAVE_YOURSELF" ,(String
"STRING" , Int
8,Int
0))
]
type Raw = [CUChar]
data Decode = Decode {Decode -> Word32
property :: Atom
,Decode -> String
pName :: String
,Decode -> Word32
pType :: Atom
,Decode -> Int
width :: Int
,Decode -> Word32
window :: Window
,Decode -> Int
indent :: Int
,Decode -> Int
limit :: Int
}
data DecodeState = DecS {DecodeState -> [CUChar]
value :: Raw
,DecodeState -> String
accum :: String
,DecodeState -> String
joint :: String
}
newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)
#ifndef __HADDOCK__
deriving (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
<$ :: forall a b. a -> Decoder b -> Decoder a
$c<$ :: forall a b. a -> Decoder b -> Decoder a
fmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
$cfmap :: forall a b. (a -> b) -> Decoder a -> Decoder b
Functor
,Functor Decoder
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
<* :: forall a b. Decoder a -> Decoder b -> Decoder a
$c<* :: forall a b. Decoder a -> Decoder b -> Decoder a
*> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c*> :: forall a b. Decoder a -> Decoder b -> Decoder b
liftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
$cliftA2 :: forall a b c. (a -> b -> c) -> Decoder a -> Decoder b -> Decoder c
<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
$c<*> :: forall a b. Decoder (a -> b) -> Decoder a -> Decoder b
pure :: forall a. a -> Decoder a
$cpure :: forall a. a -> Decoder a
Applicative
,Applicative Decoder
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 :: forall a. a -> Decoder a
$creturn :: forall a. a -> Decoder a
>> :: forall a b. Decoder a -> Decoder b -> Decoder b
$c>> :: forall a b. Decoder a -> Decoder b -> Decoder b
>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
$c>>= :: forall a b. Decoder a -> (a -> Decoder b) -> Decoder b
Monad
,Monad Decoder
forall a. IO a -> Decoder a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Decoder a
$cliftIO :: forall a. IO a -> Decoder a
MonadIO
,Monad Decoder
forall a. String -> Decoder a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> Decoder a
$cfail :: forall a. String -> Decoder a
MonadFail
,MonadState DecodeState
,MonadReader Decode
)
#endif
dumpProperty :: Atom -> String -> Window -> Int -> X String
dumpProperty :: Word32 -> String -> Word32 -> Int -> X String
dumpProperty Word32
a String
n Word32
w Int
i = do
Either String (Word32, Int, CULong, [CUChar])
prop <- forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr Word32
fmtp ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CInt
szp ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CULong
lenp ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr CULong
ackp ->
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CUChar)
vsp -> do
CInt
rc <- Display
-> Word32
-> Word32
-> CLong
-> CLong
-> Bool
-> Word32
-> Ptr Word32
-> Ptr CInt
-> Ptr CULong
-> Ptr CULong
-> Ptr (Ptr CUChar)
-> IO CInt
xGetWindowProperty
Display
d
Word32
w
Word32
a
CLong
0
forall a. Bounded a => a
maxBound
Bool
False
Word32
anyPropertyType
Ptr Word32
fmtp
Ptr CInt
szp
Ptr CULong
lenp
Ptr CULong
ackp
Ptr (Ptr CUChar)
vsp
case CInt
rc of
CInt
0 -> do
Word32
fmt <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
fmtp
Ptr CUChar
vs' <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CUChar)
vsp
Int
sz <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
szp
case () of
() | Word32
fmt forall a. Eq a => a -> a -> Bool
== Word32
none -> forall a. Ptr a -> IO CInt
xFree Ptr CUChar
vs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left String
"(property deleted)" )
| Int
sz forall a. Ord a => a -> a -> Bool
< Int
0 -> forall a. Ptr a -> IO CInt
xFree Ptr CUChar
vs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"(illegal bit size " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++
String
")" )
| Int
sz forall a. Integral a => a -> a -> a
`mod` Int
8 forall a. Eq a => a -> a -> Bool
/= Int
0 -> forall a. Ptr a -> IO CInt
xFree Ptr CUChar
vs' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"(illegal bit size " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
sz forall a. [a] -> [a] -> [a]
++
String
")" )
| Bool
otherwise -> do
Int
len <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CULong
lenp
CULong
ack <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr CULong
ackp
[CUChar]
vs <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
len forall a. Num a => a -> a -> a
* Int -> Int
bytes Int
sz) Ptr CUChar
vs'
CInt
_ <- forall a. Ptr a -> IO CInt
xFree Ptr CUChar
vs'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Word32
fmt,Int
sz,CULong
ack,[CUChar]
vs)
CInt
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"getWindowProperty failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CInt
e
case Either String (Word32, Int, CULong, [CUChar])
prop of
Left String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Right (Word32
fmt,Int
sz,CULong
ack,[CUChar]
vs) -> Word32
-> Word32
-> String
-> Word32
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Word32
w Word32
a String
n Word32
fmt Int
sz [CUChar]
vs CULong
ack Int
i
dumpProperty' :: Window
-> Atom
-> String
-> Atom
-> Int
-> Raw
-> CULong
-> Int
-> X String
dumpProperty' :: Word32
-> Word32
-> String
-> Word32
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Word32
w Word32
a String
n Word32
fmt Int
sz [CUChar]
vs CULong
ack Int
i = do
String
ptn <- Word32 -> X String
atomName Word32
fmt
let dec :: Decode
dec = Decode {property :: Word32
property = Word32
a
,pName :: String
pName = String
n
,pType :: Word32
pType = Word32
fmt
,width :: Int
width = Int
sz
,indent :: Int
indent = Int
i forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ptn forall a. Num a => a -> a -> a
+ Int
6
,window :: Word32
window = Word32
w
,limit :: Int
limit = Int
96
}
dec' :: Decode
dec' = Decode
dec {pType :: Word32
pType = Word32
cARDINAL
,width :: Int
width = Int
8
}
ds :: DecodeState
ds = DecS {value :: [CUChar]
value = [CUChar]
vs
,accum :: String
accum = String
" (" forall a. [a] -> [a] -> [a]
++ String
ptn forall a. [a] -> [a] -> [a]
++ String
") "
,joint :: String
joint = String
"= "
}
(Bool
_,DecodeState
ds') <- Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
runDecode Decode
dec DecodeState
ds forall a b. (a -> b) -> a -> b
$ Word32 -> String -> Decoder Bool
dumpProp Word32
a String
n
let fin :: Int
fin = forall (t :: * -> *) a. Foldable t => t a -> Int
length (DecodeState -> [CUChar]
value DecodeState
ds')
len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs
lost :: String
lost = if CULong
ack forall a. Eq a => a -> a -> Bool
== CULong
0 then String
"" else String
"and " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CULong
ack forall a. [a] -> [a] -> [a]
++ String
" lost bytes"
unk :: String
unk = case () of
() | Int
fin forall a. Eq a => a -> a -> Bool
== Int
len -> String
"undecodeable "
| Int
fin forall a. Eq a => a -> a -> Bool
== Int
0 -> String
"."
| Bool
otherwise -> String
"and remainder (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Int
len forall a. Num a => a -> a -> a
- Int
fin) forall a. [a] -> [a] -> [a]
++ Char
'/'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Int
len forall a. [a] -> [a] -> [a]
++ String
")"
(Bool
_,DecodeState
ds'') <- if Int
fin forall a. Eq a => a -> a -> Bool
== Int
0
then 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' ) forall a b. (a -> b) -> a -> b
$ Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dump8
(Bool
_,DecodeState
ds''') <- if CULong
ack forall a. Eq a => a -> a -> Bool
== CULong
0
then 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
" " DecodeState
ds'') forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
propSimple String
lost
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DecodeState -> String
accum DecodeState
ds'''
quickFormat :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String
quickFormat :: forall i.
(Storable i, Integral i) =>
[i] -> Decoder Bool -> X String
quickFormat [i]
v Decoder Bool
f = do
let vl :: Int
vl = forall (t :: * -> *) a. Foldable t => t a -> Int
length [i]
v
[CUChar]
vs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
vl forall a b. (a -> b) -> a -> b
$
\Ptr CULong
p -> forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CULong
p (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [i]
v :: [CULong]) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (Int
4 forall a. Num a => a -> a -> a
* Int
vl) (forall a b. Ptr a -> Ptr b
castPtr Ptr CULong
p :: Ptr CUChar)
let dec :: Decode
dec = Decode {property :: Word32
property = Word32
none
,pName :: String
pName = String
""
,pType :: Word32
pType = Word32
cARDINAL
,width :: Int
width = Int
32
,indent :: Int
indent = Int
0
,window :: Word32
window = Word32
none
,limit :: Int
limit = forall a. Bounded a => a
maxBound
}
ds :: DecodeState
ds = DecS {value :: [CUChar]
value = [CUChar]
vs
,accum :: String
accum = String
""
,joint :: String
joint = String
""
}
(Bool
r,DecodeState
ds') <- Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
runDecode Decode
dec DecodeState
ds Decoder Bool
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DecodeState -> String
accum DecodeState
ds' forall a. [a] -> [a] -> [a]
++ if Bool
r then String
"" else String
"?"
runDecode :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState)
runDecode :: Decode -> DecodeState -> Decoder Bool -> X (Bool, DecodeState)
runDecode Decode
c DecodeState
s (Decoder ReaderT Decode (StateT DecodeState X) Bool
p) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Decode (StateT DecodeState X) Bool
p Decode
c) DecodeState
s
bytes :: Int -> Int
bytes :: Int -> Int
bytes Int
w = Int
w forall a. Integral a => a -> a -> a
`div` Int
8
dumpProp :: Atom -> String -> Decoder Bool
dumpProp :: Word32 -> String -> Decoder Bool
dumpProp Word32
_ String
"CLIPBOARD" = Decoder Bool
dumpSelection
dumpProp Word32
_ String
"_NET_SUPPORTED" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_NET_CLIENT_LIST" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_NET_CLIENT_LIST_STACKING" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_NET_NUMBER_OF_DESKTOPS" = Decoder Bool
dump32
dumpProp Word32
_ String
"_NET_VIRTUAL_ROOTS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_NET_DESKTOP_GEOMETRY" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dump32
dumpProp Word32
_ String
"_NET_DESKTOP_VIEWPORT" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
dumpProp Word32
_ String
"_NET_CURRENT_DESKTOP" = Decoder Bool
dump32
dumpProp Word32
_ String
"_NET_DESKTOP_NAMES" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpUTF
dumpProp Word32
_ String
"_NET_ACTIVE_WINDOW" = Decoder Bool
dumpActiveWindow
dumpProp Word32
_ String
"_NET_WORKAREA" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"start"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"x",Decoder Bool
dump32)
,(String
"y",Decoder Bool
dump32)
]
)
,(String
"size"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
)
]
dumpProp Word32
_ String
"_NET_SUPPORTING_WM_CHECK" = Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_NET_DESKTOP_LAYOUT" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"orientation"
,[String] -> Decoder Bool
dumpEnum [String]
nwmOrientation
)
,(String
"size"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"cols",Decoder Bool
dump32)
,(String
"rows",Decoder Bool
dump32)
]
)
,(String
"origin"
,[String] -> Decoder Bool
dumpEnum [String]
nwmOrigin
)
]
dumpProp Word32
_ String
"_NET_SHOWING_DESKTOP" = Decoder Bool
dump32
dumpProp Word32
_ String
"_NET_WM_NAME" = Decoder Bool
dumpUTF
dumpProp Word32
_ String
"_NET_WM_VISIBLE_NAME" = Decoder Bool
dumpUTF
dumpProp Word32
_ String
"_NET_WM_ICON_NAME" = Decoder Bool
dumpUTF
dumpProp Word32
_ String
"_NET_WM_VISIBLE_ICON_NAME" = Decoder Bool
dumpUTF
dumpProp Word32
_ String
"_NET_WM_DESKTOP" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0xFFFFFFFF,String
"all")]
Decoder Bool
dump32
dumpProp Word32
_ String
"_NET_WM_WINDOW_TYPE" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_NET_WM_STATE" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_NET_WM_ALLOWED_ACTIONS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_NET_WM_STRUT" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left gap" ,Decoder Bool
dump32)
,(String
"right gap" ,Decoder Bool
dump32)
,(String
"top gap" ,Decoder Bool
dump32)
,(String
"bottom gap",Decoder Bool
dump32)
]
dumpProp Word32
_ String
"_NET_WM_STRUT_PARTIAL" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left gap" ,Decoder Bool
dump32)
,(String
"right gap" ,Decoder Bool
dump32)
,(String
"top gap" ,Decoder Bool
dump32)
,(String
"bottom gap" ,Decoder Bool
dump32)
,(String
"left start" ,Decoder Bool
dump32)
,(String
"left end" ,Decoder Bool
dump32)
,(String
"right start" ,Decoder Bool
dump32)
,(String
"right end" ,Decoder Bool
dump32)
,(String
"top start" ,Decoder Bool
dump32)
,(String
"top end" ,Decoder Bool
dump32)
,(String
"bottom start",Decoder Bool
dump32)
,(String
"bottom end" ,Decoder Bool
dump32)
]
dumpProp Word32
_ String
"_NET_WM_ICON_GEOMETRY" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"x",Decoder Bool
dump32)
,(String
"y",Decoder Bool
dump32)
,(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
dumpProp Word32
_ String
"_NET_WM_ICON" = String -> Decoder Bool
propSimple String
"(icon)"
dumpProp Word32
_ String
"_NET_WM_PID" = Decoder Bool
dumpPid
dumpProp Word32
_ String
"_NET_WM_HANDLED_ICONS" = String -> Decoder Bool
propSimple String
"(defined)"
dumpProp Word32
_ String
"_NET_WM_USER_TIME" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"do not map initially")]
Decoder Bool
dumpTime
dumpProp Word32
_ String
"_NET_FRAME_EXTENTS" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left" ,Decoder Bool
dump32)
,(String
"right" ,Decoder Bool
dump32)
,(String
"top" ,Decoder Bool
dump32)
,(String
"bottom",Decoder Bool
dump32)
]
dumpProp Word32
_ String
"_NET_WM_SYNC_REQUEST_COUNTER" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"illegal value 0")]
Decoder Bool
dump64
dumpProp Word32
_ String
"_NET_STARTUP_ID" = Decoder Bool
dumpUTF
dumpProp Word32
_ String
"WM_PROTOCOLS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"WM_COLORMAP_WINDOWS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Word32
_ String
"WM_STATE" = Decoder Bool
dumpState
dumpProp Word32
_ String
"WM_LOCALE_NAME" = Decoder Bool
dumpString
dumpProp Word32
_ String
"WM_CLIENT_LEADER" = Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_NET_WM_WINDOW_OPACITY" = Decoder Bool
dumpPercent
dumpProp Word32
_ String
"XdndAware" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_XKLAVIER_TRANSPARENT" = Int -> Decoder Bool
dumpInteger Int
32
dumpProp Word32
_ String
"_XKLAVIER_STATE" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"state" ,Int -> Decoder Bool
dumpInteger Int
32)
,(String
"indicators",Decoder Bool
dumpXKlInds)
]
dumpProp Word32
_ String
"_MOTIF_DRAG_RECEIVER_INFO" = Decoder Bool
dumpMotifDragReceiver
dumpProp Word32
_ String
"_OL_WIN_ATTR" = Decoder Bool
dumpOLAttrs
dumpProp Word32
_ String
"_OL_DECOR_ADD" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_OL_DECOR_DEL" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Word32
_ String
"_MOTIF_WM_HINTS" = Decoder Bool
dumpMwmHints
dumpProp Word32
_ String
"_MOTIF_WM_INFO" = Decoder Bool
dumpMwmInfo
dumpProp Word32
_ String
"_XMONAD_DECORATED_BY" = Decoder Bool
dumpWindow
dumpProp Word32
_ String
"_XMONAD_DECORATION_FOR" = Decoder Bool
dumpWindow
dumpProp Word32
a String
_ | Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_NAME = Decoder Bool
dumpString
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
pRIMARY = Decoder Bool
dumpSelection
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
sECONDARY = Decoder Bool
dumpSelection
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_TRANSIENT_FOR = do
Integer
root <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. X a -> Decoder a
inX (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Word32
theRoot)
Word32
w <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
window
WMHints {wmh_window_group :: WMHints -> Word32
wmh_window_group = Word32
wgroup} <-
forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip Display -> Word32 -> IO WMHints
getWMHints Word32
w
[(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0 ,String
"window group " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
wgroup)
,(Integer
root,String
"window group " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
wgroup)
]
Decoder Bool
dumpWindow
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rESOURCE_MANAGER = Decoder Bool
dumpString
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_COMMAND = Decoder Bool
dumpString
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_HINTS = Decoder Bool
dumpWmHints
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_CLIENT_MACHINE = Decoder Bool
dumpString
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_ICON_NAME = Decoder Bool
dumpString
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_ICON_SIZE = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"min size"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
)
,(String
"max size"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
)
,(String
"increment"
,[(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
)
]
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_NORMAL_HINTS = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_ZOOM_HINTS = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_DEFAULT_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_BEST_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_RED_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_GREEN_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_BLUE_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
rGB_GRAY_MAP = Decoder Bool
(...)
| Word32
a forall a. Eq a => a -> a -> Bool
== Word32
wM_CLASS = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"name" ,Decoder Bool
dumpString)
,(String
"class",Decoder Bool
dumpString)
]
dumpProp Word32
_ String
s | String
s String -> String -> Bool
`isCountOf` String
"WM_S" = Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"_NET_WM_CM_S" = Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"_NET_DESKTOP_LAYOUT_S" = Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"CUT_BUFFER" = Decoder Bool
dumpString
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
withJoint :: String -> Decoder a -> Decoder a
withJoint :: forall a. String -> Decoder a -> Decoder a
withJoint String
j = ((forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ String -> DecodeState -> DecodeState
withJoint' String
j) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>)
withJoint' :: String -> DecodeState -> DecodeState
withJoint' :: String -> DecodeState -> DecodeState
withJoint' String
j DecodeState
s = DecodeState
s {joint :: String
joint = String
j}
inX :: X a -> Decoder a
inX :: forall a. X a -> Decoder a
inX = forall a. ReaderT Decode (StateT DecodeState X) a -> Decoder a
Decoder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
isCountOf :: String -> String -> Bool
String
s isCountOf :: String -> String -> Bool
`isCountOf` String
pfx = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => a -> a -> Bool
(==)) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip String
s forall a b. (a -> b) -> a -> b
$
String
pfx forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
'\NUL'
withIndent :: Int -> Decoder a -> Decoder a
withIndent :: forall a. Int -> Decoder a -> Decoder a
withIndent Int
w = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Decode
r -> Decode
r {indent :: Int
indent = Decode -> Int
indent Decode
r forall a. Num a => a -> a -> a
+ Int
w})
dumpArray :: Decoder Bool -> Decoder Bool
dumpArray :: Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
item = do
forall a. Int -> Decoder a -> Decoder a
withIndent Int
1 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"[" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> Decoder a -> Decoder a
withJoint String
"" (Decoder Bool -> String -> Decoder Bool
dumpArray' Decoder Bool
item String
"")
dumpArray' :: Decoder Bool -> String -> Decoder Bool
dumpArray' :: Decoder Bool -> String -> Decoder Bool
dumpArray' Decoder Bool
item String
pfx = do
[CUChar]
vs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CUChar]
vs
then String -> Decoder Bool
append String
"]"
else String -> Decoder Bool
append String
pfx forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
whenD Decoder Bool
item (Decoder Bool -> String -> Decoder Bool
dumpArray' Decoder Bool
item String
",")
whenD :: Monad m => m Bool -> m Bool -> m Bool
whenD :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
whenD m Bool
p m Bool
f = m Bool
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m Bool
f else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
guardR :: (MonadReader r m, Eq v)
=> (r -> v)
-> v
-> (v -> v -> m a)
-> m a
-> m a
guardR :: forall r (m :: * -> *) v a.
(MonadReader r m, Eq v) =>
(r -> v) -> v -> (v -> v -> m a) -> m a -> m a
guardR r -> v
sel v
val v -> v -> m a
err m a
good = do
v
v <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> v
sel
if v
v forall a. Eq a => a -> a -> Bool
== v
val then m a
good else v -> v -> m a
err v
v v
val
fi :: Bool -> a -> a -> a
fi :: forall a. Bool -> a -> a -> a
fi Bool
p a
n a
y = if Bool
p then a
y else a
n
guardSize :: Int -> Decoder Bool -> Decoder Bool
guardSize :: Int -> Decoder Bool -> Decoder Bool
guardSize Int
64 = 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
32 Int -> Int -> Decoder Bool
propSizeErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Decoder a -> Decoder a -> Decoder a
guardSize' Int
8 Decoder Bool
propShortErr
guardSize Int
w = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall a. Int -> Decoder a -> Decoder a -> Decoder a
guardSize' Int
l Decoder a
n Decoder a
y = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[CUChar]
vs -> forall a. Bool -> a -> a -> a
fi (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs forall a. Ord a => a -> a -> Bool
>= Int
l) Decoder a
n Decoder a
y
guardType :: Atom -> Decoder Bool -> Decoder Bool
guardType :: Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
t = forall r (m :: * -> *) v a.
(MonadReader r m, Eq v) =>
(r -> v) -> v -> (v -> v -> m a) -> m a -> m a
guardR Decode -> Word32
pType Word32
t Word32 -> Word32 -> Decoder Bool
propTypeErr
dumpList :: [(String,Decoder Bool)] -> Decoder Bool
dumpList :: [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String, Decoder Bool)]
proto = do
Word32
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
pType
CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' (forall a. Bounded a => a
maxBound :: CULong) (forall a b. (a -> b) -> [a] -> [b]
map (\(String
s,Decoder Bool
d) -> (String
s,Decoder Bool
d,Word32
a)) [(String, Decoder Bool)]
proto) String
"("
dumpList' :: [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpList' :: [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpList' [(String, Decoder Bool, Word32)]
proto = CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' (forall a. Bounded a => a
maxBound :: CULong) [(String, Decoder Bool, Word32)]
proto String
"("
dumpListByMask :: CULong -> [(String,Decoder Bool)] -> Decoder Bool
dumpListByMask :: CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask CULong
m [(String, Decoder Bool)]
p = do
Word32
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
pType
CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' CULong
m (forall a b. (a -> b) -> [a] -> [b]
map (\(String
s,Decoder Bool
d) -> (String
s,Decoder Bool
d,Word32
a)) [(String, Decoder Bool)]
p) String
"("
dumpListByMask' :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpListByMask' :: CULong -> [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpListByMask' CULong
m [(String, Decoder Bool, Word32)]
p = CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' CULong
m [(String, Decoder Bool, Word32)]
p String
"("
dumpList'' :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
dumpList'' :: CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' CULong
_ [] String
_ = String -> Decoder Bool
append String
")" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
dumpList'' CULong
0 [(String, Decoder Bool, Word32)]
_ String
_ = String -> Decoder Bool
append String
")" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
dumpList'' CULong
m ((String
l,Decoder Bool
p,Word32
t):[(String, Decoder Bool, Word32)]
ps) String
sep = do
(Bool
e,String
sep') <- if CULong
m forall a. Bits a => a -> a -> a
.&. CULong
1 forall a. Eq a => a -> a -> Bool
== CULong
0
then do
DecodeState
st <- forall s (m :: * -> *). MonadState s m => m s
get
Bool
e <- forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Decode
r -> Decode
r {pType :: Word32
pType = Word32
t}) Decoder Bool
p
[CUChar]
v' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ DecodeState
st {value :: [CUChar]
value = [CUChar]
v'}
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
e,String
sep)
else do
let label :: String
label = String
sep forall a. [a] -> [a] -> [a]
++ String
l forall a. [a] -> [a] -> [a]
++ String
" = "
String -> Decoder Bool
append String
label
Bool
e <- forall a. String -> Decoder a -> Decoder a
withJoint String
"" forall a b. (a -> b) -> a -> b
$ do
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Decode
r -> Decode
r {pType :: Word32
pType = Word32
t
,indent :: Int
indent = Decode -> Int
indent Decode
r forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
label
})
Decoder Bool
p
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
e,String
",")
if Bool
e then CULong
-> [(String, Decoder Bool, Word32)] -> String -> Decoder Bool
dumpList'' (CULong
m forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(String, Decoder Bool, Word32)]
ps String
sep' else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
e
dumpString :: Decoder Bool
dumpString :: Decoder Bool
dumpString = do
Word32
fmt <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
pType
[Word32
cOMPOUND_TEXT,Word32
uTF8_STRING] <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> X Word32
getAtom [String
"COMPOUND_TEXT",String
"UTF8_STRING"]
case () of
() | Word32
fmt forall a. Eq a => a -> a -> Bool
== Word32
cOMPOUND_TEXT -> Int -> Decoder Bool -> Decoder Bool
guardSize Int
16 Decoder Bool
(...)
| Word32
fmt forall a. Eq a => a -> a -> Bool
== Word32
sTRING -> Int -> Decoder Bool -> Decoder Bool
guardSize Int
8 forall a b. (a -> b) -> a -> b
$ do
[CUChar]
vs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {value :: [CUChar]
value = []})
let ss :: [String]
ss = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Enum a, Enum b) => a -> b
twiddle [CUChar]
vs) forall a b. (a -> b) -> a -> b
$
\String
s -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
then forall a. Maybe a
Nothing
else let (String
w,String
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'\NUL') String
s
s' :: String
s' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s''
then String
s''
else forall a. [a] -> [a]
tail String
s''
in forall a. a -> Maybe a
Just (String
w,String
s')
case [String]
ss of
[String
s] -> String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s
[String]
ss' -> let go :: [a] -> String -> Decoder Bool
go (a
s:[a]
ss'') String
c = String -> Decoder Bool
append String
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Decoder Bool
append (forall a. Show a => a -> String
show a
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
[a] -> String -> Decoder Bool
go [a]
ss'' String
","
go [] String
_ = String -> Decoder Bool
append String
"]"
in String -> Decoder Bool
append String
"[" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall {a}. Show a => [a] -> String -> Decoder Bool
go [String]
ss' String
""
| Word32
fmt forall a. Eq a => a -> a -> Bool
== Word32
uTF8_STRING -> Decoder Bool
dumpUTF
| Bool
otherwise -> forall a. X a -> Decoder a
inX (Word32 -> X String
atomName Word32
fmt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> Decoder Bool
failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"unrecognized string type " forall a. [a] -> [a] -> [a]
++)
dumpSelection :: Decoder Bool
dumpSelection :: Decoder Bool
dumpSelection = do
Word32
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
property
Word32
owner <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Word32 -> IO Word32
xGetSelectionOwner Display
d Word32
a
if Word32
owner forall a. Eq a => a -> a -> Bool
== Word32
none
then String -> Decoder Bool
append String
"unowned"
else do
String
w <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Word32 -> X String
debugWindow Word32
owner
String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"owned by " forall a. [a] -> [a] -> [a]
++ String
w
dumpXKlInds :: Decoder Bool
dumpXKlInds :: Decoder Bool
dumpXKlInds = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
iNTEGER forall a b. (a -> b) -> a -> b
$ do
Maybe Word32
n <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Word32
n of
Maybe Word32
Nothing -> Decoder Bool
propShortErr
Just Word32
is -> String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"indicators " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds Word32
is Word32
1 Int
1 [])
where
dumpInds :: Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds :: Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds Word32
n Word32
bt Int
c [String]
bs | Word32
n forall a. Eq a => a -> a -> Bool
== Word32
0 Bool -> Bool -> Bool
&& Int
c forall a. Eq a => a -> a -> Bool
== Int
1 = [String
"none"]
| Word32
n forall a. Eq a => a -> a -> Bool
== Word32
0 = [String]
bs
| Word32
n forall a. Bits a => a -> a -> a
.&. Word32
bt forall a. Eq a => a -> a -> Bool
/= Word32
0 = Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds (Word32
n forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word32
bt)
(Word32
bt forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
(Int
c forall a. Num a => a -> a -> a
+ Int
1)
(forall a. Show a => a -> String
show Int
cforall a. a -> [a] -> [a]
:[String]
bs)
| Bool
otherwise = Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds Word32
n
(Word32
bt forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
(Int
c forall a. Num a => a -> a -> a
+ Int
1)
[String]
bs
dumpAtom :: Decoder Bool
dumpAtom :: Decoder Bool
dumpAtom =
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
aTOM forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
a <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
a of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
a' -> do
String
an <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Word32 -> X String
atomName forall a b. (a -> b) -> a -> b
$ 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 Int
32 forall a b. (a -> b) -> a -> b
$ Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
wINDOW forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
w <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
w of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
w' -> forall a. X a -> Decoder a
inX (Word32 -> X String
debugWindow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
w')) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Decoder Bool
append
dumpActiveWindow :: Decoder Bool
dumpActiveWindow :: Decoder Bool
dumpActiveWindow = Int -> Decoder Bool -> Decoder Bool
guardSize Int
32 forall a b. (a -> b) -> a -> b
$ do
Word32
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
pType
Word32
nAW <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Word32
getAtom String
"_NET_ACTIVE_WINDOW"
case () of
() | Word32
t forall a. Eq a => a -> a -> Bool
== Word32
wINDOW -> Decoder Bool
dumpWindow
| Word32
t forall a. Eq a => a -> a -> Bool
== Word32
nAW -> [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpList' [(String
"source" ,[String] -> Decoder Bool
dumpEnum [String]
awSource,Word32
cARDINAL)
,(String
"timestamp" ,Decoder Bool
dumpTime ,Word32
cARDINAL)
,(String
"active window",Decoder Bool
dumpWindow ,Word32
wINDOW )
]
()
_ -> do
String
t' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Word32 -> X String
atomName Word32
t
String -> Decoder Bool
failure forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"(bad type "
,String
t'
,String
"; expected WINDOW or _NET_ACTIVE_WINDOW"
]
dumpInt :: Int -> Decoder Bool
dumpInt :: Int -> Decoder Bool
dumpInt Int
w = Int -> Decoder Bool -> Decoder Bool
guardSize Int
w forall a b. (a -> b) -> a -> b
$ Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
cARDINAL forall a b. (a -> b) -> a -> b
$ Int -> (Integer -> String) -> Decoder Bool
getInt Int
w forall a. Show a => a -> String
show
dumpInteger :: Int -> Decoder Bool
dumpInteger :: Int -> Decoder Bool
dumpInteger Int
w = Int -> Decoder Bool -> Decoder Bool
guardSize Int
w forall a b. (a -> b) -> a -> b
$ Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
iNTEGER forall a b. (a -> b) -> a -> b
$ Int -> (Integer -> String) -> Decoder Bool
getInt Int
w (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> Integer
signed Int
w)
signed :: Int -> Integer -> Integer
signed :: Int -> Integer -> Integer
signed Int
w Integer
i = forall a. Bits a => Int -> a
bit (Int
w forall a. Num a => a -> a -> a
+ Int
1) forall a. Num a => a -> a -> a
- Integer
i
dump64 :: Decoder Bool
dump64 :: Decoder Bool
dump64 = Int -> Decoder Bool
dumpInt Int
64
dump32 :: Decoder Bool
dump32 :: Decoder Bool
dump32 = Int -> Decoder Bool
dumpInt Int
32
dump8 :: Decoder Bool
dump8 :: Decoder Bool
dump8 = Int -> Decoder Bool
dumpInt Int
8
dumpUTF :: Decoder Bool
dumpUTF :: Decoder Bool
dumpUTF = do
Word32
uTF8_STRING <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Word32
getAtom String
"UTF8_STRING"
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
uTF8_STRING forall a b. (a -> b) -> a -> b
$ Int -> Decoder Bool -> Decoder Bool
guardSize Int
8 forall a b. (a -> b) -> a -> b
$ do
[CUChar]
s <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {value :: [CUChar]
value = []})
String -> Decoder Bool
append forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ [CUChar]
s
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
dumpEnum' :: [String] -> Atom -> Decoder Bool
dumpEnum' :: [String] -> Word32 -> Decoder Bool
dumpEnum' [String]
ss Word32
fmt = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
fmt forall a b. (a -> b) -> a -> b
$
Int -> (Integer -> String) -> Decoder Bool
getInt Int
32 forall a b. (a -> b) -> a -> b
$
\Integer
r -> case () of
() | Integer
r forall a. Ord a => a -> a -> Bool
< Integer
0 -> String
"undefined value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
r
| Integer
r forall a. Ord a => a -> a -> Bool
>= forall i a. Num i => [a] -> i
genericLength [String]
ss -> String
"undefined value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
r
| Bool
otherwise -> forall i a. Integral i => [a] -> i -> a
genericIndex [String]
ss Integer
r
dumpPixmap :: Decoder Bool
dumpPixmap :: Decoder Bool
dumpPixmap = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
pIXMAP forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
p' <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
p' of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
p -> do
String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"pixmap " forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex Integer
p String
""
Maybe (Word32, Position, Position, Word32, Word32, Word32, CInt)
g' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$
(forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display
-> Word32
-> IO (Word32, Position, Position, Word32, Word32, Word32, CInt)
getGeometry Display
d (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p))
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
\SomeException
e -> case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just ExitCode
x -> forall a e. Exception e => e -> a
throw SomeException
e forall a b. a -> b -> a
`const` (ExitCode
x forall a. a -> a -> a
`asTypeOf` ExitCode
ExitSuccess)
Maybe ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
case Maybe (Word32, Position, Position, Word32, Word32, Word32, CInt)
g' of
Maybe (Word32, Position, Position, Word32, Word32, Word32, CInt)
Nothing -> String -> Decoder Bool
append String
" (deleted)"
Just (Word32
_,Position
x,Position
y,Word32
wid,Word32
ht,Word32
bw,CInt
dp) ->
String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
" ("
,forall a. Show a => a -> String
show Word32
wid
,Char
'x'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Word32
ht
,Char
'x'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show CInt
dp
,Char
')'forall a. a -> [a] -> [a]
:if Word32
bw forall a. Eq a => a -> a -> Bool
== Word32
0 then String
"" else Char
'+'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Word32
bw
,String
"@("
,forall a. Show a => a -> String
show Position
x
,Char
','forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show Position
y
,String
")"
]
dumpOLAttrs :: Decoder Bool
dumpOLAttrs :: Decoder Bool
dumpOLAttrs = do
Word32
pt <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Word32
getAtom String
"_OL_WIN_ATTR"
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
pt forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
msk of
Maybe Integer
Nothing -> Decoder Bool
propShortErr
Just Integer
msk' -> CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk') [(String
"window type" ,Decoder Bool
dumpAtom )
,(String
"menu" ,Decoder Bool
dump32 )
,(String
"pushpin" ,[String] -> Decoder Bool
dumpEnum [String]
bool)
,(String
"limited menu",Decoder Bool
dump32 )
]
dumpMwmHints :: Decoder Bool
dumpMwmHints :: Decoder Bool
dumpMwmHints = do
Word32
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
property
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
ta forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
msk of
Maybe Integer
Nothing -> Decoder Bool
propShortErr
Just Integer
msk' -> CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk') [(String
"functions" ,[String] -> Decoder Bool
dumpBits [String]
mwmFuncs )
,(String
"decorations",[String] -> Decoder Bool
dumpBits [String]
mwmDecos )
,(String
"input mode" ,[String] -> Decoder Bool
dumpEnum [String]
mwmInputMode)
,(String
"status" ,[String] -> Decoder Bool
dumpBits [String]
mwmState )
]
dumpMwmInfo :: Decoder Bool
dumpMwmInfo :: Decoder Bool
dumpMwmInfo = do
Word32
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
property
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
ta forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpList' [(String
"flags" ,[String] -> Decoder Bool
dumpBits [String]
mwmHints,Word32
cARDINAL)
,(String
"window",Decoder Bool
dumpWindow ,Word32
wINDOW )
]
dumpEnum :: [String] -> Decoder Bool
dumpEnum :: [String] -> Decoder Bool
dumpEnum [String]
ss = [String] -> Word32 -> Decoder Bool
dumpEnum' [String]
ss Word32
cARDINAL
dumpExcept :: [(Integer,String)] -> Decoder Bool -> Decoder Bool
dumpExcept :: [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer, String)]
xs Decoder Bool
item = do
DecodeState
sp <- forall s (m :: * -> *). MonadState s m => m s
get
Bool
rc <- Decoder Bool
item
if Bool -> Bool
not Bool
rc then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
DecodeState
that <- forall s (m :: * -> *). MonadState s m => m s
get
[CUChar]
vs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
let w :: Int
w = (forall (t :: * -> *) a. Foldable t => t a -> Int
length (DecodeState -> [CUChar]
value DecodeState
sp) forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs) forall a. Num a => a -> a -> a
* Int
8
forall s (m :: * -> *). MonadState s m => s -> m ()
put DecodeState
sp
Integer
v <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. HasCallStack => Maybe a -> a
fromJust (Int -> Decoder (Maybe Integer)
getInt' Int
w)
[(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' [] DecodeState
that Integer
_ = forall s (m :: * -> *). MonadState s m => s -> m ()
put DecodeState
that forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
dumpExcept' ((Integer
exc,String
str):[(Integer, String)]
xs) DecodeState
that Integer
val | Integer
exc 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
dumpPid :: Decoder Bool
dumpPid :: Decoder Bool
dumpPid = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
n of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
pid' -> do
let pid :: String
pid = forall a. Show a => a -> String
show Integer
pid'
ps :: CreateProcess
ps = (String -> [String] -> CreateProcess
proc String
"/bin/ps" [String
"-fp" forall a. [a] -> [a] -> [a]
++ String
pid]) {std_out :: StdStream
std_out = StdStream
CreatePipe}
(Maybe Handle
_,Maybe Handle
o,Maybe Handle
_,ProcessHandle
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
ps
case Maybe Handle
o of
Maybe Handle
Nothing -> String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"pid " forall a. [a] -> [a] -> [a]
++ String
pid
Just Handle
p' -> do
[String]
prc <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ String -> [String]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO String
hGetContents Handle
p'
String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
prc forall a. Ord a => a -> a -> Bool
< Int
2
then String
"pid " forall a. [a] -> [a] -> [a]
++ String
pid
else [String]
prc forall a. [a] -> Int -> a
!! Int
1
dumpTime :: Decoder Bool
dumpTime :: Decoder Bool
dumpTime = String -> Decoder Bool
append String
"server event # " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder Bool
dump32
dumpState :: Decoder Bool
dumpState :: Decoder Bool
dumpState = do
Word32
wM_STATE <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Word32
getAtom String
"WM_STATE"
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
wM_STATE forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpList' [(String
"state" ,[String] -> Decoder Bool
dumpEnum [String]
wmState,Word32
cARDINAL)
,(String
"icon window",Decoder Bool
dumpWindow ,Word32
wINDOW )
]
dumpMotifDragReceiver :: Decoder Bool
dumpMotifDragReceiver :: Decoder Bool
dumpMotifDragReceiver = do
Word32
ta <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Word32
getAtom String
"_MOTIF_DRAG_RECEIVER_INFO"
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
ta forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpList' [(String
"endian" ,Decoder Bool
dumpMotifEndian,Word32
cARDINAL)
,(String
"version" ,Decoder Bool
dump8 ,Word32
cARDINAL)
,(String
"style" ,Decoder Bool
dumpMDropStyle ,Word32
cARDINAL)
]
dumpMDropStyle :: Decoder Bool
dumpMDropStyle :: Decoder Bool
dumpMDropStyle = do
Maybe Integer
d <- Int -> Decoder (Maybe Integer)
getInt' Int
8
Int -> Decoder Bool -> Decoder Bool
pad Int
1 forall a b. (a -> b) -> a -> b
$ case Maybe Integer
d of
Maybe Integer
Nothing -> Decoder Bool
propShortErr
Just Integer
ps | Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
0 -> Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"none"
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
1 -> Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"drop only"
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
2 -> String -> Decoder Bool
append String
"prefer preregister " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder Bool
dumpMDPrereg
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
3 -> String -> Decoder Bool
append String
"preregister " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder Bool
dumpMDPrereg
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
4 -> Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"prefer dynamic"
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
5 -> Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"dynamic"
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
6 -> Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"prefer receiver"
| Bool
otherwise -> String -> Decoder Bool
failure forall a b. (a -> b) -> a -> b
$ String
"unknown drop style " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
ps
dumpMDPrereg :: Decoder Bool
dumpMDPrereg :: Decoder Bool
dumpMDPrereg = do
String -> Decoder Bool
append String
","
String -> Decoder Bool
append String
"proxy window = "
forall a. Int -> Decoder a -> Decoder a
withIndent Int
15 Decoder Bool
dumpWindow
String -> Decoder Bool
append String
","
String -> Decoder Bool
append String
"drop sites = "
Maybe Integer
dsc' <- Int -> Decoder (Maybe Integer)
getInt' Int
16
case Maybe Integer
dsc' of
Maybe Integer
Nothing -> Decoder Bool
propShortErr
Just Integer
dsc -> do
forall a. Int -> Decoder a -> Decoder a
withIndent Int
13 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append (forall a. Show a => a -> String
show Integer
dsc)
Int -> Decoder Bool -> Decoder Bool
pad Int
2 forall a b. (a -> b) -> a -> b
$ do
String -> Decoder Bool
append String
","
String -> Decoder Bool
append String
"total size = "
forall a. Int -> Decoder a -> Decoder a
withIndent Int
13 Decoder Bool
dump32
Int -> Decoder Bool
dumpMDBlocks forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dsc
dumpMDBlocks :: Int -> Decoder Bool
dumpMDBlocks :: Int -> Decoder Bool
dumpMDBlocks Int
_ = String -> Decoder Bool
propSimple String
"(drop site info)"
dumpMotifEndian :: Decoder Bool
dumpMotifEndian :: Decoder Bool
dumpMotifEndian = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
cARDINAL forall a b. (a -> b) -> a -> b
$ Int -> Decoder Bool -> Decoder Bool
guardSize Int
8 forall a b. (a -> b) -> a -> b
$ do
String
c <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Enum a, Enum b) => a -> b
twiddle forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder [CUChar]
eat Int
1
case String
c of
[Char
'l'] -> String -> Decoder Bool
append String
"little"
[Char
'B'] -> String -> Decoder Bool
append String
"big"
String
_ -> String -> Decoder Bool
failure String
"bad endian flag"
pad :: Int -> Decoder Bool -> Decoder Bool
pad :: Int -> Decoder Bool -> Decoder Bool
pad Int
n Decoder Bool
p = do
[CUChar]
vs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> [CUChar]
value
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs forall a. Ord a => a -> a -> Bool
< Int
n
then Decoder Bool
propShortErr
else forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {value :: [CUChar]
value = forall a. Int -> [a] -> [a]
drop Int
n [CUChar]
vs}) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Decoder Bool
p
dumpPercent :: Decoder Bool
dumpPercent :: Decoder Bool
dumpPercent = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
n of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
n' ->
let pct :: Double
pct = Double
100 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n' forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32)
pct :: Double
in String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round Double
pct :: Integer) forall a. [a] -> [a] -> [a]
++ String
"%"
dumpWmHints :: Decoder Bool
dumpWmHints :: Decoder Bool
dumpWmHints =
Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
wM_HINTS forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
msk of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
msk' -> CULong -> [(String, Decoder Bool, Word32)] -> Decoder Bool
dumpListByMask' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk')
[(String
"input" ,[String] -> Decoder Bool
dumpEnum [String]
bool ,Word32
cARDINAL)
,(String
"initial_state",[String] -> Decoder Bool
dumpEnum [String]
wmState,Word32
cARDINAL)
,(String
"icon_pixmap" ,Decoder Bool
dumpPixmap ,Word32
pIXMAP )
,(String
"icon_window" ,Decoder Bool
dumpWindow ,Word32
wINDOW )
,(String
"icon_x" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"icon_y" ,Decoder Bool
dump32 ,Word32
cARDINAL)
,(String
"icon_mask" ,Decoder Bool
dumpPixmap ,Word32
pIXMAP )
,(String
"window_group" ,Decoder Bool
dumpWindow ,Word32
wINDOW )
]
dumpBits :: [String] -> Decoder Bool
dumpBits :: [String] -> Decoder Bool
dumpBits [String]
bs = Word32 -> Decoder Bool -> Decoder Bool
guardType Word32
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
n of
Maybe Integer
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just Integer
n' -> [String] -> Int -> Int -> String -> Decoder Bool
dumpBits' [String]
bs Int
1 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n') String
""
dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool
dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool
dumpBits' [] Int
_ Int
n String
p = if Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else String -> Decoder Bool
append (String
p forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n)
dumpBits' (String
s:[String]
ss) Int
b Int
n String
p = do
String
p' <- if Int
n forall a. Bits a => a -> a -> a
.&. Int
b forall a. Eq a => a -> a -> Bool
/= Int
0
then String -> Decoder Bool
append (String
p forall a. [a] -> [a] -> [a]
++ String
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
"|"
else forall (m :: * -> *) a. Monad m => a -> m a
return String
p
[String] -> Int -> Int -> String -> Decoder Bool
dumpBits' [String]
ss (Int
b forall a. Bits a => a -> Int -> a
`shiftL` Int
1) (Int
n forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Int
b) String
p'
mwmFuncs :: [String]
mwmFuncs :: [String]
mwmFuncs = [String
"all except"
,String
"resize"
,String
"move"
,String
"minimize"
,String
"maximize"
,String
"close"
]
mwmDecos :: [String]
mwmDecos :: [String]
mwmDecos = [String
"all except"
,String
"border"
,String
"resize handle"
,String
"title"
,String
"menu button"
,String
"maximize button"
,String
"minimize button"
]
mwmInputMode :: [String]
mwmInputMode :: [String]
mwmInputMode = [String
"modeless"
,String
"application modal"
,String
"system model"
,String
"full application modal"
]
mwmState :: [String]
mwmState :: [String]
mwmState = [String
"tearoff window"
]
mwmHints :: [String]
mwmHints :: [String]
mwmHints = [String
"standard startup"
,String
"custom startup"
]
awSource :: [String]
awSource :: [String]
awSource = [String
"unspecified"
,String
"application"
,String
"pager/task list"
]
wmPlacement :: [String]
wmPlacement :: [String]
wmPlacement = [String
"Above"
,String
"Below"
,String
"TopIf"
,String
"BottomIf"
,String
"Opposite"
]
bool :: [String]
bool :: [String]
bool = [String
"False",String
"True"]
nwmOrientation :: [String]
nwmOrientation :: [String]
nwmOrientation = Maybe String -> [String] -> [String]
nwmEnum (forall a. a -> Maybe a
Just String
"ORIENTATION") [String
"HORZ",String
"VERT"]
nwmOrigin :: [String]
nwmOrigin :: [String]
nwmOrigin = Maybe String -> [String] -> [String]
nwmEnum forall a. Maybe a
Nothing [String
"TOPLEFT",String
"TOPRIGHT",String
"BOTTOMRIGHT",String
"BOTTOMLEFT"]
wmState :: [String]
wmState :: [String]
wmState = [String
"Withdrawn",String
"Normal",String
"Zoomed (obsolete)",String
"Iconified",String
"Inactive"]
nwmEnum :: Maybe String
-> [String]
-> [String]
Maybe String
Nothing [String]
vs = forall a b. (a -> b) -> [a] -> [b]
map ( String
"_NET_WM_" forall a. [a] -> [a] -> [a]
++) [String]
vs
nwmEnum (Just String
prefix) [String]
vs = forall a b. (a -> b) -> [a] -> [b]
map ((String
"_NET_WM_" forall a. [a] -> [a] -> [a]
++ String
prefix forall a. [a] -> [a] -> [a]
++ String
"_") forall a. [a] -> [a] -> [a]
++) [String]
vs
getInt' :: Int -> Decoder (Maybe Integer)
getInt' :: Int -> Decoder (Maybe Integer)
getInt' Int
64 = 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
32 (\Int
a Int
e -> Int -> Int -> Decoder Bool
propSizeErr Int
a Int
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
forall a. Int -> Decoder a -> Decoder a -> Decoder a
guardSize' Int
8 (Decoder Bool
propShortErr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
Integer
lo <- Int -> Decoder Integer
inhale Int
32
Integer
hi <- Int -> Decoder Integer
inhale Int
32
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer
lo forall a. Num a => a -> a -> a
+ Integer
hi forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32) forall a. Num a => a -> a -> a
+ Integer
1)
getInt' Int
w = 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
a Int
e -> Int -> Int -> Decoder Bool
propSizeErr Int
a Int
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
forall a. Int -> Decoder a -> Decoder a -> Decoder a
guardSize' (Int -> Int
bytes Int
w) (Decoder Bool
propShortErr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder Integer
inhale Int
w
getInt :: Int -> (Integer -> String) -> Decoder Bool
getInt :: Int -> (Integer -> String) -> Decoder Bool
getInt Int
w Integer -> String
f = Int -> Decoder (Maybe Integer)
getInt' Int
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (String -> Decoder Bool
append forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
f)
inhale :: Int -> Decoder Integer
inhale :: Int -> Decoder Integer
inhale Int
8 = do
[CUChar
b] <- Int -> Decoder [CUChar]
eat Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral CUChar
b
inhale Int
16 = do
[CUChar
b0,CUChar
b1] <- Int -> Decoder [CUChar]
eat Int
2
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
2 forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
p -> do
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CUChar
p [CUChar
b0,CUChar
b1]
[Word16
v] <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 (forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
p :: Ptr Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v
inhale Int
32 = do
[CUChar
b0,CUChar
b1,CUChar
b2,CUChar
b3] <- Int -> Decoder [CUChar]
eat Int
4
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
4 forall a b. (a -> b) -> a -> b
$ \Ptr CUChar
p -> do
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CUChar
p [CUChar
b0,CUChar
b1,CUChar
b2,CUChar
b3]
[Word32
v] <- forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
1 (forall a b. Ptr a -> Ptr b
castPtr Ptr CUChar
p :: Ptr Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
inhale Int
b = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"inhale " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
b
eat :: Int -> Decoder Raw
eat :: Int -> Decoder [CUChar]
eat Int
n = do
([CUChar]
bs,[CUChar]
rest) <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Int -> [a] -> ([a], [a])
splitAt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeState -> [CUChar]
value)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {value :: [CUChar]
value = [CUChar]
rest})
forall (m :: * -> *) a. Monad m => a -> m a
return [CUChar]
bs
append :: String -> Decoder Bool
append :: String -> Decoder Bool
append = Bool -> String -> Decoder Bool
append' Bool
True
failure :: String -> Decoder Bool
failure :: String -> Decoder Bool
failure = Bool -> String -> Decoder Bool
append' Bool
False
append' :: Bool -> String -> Decoder Bool
append' :: Bool -> String -> Decoder Bool
append' Bool
b String
s = do
String
j <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets DecodeState -> String
joint
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {accum :: String
accum = DecodeState -> String
accum DecodeState
r forall a. [a] -> [a] -> [a]
++ String
j forall a. [a] -> [a] -> [a]
++ String
s})
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
propSimple :: String -> Decoder Bool
propSimple :: String -> Decoder Bool
propSimple String
s = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\DecodeState
r -> DecodeState
r {value :: [CUChar]
value = []}) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Decoder Bool
append String
s
propShortErr :: Decoder Bool
propShortErr :: Decoder Bool
propShortErr = String -> Decoder Bool
failure String
"(property ended prematurely)"
propSizeErr :: Int -> Int -> Decoder Bool
propSizeErr :: Int -> Int -> Decoder Bool
propSizeErr Int
e Int
a = String -> Decoder Bool
failure forall a b. (a -> b) -> a -> b
$ String
"(bad bit width " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
a forall a. [a] -> [a] -> [a]
++
String
"; expected " forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> String
show Int
e forall a. [a] -> [a] -> [a]
++
String
")"
propTypeErr :: Atom -> Atom -> Decoder Bool
propTypeErr :: Word32 -> Word32 -> Decoder Bool
propTypeErr Word32
a Word32
e = do
String
e' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Word32 -> X String
atomName Word32
e
String
a' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Word32 -> X String
atomName Word32
a
String -> Decoder Bool
failure forall a b. (a -> b) -> a -> b
$ String
"(bad type " forall a. [a] -> [a] -> [a]
++ String
a' forall a. [a] -> [a] -> [a]
++String
"; expected " forall a. [a] -> [a] -> [a]
++ String
e' forall a. [a] -> [a] -> [a]
++ String
")"
(...) :: Decoder Bool
... :: Decoder Bool
(...) = do
String
fmt <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Word32
pType forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. X a -> Decoder a
inX forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> X String
atomName
String -> Decoder Bool
propSimple forall a b. (a -> b) -> a -> b
$ String
"(unimplemented type " forall a. [a] -> [a] -> [a]
++ String
fmt forall a. [a] -> [a] -> [a]
++ String
")"
twiddle :: (Enum a, Enum b) => a -> b
twiddle :: forall a b. (Enum a, Enum b) => a -> b
twiddle = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum