Copyright | (c) 2022 L. S. Leary |
---|---|
License | BSD3-style (see LICENSE) |
Maintainer | @LSLeary (on github) |
Stability | unstable |
Portability | unportable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Provides History
, a variation on a LIFO stack with a uniqueness property.
In order to achieve the desired asymptotics, the data type is implemented as
an ordered Map.
Documentation
A history of unique k
-events with a
-annotations.
History k a
can be considered a (LIFO) stack of (k, a)
values with the
property that each k
is unique. From this point of view, event
pushes
and ledger
pops/peeks all.
The naive implementation has O(n) event
and erase
due to the
uniqueness condition, but we can still use it as a denotation:
mu :: History k a -> [(k, a)]
As an opaque data type with strict operations, History k a
values are all
finite expressions in the core interface: origin
, erase
and event
.
Hence we define mu
by structural induction on these three cases.
Instances
Foldable (History k) Source # | |
Defined in XMonad.Util.History fold :: Monoid m => History k m -> m # foldMap :: Monoid m => (a -> m) -> History k a -> m # foldMap' :: Monoid m => (a -> m) -> History k a -> m # foldr :: (a -> b -> b) -> b -> History k a -> b # foldr' :: (a -> b -> b) -> b -> History k a -> b # foldl :: (b -> a -> b) -> b -> History k a -> b # foldl' :: (b -> a -> b) -> b -> History k a -> b # foldr1 :: (a -> a -> a) -> History k a -> a # foldl1 :: (a -> a -> a) -> History k a -> a # toList :: History k a -> [a] # length :: History k a -> Int # elem :: Eq a => a -> History k a -> Bool # maximum :: Ord a => History k a -> a # minimum :: Ord a => History k a -> a # | |
Traversable (History k) Source # | |
Functor (History k) Source # | |
(Read k, Read a, Ord k) => Read (History k a) Source # | |
(Show k, Show a) => Show (History k a) Source # | |
(Eq k, Eq a) => Eq (History k a) Source # | |
(Ord k, Ord a) => Ord (History k a) Source # | |
Defined in XMonad.Util.History |
event :: Ord k => k -> a -> History k a -> History k a Source #
O(log n). A new event makes history; its predecessor forgotten.
mu (event k a h) := (k, a) : mu (erase k h)
erase :: Ord k => k -> History k a -> History k a Source #
O(log n). Erase an event from history.
mu (erase k h) := filter ((k /=) . fst) (mu h)
ledger :: History k a -> [(k, a)] Source #
O(n). Read history, starting with the modern day. ledger
is mu
.
transcribe :: Ord k => [(k, a)] -> History k a Source #
O(n * log n). Transcribe a ledger.