tv xmonad service: save state on shutdown

tv/2configs/xserver/default.nix

@@ -44,11 +44,14 @@ let
     systemd.services.display-manager = mkForce {};
 
     services.xserver.enable = true;
+
     systemd.services.xmonad = {
       wantedBy = [ "multi-user.target" ];
       requires = [ "xserver.service" ];
+      environment = xmonad-environment;
       serviceConfig = {
-        ExecStart = "${xmonad}/bin/xmonad";
+        ExecStart = "${xmonad-start}/bin/xmonad";
+        ExecStop = "${xmonad-stop}/bin/xmonad-stop";
         User = user.name;
         WorkingDirectory = user.home;
       };
@@ -69,15 +72,19 @@ let
     };
   };
 
-  xmonad = let
+  xmonad-pkg = pkgs.haskellPackages.callPackage xmonad-src {};
-    pkg = pkgs.haskellPackages.callPackage src {};
+  xmonad-src = pkgs.runCommand "xmonad-package" {} ''
-    src = pkgs.runCommand "xmonad-package" {} ''
+    ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out
-      ${pkgs.cabal2nix}/bin/cabal2nix ${./xmonad} > $out
+  '';
-    '';
+
-  in pkgs.writeScriptBin "xmonad" ''
+  xmonad-environment = {
-    #! /bin/sh
+    DISPLAY = ":${toString config.services.xserver.display}";
+    XMONAD_STATE = "/tmp/xmonad.state";
+  };
+
+  xmonad-start = pkgs.writeScriptBin "xmonad" ''
+    #! ${pkgs.bash}/bin/bash
     set -efu
-    export DISPLAY; DISPLAY=:${toString config.services.xserver.display}
     export PATH; PATH=${makeSearchPath "bin" [
       pkgs.rxvt_unicode
     ]}:/var/setuid-wrappers
@@ -93,7 +100,17 @@ let
     settle ${pkgs.xorg.xhost}/bin/xhost +LOCAL:
     settle ${pkgs.xorg.xrdb}/bin/xrdb -merge ${import ./Xresources.nix args}
     settle ${pkgs.xorg.xsetroot}/bin/xsetroot -solid '#1c1c1c'
-    exec ${pkg}/bin/xmonad
+    if test -e "$XMONAD_STATE"; then
+      IFS=''$'\n'
+      exec ${xmonad-pkg}/bin/xmonad --resume $(< "$XMONAD_STATE")
+    else
+      exec ${xmonad-pkg}/bin/xmonad
+    fi
+  '';
+
+  xmonad-stop = pkgs.writeScriptBin "xmonad-stop" ''
+    #! /bin/sh
+    exec ${xmonad-pkg}/bin/xmonad --shutdown
   '';
 
   xserver-environment = {
@@ -103,7 +120,7 @@ let
       [ "${pkgs.xorg.libX11}/lib" "${pkgs.xorg.libXext}/lib" ]
       ++ concatLists (catAttrs "libPath" config.services.xserver.drivers));
   };
-      
+
   xserver = pkgs.writeScriptBin "xserver" ''
     #! /bin/sh
     set -efu

tv/2configs/xserver/xmonad/Main.hs

@@ -1,9 +1,11 @@
 {-# LANGUAGE DeriveDataTypeable #-} -- for XS
+{-# LANGUAGE LambdaCase #-}
 
 
 module Main where
 
 import XMonad
+import System.Environment (getArgs)
 import XMonad.Prompt (defaultXPConfig)
 import XMonad.Actions.DynamicWorkspaces ( addWorkspacePrompt, renameWorkspace
                                         , removeEmptyWorkspace)
@@ -30,6 +32,7 @@ import XMonad.Layout.PerWorkspace (onWorkspace)
 import Util.Pager
 import Util.Rhombus
 import Util.Debunk
+import Util.Shutdown
 
 
 --data MyState = MyState deriving Typeable
@@ -48,11 +51,12 @@ myFont :: String
 myFont = "-schumacher-*-*-*-*-*-*-*-*-*-*-*-iso10646-*"
 
 main :: IO ()
-main = do
+main = getArgs >>= \case
-    -- TODO exec (shlex "xrdb -merge" ++ [HOME ++ "/.Xresources"])
+    ["--shutdown"] -> sendShutdownEvent
-    -- TODO exec (shlex "xsetroot -solid '#1c1c1c'")
+    _ -> mainNoArgs
-    --spawn "xrdb -merge \"$HOME/.Xresources\""
+
-    --spawn "xsetroot -solid '#1c1c1c'"
+mainNoArgs :: IO ()
+mainNoArgs = do
     xmonad
         -- $ withUrgencyHookC dzenUrgencyHook { args = ["-bg", "magenta", "-fg", "magenta", "-h", "2"], duration = 500000 }
         --                   urgencyConfig { remindWhen = Every 1 }
@@ -80,6 +84,7 @@ main = do
             , startupHook       = spawn "echo emit XMonadStartup"
             , normalBorderColor  = "#1c1c1c"
             , focusedBorderColor = "#f000b0"
+            , handleEventHook = handleShutdownEvent
             }
   where
     myLayout =
@@ -118,8 +123,7 @@ spawnTermAt _    = spawn myTerm
 
 myKeys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
 myKeys conf = Map.fromList $
-    [ ((_4C , xK_Delete ), spawn "make -C $HOME/.xmonad reload")
+    [ ((_4  , xK_Escape ), spawn "/var/setuid-wrappers/slock")
-    , ((_4  , xK_Escape ), spawn "/var/setuid-wrappers/slock")
     , ((_4S , xK_c      ), kill)
 
     , ((_4  , xK_x      ), chooseAction spawnTermAt)

tv/2configs/xserver/xmonad/Util/Shutdown.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE LambdaCase #-}
+module Util.Shutdown
+    ( sendShutdownEvent
+    , handleShutdownEvent
+    , shutdown
+    )
+  where
+
+import Control.Monad
+import Data.Monoid
+import Data.Maybe (catMaybes)
+import qualified Data.Map as Map
+import System.Environment (getEnv)
+import System.Exit (exitSuccess)
+import XMonad
+import qualified XMonad.StackSet as W
+
+sendShutdownEvent :: IO ()
+sendShutdownEvent = do
+    dpy <- openDisplay ""
+    rw <- rootWindow dpy $ defaultScreen dpy
+    a <- internAtom dpy "XMONAD_SHUTDOWN" False
+    allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw a 32 0 currentTime
+        sendEvent dpy rw False structureNotifyMask e
+    sync dpy False
+
+handleShutdownEvent :: Event -> X All
+handleShutdownEvent = \case
+  ClientMessageEvent { ev_message_type = mt } -> do
+    c <- (mt ==) <$> getAtom "XMONAD_SHUTDOWN"
+    when c shutdown
+    return (All c)
+  _ ->
+    return (All True)
+
+shutdown :: X ()
+shutdown = do
+  broadcastMessage ReleaseResources
+  io . flush =<< asks display
+  let wsData = show . W.mapLayout show . windowset
+      maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
+      maybeShow (t, Left str) = Just (t, str)
+      maybeShow _ = Nothing
+      extState =
+        return . show . catMaybes . map maybeShow . Map.toList . extensibleState
+  s <- gets (\s -> (wsData s : extState s))
+  _ <- io $ do
+    path <- getEnv "XMONAD_STATE"
+    writeFile path (concatMap (++"\n") s)
+    exitSuccess
+  return ()