blob: 9195a9258870f8bdfb86adc952ad68367de65d41 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
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.Hooks.WindowChange
import Rahm.Desktop.Common
import Rahm.Desktop.Logger
import Data.Sequence (Seq(..))
import qualified Data.Sequence as Seq
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 (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')
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
historyHook :: Maybe Location -> Location -> X ()
historyHook Nothing loc =
XS.modify $ \(History z) -> History (pushZipper loc z)
historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do
XS.modify $ \(History z) -> History (pushZipper l z)
historyHook _ _ = return ()
|
