
Hi all, I have an idea that I'd rather run by folks before implementing--particularly as my tag-as-not-Num patches haven't been accepted. I'd like to add a tag field to Stack data Stack i a = Stack { data :: !i -- name of this stack , focus :: !a -- focused thing in this set , up :: [a] -- clowns to the left , down :: [a] } -- jokers to the right deriving (Show, Read, Eq) and thus eliminate the Workspace data type. The goal of this would be to also eliminate the Screen and StackSet types, replacing them with something like: type Workspace i a = Either i (Stack i a) tag :: Workspace i a -> i tag (Left i) = i tag (Right s) = data s type Screen i a sid = Stack sid (Workspace i a) screen :: Screen i a sid -> sid screen = data workspace :: Screen i a sid -> Workspace i a workspace = focus . stack' type StackSet i a sid = Stack (M.Map a RationalRect) floating :: StackSet i a sid -> M.Map a RationalRect floating = data current :: StackSet i a sid -> Screen i a sid current = focus visible :: StackSet i a sid -> [Screen i a sid] visible s = reverse (up s) ++ down s hidden :: StackSet i a sid -> [Workspace i a] hidden s = map h (integrate s) where h scr = up scr ++ down scr As you can see, the idea would be to use type to define synonyms for the current data types, and functions to define accessors that grant the same information as the current data structures (with almost the same API). And indeed, Workspace, Screen and StackSet would still each be distinct types, so we aren't losing any typesafety. I think that code will be simplified: the same function can shift focus between Screens, Workspaces and Windows. We'll need a new function (easily written) to shift a Workspace to a given Screen, but on the whole things look to me like they'll be nicer. This data structure includes a bit more information than our current StackSet, in that it associates each Workspace with a given Screen. This was recently requested as an option, so I think this is a good thing. Note that this doesn't require a change of behavior, is just make the existing behavior slightly more complicated, and the behavior where Workspaces are pinned associated with screens possible. I only have one screen, but I can certainly imagine that if I had one large and one small screen, I might like to be able to designate certain Workspaces for either one or the other. As you can tell, this is part of my scheme to make xmonad code prettier. I greatly dislike having so many distinct data types, each implementing basically the same sort of functionality in different ways: * StackSet stores which Screen has focus... and which Workspaces aren't visible. * Screen stores which Workspace has focus on that screen, but has no information about unfocussed Workspaces (those are in StackSet). * Workspace stores which Window has focus, and also which other windows are on that Workspace. This is almost but not quite symmetric, and that bothers me. It also has the result that the order of Workspaces is not stored anywhere except in the workspace tags, which means we need to sort the workspaces in RotView. So we store focus-order (which is also enforced to be stacking order now) for Windows, but not for Workspaces or Screens. Which among other things means that there's no nice way for a user (or XMonadContrib module) to alter the focus order for either Screens or Workspaces. Anyhow, comments, suggestions and estimates as to whether such a drastic change would be accepted will all be appreciated. -- David Roundy http://www.darcs.net

On Sat, 16 Jun 2007 13:26:25 -0700
David Roundy
Hi all,
I have an idea that I'd rather run by folks before implementing--particularly as my tag-as-not-Num patches haven't been accepted. I'd like to add a tag field to Stack
data Stack i a = Stack { data :: !i -- name of this stack , focus :: !a -- focused thing in this set , up :: [a] -- clowns to the left , down :: [a] } -- jokers to the right deriving (Show, Read, Eq)
and thus eliminate the Workspace data type.
This means that all stack manipulating functions need to keep track of this tag, a bit of a pain in my opinion.
The goal of this would be to also eliminate the Screen and StackSet types, replacing them with something like:
type Workspace i a = Either i (Stack i a)
This is where the tag becomes painful :). (i, Maybe (Stack a)) is much nicer in my opinion (or an equivalent named record).
tag :: Workspace i a -> i tag (Left i) = i tag (Right s) = data s
type Screen i a sid = Stack sid (Workspace i a)
screen :: Screen i a sid -> sid screen = data
workspace :: Screen i a sid -> Workspace i a workspace = focus . stack'
type StackSet i a sid = Stack (M.Map a RationalRect)
It looks like you missed something in the definition of StackSet. Perhaps you mean 'Stack (Map a Rect) (Workspace i a)'?
floating :: StackSet i a sid -> M.Map a RationalRect floating = data
current :: StackSet i a sid -> Screen i a sid current = focus
visible :: StackSet i a sid -> [Screen i a sid] visible s = reverse (up s) ++ down s
hidden :: StackSet i a sid -> [Workspace i a] hidden s = map h (integrate s) where h scr = up scr ++ down scr
As you can see, the idea would be to use type to define synonyms for the current data types, and functions to define accessors that grant the same information as the current data structures (with almost the same API). And indeed, Workspace, Screen and StackSet would still each be distinct types, so we aren't losing any typesafety.
I think that code will be simplified: the same function can shift focus between Screens, Workspaces and Windows. We'll need a new function (easily written) to shift a Workspace to a given Screen, but on the whole things look to me like they'll be nicer.
This data structure includes a bit more information than our current StackSet, in that it associates each Workspace with a given Screen. This was recently requested as an option, so I think this is a good thing. Note that this doesn't require a change of behavior, is just make the existing behavior slightly more complicated, and the behavior where Workspaces are pinned associated with screens possible. I only have one screen, but I can certainly imagine that if I had one large and one small screen, I might like to be able to designate certain Workspaces for either one or the other.
I have a gut feeling that this will significantly complicate a few core functions. 'view' (and the new proposed version, greedyView) seem to be a bit painful with this proposal. 'rescreen' will also become more complicated.
As you can tell, this is part of my scheme to make xmonad code prettier. I greatly dislike having so many distinct data types, each implementing basically the same sort of functionality in different ways:
* StackSet stores which Screen has focus... and which Workspaces aren't visible.
* Screen stores which Workspace has focus on that screen, but has no information about unfocussed Workspaces (those are in StackSet).
* Workspace stores which Window has focus, and also which other windows are on that Workspace.
This is almost but not quite symmetric, and that bothers me. It also has the result that the order of Workspaces is not stored anywhere except in the workspace tags, which means we need to sort the workspaces in RotView. So we store focus-order (which is also enforced to be stacking order now) for Windows, but not for Workspaces or Screens. Which among other things means that there's no nice way for a user (or XMonadContrib module) to alter the focus order for either Screens or Workspaces.
Anyhow, comments, suggestions and estimates as to whether such a drastic change would be accepted will all be appreciated.
There is a fundamental tension here: the original authors perceive StackSet as a structure indexed by workspace ids, but you'd like to use it as a rotational structure. The current implementation is well optimized for the operations supported by the core -- I'm reluctant to complicate core operations to simplify operations in a contrib module. Cheers, Spencer Janssen

