make working directories of topics persistent (where not explictly given from initial config)

src/XMonad/Custom/TopicSpace.hs

@@ -8,6 +8,8 @@ module XMonad.Custom.TopicSpace (
   , spawnInTopicDir
   , setTopicDir
   , promptSetTopicDir
+  , updateTopicConfig
+  , currentTopicConfig
   ) where
 
 
@@ -52,7 +54,7 @@ import qualified XMonad.StackSet as W
 import XMonad
 import XMonad.Actions.TopicSpace
 import XMonad.Prompt
-import XMonad.Prompt.Workspace
+import XMonad.Prompt.Directory (directoryPrompt)
 
 
 -- | An alias for topicNames.
@@ -72,34 +74,115 @@ inHomeTI = inHome
 simpleTI :: Topic -> TopicItem
 simpleTI n = TI n "~/." (pure ())
 
-
 --------------------------------------------t
 -- X state implementation and tools
 
 
 -- | Store config in X extensible state
--- We do this by wrapping into a store type to avoid
+-- We want to store the associated directories as persistent (surviving restarts of XMonad)
--- orphan instance declarations
+-- Thus, we actually have to split the data of TopicConfig up into the directory mapping
-data StoreTopicConfig = StoreTopicConfig TopicConfig
+-- and the rest (associated actions etc)
-instance ExtensionClass StoreTopicConfig where
+
-  initialValue = StoreTopicConfig def
+
+
+-- | Management for storage of the associated topic dirs
+
+-- | associated directories
+type DirTopicConfig = Map Topic Dir
+
+data StoreDirTopicConfig = StoreDirTopicConfig DirTopicConfig deriving (Read, Eq, Show)
+
+-- | Make this new type storable
+instance ExtensionClass StoreDirTopicConfig where
+  initialValue = StoreDirTopicConfig empty
+  extensionType = PersistentExtension
+
+-- | Unwrap a stored dir topic config
+unwrapDirTopicConfig :: StoreDirTopicConfig -> DirTopicConfig
+unwrapDirTopicConfig (StoreDirTopicConfig tc) = tc
+
+-- | store new DirTopicConfig
+updateDirTopicConfig :: DirTopicConfig -> X ()
+updateDirTopicConfig = XS.put . StoreDirTopicConfig
+
+-- | retrieve current value of DirTopicConfig
+currentDirTopicConfig :: X DirTopicConfig
+currentDirTopicConfig = fmap unwrapDirTopicConfig XS.get
+
+
+-- | All other associated data
+
+
+-- | This is just copied from XMonad.Actions.TopicSpace, but with the directory map left out
+-- Also, maxTopicHistory is left out, since this field is deprecated anyways
+data ShallowTopicConfig = ShallowTopicConfig { sTopicActions       :: Map Topic (X ())
+                                               -- ^ This mapping associates an action to trigger when
+                                               -- switching to a given topic which workspace is empty.
+                                             , sDefaultTopicAction :: Topic -> X ()
+                                               -- ^ This is the default topic action.
+                                             , sDefaultTopic       :: Topic
+                                               -- ^ This is the default (= fallback) topic.
+                                             }
+instance Default ShallowTopicConfig where
+  def = shallowTopicConfig def
+
+
+
+data StoreShallowTopicConfig = StoreShallowTopicConfig ShallowTopicConfig
+instance ExtensionClass StoreShallowTopicConfig where
+  initialValue = StoreShallowTopicConfig def
 
 -- | Unwrap a stored topic config
-topicConfig :: StoreTopicConfig -> TopicConfig
+unwrapShallowTopicConfig :: StoreShallowTopicConfig -> ShallowTopicConfig
-topicConfig (StoreTopicConfig tc) = tc
+unwrapShallowTopicConfig (StoreShallowTopicConfig tc) = tc
+
+-- | Update currently stored ShallowTopicConfig
+updateShallowTopicConfig :: ShallowTopicConfig -> X ()
+updateShallowTopicConfig = XS.put . StoreShallowTopicConfig
+
+-- | Retrieve current value of ShallowTopicConfig
+currentShallowTopicConfig :: X ShallowTopicConfig
+currentShallowTopicConfig = fmap unwrapShallowTopicConfig XS.get
+
+
+
+-- | Easy methods for mergin/splitting TopicConfigs
+
+
+dirTopicConfig :: TopicConfig -> DirTopicConfig
+dirTopicConfig = topicDirs
+
+shallowTopicConfig :: TopicConfig -> ShallowTopicConfig
+shallowTopicConfig tc = ShallowTopicConfig (topicActions tc) (defaultTopicAction tc) (defaultTopic tc)
+
+combineConfigs :: DirTopicConfig -> ShallowTopicConfig -> TopicConfig
+combineConfigs dirs s = def { topicDirs = dirs
+                            , topicActions = sTopicActions s
+                            , defaultTopicAction =  sDefaultTopicAction s
+                            , defaultTopic = sDefaultTopic s
+                            }
 
 -- | Update the value of the topic config in the X state
 updateTopicConfig :: TopicConfig -> X ()
-updateTopicConfig = XS.put . StoreTopicConfig
+updateTopicConfig c =  (updateDirTopicConfig $ dirTopicConfig c)
+                    >> (updateShallowTopicConfig $ shallowTopicConfig c)
 
 -- | Retrieve the current topic config from the X state
 currentTopicConfig :: X TopicConfig
-currentTopicConfig = fmap topicConfig XS.get
+currentTopicConfig = do
+    dir <- currentDirTopicConfig
+    shallow <- currentShallowTopicConfig
+    return $ combineConfigs dir shallow
 
 -- | Put initial topic Config into X state at startup
 -- Add this to the XConfig startupHook
+-- working directories of topics with no explicit directory set
+-- are restored from the last XMonad run
 topicStartupHook :: TopicConfig -> X ()
-topicStartupHook = updateTopicConfig
+topicStartupHook tc = do
+        lastDirs <- currentDirTopicConfig
+        updateDirTopicConfig $ union (topicDirs tc) lastDirs
+        updateShallowTopicConfig $ shallowTopicConfig tc
 
 
 -------------------------------------------
@@ -125,11 +208,9 @@ spawnInTopicDir cmd = do
 setTopicDir :: Dir -> X ()
 setTopicDir dir = do
   ws <- gets (W.currentTag . windowset)
-  tc <- currentTopicConfig
+  dtc <- currentDirTopicConfig
-  updateTopicConfig tc {
+  updateDirTopicConfig $ insert ws dir dtc
-    topicDirs = insert ws dir $ topicDirs tc
-  }
 
 -- | Prompt for the new working directory
 promptSetTopicDir :: XPConfig -> X ()
-promptSetTopicDir xpc = workspacePrompt xpc setTopicDir
+promptSetTopicDir xpc = directoryPrompt xpc "Set working dir:" setTopicDir