From be962db7586e120adb810e506f456b7ab80f486e Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@cse.unsw.edu.au>
Date: Sat, 9 Jun 2007 15:17:16 +0200
Subject: HEADS UP: (logging format change). use a custom pretty printer, for
 an easier format to parse, than 'show' produces

darcs-hash:20070609131716-9c5c1-ac6b3d7e8193b16ca9ae65f32d5373090107eca1
---
 Main.hs       |  2 +-
 Operations.hs |  2 +-
 StackSet.hs   |  1 -
 XMonad.hs     | 44 ++++++++++++++++++++++++++++++++++++++++++--
 4 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/Main.hs b/Main.hs
index de1b979..aaa4970 100644
--- a/Main.hs
+++ b/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)
diff --git a/Operations.hs b/Operations.hs
index bd85637..0716533 100644
--- a/Operations.hs
+++ b/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.
diff --git a/StackSet.hs b/StackSet.hs
index 34e6b10..4b74646 100644
--- a/StackSet.hs
+++ b/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 :-)
-
diff --git a/XMonad.hs b/XMonad.hs
index 01d4199..058da37 100644
--- a/XMonad.hs
+++ b/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))
+
-- 
cgit v1.2.3