    {-# LANGUAGE NamedFieldPuns, DeriveTraversable #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.History
    -- Description :  Track history in /O(log n)/ time.
    -- Copyright   :  (c) 2022 L. S. Leary
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  @LSLeary (on github)
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- 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.
    --
    -----------------------------------------------------------------------------

    module XMonad.Util.History (
      History,
      origin,
      event,
      erase,
      recall,
      ledger,
      transcribe,
      ) where

    -- base
    import Data.Function (on)
    import Text.Read
      ( Read(readPrec, readListPrec), Lexeme(Ident)
      , parens, prec, lexP, step, readListPrecDefault
      )

    -- containers
    import Data.IntMap (IntMap)
    import qualified Data.IntMap.Strict as I
    import Data.Map (Map)
    import qualified Data.Map.Strict as M

    -- | 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.
    --
    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 -> b) -> History k a -> History k b)
    -> (forall a b. a -> History k b -> History k a)
    -> Functor (History k)
    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
    $cfmap :: forall k a b. (a -> b) -> History k a -> History k b
    fmap :: forall a b. (a -> b) -> History k a -> History k b
    $c<$ :: forall k a b. a -> History k b -> History k a
    <$ :: forall a b. a -> History k b -> History k a
    Functor, (forall m. Monoid m => History k m -> m)
    -> (forall m a. Monoid m => (a -> m) -> History k a -> m)
    -> (forall m a. Monoid m => (a -> m) -> History k a -> m)
    -> (forall a b. (a -> b -> b) -> b -> History k a -> b)
    -> (forall a b. (a -> b -> b) -> b -> History k a -> b)
    -> (forall b a. (b -> a -> b) -> b -> History k a -> b)
    -> (forall b a. (b -> a -> b) -> b -> History k a -> b)
    -> (forall a. (a -> a -> a) -> History k a -> a)
    -> (forall a. (a -> a -> a) -> History k a -> a)
    -> (forall a. History k a -> [a])
    -> (forall a. History k a -> Bool)
    -> (forall a. History k a -> Int)
    -> (forall a. Eq a => a -> History k a -> Bool)
    -> (forall a. Ord a => History k a -> a)
    -> (forall a. Ord a => History k a -> a)
    -> (forall a. Num a => History k a -> a)
    -> (forall a. Num a => History k a -> a)
    -> Foldable (History k)
    forall a. Eq a => a -> History k a -> Bool
    forall a. Num a => History k a -> a
    forall a. Ord a => History k a -> a
    forall m. Monoid m => History k m -> m
    forall a. History k a -> Bool
    forall a. History k a -> Int
    forall a. History k a -> [a]
    forall a. (a -> a -> a) -> History k a -> a
    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 b a. (b -> a -> b) -> b -> History k a -> b
    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
    $cfold :: forall k m. Monoid m => History k m -> m
    fold :: forall m. Monoid m => History k m -> 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
    foldMap' :: forall m a. Monoid m => (a -> m) -> History k a -> m
    $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
    foldr' :: forall a b. (a -> b -> 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
    foldl' :: forall b a. (b -> a -> b) -> b -> History k a -> b
    $cfoldr1 :: forall k a. (a -> a -> a) -> History k a -> a
    foldr1 :: forall a. (a -> a -> a) -> History k a -> a
    $cfoldl1 :: forall k a. (a -> a -> a) -> History k a -> a
    foldl1 :: forall a. (a -> a -> a) -> History k a -> a
    $ctoList :: forall k a. History k a -> [a]
    toList :: forall a. History k a -> [a]
    $cnull :: forall k a. History k a -> Bool
    null :: forall a. History k a -> Bool
    $clength :: forall k a. History k a -> Int
    length :: forall a. History k a -> Int
    $celem :: forall k a. Eq a => a -> History k a -> Bool
    elem :: forall a. Eq a => a -> History k a -> Bool
    $cmaximum :: forall k a. Ord a => History k a -> a
    maximum :: forall a. Ord a => History k a -> a
    $cminimum :: forall k a. Ord a => History k a -> a
    minimum :: forall a. Ord a => History k a -> a
    $csum :: forall k a. Num a => History k a -> a
    sum :: forall a. Num a => History k a -> a
    $cproduct :: forall k a. Num a => History k a -> a
    product :: forall a. Num a => History k a -> a
    Foldable, Functor (History k)
    Foldable (History k)
    (Functor (History k), Foldable (History k)) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> History k a -> f (History k b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        History k (f a) -> f (History k a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> History k a -> m (History k b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        History k (m a) -> m (History k a))
    -> Traversable (History k)
    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 (m :: * -> *) a.
    Monad m =>
    History k (m a) -> m (History k a)
    forall (f :: * -> *) a.
    Applicative f =>
    History k (f a) -> f (History k a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> History k a -> m (History k b)
    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)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> History k a -> f (History k b)
    $csequenceA :: forall k (f :: * -> *) a.
    Applicative f =>
    History k (f a) -> f (History k a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    History k (f a) -> f (History k a)
    $cmapM :: forall k (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> History k a -> m (History k b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> History k a -> m (History k b)
    $csequence :: forall k (m :: * -> *) a.
    Monad m =>
    History k (m a) -> m (History k a)
    sequence :: forall (m :: * -> *) a.
    Monad m =>
    History k (m a) -> m (History k a)
    Traversable)

    instance (Eq  k, Eq  a) => Eq  (History k a) where == :: History k a -> History k a -> Bool
    (==)    = [(k, a)] -> [(k, a)] -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)    ([(k, a)] -> [(k, a)] -> Bool)
    -> (History k a -> [(k, a)]) -> History k a -> History k a -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` History k a -> [(k, a)]
    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 = [(k, a)] -> [(k, a)] -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare ([(k, a)] -> [(k, a)] -> Ordering)
    -> (History k a -> [(k, a)])
    -> History k a
    -> History k a
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` History k a -> [(k, a)]
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    app_prec)
        (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String -> ShowS
    showString String
    "transcribe "
        ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [(k, a)] -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec (Int
    app_precInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (History k a -> [(k, a)]
    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 = ReadPrec (History k a) -> ReadPrec (History k a)
    forall a. ReadPrec a -> ReadPrec a
    parens (ReadPrec (History k a) -> ReadPrec (History k a))
    -> (ReadPrec (History k a) -> ReadPrec (History k a))
    -> ReadPrec (History k a)
    -> ReadPrec (History k a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> ReadPrec (History k a) -> ReadPrec (History k a)
    forall a. Int -> ReadPrec a -> ReadPrec a
    prec Int
    app_prec (ReadPrec (History k a) -> ReadPrec (History k a))
    -> ReadPrec (History k a) -> ReadPrec (History k a)
    forall a b. (a -> b) -> a -> b
    $ do
        Ident "transcribe" <- ReadPrec Lexeme
    lexP
        l <- step readPrec
        pure (transcribe l)
        where app_prec :: Int
    app_prec = Int
    10
      readListPrec :: ReadPrec [History k a]
    readListPrec = ReadPrec [History k a]
    forall a. Read a => ReadPrec [a]
    readListPrecDefault

    -- | /O(1)/. A history of nothing.
    --
    -- > mu origin := []
    --
    origin :: History k a
    origin :: forall k a. History k a
    origin = IntMap (k, a) -> Map k Int -> History k a
    forall k a. IntMap (k, a) -> Map k Int -> History k a
    History IntMap (k, a)
    forall a. IntMap a
    I.empty Map k Int
    forall k a. Map k a
    M.empty

    -- | /O(log n)/. A new event makes history; its predecessor forgotten.
    --
    -- > mu (event k a h) := (k, a) : mu (erase k h)
    --
    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 :: forall k a. History k a -> IntMap (k, a)
    annals :: IntMap (k, a)
    annals,Map k Int
    recorded :: forall k a. History k a -> Map k Int
    recorded :: Map k Int
    recorded} = History
      { annals :: IntMap (k, a)
    annals   = Int -> (k, a) -> IntMap (k, a) -> IntMap (k, a)
    forall a. Int -> a -> IntMap a -> IntMap a
    I.insert Int
    ik (k
    k, a
    a) (IntMap (k, a) -> IntMap (k, a))
    -> (IntMap (k, a) -> IntMap (k, a))
    -> IntMap (k, a)
    -> IntMap (k, a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IntMap (k, a) -> IntMap (k, a))
    -> (Int -> IntMap (k, a) -> IntMap (k, a))
    -> Maybe Int
    -> IntMap (k, a)
    -> IntMap (k, a)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IntMap (k, a) -> IntMap (k, a)
    forall a. a -> a
    id Int -> IntMap (k, a) -> IntMap (k, a)
    forall a. Int -> IntMap a -> IntMap a
    I.delete Maybe Int
    mseen (IntMap (k, a) -> IntMap (k, a)) -> IntMap (k, a) -> IntMap (k, a)
    forall a b. (a -> b) -> a -> b
    $ IntMap (k, a)
    annals
      , recorded :: Map k Int
    recorded = Map k Int
    recorded'
      }
      where
        ik :: Int
    ik = Int
    -> (((Int, (k, a)), IntMap (k, a)) -> Int)
    -> Maybe ((Int, (k, a)), IntMap (k, a))
    -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 (\((Int
    i, (k, a)
    _), IntMap (k, a)
    _) -> Int -> Int
    forall a. Enum a => a -> a
    pred Int
    i) (IntMap (k, a) -> Maybe ((Int, (k, a)), IntMap (k, a))
    forall a. IntMap a -> Maybe ((Int, a), IntMap a)
    I.minViewWithKey IntMap (k, a)
    annals)
        (Maybe Int
    mseen, Map k Int
    recorded') = (k -> Int -> Int -> Int)
    -> k -> Int -> Map k Int -> (Maybe Int, Map k Int)
    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

    -- | /O(log n)/. Erase an event from history.
    --
    -- > mu (erase k h) := filter ((k /=) . fst) (mu h)
    --
    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 :: forall k a. History k a -> IntMap (k, a)
    annals :: IntMap (k, a)
    annals,Map k Int
    recorded :: forall k a. History k a -> Map k Int
    recorded :: Map k Int
    recorded} = History
      { annals :: IntMap (k, a)
    annals   = (IntMap (k, a) -> IntMap (k, a))
    -> (Int -> IntMap (k, a) -> IntMap (k, a))
    -> Maybe Int
    -> IntMap (k, a)
    -> IntMap (k, a)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe IntMap (k, a) -> IntMap (k, a)
    forall a. a -> a
    id Int -> IntMap (k, a) -> IntMap (k, a)
    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') = (k -> Int -> Maybe Int) -> k -> Map k Int -> (Maybe Int, Map k Int)
    forall k a.
    Ord k =>
    (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
    M.updateLookupWithKey (\k
    _ Int
    _ -> Maybe Int
    forall a. Maybe a
    Nothing) k
    k Map k Int
    recorded

    -- | /O(log n)/. Recall an event.
    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 :: forall k a. History k a -> IntMap (k, a)
    annals :: IntMap (k, a)
    annals,Map k Int
    recorded :: forall k a. History k a -> Map k Int
    recorded :: Map k Int
    recorded} = do
      ik     <- k -> Map k Int -> Maybe Int
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup k
    k Map k Int
    recorded
      (_, a) <- I.lookup ik annals
      pure a

    -- | /O(n)/. Read history, starting with the modern day. @ledger@ is @mu@.
    ledger :: History k a -> [(k, a)]
    ledger :: forall k a. History k a -> [(k, a)]
    ledger = IntMap (k, a) -> [(k, a)]
    forall a. IntMap a -> [a]
    I.elems (IntMap (k, a) -> [(k, a)])
    -> (History k a -> IntMap (k, a)) -> History k a -> [(k, a)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . History k a -> IntMap (k, a)
    forall k a. History k a -> IntMap (k, a)
    annals

    -- | /O(n * log n)/. Transcribe a ledger.
    transcribe :: Ord k => [(k, a)] -> History k a
    transcribe :: forall k a. Ord k => [(k, a)] -> History k a
    transcribe = ((k, a) -> History k a -> History k a)
    -> History k a -> [(k, a)] -> History k a
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((k -> a -> History k a -> History k a)
    -> (k, a) -> History k a -> History k a
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry k -> a -> History k a -> History k a
    forall k a. Ord k => k -> a -> History k a -> History k a
    event) History k a
    forall k a. History k a
    origin