{-# 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 hiding (void)
import Foreign.C.Types
import Numeric (showHex)
import System.Exit
import System.IO
import System.Process
import GHC.Stack (HasCallStack, prettyCallStack, callStack)
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 -> Atom
ev_window = Atom
w
,ev_parent :: Event -> Atom
ev_parent = Atom
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 -> Atom
ev_above = Atom
above
,ev_detail :: Event -> CInt
ev_detail = CInt
place
,ev_value_mask :: Event -> CULong
ev_value_mask = CULong
msk
} = do
String -> Atom -> X ()
windowEvent String
"ConfigureRequest" Atom
w
String -> Atom -> X ()
windowEvent String
" parent" Atom
p
String
s <- forall i.
(HasCallStack, 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 Atom
above,CInt
place] forall a b. (a -> b) -> a -> b
$
HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpListByMask' CULong
msk [(String
"x" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"y" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"width" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"height" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"border_width",HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"sibling" ,HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
,(String
"detail" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
wmPlacement,Atom
cARDINAL)
]
String -> String -> X ()
say String
" requested" String
s
debugEventsHook' ConfigureEvent {ev_window :: Event -> Atom
ev_window = Atom
w
,ev_above :: Event -> Atom
ev_above = Atom
above
} = do
String -> Atom -> X ()
windowEvent String
"Configure" Atom
w
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Atom
above forall a. Eq a => a -> a -> Bool
/= Atom
none) forall a b. (a -> b) -> a -> b
$ Atom -> X String
debugWindow Atom
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 -> Atom
ev_window = Atom
w
,ev_parent :: Event -> Atom
ev_parent = Atom
p
} =
String -> Atom -> X ()
windowEvent String
"MapRequest" Atom
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Atom -> X ()
windowEvent String
" parent" Atom
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 -> Atom
ev_window = Atom
w
,ev_state :: Event -> KeyMask
ev_state = KeyMask
s
,ev_button :: Event -> Word32
ev_button = Word32
b
} = do
String -> Atom -> X ()
windowEvent String
"Button" Atom
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 -> Atom
ev_window = Atom
w
} =
String -> Atom -> X ()
windowEvent String
"DestroyWindow" Atom
w
debugEventsHook' UnmapEvent {ev_window :: Event -> Atom
ev_window = Atom
w
} =
String -> Atom -> X ()
windowEvent String
"Unmap" Atom
w
debugEventsHook' MapNotifyEvent {ev_window :: Event -> Atom
ev_window = Atom
w
} =
String -> Atom -> X ()
windowEvent String
"MapNotify" Atom
w
debugEventsHook' CrossingEvent {} =
forall (m :: * -> *) a. Monad m => a -> m a
return ()
debugEventsHook' SelectionRequest {ev_requestor :: Event -> Atom
ev_requestor = Atom
rw
,ev_owner :: Event -> Atom
ev_owner = Atom
ow
,ev_selection :: Event -> Atom
ev_selection = Atom
a
} =
String -> Atom -> X ()
windowEvent String
"SelectionRequest" Atom
rw forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Atom -> X ()
windowEvent String
" owner" Atom
ow forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
String -> Atom -> X ()
atomEvent String
" atom" Atom
a
debugEventsHook' PropertyEvent {ev_window :: Event -> Atom
ev_window = Atom
w
,ev_atom :: Event -> Atom
ev_atom = Atom
a
,ev_propstate :: Event -> CInt
ev_propstate = CInt
s
} = do
String
a' <- Atom -> X String
atomName Atom
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 -> Atom -> X ()
windowEvent String
"Property on" Atom
w
String
s' <- case CInt
s of
CInt
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"deleted"
CInt
0 -> HasCallStack => Atom -> String -> Atom -> Int -> X String
dumpProperty Atom
a String
a' Atom
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 -> Atom
ev_window = Atom
w
} =
String -> Atom -> X ()
windowEvent String
"Expose" Atom
w
debugEventsHook' ClientMessageEvent {ev_window :: Event -> Atom
ev_window = Atom
w
,ev_message_type :: Event -> Atom
ev_message_type = Atom
a
,ev_data :: Event -> [CInt]
ev_data = [CInt]
vs'
} = do
String -> Atom -> X ()
windowEvent String
"ClientMessage on" Atom
w
String
n <- Atom -> X String
atomName Atom
a
(Atom
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 (Atom
a,Int
32,forall (t :: * -> *) a. Foldable t => t a -> Int
length [CInt]
vs')
Just (String
ta',Int
b,Int
l) -> do
Atom
ta <- String -> X Atom
getAtom String
ta'
forall (m :: * -> *) a. Monad m => a -> m a
return (Atom
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 <- HasCallStack =>
Atom
-> Atom
-> String
-> Atom
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Atom
w Atom
a String
n Atom
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 :: Atom -> X String
atomName Atom
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 Atom
a forall a. [a] -> [a] -> [a]
++ String
")") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Atom -> IO (Maybe String)
getAtomName Display
d Atom
a
atomEvent :: String -> Atom -> X ()
atomEvent :: String -> Atom -> X ()
atomEvent String
l Atom
a = Atom -> X String
atomName Atom
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 -> Atom -> X ()
windowEvent String
l Atom
w = Atom -> X String
debugWindow Atom
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 ()
XMonad.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 -> Atom
property :: Atom
,Decode -> String
pName :: String
,Decode -> Atom
pType :: Atom
,Decode -> Int
width :: Int
,Decode -> Atom
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)
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
)
dumpProperty :: HasCallStack => Atom -> String -> Window -> Int -> X String
dumpProperty :: HasCallStack => Atom -> String -> Atom -> Int -> X String
dumpProperty Atom
a String
n Atom
w Int
i = do
Either String (Atom, 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 Atom
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
-> Atom
-> Atom
-> CLong
-> CLong
-> Bool
-> Atom
-> Ptr Atom
-> Ptr CInt
-> Ptr CULong
-> Ptr CULong
-> Ptr (Ptr CUChar)
-> IO CInt
xGetWindowProperty
Display
d
Atom
w
Atom
a
CLong
0
forall a. Bounded a => a
maxBound
Bool
False
Atom
anyPropertyType
Ptr Atom
fmtp
Ptr CInt
szp
Ptr CULong
lenp
Ptr CULong
ackp
Ptr (Ptr CUChar)
vsp
case CInt
rc of
CInt
0 -> do
Atom
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 Atom
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
() | Atom
fmt forall a. Eq a => a -> a -> Bool
== Atom
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 (Atom
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 (Atom, Int, CULong, [CUChar])
prop of
Left String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Right (Atom
fmt,Int
sz,CULong
ack,[CUChar]
vs) -> HasCallStack =>
Atom
-> Atom
-> String
-> Atom
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Atom
w Atom
a String
n Atom
fmt Int
sz [CUChar]
vs CULong
ack Int
i
dumpProperty' :: HasCallStack
=> Window
-> Atom
-> String
-> Atom
-> Int
-> Raw
-> CULong
-> Int
-> X String
dumpProperty' :: HasCallStack =>
Atom
-> Atom
-> String
-> Atom
-> Int
-> [CUChar]
-> CULong
-> Int
-> X String
dumpProperty' Atom
w Atom
a String
n Atom
fmt Int
sz [CUChar]
vs CULong
ack Int
i = do
String
ptn <- Atom -> X String
atomName Atom
fmt
let dec :: Decode
dec = Decode {property :: Atom
property = Atom
a
,pName :: String
pName = String
n
,pType :: Atom
pType = Atom
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 :: Atom
window = Atom
w
,limit :: Int
limit = Int
96
}
dec' :: Decode
dec' = Decode
dec {pType :: Atom
pType = Atom
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
$ HasCallStack => Atom -> String -> Decoder Bool
dumpProp Atom
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
$ HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => 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 :: (HasCallStack, Storable i, Integral i) => [i] -> Decoder Bool -> X String
quickFormat :: forall i.
(HasCallStack, 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 :: Atom
property = Atom
none
,pName :: String
pName = String
""
,pType :: Atom
pType = Atom
cARDINAL
,width :: Int
width = Int
32
,indent :: Int
indent = Int
0
,window :: Atom
window = Atom
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 :: HasCallStack => Atom -> String -> Decoder Bool
dumpProp :: HasCallStack => Atom -> String -> Decoder Bool
dumpProp Atom
_ String
"CLIPBOARD" = HasCallStack => Decoder Bool
dumpSelection
dumpProp Atom
_ String
"_NET_SUPPORTED" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_NET_CLIENT_LIST" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_NET_CLIENT_LIST_STACKING" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_NET_NUMBER_OF_DESKTOPS" = HasCallStack => Decoder Bool
dump32
dumpProp Atom
_ String
"_NET_VIRTUAL_ROOTS" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_NET_DESKTOP_GEOMETRY" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dump32
dumpProp Atom
_ String
"_NET_DESKTOP_VIEWPORT" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_CURRENT_DESKTOP" = HasCallStack => Decoder Bool
dump32
dumpProp Atom
_ String
"_NET_DESKTOP_NAMES" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"_NET_ACTIVE_WINDOW" = HasCallStack => Decoder Bool
dumpActiveWindow
dumpProp Atom
_ String
"_NET_WORKAREA" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"start"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"x",HasCallStack => Decoder Bool
dump32)
,(String
"y",HasCallStack => Decoder Bool
dump32)
]
)
,(String
"size"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
)
]
dumpProp Atom
_ String
"_NET_SUPPORTING_WM_CHECK" = HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_NET_DESKTOP_LAYOUT" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"orientation"
,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
nwmOrientation
)
,(String
"size"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"cols",HasCallStack => Decoder Bool
dump32)
,(String
"rows",HasCallStack => Decoder Bool
dump32)
]
)
,(String
"origin"
,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
nwmOrigin
)
]
dumpProp Atom
_ String
"_NET_SHOWING_DESKTOP" = HasCallStack => Decoder Bool
dump32
dumpProp Atom
_ String
"_NET_WM_NAME" = HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"_NET_WM_VISIBLE_NAME" = HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"_NET_WM_ICON_NAME" = HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"_NET_WM_VISIBLE_ICON_NAME" = HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"_NET_WM_DESKTOP" = HasCallStack => Decoder Bool
dumpSetDesktop
dumpProp Atom
_ String
"_NET_WM_WINDOW_TYPE" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_NET_WM_STATE" = HasCallStack => Decoder Bool
dumpNWState
dumpProp Atom
_ String
"_NET_WM_ALLOWED_ACTIONS" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_NET_WM_STRUT" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"right gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"top gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"bottom gap",HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_WM_STRUT_PARTIAL" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"right gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"top gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"bottom gap" ,HasCallStack => Decoder Bool
dump32)
,(String
"left start" ,HasCallStack => Decoder Bool
dump32)
,(String
"left end" ,HasCallStack => Decoder Bool
dump32)
,(String
"right start" ,HasCallStack => Decoder Bool
dump32)
,(String
"right end" ,HasCallStack => Decoder Bool
dump32)
,(String
"top start" ,HasCallStack => Decoder Bool
dump32)
,(String
"top end" ,HasCallStack => Decoder Bool
dump32)
,(String
"bottom start",HasCallStack => Decoder Bool
dump32)
,(String
"bottom end" ,HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_WM_ICON_GEOMETRY" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"x",HasCallStack => Decoder Bool
dump32)
,(String
"y",HasCallStack => Decoder Bool
dump32)
,(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_WM_ICON" = String -> Decoder Bool
propSimple String
"(icon)"
dumpProp Atom
_ String
"_NET_WM_PID" = HasCallStack => Decoder Bool
dumpPid
dumpProp Atom
_ String
"_NET_WM_HANDLED_ICONS" = String -> Decoder Bool
propSimple String
"(defined)"
dumpProp Atom
_ String
"_NET_WM_USER_TIME" = HasCallStack => [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"do not map initially")]
HasCallStack => Decoder Bool
dumpTime
dumpProp Atom
_ String
"_NET_FRAME_EXTENTS" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"left" ,HasCallStack => Decoder Bool
dump32)
,(String
"right" ,HasCallStack => Decoder Bool
dump32)
,(String
"top" ,HasCallStack => Decoder Bool
dump32)
,(String
"bottom",HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_WM_SYNC_REQUEST_COUNTER" = HasCallStack => [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0,String
"illegal value 0")]
HasCallStack => Decoder Bool
dump64
dumpProp Atom
_ String
"_NET_WM_OPAQUE_REGION" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray forall a b. (a -> b) -> a -> b
$ HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"x",HasCallStack => Decoder Bool
dump32)
,(String
"y",HasCallStack => Decoder Bool
dump32)
,(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
dumpProp Atom
_ String
"_NET_WM_BYPASS_COMPOSITOR" = HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
cpState
dumpProp Atom
_ String
"_NET_STARTUP_ID" = HasCallStack => Decoder Bool
dumpUTF
dumpProp Atom
_ String
"WM_PROTOCOLS" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"WM_COLORMAP_WINDOWS" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"WM_STATE" = HasCallStack => Decoder Bool
dumpState
dumpProp Atom
_ String
"WM_LOCALE_NAME" = HasCallStack => Decoder Bool
dumpString
dumpProp Atom
_ String
"WM_CLIENT_LEADER" = HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_NET_WM_WINDOW_OPACITY" = HasCallStack => Decoder Bool
dumpPercent
dumpProp Atom
_ String
"XdndAware" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_XKLAVIER_TRANSPARENT" = HasCallStack => Int -> Decoder Bool
dumpInteger Int
32
dumpProp Atom
_ String
"_XKLAVIER_STATE" = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"state" ,HasCallStack => Int -> Decoder Bool
dumpInteger Int
32)
,(String
"indicators",HasCallStack => Decoder Bool
dumpXKlInds)
]
dumpProp Atom
_ String
"_MOTIF_DRAG_RECEIVER_INFO" = HasCallStack => Decoder Bool
dumpMotifDragReceiver
dumpProp Atom
_ String
"_OL_WIN_ATTR" = HasCallStack => Decoder Bool
dumpOLAttrs
dumpProp Atom
_ String
"_OL_DECOR_ADD" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_OL_DECOR_DEL" = HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
dumpProp Atom
_ String
"_MOTIF_WM_HINTS" = HasCallStack => Decoder Bool
dumpMwmHints
dumpProp Atom
_ String
"_MOTIF_WM_INFO" = HasCallStack => Decoder Bool
dumpMwmInfo
dumpProp Atom
_ String
"_XMONAD_DECORATED_BY" = HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
_ String
"_XMONAD_DECORATION_FOR" = HasCallStack => Decoder Bool
dumpWindow
dumpProp Atom
a String
_ | Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_NAME = HasCallStack => Decoder Bool
dumpString
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
pRIMARY = HasCallStack => Decoder Bool
dumpSelection
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
sECONDARY = HasCallStack => Decoder Bool
dumpSelection
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
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 -> Atom
theRoot)
Atom
w <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
window
WMHints {wmh_window_group :: WMHints -> Atom
wmh_window_group = Atom
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 -> Atom -> IO WMHints
getWMHints Atom
w
HasCallStack => [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0 ,String
"window group " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Atom
wgroup)
,(Integer
root,String
"window group " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Atom
wgroup)
]
HasCallStack => Decoder Bool
dumpWindow
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rESOURCE_MANAGER = HasCallStack => Decoder Bool
dumpString
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_COMMAND = HasCallStack => Decoder Bool
dumpString
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_HINTS = HasCallStack => Decoder Bool
dumpWmHints
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_CLIENT_MACHINE = HasCallStack => Decoder Bool
dumpString
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_ICON_NAME = HasCallStack => Decoder Bool
dumpString
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_ICON_SIZE = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"min size"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
)
,(String
"max size"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
)
,(String
"increment"
,HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"w",HasCallStack => Decoder Bool
dump32)
,(String
"h",HasCallStack => Decoder Bool
dump32)
]
)
]
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_NORMAL_HINTS = HasCallStack => Decoder Bool
dumpSizeHints
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_ZOOM_HINTS = HasCallStack => Decoder Bool
dumpSizeHints
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_DEFAULT_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_BEST_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_RED_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_GREEN_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_BLUE_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
rGB_GRAY_MAP = Decoder Bool
(...)
| Atom
a forall a. Eq a => a -> a -> Bool
== Atom
wM_CLASS = HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String
"name" ,HasCallStack => Decoder Bool
dumpString)
,(String
"class",HasCallStack => Decoder Bool
dumpString)
]
dumpProp Atom
_ String
s | String
s String -> String -> Bool
`isCountOf` String
"WM_S" = HasCallStack => Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"_NET_WM_CM_S" = HasCallStack => Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"_NET_DESKTOP_LAYOUT_S" = HasCallStack => Decoder Bool
dumpSelection
| String
s String -> String -> Bool
`isCountOf` String
"CUT_BUFFER" = HasCallStack => 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 :: HasCallStack => Decoder Bool -> Decoder Bool
dumpArray :: HasCallStack => 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
"" (HasCallStack => Decoder Bool -> String -> Decoder Bool
dumpArray' Decoder Bool
item String
"")
dumpArray' :: HasCallStack => Decoder Bool -> String -> Decoder Bool
dumpArray' :: HasCallStack => 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 :: * -> *).
(HasCallStack, Monad m) =>
m Bool -> m Bool -> m Bool
whenD Decoder Bool
item (HasCallStack => Decoder Bool -> String -> Decoder Bool
dumpArray' Decoder Bool
item String
",")
whenD :: (HasCallStack, Monad m) => m Bool -> m Bool -> m Bool
whenD :: forall (m :: * -> *).
(HasCallStack, 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 :: (HasCallStack, MonadReader r m, Eq v)
=> (r -> v)
-> v
-> (v -> v -> m a)
-> m a
-> m a
guardR :: forall r (m :: * -> *) v a.
(HasCallStack, 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 :: HasCallStack => Bool -> a -> a -> a
fi :: forall a. HasCallStack => Bool -> a -> a -> a
fi Bool
p a
n a
y = if Bool
p then a
y else a
n
guardSize :: HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize :: HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
64 = forall r (m :: * -> *) v a.
(HasCallStack, 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.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize' Int
8 (HasCallStack => Int -> Decoder Bool
propShortErr' Int
1)
guardSize Int
w = forall r (m :: * -> *) v a.
(HasCallStack, 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.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize' (Int -> Int
bytes Int
w) (HasCallStack => Int -> Decoder Bool
propShortErr' Int
2)
guardSize' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a
guardSize' :: forall a.
HasCallStack =>
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. HasCallStack => Bool -> a -> a -> a
fi (forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs forall a. Ord a => a -> a -> Bool
>= Int -> Int
bytes Int
l) Decoder a
n Decoder a
y
guardSize'' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' :: forall a.
HasCallStack =>
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. HasCallStack => Bool -> a -> a -> a
fi (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CUChar]
vs Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Int
length [CUChar]
vs forall a. Ord a => a -> a -> Bool
>= Int -> Int
bytes Int
l) Decoder a
n Decoder a
y
guardType :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
t = forall r (m :: * -> *) v a.
(HasCallStack, MonadReader r m, Eq v) =>
(r -> v) -> v -> (v -> v -> m a) -> m a -> m a
guardR Decode -> Atom
pType Atom
t Atom -> Atom -> Decoder Bool
propTypeErr
dumpList :: HasCallStack => [(String,Decoder Bool)] -> Decoder Bool
dumpList :: HasCallStack => [(String, Decoder Bool)] -> Decoder Bool
dumpList [(String, Decoder Bool)]
proto = do
Atom
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> 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,Atom
a)) [(String, Decoder Bool)]
proto) String
"("
dumpList' :: HasCallStack => [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpList' :: HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String, Decoder Bool, Atom)]
proto = HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> String -> Decoder Bool
dumpList'' (forall a. Bounded a => a
maxBound :: CULong) [(String, Decoder Bool, Atom)]
proto String
"("
dumpListByMask :: HasCallStack => CULong -> [(String,Decoder Bool)] -> Decoder Bool
dumpListByMask :: HasCallStack => CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask CULong
m [(String, Decoder Bool)]
p = do
Atom
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> String -> Decoder Bool
dumpList'' CULong
m (forall a b. (a -> b) -> [a] -> [b]
map (\(String
s,Decoder Bool
d) -> (String
s,Decoder Bool
d,Atom
a)) [(String, Decoder Bool)]
p) String
"("
dumpListByMask' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpListByMask' :: HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpListByMask' CULong
m [(String, Decoder Bool, Atom)]
p = HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> String -> Decoder Bool
dumpList'' CULong
m [(String, Decoder Bool, Atom)]
p String
"("
dumpList'' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
dumpList'' :: HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> 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, Atom)]
_ 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,Atom
t):[(String, Decoder Bool, Atom)]
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 :: Atom
pType = Atom
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 :: Atom
pType = Atom
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 HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> String -> Decoder Bool
dumpList'' (CULong
m forall a. Bits a => a -> Int -> a
`shiftR` Int
1) [(String, Decoder Bool, Atom)]
ps String
sep' else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
e
dumpString :: HasCallStack => Decoder Bool
dumpString :: HasCallStack => Decoder Bool
dumpString = do
Atom
fmt <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
[Atom
cOMPOUND_TEXT,Atom
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 Atom
getAtom [String
"COMPOUND_TEXT",String
"UTF8_STRING"]
case () of
() | Atom
fmt forall a. Eq a => a -> a -> Bool
== Atom
cOMPOUND_TEXT -> forall a.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' Int
16 (HasCallStack => Int -> Decoder Bool
propShortErr' Int
3) ( ... )
| Atom
fmt forall a. Eq a => a -> a -> Bool
== Atom
sTRING -> forall a.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' Int
8 (HasCallStack => Int -> Decoder Bool
propShortErr' Int
4) 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' = forall a. Int -> [a] -> [a]
drop Int
1 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
""
| Atom
fmt forall a. Eq a => a -> a -> Bool
== Atom
uTF8_STRING -> HasCallStack => Decoder Bool
dumpUTF
| Bool
otherwise -> forall a. X a -> Decoder a
inX (Atom -> X String
atomName Atom
fmt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
HasCallStack => String -> Decoder Bool
failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"unrecognized string type " forall a. [a] -> [a] -> [a]
++)
dumpSelection :: HasCallStack => Decoder Bool
dumpSelection :: HasCallStack => Decoder Bool
dumpSelection = do
Atom
a <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
property
Atom
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 -> Atom -> IO Atom
xGetSelectionOwner Display
d Atom
a
if Atom
owner forall a. Eq a => a -> a -> Bool
== Atom
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
$ Atom -> X String
debugWindow Atom
owner
String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"owned by " forall a. [a] -> [a] -> [a]
++ String
w
dumpXKlInds :: HasCallStack => Decoder Bool
dumpXKlInds :: HasCallStack => Decoder Bool
dumpXKlInds = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
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
<$> HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Word32
n of
Maybe Word32
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
5
Just Word32
is -> String -> Decoder Bool
append forall a b. (a -> b) -> a -> b
$ String
"indicators " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds Word32
is Word32
1 Int
1 [])
where
dumpInds :: HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds :: HasCallStack => 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 = HasCallStack => 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 = HasCallStack => 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 :: HasCallStack => Decoder Bool
dumpAtom :: HasCallStack => Decoder Bool
dumpAtom = HasCallStack => Atom -> Decoder Bool
dumpAtom'' Atom
aTOM
dumpAtom'' :: HasCallStack => Atom -> Decoder Bool
dumpAtom'' :: HasCallStack => Atom -> Decoder Bool
dumpAtom'' Atom
t =
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
t forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
a <- HasCallStack => 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
$ Atom -> 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 :: HasCallStack => Decoder Bool
dumpWindow :: HasCallStack => Decoder Bool
dumpWindow = HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
32 forall a b. (a -> b) -> a -> b
$ HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
wINDOW forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
w <- HasCallStack => 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
0 -> String -> Decoder Bool
append String
"none"
Just Integer
w' -> forall a. X a -> Decoder a
inX (Atom -> 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 :: HasCallStack => Decoder Bool
dumpActiveWindow :: HasCallStack => Decoder Bool
dumpActiveWindow = HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
32 forall a b. (a -> b) -> a -> b
$ do
Atom
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
Atom
nAW <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"_NET_ACTIVE_WINDOW"
case () of
() | Atom
t forall a. Eq a => a -> a -> Bool
== Atom
wINDOW -> HasCallStack => Decoder Bool
dumpWindow
| Atom
t forall a. Eq a => a -> a -> Bool
== Atom
nAW -> HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"source" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
awSource,Atom
cARDINAL)
,(String
"timestamp" ,HasCallStack => Decoder Bool
dumpTime ,Atom
cARDINAL)
,(String
"active window",HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
]
()
_ -> do
String
t' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Atom -> X String
atomName Atom
t
HasCallStack => 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)"
]
dumpSetDesktop :: HasCallStack => Decoder Bool
dumpSetDesktop :: HasCallStack => Decoder Bool
dumpSetDesktop = HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
32 forall a b. (a -> b) -> a -> b
$ do
Atom
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
Atom
nWD <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"_NET_WM_DESKTOP"
case () of
() | Atom
t forall a. Eq a => a -> a -> Bool
== Atom
cARDINAL -> HasCallStack => [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0xFFFFFFFF,String
"all")]
HasCallStack => Decoder Bool
dump32
| Atom
t forall a. Eq a => a -> a -> Bool
== Atom
nWD -> HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"desktop",HasCallStack => [(Integer, String)] -> Decoder Bool -> Decoder Bool
dumpExcept [(Integer
0xFFFFFFFF,String
"all")]
HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"source" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
awSource ,Atom
cARDINAL)
]
()
_ -> do
String
t' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Atom -> X String
atomName Atom
t
HasCallStack => 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 CARDINAL or _NET_WM_DESKTOP)"
]
dumpNWState :: HasCallStack => Decoder Bool
dumpNWState :: HasCallStack => Decoder Bool
dumpNWState = forall a.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' Int
32 HasCallStack => Decoder Bool
propShortErr forall a b. (a -> b) -> a -> b
$ do
Atom
t <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
pType
Atom
nWS <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"_NET_WM_STATE"
case () of
() | Atom
t forall a. Eq a => a -> a -> Bool
== Atom
aTOM -> HasCallStack => Decoder Bool -> Decoder Bool
dumpArray HasCallStack => Decoder Bool
dumpAtom
| Atom
t forall a. Eq a => a -> a -> Bool
== Atom
nWS -> HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"action",HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
nwAction,Atom
cARDINAL)
,(String
"atom1" ,HasCallStack => Decoder Bool
dumpAtom ,Atom
aTOM)
,(String
"atom2" ,HasCallStack => Decoder Bool
dumpAtom ,Atom
aTOM)
]
()
_ -> do
String
t' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Atom -> X String
atomName Atom
t
HasCallStack => 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 ATOM or _NET_WM_STATE)"
]
dumpInt :: HasCallStack => Int -> Decoder Bool
dumpInt :: HasCallStack => Int -> Decoder Bool
dumpInt Int
w = HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
w forall a b. (a -> b) -> a -> b
$ HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
cARDINAL forall a b. (a -> b) -> a -> b
$ Int -> (Integer -> String) -> Decoder Bool
getInt Int
w forall a. Show a => a -> String
show
dumpInteger :: HasCallStack => Int -> Decoder Bool
dumpInteger :: HasCallStack => Int -> Decoder Bool
dumpInteger Int
w = HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize Int
w forall a b. (a -> b) -> a -> b
$ HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
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
. HasCallStack => Int -> Integer -> Integer
signed Int
w)
signed :: HasCallStack => Int -> Integer -> Integer
signed :: HasCallStack => 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 :: HasCallStack => Decoder Bool
dump64 :: HasCallStack => Decoder Bool
dump64 = HasCallStack => Int -> Decoder Bool
dumpInt Int
64
dump32 :: HasCallStack => Decoder Bool
dump32 :: HasCallStack => Decoder Bool
dump32 = HasCallStack => Int -> Decoder Bool
dumpInt Int
32
dump8 :: HasCallStack => Decoder Bool
dump8 :: HasCallStack => Decoder Bool
dump8 = HasCallStack => Int -> Decoder Bool
dumpInt Int
8
dumpUTF :: HasCallStack => Decoder Bool
dumpUTF :: HasCallStack => Decoder Bool
dumpUTF = do
Atom
uTF8_STRING <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"UTF8_STRING"
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
uTF8_STRING forall a b. (a -> b) -> a -> b
$ forall a.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' Int
8 HasCallStack => Decoder Bool
propShortErr 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' :: HasCallStack => [String] -> Atom -> Decoder Bool
dumpEnum' :: HasCallStack => [String] -> Atom -> Decoder Bool
dumpEnum' [String]
ss Atom
fmt = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
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 :: HasCallStack => Decoder Bool
dumpPixmap :: HasCallStack => Decoder Bool
dumpPixmap = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
pIXMAP forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
p' <- HasCallStack => 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
0 -> String -> Decoder Bool
append String
"none"
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 (Atom, 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
-> Atom
-> IO (Atom, 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 (Atom, Position, Position, Word32, Word32, Word32, CInt)
g' of
Maybe (Atom, Position, Position, Word32, Word32, Word32, CInt)
Nothing -> String -> Decoder Bool
append String
" (deleted)"
Just (Atom
_,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 :: HasCallStack => Decoder Bool
dumpOLAttrs :: HasCallStack => Decoder Bool
dumpOLAttrs = do
Atom
pt <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"_OL_WIN_ATTR"
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
pt forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
msk of
Maybe Integer
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
7
Just Integer
msk' -> HasCallStack => CULong -> [(String, Decoder Bool)] -> Decoder Bool
dumpListByMask (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk') [(String
"window type" ,HasCallStack => Decoder Bool
dumpAtom )
,(String
"menu" ,HasCallStack => Decoder Bool
dump32 )
,(String
"pushpin" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
bool)
,(String
"limited menu",HasCallStack => Decoder Bool
dump32 )
]
dumpMwmHints :: HasCallStack => Decoder Bool
dumpMwmHints :: HasCallStack => Decoder Bool
dumpMwmHints = do
Atom
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
property
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
ta forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
32
case Maybe Integer
msk of
Maybe Integer
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
8
Just Integer
msk' -> HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpListByMask' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk') [(String
"functions" ,HasCallStack => [String] -> Decoder Bool
dumpBits [String]
mwmFuncs ,Atom
cARDINAL)
,(String
"decorations",HasCallStack => [String] -> Decoder Bool
dumpBits [String]
mwmDecos ,Atom
cARDINAL)
,(String
"input mode" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
mwmInputMode,Atom
cARDINAL)
,(String
"status" ,HasCallStack => [String] -> Decoder Bool
dumpBits [String]
mwmState ,Atom
cARDINAL)
]
dumpMwmInfo :: HasCallStack => Decoder Bool
dumpMwmInfo :: HasCallStack => Decoder Bool
dumpMwmInfo = do
Atom
ta <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Decode -> Atom
property
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
ta forall a b. (a -> b) -> a -> b
$ HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"flags" ,HasCallStack => [String] -> Decoder Bool
dumpBits [String]
mwmHints,Atom
cARDINAL)
,(String
"window",HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
]
dumpSizeHints :: HasCallStack => Decoder Bool
dumpSizeHints :: HasCallStack => Decoder Bool
dumpSizeHints = do
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
wM_SIZE_HINTS forall a b. (a -> b) -> a -> b
$ do
Maybe CULong
msk <- 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
<$> HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
32
Int -> Decoder [CUChar]
eat (Int
4 forall a. Num a => a -> a -> a
* Int
4) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
case Maybe CULong
msk of
Maybe CULong
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
9
Just CULong
msk' -> HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpListByMask' CULong
msk' [(String
"min size" ,HasCallStack => Decoder Bool
dumpSize ,Atom
cARDINAL)
,(String
"max size" ,HasCallStack => Decoder Bool
dumpSize ,Atom
cARDINAL)
,(String
"increment" ,HasCallStack => Decoder Bool
dumpSize ,Atom
cARDINAL)
,(String
"aspect ratio",HasCallStack => Decoder Bool
dumpAspect,Atom
cARDINAL)
,(String
"base size" ,HasCallStack => Decoder Bool
dumpSize ,Atom
cARDINAL)
,(String
"gravity" ,HasCallStack => Decoder Bool
dumpGrav ,Atom
cARDINAL)
]
dumpSize :: HasCallStack => Decoder Bool
dumpSize :: HasCallStack => Decoder Bool
dumpSize = String -> Decoder Bool
append String
"(" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => Decoder Bool
dump32 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Decoder Bool
append String
"," forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => Decoder Bool
dump32 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Decoder Bool
append String
")"
dumpAspect :: HasCallStack => Decoder Bool
dumpAspect :: HasCallStack => Decoder Bool
dumpAspect = do
String -> Decoder Bool
append String
"min = "
HasCallStack => Decoder Bool
dump32
String -> Decoder Bool
append String
"/"
HasCallStack => Decoder Bool
dump32
String -> Decoder Bool
append String
", max = "
HasCallStack => Decoder Bool
dump32
String -> Decoder Bool
append String
"/"
HasCallStack => Decoder Bool
dump32
dumpGrav :: HasCallStack => Decoder Bool
dumpGrav :: HasCallStack => Decoder Bool
dumpGrav = HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
wmGravity
dumpEnum :: HasCallStack => [String] -> Decoder Bool
dumpEnum :: HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
ss = HasCallStack => [String] -> Atom -> Decoder Bool
dumpEnum' [String]
ss Atom
cARDINAL
dumpExcept :: HasCallStack => [(Integer,String)] -> Decoder Bool -> Decoder Bool
dumpExcept :: HasCallStack => [(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 (HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
w)
HasCallStack =>
[(Integer, String)] -> DecodeState -> Integer -> Decoder Bool
dumpExcept' [(Integer, String)]
xs DecodeState
that Integer
v
dumpExcept' :: HasCallStack
=> [(Integer,String)]
-> DecodeState
-> Integer
-> Decoder Bool
dumpExcept' :: HasCallStack =>
[(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 = HasCallStack =>
[(Integer, String)] -> DecodeState -> Integer -> Decoder Bool
dumpExcept' [(Integer, String)]
xs DecodeState
that Integer
val
dumpPid :: HasCallStack => Decoder Bool
dumpPid :: HasCallStack => Decoder Bool
dumpPid = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- HasCallStack => 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 :: HasCallStack => Decoder Bool
dumpTime :: HasCallStack => Decoder Bool
dumpTime = String -> Decoder Bool
append String
"server event # " forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => Decoder Bool
dump32
dumpState :: HasCallStack => Decoder Bool
dumpState :: HasCallStack => Decoder Bool
dumpState = do
Atom
wM_STATE <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"WM_STATE"
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
wM_STATE forall a b. (a -> b) -> a -> b
$ HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"state" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
wmState,Atom
cARDINAL)
,(String
"icon window",HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
]
dumpMotifDragReceiver :: HasCallStack => Decoder Bool
dumpMotifDragReceiver :: HasCallStack => Decoder Bool
dumpMotifDragReceiver = do
Atom
ta <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ String -> X Atom
getAtom String
"_MOTIF_DRAG_RECEIVER_INFO"
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
ta forall a b. (a -> b) -> a -> b
$ HasCallStack => [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpList' [(String
"endian" ,HasCallStack => Decoder Bool
dumpMotifEndian,Atom
cARDINAL)
,(String
"version" ,HasCallStack => Decoder Bool
dump8 ,Atom
cARDINAL)
,(String
"style" ,HasCallStack => Decoder Bool
dumpMDropStyle ,Atom
cARDINAL)
]
dumpMDropStyle :: HasCallStack => Decoder Bool
dumpMDropStyle :: HasCallStack => Decoder Bool
dumpMDropStyle = do
Maybe Integer
d <- HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
8
HasCallStack => Int -> Decoder Bool -> Decoder Bool
pad Int
1 forall a b. (a -> b) -> a -> b
$ case Maybe Integer
d of
Maybe Integer
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
9
Just Integer
ps | Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
0 -> HasCallStack => 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 -> HasCallStack => 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
>> HasCallStack => 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
>> HasCallStack => Decoder Bool
dumpMDPrereg
| Integer
ps forall a. Eq a => a -> a -> Bool
== Integer
4 -> HasCallStack => 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 -> HasCallStack => 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 -> HasCallStack => Int -> Decoder Bool -> Decoder Bool
pad Int
12 forall a b. (a -> b) -> a -> b
$ String -> Decoder Bool
append String
"prefer receiver"
| Bool
otherwise -> HasCallStack => 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 :: HasCallStack => Decoder Bool
dumpMDPrereg :: HasCallStack => 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 HasCallStack => Decoder Bool
dumpWindow
String -> Decoder Bool
append String
","
String -> Decoder Bool
append String
"drop sites = "
Maybe Integer
dsc' <- HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
16
case Maybe Integer
dsc' of
Maybe Integer
Nothing -> HasCallStack => Int -> Decoder Bool
propShortErr' Int
10
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)
HasCallStack => 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 HasCallStack => 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 :: HasCallStack => Decoder Bool
dumpMotifEndian :: HasCallStack => Decoder Bool
dumpMotifEndian = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
cARDINAL forall a b. (a -> b) -> a -> b
$ HasCallStack => 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
_ -> HasCallStack => String -> Decoder Bool
failure String
"bad endian flag"
pad :: HasCallStack => Int -> Decoder Bool -> Decoder Bool
pad :: HasCallStack => 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 HasCallStack => Int -> Decoder Bool
propShortErr' Int
11
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 :: HasCallStack => Decoder Bool
dumpPercent :: HasCallStack => Decoder Bool
dumpPercent = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- HasCallStack => 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 :: HasCallStack => Decoder Bool
dumpWmHints :: HasCallStack => Decoder Bool
dumpWmHints =
HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
wM_HINTS forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
msk <- HasCallStack => 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' -> HasCallStack =>
CULong -> [(String, Decoder Bool, Atom)] -> Decoder Bool
dumpListByMask' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
msk')
[(String
"input" ,HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
bool ,Atom
cARDINAL)
,(String
"initial_state",HasCallStack => [String] -> Decoder Bool
dumpEnum [String]
wmState,Atom
cARDINAL)
,(String
"icon_pixmap" ,HasCallStack => Decoder Bool
dumpPixmap ,Atom
pIXMAP )
,(String
"icon_window" ,HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
,(String
"icon_x" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"icon_y" ,HasCallStack => Decoder Bool
dump32 ,Atom
cARDINAL)
,(String
"icon_mask" ,HasCallStack => Decoder Bool
dumpPixmap ,Atom
pIXMAP )
,(String
"window_group" ,HasCallStack => Decoder Bool
dumpWindow ,Atom
wINDOW )
]
dumpBits :: HasCallStack => [String] -> Decoder Bool
dumpBits :: HasCallStack => [String] -> Decoder Bool
dumpBits [String]
bs = HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType Atom
cARDINAL forall a b. (a -> b) -> a -> b
$ do
Maybe Integer
n <- HasCallStack => 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"
]
cpState :: [String]
cpState :: [String]
cpState = [String
"no preference",String
"disable compositing",String
"force compositing"]
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"]
nwAction :: [String]
nwAction :: [String]
nwAction = [String
"Clear", String
"Set", String
"Toggle"]
wmGravity :: [String]
wmGravity :: [String]
wmGravity = [String
"forget/unmap",String
"NW",String
"N",String
"NE",String
"W",String
"C",String
"E",String
"SW",String
"S",String
"SE",String
"static"]
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' :: HasCallStack => Int -> Decoder (Maybe Integer)
getInt' :: HasCallStack => Int -> Decoder (Maybe Integer)
getInt' Int
64 = forall r (m :: * -> *) v a.
(HasCallStack, 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.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize' Int
8 (HasCallStack => 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.
(HasCallStack, 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.
HasCallStack =>
Int -> Decoder a -> Decoder a -> Decoder a
guardSize' (Int -> Int
bytes Int
w) (HasCallStack => Int -> Decoder Bool
propShortErr' Int
13 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 = HasCallStack => 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 :: HasCallStack => String -> Decoder Bool
failure :: HasCallStack => String -> Decoder Bool
failure = Bool -> String -> Decoder Bool
append' Bool
False forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack HasCallStack => CallStack
callStack)
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 :: HasCallStack => Decoder Bool
propShortErr :: HasCallStack => Decoder Bool
propShortErr = HasCallStack => String -> Decoder Bool
failure String
"(property ended prematurely)"
propShortErr' :: HasCallStack => Int -> Decoder Bool
propShortErr' :: HasCallStack => Int -> Decoder Bool
propShortErr' Int
n = HasCallStack => String -> Decoder Bool
failure forall a b. (a -> b) -> a -> b
$ String
"(short prop " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
")"
propSizeErr :: Int -> Int -> Decoder Bool
propSizeErr :: Int -> Int -> Decoder Bool
propSizeErr Int
e Int
a = HasCallStack => 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 :: Atom -> Atom -> Decoder Bool
propTypeErr Atom
a Atom
e = do
String
e' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Atom -> X String
atomName Atom
e
String
a' <- forall a. X a -> Decoder a
inX forall a b. (a -> b) -> a -> b
$ Atom -> X String
atomName Atom
a
HasCallStack => 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 -> Atom
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
. Atom -> 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