twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-07-31 20:21:51 -07:00
Code Issues Packages Projects Releases Wiki Activity

dumpString: avoid monadic pattern matching in pure code

Browse Source 
These changes avoid the need for having a MonadFail instance for Decoder.
This commit is contained in:
Peter Simons
2018-09-28 11:45:39 +02:00
parent 5334130bf7
commit 778e32305f
1 changed files with 25 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
XMonad/Hooks/DebugEvents.hs
View File

@@ -696,30 +696,31 @@ dumpList'' m ((l,p,t):ps) sep = do
dumpString :: Decoder Bool
dumpString = do
fmt <- asks pType
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case x of
[cOMPOUND_TEXT,uTF8_STRING] -> case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection
dumpSelection :: Decoder Bool