{-# 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 -> 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 String
"ConfigureRequest" Window
w
String -> Window -> X ()
windowEvent String
" parent" Window
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 Window
above,CInt
place] forall a b. (a -> b) -> a -> b
$
CULong -> [(String, Decoder Bool, Window)] -> Decoder Bool
dumpListByMask' CULong
msk [(String
"x" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"y" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"width" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"height" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"border_width",Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"sibling" ,Decoder Bool
dumpWindow ,Window
wINDOW )
,(String
"detail" ,[String] -> Decoder Bool
dumpEnum [String]
wmPlacement,Window
cARDINAL)
]
String -> String -> X ()
say String
" 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 String
"Configure" Window
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
above forall a. Eq a => a -> a -> Bool
/= Window
none) forall a b. (a -> b) -> a -> b
$ Window -> X String
debugWindow Window
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 -> Window
ev_window = Window
w
,ev_parent :: Event -> Window
ev_parent = Window
p
} =
String -> Window -> X ()
windowEvent String
"MapRequest" Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Window -> X ()
windowEvent String
" parent" Window
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 -> Window
ev_window = Window
w
,ev_state :: Event -> KeyMask
ev_state = KeyMask
s
,ev_button :: Event -> Word32
ev_button = Word32
b
} = do
String -> Window -> X ()
windowEvent String
"Button" Window
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 -> Window
ev_window = Window
w
} =
String -> Window -> X ()
windowEvent String
"DestroyWindow" Window
w
debugEventsHook' UnmapEvent {ev_window :: Event -> Window
ev_window = Window
w
} =
String -> Window -> X ()
windowEvent String
"Unmap" Window
w
debugEventsHook' MapNotifyEvent {ev_window :: Event -> Window
ev_window = Window
w
} =
String -> Window -> X ()
windowEvent String
"MapNotify" Window
w
debugEventsHook' CrossingEvent {} =
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 String
"SelectionRequest" Window
rw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Window -> X ()
windowEvent String
" owner" Window
ow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Window -> X ()
atomEvent String
" 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
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 -> Window -> X ()
windowEvent String
"Property on" Window
w
String
s' <- case CInt
s of
CInt
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"deleted"
CInt
0 -> Window -> String -> Window -> Int -> X String
dumpProperty Window
a String
a' Window
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 -> Window
ev_window = Window
w
} =
String -> Window -> X ()
windowEvent String
"Expose" Window
w
debugEventsHook' ClientMessageEvent {ev_window :: Event -> Window
ev_window = Window
w
,ev_message_type :: Event -> Window
ev_message_type = Window
a
,ev_data :: Event -> [CInt]
ev_data = [CInt]
vs'
} = do
String -> Window -> X ()
windowEvent String
"ClientMessage on" Window
w
String
n <- Window -> X String
atomName Window
a
(Window
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 (Window
a,Int
32,forall (t :: * -> *) a. Foldable t => t a -> Int
length [CInt]
vs')
Just (String
ta',Int
b,Int
l) -> do
Window
ta <- String -> X Window
getAtom String
ta'
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 <- 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 <- Window
-> Window
-> String
-> Window
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Window
w Window
a String
n Window
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 :: Window -> X String
atomName Window
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 Window
a forall a. [a] -> [a] -> [a]
++ String
")") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> IO (Maybe String)
getAtomName Display
d Window
a
atomEvent :: String -> Atom -> X ()
atomEvent :: String -> Window -> X ()
atomEvent String
l Window
a = Window -> X String
atomName Window
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 -> Window -> X ()
windowEvent String
l Window
w = Window -> X String
debugWindow Window
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 -> Window
property :: Atom
,Decode -> String
pName :: String
,Decode -> Window
pType :: Atom
,Decode -> Int
width :: Int
,Decode -> Window
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 :: Window -> String -> Window -> Int -> X String
dumpProperty Window
a String
n Window
w Int
i = do
Either String (Window, 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 Window
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
-> 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
CLong
0
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
CInt
0 -> do
Window
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 Window
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
() | Window
fmt forall a. Eq a => a -> a -> Bool
== Window
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 (Window
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 (Window, Int, CULong, [CUChar])
prop of
Left String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Right (Window
fmt,Int
sz,CULong
ack,[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
dumpProperty' :: Window
-> Atom
-> String
-> Atom
-> Int
-> Raw
-> CULong
-> Int
-> X String
dumpProperty' :: 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 = do
String
ptn <- Window -> X String
atomName Window
fmt
let dec :: Decode
dec = 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 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 :: Window
window = Window
w
,limit :: Int
limit = Int
96
}
dec' :: Decode
dec' = Decode
dec {pType :: Window
pType = Window
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
$ Window -> String -> Decoder Bool
dumpProp Window
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 :: Window
property = Window
none
,pName :: String
pName = String
""
,pType :: Window
pType = Window
cARDINAL
,width :: Int
width = Int
32
,indent :: Int
indent = Int
0
,window :: Window
window = Window
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 :: Window -> String -> Decoder Bool
dumpProp Window
_ String
"CLIPBOARD" = Decoder Bool
dumpSelection
dumpProp Window
_ String
"_NET_SUPPORTED" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_NET_CLIENT_LIST" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Window
_ String
"_NET_CLIENT_LIST_STACKING" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Window
_ String
"_NET_NUMBER_OF_DESKTOPS" = Decoder Bool
dump32
dumpProp Window
_ String
"_NET_VIRTUAL_ROOTS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Window
_ String
"_NET_DESKTOP_GEOMETRY" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dump32
dumpProp Window
_ String
"_NET_DESKTOP_VIEWPORT" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",Decoder Bool
dump32)
,(String
"h",Decoder Bool
dump32)
]
dumpProp Window
_ String
"_NET_CURRENT_DESKTOP" = Decoder Bool
dump32
dumpProp Window
_ String
"_NET_DESKTOP_NAMES" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpUTF
dumpProp Window
_ String
"_NET_ACTIVE_WINDOW" = Decoder Bool
dumpActiveWindow
dumpProp Window
_ 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 Window
_ String
"_NET_SUPPORTING_WM_CHECK" = Decoder Bool
dumpWindow
dumpProp Window
_ 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 Window
_ String
"_NET_SHOWING_DESKTOP" = Decoder Bool
dump32
dumpProp Window
_ String
"_NET_WM_NAME" = Decoder Bool
dumpUTF
dumpProp Window
_ String
"_NET_WM_VISIBLE_NAME" = Decoder Bool
dumpUTF
dumpProp Window
_ String
"_NET_WM_ICON_NAME" = Decoder Bool
dumpUTF
dumpProp Window
_ String
"_NET_WM_VISIBLE_ICON_NAME" = Decoder Bool
dumpUTF
dumpProp Window
_ String
"_NET_WM_DESKTOP" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0xFFFFFFFF,String
"all")]
Decoder Bool
dump32
dumpProp Window
_ String
"_NET_WM_WINDOW_TYPE" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_NET_WM_STATE" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_NET_WM_ALLOWED_ACTIONS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ 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 Window
_ 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 Window
_ 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 Window
_ String
"_NET_WM_ICON" = String -> Decoder Bool
propSimple String
"(icon)"
dumpProp Window
_ String
"_NET_WM_PID" = Decoder Bool
dumpPid
dumpProp Window
_ String
"_NET_WM_HANDLED_ICONS" = String -> Decoder Bool
propSimple String
"(defined)"
dumpProp Window
_ String
"_NET_WM_USER_TIME" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"do not map initially")]
Decoder Bool
dumpTime
dumpProp Window
_ 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 Window
_ String
"_NET_WM_SYNC_REQUEST_COUNTER" = [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"illegal value 0")]
Decoder Bool
dump64
dumpProp Window
_ String
"_NET_STARTUP_ID" = Decoder Bool
dumpUTF
dumpProp Window
_ String
"WM_PROTOCOLS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"WM_COLORMAP_WINDOWS" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpWindow
dumpProp Window
_ String
"WM_STATE" = Decoder Bool
dumpState
dumpProp Window
_ String
"WM_LOCALE_NAME" = Decoder Bool
dumpString
dumpProp Window
_ String
"WM_CLIENT_LEADER" = Decoder Bool
dumpWindow
dumpProp Window
_ String
"_NET_WM_WINDOW_OPACITY" = Decoder Bool
dumpPercent
dumpProp Window
_ String
"XdndAware" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_XKLAVIER_TRANSPARENT" = Int -> Decoder Bool
dumpInteger Int
32
dumpProp Window
_ String
"_XKLAVIER_STATE" = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"state" ,Int -> Decoder Bool
dumpInteger Int
32)
,(String
"indicators",Decoder Bool
dumpXKlInds)
]
dumpProp Window
_ String
"_MOTIF_DRAG_RECEIVER_INFO" = Decoder Bool
dumpMotifDragReceiver
dumpProp Window
_ String
"_OL_WIN_ATTR" = Decoder Bool
dumpOLAttrs
dumpProp Window
_ String
"_OL_DECOR_ADD" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_OL_DECOR_DEL" = Decoder Bool -> Decoder Bool
dumpArray Decoder Bool
dumpAtom
dumpProp Window
_ String
"_MOTIF_WM_HINTS" = Decoder Bool
dumpMwmHints
dumpProp Window
_ String
"_MOTIF_WM_INFO" = Decoder Bool
dumpMwmInfo
dumpProp Window
_ String
"_XMONAD_DECORATED_BY" = Decoder Bool
dumpWindow
dumpProp Window
_ String
"_XMONAD_DECORATION_FOR" = Decoder Bool
dumpWindow
dumpProp Window
a String
_ | Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_NAME = Decoder Bool
dumpString
| Window
a forall a. Eq a => a -> a -> Bool
== Window
pRIMARY = Decoder Bool
dumpSelection
| Window
a forall a. Eq a => a -> a -> Bool
== Window
sECONDARY = Decoder Bool
dumpSelection
| Window
a forall a. Eq a => a -> a -> Bool
== Window
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 -> Window
theRoot)
Window
w <- 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
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 -> Window -> IO WMHints
getWMHints Window
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 Window
wgroup)
,(Integer
root,String
"window group " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Window
wgroup)
]
Decoder Bool
dumpWindow
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rESOURCE_MANAGER = Decoder Bool
dumpString
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_COMMAND = Decoder Bool
dumpString
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_HINTS = Decoder Bool
dumpWmHints
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_CLIENT_MACHINE = Decoder Bool
dumpString
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_ICON_NAME = Decoder Bool
dumpString
| Window
a forall a. Eq a => a -> a -> Bool
== Window
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)
]
)
]
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_NORMAL_HINTS = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_ZOOM_HINTS = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_DEFAULT_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_BEST_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_RED_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_GREEN_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_BLUE_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
rGB_GRAY_MAP = Decoder Bool
(...)
| Window
a forall a. Eq a => a -> a -> Bool
== Window
wM_CLASS = [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"name" ,Decoder Bool
dumpString)
,(String
"class",Decoder Bool
dumpString)
]
dumpProp Window
_ 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 :: Window -> Decoder Bool -> Decoder Bool
guardType Window
t = 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
dumpList :: [(String,Decoder Bool)] -> Decoder Bool
dumpList :: [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String, Decoder Bool)]
proto = do
Window
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
pType
CULong
-> [(String, Decoder Bool, Window)] -> 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,Window
a)) [(String, Decoder Bool)]
proto) String
"("
dumpList' :: [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpList' :: [(String, Decoder Bool, Window)] -> Decoder Bool
dumpList' [(String, Decoder Bool, Window)]
proto = CULong
-> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
dumpList'' (forall a. Bounded a => a
maxBound :: CULong) [(String, Decoder Bool, Window)]
proto String
"("
dumpListByMask :: CULong -> [(String,Decoder Bool)] -> Decoder Bool
dumpListByMask :: CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask CULong
m [(String, Decoder Bool)]
p = do
Window
a <- 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 (forall a b. (a -> b) -> [a] -> [b]
map (\(String
s,Decoder Bool
d) -> (String
s,Decoder Bool
d,Window
a)) [(String, Decoder Bool)]
p) String
"("
dumpListByMask' :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpListByMask' :: CULong -> [(String, Decoder Bool, Window)] -> Decoder Bool
dumpListByMask' CULong
m [(String, Decoder Bool, Window)]
p = CULong
-> [(String, Decoder Bool, Window)] -> String -> Decoder Bool
dumpList'' CULong
m [(String, Decoder Bool, Window)]
p String
"("
dumpList'' :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
dumpList'' :: CULong
-> [(String, Decoder Bool, Window)] -> 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, Window)]
_ 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,Window
t):[(String, Decoder Bool, Window)]
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 :: Window
pType = Window
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 :: Window
pType = Window
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, Window)] -> String -> Decoder Bool
dumpList'' (CULong
m forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(String, Decoder Bool, Window)]
ps String
sep' else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
e
dumpString :: Decoder Bool
dumpString :: Decoder Bool
dumpString = do
Window
fmt <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
pType
[Window
cOMPOUND_TEXT,Window
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 Window
getAtom [String
"COMPOUND_TEXT",String
"UTF8_STRING"]
case () of
() | Window
fmt forall a. Eq a => a -> a -> Bool
== Window
cOMPOUND_TEXT -> Int -> Decoder Bool -> Decoder Bool
guardSize Int
16 Decoder Bool
(...)
| Window
fmt forall a. Eq a => a -> a -> Bool
== Window
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
""
| Window
fmt forall a. Eq a => a -> a -> Bool
== Window
uTF8_STRING -> Decoder Bool
dumpUTF
| Bool
otherwise -> forall a. X a -> Decoder a
inX (Window -> X String
atomName Window
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
Window
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
property
Window
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 -> Window -> IO Window
xGetSelectionOwner Display
d Window
a
if Window
owner forall a. Eq a => a -> a -> Bool
== Window
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
$ Window -> X String
debugWindow Window
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 = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 =
Window -> Decoder Bool -> Decoder Bool
guardType Window
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
$ Window -> 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
$ Window -> Decoder Bool -> Decoder Bool
guardType Window
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 (Window -> 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
Window
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
pType
Window
nAW <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Window
getAtom String
"_NET_ACTIVE_WINDOW"
case () of
() | Window
t forall a. Eq a => a -> a -> Bool
== Window
wINDOW -> Decoder Bool
dumpWindow
| Window
t forall a. Eq a => a -> a -> Bool
== Window
nAW -> [(String, Decoder Bool, Window)] -> Decoder Bool
dumpList' [(String
"source" ,[String] -> Decoder Bool
dumpEnum [String]
awSource,Window
cARDINAL)
,(String
"timestamp" ,Decoder Bool
dumpTime ,Window
cARDINAL)
,(String
"active window",Decoder Bool
dumpWindow ,Window
wINDOW )
]
()
_ -> do
String
t' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Window -> X String
atomName Window
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
$ Window -> Decoder Bool -> Decoder Bool
guardType Window
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
$ Window -> Decoder Bool -> Decoder Bool
guardType Window
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
Window
uTF8_STRING <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Window
getAtom String
"UTF8_STRING"
Window -> Decoder Bool -> Decoder Bool
guardType Window
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] -> Window -> Decoder Bool
dumpEnum' [String]
ss Window
fmt = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 (Window, 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
-> Window
-> IO (Window, 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 (Window, Position, Position, Word32, Word32, Word32, CInt)
g' of
Maybe (Window, Position, Position, Word32, Word32, Word32, CInt)
Nothing -> String -> Decoder Bool
append String
" (deleted)"
Just (Window
_,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
Window
pt <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Window
getAtom String
"_OL_WIN_ATTR"
Window -> Decoder Bool -> Decoder Bool
guardType Window
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
Window
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
property
Window -> Decoder Bool -> Decoder Bool
guardType Window
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
Window
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Window
property
Window -> Decoder Bool -> Decoder Bool
guardType Window
ta forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Window)] -> Decoder Bool
dumpList' [(String
"flags" ,[String] -> Decoder Bool
dumpBits [String]
mwmHints,Window
cARDINAL)
,(String
"window",Decoder Bool
dumpWindow ,Window
wINDOW )
]
dumpEnum :: [String] -> Decoder Bool
dumpEnum :: [String] -> Decoder Bool
dumpEnum [String]
ss = [String] -> Window -> Decoder Bool
dumpEnum' [String]
ss Window
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 = Window -> Decoder Bool -> Decoder Bool
guardType Window
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
Window
wM_STATE <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Window
getAtom String
"WM_STATE"
Window -> Decoder Bool -> Decoder Bool
guardType Window
wM_STATE forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Window)] -> Decoder Bool
dumpList' [(String
"state" ,[String] -> Decoder Bool
dumpEnum [String]
wmState,Window
cARDINAL)
,(String
"icon window",Decoder Bool
dumpWindow ,Window
wINDOW )
]
dumpMotifDragReceiver :: Decoder Bool
dumpMotifDragReceiver :: Decoder Bool
dumpMotifDragReceiver = do
Window
ta <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Window
getAtom String
"_MOTIF_DRAG_RECEIVER_INFO"
Window -> Decoder Bool -> Decoder Bool
guardType Window
ta forall a b. (a -> b) -> a -> b
$ [(String, Decoder Bool, Window)] -> Decoder Bool
dumpList' [(String
"endian" ,Decoder Bool
dumpMotifEndian,Window
cARDINAL)
,(String
"version" ,Decoder Bool
dump8 ,Window
cARDINAL)
,(String
"style" ,Decoder Bool
dumpMDropStyle ,Window
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 = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 =
Window -> Decoder Bool -> Decoder Bool
guardType Window
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, Window)] -> Decoder Bool
dumpListByMask' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk')
[(String
"input" ,[String] -> Decoder Bool
dumpEnum [String]
bool ,Window
cARDINAL)
,(String
"initial_state",[String] -> Decoder Bool
dumpEnum [String]
wmState,Window
cARDINAL)
,(String
"icon_pixmap" ,Decoder Bool
dumpPixmap ,Window
pIXMAP )
,(String
"icon_window" ,Decoder Bool
dumpWindow ,Window
wINDOW )
,(String
"icon_x" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"icon_y" ,Decoder Bool
dump32 ,Window
cARDINAL)
,(String
"icon_mask" ,Decoder Bool
dumpPixmap ,Window
pIXMAP )
,(String
"window_group" ,Decoder Bool
dumpWindow ,Window
wINDOW )
]
dumpBits :: [String] -> Decoder Bool
dumpBits :: [String] -> Decoder Bool
dumpBits [String]
bs = Window -> Decoder Bool -> Decoder Bool
guardType Window
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 :: Window -> Window -> Decoder Bool
propTypeErr Window
a Window
e = do
String
e' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Window -> X String
atomName Window
e
String
a' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Window -> X String
atomName Window
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 -> Window
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
. Window -> 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