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

X.L.Groups: Rewrite gen using infinite streams

Browse Source
This commit is contained in:
Tony Zorman 2023-10-15 11:43:12 +02:00
parent 7599c898ef
commit c3d16bfa99
1 changed files with 21 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
XMonad/Layout/Groups.hs
View File

@ -105,8 +105,8 @@ data Uniq = U Integer Integer
-- seed. All keys generated with this method will be different -- seed. All keys generated with this method will be different
-- provided you don't use 'gen' again with a key from the list. -- provided you don't use 'gen' again with a key from the list.
-- (if you need to do that, see 'split' instead) -- (if you need to do that, see 'split' instead)
gen :: Uniq -> (Uniq, [Uniq]) gen :: Uniq -> (Uniq, Stream Uniq)
gen (U i1 i2) = (U (i1+1) i2, map (U i1) [i2..]) gen (U i1 i2) = (U (i1+1) i2, fmap (U i1) (fromList [i2..]))
-- | Split an infinite list into two. I ended up not -- | Split an infinite list into two. I ended up not
-- needing this, but let's keep it just in case. -- needing this, but let's keep it just in case.
@ -197,16 +197,16 @@ instance Message GroupsMessage
modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))
-> Groups l l2 a -> Groups l l2 a -> Groups l l2 a -> Groups l l2 a
modifyGroups f g = let (seed', ids) = gen (seed g) modifyGroups f g = let (seed', ident :~ _) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ
in g { groups = fromMaybe defaultGroups . f . Just $ groups g in g { groups = fromMaybe defaultGroups . f . Just $ groups g
, seed = seed' } , seed = seed' }
modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a))) modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
-> Groups l l2 a -> X (Groups l l2 a) -> Groups l l2 a -> X (Groups l l2 a)
modifyGroupsX f g = do modifyGroupsX f g = do
let (seed', ids) = gen (seed g) let (seed', ident :~ _) = gen (seed g)
defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ defaultGroups = fromJust $ singletonZ $ G (ID ident $ baseLayout g) emptyZ
g' <- f . Just $ groups g g' <- f . Just $ groups g
return g { groups = fromMaybe defaultGroups g', seed = seed' } return g { groups = fromMaybe defaultGroups g', seed = seed' }
@ -218,12 +218,12 @@ modifyGroupsX f g = do
-- other stack changes as gracefully as possible. -- other stack changes as gracefully as possible.
readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a
readapt z g = let mf = getFocusZ z readapt z g = let mf = getFocusZ z
(seed', ids) = gen $ seed g (seed', ident :~ _) = gen $ seed g
g' = g { seed = seed' } g' = g { seed = seed' }
in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z)
>>> filterKeepLast (isJust . gZipper) >>> filterKeepLast (isJust . gZipper)
>>> findNewWindows (W.integrate' z) >>> findNewWindows (W.integrate' z)
>>> addWindows (ID (head ids) $ baseLayout g) >>> addWindows (ID ident $ baseLayout g)
>>> focusGroup mf >>> focusGroup mf
>>> onFocusedZ (onZipper $ focusWindow mf) >>> onFocusedZ (onZipper $ focusWindow mf)
where filterKeepLast _ Nothing = Nothing where filterKeepLast _ Nothing = Nothing
@ -379,10 +379,10 @@ type ModifySpecX = forall l. WithID l Window
-- | Apply a ModifySpec. -- | Apply a ModifySpec.
applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
applySpec f g = applySpec f g =
let (seed', ids) = gen $ seed g let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list
g' = flip modifyGroups g $ f (ID (head ids) $ baseLayout g) g' = flip modifyGroups g $ f (ID ident $ baseLayout g)
>>> toTags >>> toTags
>>> foldr (reID g) ((tail ids, []), []) >>> foldr (reID g) ((ids, []), [])
>>> snd >>> snd
>>> fromTags >>> fromTags
in if groups g == groups g' in if groups g == groups g'
@ -391,10 +391,10 @@ applySpec f g =
applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
applySpecX f g = do applySpecX f g = do
let (seed', ids) = gen $ seed g let (seed', ident :~ ids) = gen $ seed g -- gen generates an infinite list
g' <- flip modifyGroupsX g $ f (ID (head ids) $ baseLayout g) g' <- flip modifyGroupsX g $ f (ID ident $ baseLayout g)
>>> fmap toTags >>> fmap toTags
>>> fmap (foldr (reID g) ((tail ids, []), [])) >>> fmap (foldr (reID g) ((ids, []), []))
>>> fmap snd >>> fmap snd
>>> fmap fromTags >>> fmap fromTags
return $ if groups g == groups g' return $ if groups g == groups g'
@ -403,12 +403,11 @@ applySpecX f g = do
reID :: Groups l l2 Window reID :: Groups l l2 Window
-> Either (Group l Window) (Group l Window) -> Either (Group l Window) (Group l Window)
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])
-> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)]) -> ((Stream Uniq, [Uniq]), [Either (Group l Window) (Group l Window)])
reID _ _ (([], _), _) = undefined -- The list of ids is infinite reID g eg ((ident :~ ids, seen), egs)
reID g eg ((id:ids, seen), egs) = if myID `elem` seen | myID `elem` seen = ((ids, seen), mapE_ (setID ident) eg:egs)
then ((ids, seen), mapE_ (setID id) eg:egs) | otherwise = ((ident :~ ids, myID:seen), eg:egs)
else ((id:ids, myID:seen), eg:egs)
where myID = getID $ gLayout $ fromE eg where myID = getID $ gLayout $ fromE eg
setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z