Skip to content

Commit

Permalink
Make extensibleState primarily keyed by TypeRep instead of type names
Browse files Browse the repository at this point in the history
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: xmonad/xmonad-contrib#94
Related: xmonad/xmonad-contrib#600
  • Loading branch information
liskin committed Sep 2, 2021
1 parent f89df98 commit 6a507c6
Show file tree
Hide file tree
Showing 4 changed files with 40 additions and 12 deletions.
7 changes: 7 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
31 changes: 26 additions & 5 deletions src/XMonad/Core.hs
Original file line number Diff line number Diff line change
@@ -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 #-}

-----------------------------------------------------------------------------
-- |
Expand All @@ -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,
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
--
Expand Down
12 changes: 6 additions & 6 deletions src/XMonad/Operations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion xmonad.cabal
Original file line number Diff line number Diff line change
@@ -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
Expand Down

0 comments on commit 6a507c6

Please sign in to comment.