twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-11 18:22:16 -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 :: Decoder Bool
dumpString = do dumpString = do
fmt <- asks pType fmt <- asks pType
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"] x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of case x of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...) [cOMPOUND_TEXT,uTF8_STRING] -> case () of
| fmt == sTRING -> guardSize 8 $ do () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
vs <- gets value | fmt == sTRING -> guardSize 8 $ do
modify (\r -> r {value = []}) vs <- gets value
let ss = flip unfoldr (map twiddle vs) $ modify (\r -> r {value = []})
\s -> if null s let ss = flip unfoldr (map twiddle vs) $
then Nothing \s -> if null s
else let (w,s'') = break (== '\NUL') s then Nothing
s' = if null s'' else let (w,s'') = break (== '\NUL') s
then s'' s' = if null s''
else tail s'' then s''
in Just (w,s') else tail s''
case ss of in Just (w,s')
[s] -> append $ show s case ss of
ss' -> let go (s:ss'') c = append c >> [s] -> append $ show s
append (show s) >> ss' -> let go (s:ss'') c = append c >>
go ss'' "," append (show s) >>
go [] _ = append "]" go ss'' ","
in append "[" >> go ss' "" go [] _ = append "]"
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :) in append "[" >> go ss' ""
| otherwise -> (inX $ atomName fmt) >>= | fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
failure . ("unrecognized string type " ++) | otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection -- show who owns a selection
dumpSelection :: Decoder Bool dumpSelection :: Decoder Bool