Make history much, much more reliable.

This time history is being done using a hook to keep track of history.
This means I don't have to manually call pushHistory every time I focus
a new window.

1 files changed, 79 insertions, 12 deletions

diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs
index 8aff845..dfecc63 100644
--- a/src/Rahm/Desktop/History.hs
+++ b/src/Rahm/Desktop/History.hs
@@ -1,25 +1,92 @@
 module Rahm.Desktop.History where
 
+import XMonad
+import Text.Printf
+import qualified XMonad.StackSet as W
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
 import Data.Default
+import qualified XMonad.Util.ExtensibleState as XS
 
+import Data.Foldable (toList)
+import Rahm.Desktop.Workspaces (gotoWorkspace)
 import Rahm.Desktop.Hooks.WindowChange
+import Rahm.Desktop.Logger
+import Rahm.Desktop.Marking
+import Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
 
-data History = History {
-    currentIndex :: Int
-  , history :: IntMap Location
-  }
+data BoundedSeqZipper a = BoundedSeqZipper Int (Seq a) (Seq a)
+  deriving (Eq, Show, Ord, Read)
+
+instance Functor BoundedSeqZipper where
+  fmap fn (BoundedSeqZipper i h t) = BoundedSeqZipper i (fmap fn h) (fmap fn t)
+
+zipperDbgPrint :: (Show a) => BoundedSeqZipper a -> String
+zipperDbgPrint (BoundedSeqZipper _ h (c :<| t)) =
+  concat $
+    map (printf " %s " . show) (toList h) ++
+    [printf "[%s]" (show c)] ++
+    map (printf " %s " . show) (toList t)
+zipperDbgPrint _ = "<empty>"
+
+pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a
+pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _))
+    | maxSize <= Seq.length tail =
+  BoundedSeqZipper maxSize mempty (e :<| tail)
+pushZipper e (BoundedSeqZipper maxSize _ tail) =
+  BoundedSeqZipper maxSize mempty (e :<| tail)
+
+getZipper :: BoundedSeqZipper a -> Maybe a
+getZipper (BoundedSeqZipper _ _ (e :<| _)) = Just e
+getZipper _ = Nothing
+
+zipperBack :: BoundedSeqZipper a -> BoundedSeqZipper a
+zipperBack (BoundedSeqZipper s h (e :<| t)) = BoundedSeqZipper s (e :<| h) t
+zipperBack b = b
+
+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
+} deriving (Read, Show)
 
 instance Default History where
-  def = History 0 IntMap.empty
+  def = History (BoundedSeqZipper 1000 mempty mempty)
 
-addToHistory :: Location -> History -> History
-addToHistory loc (History currentIndex hist) =
-  let hist' = if currentIndex > 100
-                then IntMap.delete (currentIndex - 100) hist
-                else hist
-    in History (currentIndex + 1 ) (IntMap.insert currentIndex loc hist)
+instance ExtensionClass History where
+  initialValue = def
+  -- extensionType = PersistentExtension
+
+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')
+
+lastWindow :: X (Maybe Location)
+lastWindow = getZipper . zipperBack . currentZipper <$> XS.get
+
+jumpToLastLocation :: X ()
+jumpToLastLocation = mapM_ focusLocation =<< lastWindow
+  
 
 historyHook :: Location -> Location -> X ()
-historyHook = undefined
+historyHook (Location ws _) l@(Location ws' _) | ws /= ws' = do
+  XS.modify $ \(History z) -> History (pushZipper l z)
+
+historyHook _ _ = return ()
+
+focusLocation :: Location -> X ()
+focusLocation (Location ws Nothing) = gotoWorkspace ws
+focusLocation (Location _ (Just win)) = windows $ W.focusWindow win