HEADS UP: (logging format change). use a custom pretty printer, for an easier format to parse, than 'show' produces

Main.hs

@@ -94,7 +94,7 @@ main = do
                       , w  <- W.integrate (W.stack wk) ]
 
             mapM_ manage ws -- find new windows
-            when logging $ withWindowSet (io . hPrint stdout)
+            when logging $ withWindowSet (io . putStrLn . serial)
 
             -- main loop, for all you HOF/recursion fans out there.
             forever $ handle =<< io (nextEvent dpy e >> getEvent e)

Operations.hs

@@ -179,7 +179,7 @@ windows f = do
         -- urgh : not our delete policy, but close.
 
     setTopFocus
-    when logging $ withWindowSet (io . hPrint stdout)
+    when logging $ withWindowSet (io . putStrLn . serial)
     -- io performGC -- really helps, but seems to trigger GC bugs?
 
     -- We now go to some effort to compute the minimal set of windows to hide.

StackSet.hs

@@ -412,4 +412,3 @@ shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))]
             then maybe s go (peek s) else s
     where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w]
                            -- ^^ poor man's state monad :-)
-

XMonad.hs

@@ -18,11 +18,11 @@
 module XMonad (
     X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..),
     Typeable, Message, SomeMessage(..), fromMessage, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW,
-    runX, io, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
+    runX, io, serial, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX,
     atom_WM_STATE
   ) where
 
-import StackSet (StackSet)
+import StackSet
 
 import Control.Monad.State
 import Control.Monad.Reader
@@ -32,6 +32,8 @@ import System.Exit
 import System.Environment
 import Graphics.X11.Xlib
 import Data.Typeable
+import Data.List (intersperse,sortBy)
+import Text.PrettyPrint
 
 import qualified Data.Map as M
 import qualified Data.Set as S
@@ -181,3 +183,41 @@ whenX a f = a >>= \b -> when b f
 -- be found in your .xsession-errors file
 trace :: String -> X ()
 trace msg = io $! do hPutStrLn stderr msg; hFlush stderr
+
+-- ---------------------------------------------------------------------
+-- Serialise a StackSet in a simple format
+--
+--   4|1:16777220:16777220,2:18874372:18874372,3::,4::,5::,6::,7::,8::,9::
+--
+
+infixl 6 <:>, <|>
+(<:>), (<|>)  :: Doc -> Doc -> Doc
+p <:> q = p <> char ':' <> q
+p <|> q = p <> char '|' <> q
+
+serial :: WindowSet -> String
+serial = render . ppr
+
+newtype Windows = Windows [Window]
+
+class Pretty a where ppr :: a -> Doc
+
+instance Pretty Window where ppr = text . show
+
+instance Pretty a => Pretty [a] where
+    ppr = hcat . intersperse (char ',') . map ppr
+
+instance Pretty Windows where
+    ppr (Windows s) = hcat . intersperse (char ';') . map ppr $ s
+
+instance Pretty WindowSet where
+    ppr s = int (1 + fromIntegral (tag . workspace . current $ s)) <|>
+            ppr (sortBy (\a b -> tag a `compare` tag b)
+                    (map workspace (current s : visible s) ++ hidden s))
+
+instance Pretty (Workspace WorkspaceId Window) where
+    ppr (Workspace i s) =
+        int (1 + fromIntegral i)
+             <:> (case s of Empty -> empty ; _ -> ppr (focus s))
+             <:> ppr (Windows (integrate s))
+