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.

1 files changed, 113 insertions, 45 deletions

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 ()