Change history to work on a per-screen basis.

This change is still experimental, but it is more intuitive that each
screen has its own history because each screen is generally dedicated to
a specific use case.

I'm going to try this on for size, though it is possible that
per-workspace history mighte prove to be more useful. We'll see.

3 files changed, 126 insertions, 52 deletions

diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index 730a216..0ac41a7 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -7,6 +7,7 @@ module Rahm.Desktop.Common
     windowJump,
     withBorderColor,
     withBorderWidth,
+    getCurrentScreen,
     gotoWorkspace,
     moveLocationToWorkspace,
     getCurrentWorkspace,
@@ -37,7 +38,8 @@ import qualified Rahm.Desktop.StackSet as S
   )
 import Text.Printf (printf)
 import XMonad
-  ( Window,
+  ( ScreenId,
+    Window,
     WorkspaceId,
     X,
     XConf (config, display),
@@ -169,6 +171,10 @@ getCurrentWorkspace = withWindowSet $
   \(S.StackSet (S.Screen (S.Workspace t _ _) _ _) _ _ _) -> do
     return t
 
+getCurrentScreen :: X ScreenId
+getCurrentScreen = withWindowSet $
+  \(S.StackSet (S.Screen _ sid _) _ _ _) -> return sid
+
 getCurrentLocation :: X Location
 getCurrentLocation = do
   ws <- getCurrentWorkspace
diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index e3b0927..dc6d6a1 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -4,24 +4,25 @@ module Rahm.Desktop.History
     getZipper,
     zipperBack,
     zipperForward,
-    pastHistory,
-    getMostRecentLocationInHistory,
-    historyBack,
-    historyForward,
-    lastLocation,
+    historyHook,
     nextLocation,
     jumpToLastLocation,
-    historyHook,
+    lastLocation,
+    historyBack,
+    historyForward,
   )
 where
 
 import Data.Default (Default (..))
 import Data.Foldable (toList)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
 import Data.Sequence (Seq (..))
 import qualified Data.Sequence as Seq (length, (!?))
-import Rahm.Desktop.Common (Location (Location), focusLocation)
+import Rahm.Desktop.Common (Location (Location), focusLocation, getCurrentScreen)
 import Text.Printf (printf)
-import XMonad (ExtensionClass (extensionType, initialValue), StateExtension (..), X)
+import XMonad (ExtensionClass (extensionType, initialValue), ScreenId, StateExtension (..), X)
 import qualified XMonad.Util.ExtensibleState as XS
   ( get,
     modify,
@@ -61,57 +62,124 @@ zipperForward :: BoundedSeqZipper a -> BoundedSeqZipper a
 zipperForward (BoundedSeqZipper s (e :<| h) t) = BoundedSeqZipper s h (e :<| t)
 zipperForward b = b
 
-newtype History = History
-  { currentZipper :: BoundedSeqZipper Location
+data History = History
+  { historyByScreenId :: Map ScreenId (BoundedSeqZipper Location),
+    gobalHistory :: BoundedSeqZipper Location
   }
   deriving (Read, Show)
 
 instance Default History where
-  def = History (BoundedSeqZipper 1000 mempty mempty)
+  def = History mempty (BoundedSeqZipper 1000 mempty mempty)
 
 instance ExtensionClass History where
   initialValue = def
   extensionType = PersistentExtension
 
-pastHistory :: Int -> X (Maybe Location)
-pastHistory i = do
-  History (BoundedSeqZipper _ _ t) <- XS.get
-  return $ t Seq.!? i
-
-getMostRecentLocationInHistory :: X (Maybe Location)
-getMostRecentLocationInHistory = do
-  History z <- XS.get
-  case z of
-    (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
-    (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
-    _ -> return Nothing
-
-historyBack :: X ()
-historyBack = do
-  History z <- XS.get
-  let z' = zipperBack z
-  mapM_ focusLocation (getZipper z')
-  XS.put (History z')
-
-historyForward :: X ()
-historyForward = do
-  History z <- XS.get
-  let z' = zipperForward z
-  mapM_ focusLocation (getZipper z')
-  XS.put (History z')
+getCurrentZipper :: ScreenId -> History -> BoundedSeqZipper Location
+getCurrentZipper screenId (History byScreenId _) =
+  fromMaybe
+    (BoundedSeqZipper 1000 mempty mempty)
+    (Map.lookup screenId byScreenId)
+
+historyDo :: (forall a. BoundedSeqZipper a -> BoundedSeqZipper a) -> X ()
+historyDo f = do
+  screenId <- getCurrentScreen
+  History byScreenId gb <- XS.get
+  let mz' = Map.lookup screenId byScreenId
+  case mz' of
+    Nothing ->
+      return ()
+    Just z -> do
+      let z' = f z
+      mapM_ focusLocation (getZipper z')
+      XS.put
+        ( History (Map.insert screenId z' byScreenId) gb
+        )
+
+historyBack = historyDo zipperBack
+
+historyForward = historyDo zipperForward
+
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastLocation
 
+-- pastGlobalHistory :: Int -> X (Maybe Location)
+-- pastGlobalHistory i = do
+--   History (BoundedSeqZipper _ _ t) _ <- XS.get
+--   return $ t Seq.!? i
+--
+-- getMostRecentLocationInGlobalHistory :: X (Maybe Location)
+-- getMostRecentLocationInGlobalHistory = do
+--   History z _ <- XS.get
+--   case z of
+--     (BoundedSeqZipper _ (_ :|> h) _) -> return $ Just h
+--     (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t
+--     _ -> return Nothing
+--
+-- globalHistoryBack :: X ()
+-- globalHistoryBack = do
+--   History z _ <- XS.get
+--   let z' = zipperBack z
+--   mapM_ focusLocation (getZipper z')
+--   XS.put (History z')
+--
+-- globalHistoryForward :: X ()
+-- globalHistoryForward = do
+--   History z _ <- XS.get
+--   let z' = zipperForward z
+--   mapM_ focusLocation (getZipper z')
+--   XS.put (History z')
+--
+-- lastLocation :: X (Maybe Location)
+-- lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
+--
+-- nextLocation :: X (Maybe Location)
+-- nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
+--
+-- jumpToLastLocation :: X ()
+-- jumpToLastLocation = mapM_ focusLocation =<< lastLocation
+--
+
+-- Get the last location for the current screen.
 lastLocation :: X (Maybe Location)
-lastLocation = getZipper . zipperBack . currentZipper <$> XS.get
+lastLocation = do
+  screenId <- getCurrentScreen
+  getZipper . zipperBack . getCurrentZipper screenId <$> XS.get
 
 nextLocation :: X (Maybe Location)
-nextLocation = getZipper . zipperForward . currentZipper <$> XS.get
-
-jumpToLastLocation :: X ()
-jumpToLastLocation = mapM_ focusLocation =<< lastLocation
+nextLocation = do
+  screenId <- getCurrentScreen
+  getZipper . zipperForward . getCurrentZipper screenId <$> XS.get
 
 historyHook :: Maybe Location -> Location -> X ()
-historyHook Nothing loc =
-  XS.modify $ \(History z) -> History (pushZipper loc z)
+historyHook Nothing loc = do
+  currentScreen <- getCurrentScreen
+
+  XS.modify $ \(History byScreen global) ->
+    History
+      ( Map.alter
+          ( Just
+              . pushZipper loc
+              . fromMaybe (BoundedSeqZipper 1000 mempty mempty)
+          )
+          currentScreen
+          byScreen
+      )
+      (pushZipper loc global)
+-- History hook where the 'from' location workspace does not match the 'to'
+-- location workspace.
 historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
-  XS.modify $ \(History z) -> History (pushZipper l z)
+  currentScreen <- getCurrentScreen
+
+  XS.modify $ \(History byScreen z) ->
+    History
+      ( Map.alter
+          ( Just
+              . pushZipper l
+              . fromMaybe (BoundedSeqZipper 1000 mempty mempty)
+          )
+          currentScreen
+          byScreen
+      )
+      (pushZipper l z)
 historyHook _ _ = return ()
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 71551e8..e7a7cb9 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -71,10 +71,10 @@ import Rahm.Desktop.Common
     windowsInWorkspace,
   )
 import Rahm.Desktop.History
-  ( getMostRecentLocationInHistory,
+  ( -- getMostRecentLocationInHistory,
     lastLocation,
     nextLocation,
-    pastHistory,
+    -- pastHistory,
   )
 import Rahm.Desktop.Logger (LogLevel (Info, Trace), logs)
 import Rahm.Desktop.Marking
@@ -543,11 +543,11 @@ readNextLocationSet =
       -- A character is the base-case. Refers to a collection of windows.
       (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch]
       -- Goes to the most recent location in history.
-      (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory)
+      -- (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory)
       -- A Digit goes to the past history.
-      (_, _, [ch])
-        | isDigit ch ->
-          (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
+      -- (_, _, [ch])
+      --   | isDigit ch ->
+      --     (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30))
       -- The current window.
       (_, _, ".") -> (: []) <$> mt getCurrentLocation
       -- The window on the far-left of the screens.