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
106
107
108
109
110
111
112
113
114
115
116
117
|
module Rahm.Desktop.History
( zipperDbgPrint,
pushZipper,
getZipper,
zipperBack,
zipperForward,
pastHistory,
getMostRecentLocationInHistory,
historyBack,
historyForward,
lastLocation,
nextLocation,
jumpToLastLocation,
historyHook,
)
where
import Data.Default (Default (..))
import Data.Foldable (toList)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq (length, (!?))
import Rahm.Desktop.Common (Location (Location), focusLocation)
import Text.Printf (printf)
import XMonad (ExtensionClass (extensionType, initialValue), StateExtension (..), X)
import qualified XMonad.Util.ExtensibleState as XS
( get,
modify,
put,
)
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 ()
|