On Mon, Jun 18, 2007 at 03:37:20PM -0500, Spencer Janssen wrote:
On Sat, 16 Jun 2007 13:26:25 -0700 David Roundy
wrote: I have an idea that I'd rather run by folks before implementing--particularly as my tag-as-not-Num patches haven't been accepted. I'd like to add a tag field to Stack
data Stack i a = Stack { data :: !i -- name of this stack , focus :: !a -- focused thing in this set , up :: [a] -- clowns to the left , down :: [a] } -- jokers to the right deriving (Show, Read, Eq)
and thus eliminate the Workspace data type.
This means that all stack manipulating functions need to keep track of this tag, a bit of a pain in my opinion.
I'd point out that we have to keep track of this tag anyhow, so we haven't complicated anything (with one exception, which you point out). And since we've reduced by a factor of three the number of data structures, I suspect we'll gain significantly in code simplicity, since you need one-third as many manipulation functions.
The goal of this would be to also eliminate the Screen and StackSet types, replacing them with something like:
type Workspace i a = Either i (Stack i a)
This is where the tag becomes painful :). (i, Maybe (Stack a)) is much nicer in my opinion (or an equivalent named record).
Yes, this is indeed ugly. It'd be far prettier if we could avoid allowing empty workspaces and create them on demand. But alas, users should be able expect to not lose a carefuly configured layout just because they closed all the windows in that workspace. Still, it'd be very pretty to only allow non-empty workspaces! :)
type StackSet i a sid = Stack (M.Map a RationalRect)
It looks like you missed something in the definition of StackSet. Perhaps you mean 'Stack (Map a Rect) (Workspace i a)'?
Right.
This data structure includes a bit more information than our current StackSet, in that it associates each Workspace with a given Screen. This was recently requested as an option, so I think this is a good thing. Note that this doesn't require a change of behavior, is just make the existing behavior slightly more complicated, and the behavior where Workspaces are pinned associated with screens possible. I only have one screen, but I can certainly imagine that if I had one large and one small screen, I might like to be able to designate certain Workspaces for either one or the other.
I have a gut feeling that this will significantly complicate a few core functions. 'view' (and the new proposed version, greedyView) seem to be a bit painful with this proposal. 'rescreen' will also become more complicated.
True, view is made more complicated, but not overly so. I don't see why rescreen would become more complicated, but won't disagree.
Anyhow, comments, suggestions and estimates as to whether such a drastic change would be accepted will all be appreciated.
There is a fundamental tension here: the original authors perceive StackSet as a structure indexed by workspace ids, but you'd like to use it as a rotational structure. [...]
That's true. I greatly prefer the simplicity of rotating through workspaces and if I had more than one screen, I'm sure I'd want to rotate through those. I suppose you core folks only allow rotation through windows because it's too hard to assocate an index with each window. The other major consideration is that of symmetry. It feels like xmonad core is going the way of ion3, which I'd prefer to avoid: we've got four levels already of distinct data types, and with dons' idea of using a stack for the float layer (of which I totally approve) we'll have even more complexity. I *very* much like the idea of using the same data structure and the same to get the same effect. I guess another factor is the fact you seem to think of the screen and workspace levels as being static, while I'd much prefer a dynamic configuration--particularly at the workspace level. Which means inserting and deleting workspaces becomes a meaningful concept, and the same sorts of issues come up that have already been dealt with on the window level: where does focus go when you delete a workspace? Where does it go if a screen disappears (which I understand could happen with xrandr?)? I think it'll be nicer to have a more unified picture. And while this code simplifies some functions and complicates others, it doesn't impose any change in behavior.
The current implementation is well optimized for the operations supported by the core -- I'm reluctant to complicate core operations to simplify operations in a contrib module.
By well-optimized, do you mean for speed or simplicity of code? I hardly believe that it is really well-optimized for speed. When the total number of workspaces is limited to 10 (yes, in theory it could be increased, but not by much without making the UI cumbersome), an O(log(n)) code is unlikely to beat a O(n) code, at least not by much. In any case, my hope would be to simplify the core code, not to complicate it. If the core developers don't believe this could be a simplification, then I won't make the attempt. -- David Roundy Department of Physics Oregon State University
participants (2)
-
David Roundy
-
Spencer Janssen