From 6a507c681a289d92fb5674b08dd5f8a84380977f Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 30 Aug 2021 22:38:10 +0100 Subject: [PATCH] Make extensibleState primarily keyed by TypeRep instead of type names We've been using the String we get out of `show . typeOf` as key in `extensibleState`, but that has a somewhat serious bug: it shows unqualified type names, so if two modules use the same type name, their extensible states will be stored in one place and get overwritten all the time. To fix this, the `extensibleState` map is now primarily keyed by the TypeRep themselves, with fallback to String for not yet deserialized data. XMonad.Core now exports `showExtType` which serializes type names qualified, and this is used in `writeStateToFile`. A simpler fix would be to just change the serialization of type names in `XMonad.Util.ExtensibleState`, but I'm afraid that might slows things down: Most types used here will start with "XMonad.", and that's a lot of useless linked-list pointer jumping. Fixes: https://github.com/xmonad/xmonad-contrib/issues/94 Related: https://github.com/xmonad/xmonad-contrib/pull/600 --- CHANGES.md | 7 +++++++ src/XMonad/Core.hs | 31 ++++++++++++++++++++++++++----- src/XMonad/Operations.hs | 12 ++++++------ xmonad.cabal | 2 +- 4 files changed, 40 insertions(+), 12 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 1d626dc8..863bc00f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -65,6 +65,13 @@ it easier for us to clean up the codebase. These can still be suppressed manually using an `OPTIONS_GHC` pragma with `-Wno-deprecations`. + * Extensible state type names no longer need to be unique, because the + `extensibleState` map in `XState` is now primarily keyed by the + machine-readable type representation rather than the human-readable type + name. Human-readable type names are still used for serialization of state + between restarts, and this representation now encodes module names as + well to avoid conflicts between types with equal names. + ## 0.15 (September 30, 2018) * Reimplement `sendMessage` to deal properly with windowset changes made diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 46a09397..e83a0336 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -1,6 +1,13 @@ -{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, - MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable, - LambdaCase, NamedFieldPuns, DeriveTraversable #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -23,7 +30,7 @@ module XMonad.Core ( XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, Typeable, Message, SomeMessage(..), fromMessage, LayoutMessages(..), - StateExtension(..), ExtensionClass(..), ConfExtension(..), + StateExtension(..), ExtensionClass(..), ConfExtension(..), showExtType, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, @@ -73,7 +80,7 @@ data XState = XState , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents , dragging :: !(Maybe (Position -> Position -> X (), X ())) , numberlockMask :: !KeyMask -- ^ The numlock modifier - , extensibleState :: !(M.Map String (Either String StateExtension)) + , extensibleState :: !(M.Map (Either String TypeRep) (Either String StateExtension)) -- ^ stores custom state information. -- -- The module "XMonad.Util.ExtensibleState" in xmonad-contrib @@ -420,6 +427,20 @@ data StateExtension = -- | Existential type to store a config extension. data ConfExtension = forall a. Typeable a => ConfExtension a +-- | Serialize extension type name. +-- Produces a (more) unique representation than the Show instance of TypeRep +-- which only includes type names but not module/package names. 'showExtType' +-- adds modules names as well. Package names are omitted to support migration +-- of extensible state during xmonad version upgrades. +showExtType :: TypeRep -> String +showExtType = ($ "") . showTypeRep + where + showTypeRep (splitTyConApp -> (tc, tas)) = + showParen (not (null tas)) $ + showTyCon tc . foldr (\ta -> ((showChar ' ' . showTypeRep ta) .)) id tas + showTyCon tc = + showString (tyConModule tc) . showChar '.' . showString (tyConName tc) + -- --------------------------------------------------------------------- -- | General utilities -- diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs index f87330a6..9ef8cb56 100644 --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -23,13 +23,13 @@ import qualified XMonad.StackSet as W import Data.Maybe import Data.Monoid (Endo(..),Any(..)) import Data.List (nub, (\\), find) +import Data.Bifunctor (bimap) import Data.Bits ((.|.), (.&.), complement, testBit) import Data.Function (on) import Data.Ratio import qualified Data.Map as M import qualified Data.Set as S -import Control.Arrow (second) import Control.Monad.Reader import Control.Monad.State import qualified Control.Exception as C @@ -473,12 +473,12 @@ data StateFile = StateFile -- so that xmonad can resume with that state intact. writeStateToFile :: X () writeStateToFile = do - let maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext) - maybeShow (t, Left str) = Just (t, str) - maybeShow _ = Nothing + let showExt (Right t, Right (PersistentExtension ext)) = Just (showExtType t, show ext) + showExt (Left t, Left str) = Just (t, str) + showExt _ = Nothing wsData = W.mapLayout show . windowset - extState = catMaybes . map maybeShow . M.toList . extensibleState + extState = catMaybes . map showExt . M.toList . extensibleState path <- asks $ stateFileName . directories stateData <- gets (\s -> StateFile (wsData s) (extState s)) @@ -502,7 +502,7 @@ readStateFile xmc = do sf <- join sf' let winset = W.ensureTags layout (workspaces xmc) $ W.mapLayout (fromMaybe layout . maybeRead lreads) (sfWins sf) - extState = M.fromList . map (second Left) $ sfExt sf + extState = M.fromList . map (bimap Left Left) $ sfExt sf return XState { windowset = winset , numberlockMask = 0 diff --git a/xmonad.cabal b/xmonad.cabal index c7778ee1..049ee4b8 100644 --- a/xmonad.cabal +++ b/xmonad.cabal @@ -1,5 +1,5 @@ name: xmonad -version: 0.16.99999 +version: 0.16.999999 synopsis: A tiling window manager description: xmonad is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising