{-# LANGUAGE NamedFieldPuns, DeriveTraversable #-}
module XMonad.Util.History (
History,
origin,
event,
erase,
recall,
ledger,
transcribe,
) where
import Data.Function (on)
import Text.Read
( Read(readPrec, readListPrec), Lexeme(Ident)
, parens, prec, lexP, step, readListPrecDefault
)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as I
import Data.Map (Map)
import qualified Data.Map.Strict as M
data History k a = History
{ forall k a. History k a -> IntMap (k, a)
annals :: !(IntMap (k, a))
, forall k a. History k a -> Map k Int
recorded :: !(Map k Int)
} deriving (forall a b. a -> History k b -> History k a
forall a b. (a -> b) -> History k a -> History k b
forall k a b. a -> History k b -> History k a
forall k a b. (a -> b) -> History k a -> History k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> History k b -> History k a
$c<$ :: forall k a b. a -> History k b -> History k a
fmap :: forall a b. (a -> b) -> History k a -> History k b
$cfmap :: forall k a b. (a -> b) -> History k a -> History k b
Functor, forall a. History k a -> Bool
forall k a. Eq a => a -> History k a -> Bool
forall k a. Num a => History k a -> a
forall k a. Ord a => History k a -> a
forall m a. Monoid m => (a -> m) -> History k a -> m
forall k m. Monoid m => History k m -> m
forall k a. History k a -> Bool
forall k a. History k a -> Int
forall k a. History k a -> [a]
forall a b. (a -> b -> b) -> b -> History k a -> b
forall k a. (a -> a -> a) -> History k a -> a
forall k m a. Monoid m => (a -> m) -> History k a -> m
forall k b a. (b -> a -> b) -> b -> History k a -> b
forall k a b. (a -> b -> b) -> b -> History k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => History k a -> a
$cproduct :: forall k a. Num a => History k a -> a
sum :: forall a. Num a => History k a -> a
$csum :: forall k a. Num a => History k a -> a
minimum :: forall a. Ord a => History k a -> a
$cminimum :: forall k a. Ord a => History k a -> a
maximum :: forall a. Ord a => History k a -> a
$cmaximum :: forall k a. Ord a => History k a -> a
elem :: forall a. Eq a => a -> History k a -> Bool
$celem :: forall k a. Eq a => a -> History k a -> Bool
length :: forall a. History k a -> Int
$clength :: forall k a. History k a -> Int
null :: forall a. History k a -> Bool
$cnull :: forall k a. History k a -> Bool
toList :: forall a. History k a -> [a]
$ctoList :: forall k a. History k a -> [a]
foldl1 :: forall a. (a -> a -> a) -> History k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> History k a -> a
foldr1 :: forall a. (a -> a -> a) -> History k a -> a
$cfoldr1 :: forall k a. (a -> a -> a) -> History k a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> History k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> History k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> History k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> History k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> History k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> History k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> History k a -> b
$cfoldr :: forall k a b. (a -> b -> b) -> b -> History k a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> History k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> History k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> History k a -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> History k a -> m
fold :: forall m. Monoid m => History k m -> m
$cfold :: forall k m. Monoid m => History k m -> m
Foldable, forall k. Functor (History k)
forall k. Foldable (History k)
forall k (m :: * -> *) a.
Monad m =>
History k (m a) -> m (History k a)
forall k (f :: * -> *) a.
Applicative f =>
History k (f a) -> f (History k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> History k a -> m (History k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> History k a -> f (History k b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> History k a -> f (History k b)
sequence :: forall (m :: * -> *) a.
Monad m =>
History k (m a) -> m (History k a)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
History k (m a) -> m (History k a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> History k a -> m (History k b)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> History k a -> m (History k b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
History k (f a) -> f (History k a)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
History k (f a) -> f (History k a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> History k a -> f (History k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> History k a -> f (History k b)
Traversable)
instance (Eq k, Eq a) => Eq (History k a) where == :: History k a -> History k a -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. History k a -> [(k, a)]
ledger
instance (Ord k, Ord a) => Ord (History k a) where compare :: History k a -> History k a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall k a. History k a -> [(k, a)]
ledger
instance (Show k, Show a) => Show (History k a) where
showsPrec :: Int -> History k a -> ShowS
showsPrec Int
d History k a
h
= Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
app_prec)
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"transcribe "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precforall a. Num a => a -> a -> a
+Int
1) (forall k a. History k a -> [(k, a)]
ledger History k a
h)
where app_prec :: Int
app_prec = Int
10
instance (Read k, Read a, Ord k) => Read (History k a) where
readPrec :: ReadPrec (History k a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec forall a b. (a -> b) -> a -> b
$ do
Ident String
"transcribe" <- ReadPrec Lexeme
lexP
[(k, a)]
l <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall k a. Ord k => [(k, a)] -> History k a
transcribe [(k, a)]
l)
where app_prec :: Int
app_prec = Int
10
readListPrec :: ReadPrec [History k a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
origin :: History k a
origin :: forall k a. History k a
origin = forall k a. IntMap (k, a) -> Map k Int -> History k a
History forall a. IntMap a
I.empty forall k a. Map k a
M.empty
event :: Ord k => k -> a -> History k a -> History k a
event :: forall k a. Ord k => k -> a -> History k a -> History k a
event k
k a
a History{IntMap (k, a)
annals :: IntMap (k, a)
annals :: forall k a. History k a -> IntMap (k, a)
annals,Map k Int
recorded :: Map k Int
recorded :: forall k a. History k a -> Map k Int
recorded} = History
{ annals :: IntMap (k, a)
annals = forall a. Int -> a -> IntMap a -> IntMap a
I.insert Int
ik (k
k, a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Int -> IntMap a -> IntMap a
I.delete Maybe Int
mseen forall a b. (a -> b) -> a -> b
$ IntMap (k, a)
annals
, recorded :: Map k Int
recorded = Map k Int
recorded'
}
where
ik :: Int
ik = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (\((Int
i, (k, a)
_), IntMap (k, a)
_) -> forall a. Enum a => a -> a
pred Int
i) (forall a. IntMap a -> Maybe ((Int, a), IntMap a)
I.minViewWithKey IntMap (k, a)
annals)
(Maybe Int
mseen, Map k Int
recorded') = forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
M.insertLookupWithKey (\k
_ Int
x Int
_ -> Int
x) k
k Int
ik Map k Int
recorded
erase :: Ord k => k -> History k a -> History k a
erase :: forall k a. Ord k => k -> History k a -> History k a
erase k
k History{IntMap (k, a)
annals :: IntMap (k, a)
annals :: forall k a. History k a -> IntMap (k, a)
annals,Map k Int
recorded :: Map k Int
recorded :: forall k a. History k a -> Map k Int
recorded} = History
{ annals :: IntMap (k, a)
annals = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id forall a. Int -> IntMap a -> IntMap a
I.delete Maybe Int
mseen IntMap (k, a)
annals
, recorded :: Map k Int
recorded = Map k Int
recorded'
}
where (Maybe Int
mseen, Map k Int
recorded') = forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\k
_ Int
_ -> forall a. Maybe a
Nothing) k
k Map k Int
recorded
recall :: Ord k => k -> History k a -> Maybe a
recall :: forall k a. Ord k => k -> History k a -> Maybe a
recall k
k History{IntMap (k, a)
annals :: IntMap (k, a)
annals :: forall k a. History k a -> IntMap (k, a)
annals,Map k Int
recorded :: Map k Int
recorded :: forall k a. History k a -> Map k Int
recorded} = do
Int
ik <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup k
k Map k Int
recorded
(k
_, a
a) <- forall a. Int -> IntMap a -> Maybe a
I.lookup Int
ik IntMap (k, a)
annals
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
ledger :: History k a -> [(k, a)]
ledger :: forall k a. History k a -> [(k, a)]
ledger = forall a. IntMap a -> [a]
I.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. History k a -> IntMap (k, a)
annals
transcribe :: Ord k => [(k, a)] -> History k a
transcribe :: forall k a. Ord k => [(k, a)] -> History k a
transcribe = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> History k a -> History k a
event) forall k a. History k a
origin