{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module      : KMonad.Util.LayerStack
Description : A container of overlapping mappings
Copyright   : (c) David Janssen, 2019
License     : MIT
Maintainer  : janssen.dhj@gmail.com
Stability   : experimental
Portability : portable

A 'LayerStack' is a set of different mappings between keys and values, and
provides functionality for keeping track of a `stack` of these mappings. Lookup
in a 'LayerStack' happens by checking the front-most mapping on the stack, and
if that fails, descending deeper.

A 'LayerStack' has 3 type parameters, in the documentation we will refer to
those as:
  - l: The layer key, which is the identifier for the different layers
  - k: The item key, which is the per-layer identifier for different items
  - a: The item (value), which is the value stored for k in a particular layer

'LayerStack' is used to implement the basic keymap logic in KMonad, where the
configuration for a keyboard is essentially a set of layers. Each layer maps
keycodes to buttons, and the entire layers can be overlayed on top of eachother.

-}
module KMonad.Util.LayerStack
  ( -- * Basic types
    -- $types
    Layer
  , mkLayer
  , LayerStack
  , mkLayerStack
  , items
  , maps
  , stack

    -- * Basic operations on LayerStacks
    -- $ops
  , atKey
  , inLayer
  , pushLayer
  , popLayer

    -- * Things that can go wrong with LayerStacks
    -- $err
  , LayerStackError(..)
  , AsLayerStackError(..)
  )

where

import KMonad.Prelude

import RIO.List (delete)

import qualified RIO.HashMap as M
import qualified RIO.HashSet as S

--------------------------------------------------------------------------------
-- $err

-- | The things that can go wrong with a 'LayerStack'
data LayerStackError l
  = LayerDoesNotExist l   -- ^ Requested use of a non-existing layer
  | LayerNotOnStack   l   -- ^ Requested use of a non-stack layer
  deriving Int -> LayerStackError l -> ShowS
[LayerStackError l] -> ShowS
LayerStackError l -> String
(Int -> LayerStackError l -> ShowS)
-> (LayerStackError l -> String)
-> ([LayerStackError l] -> ShowS)
-> Show (LayerStackError l)
forall l. Show l => Int -> LayerStackError l -> ShowS
forall l. Show l => [LayerStackError l] -> ShowS
forall l. Show l => LayerStackError l -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall l. Show l => Int -> LayerStackError l -> ShowS
showsPrec :: Int -> LayerStackError l -> ShowS
$cshow :: forall l. Show l => LayerStackError l -> String
show :: LayerStackError l -> String
$cshowList :: forall l. Show l => [LayerStackError l] -> ShowS
showList :: [LayerStackError l] -> ShowS
Show
makeClassyPrisms ''LayerStackError

instance (Typeable l, Show l) => Exception (LayerStackError l)

--------------------------------------------------------------------------------
-- $constraints

-- | The type of things that can function as either layer or item keys in a
-- LayerStack.
type CanKey k = (Eq k, Hashable k)

--------------------------------------------------------------------------------
-- $types

-- | A 'Layer' is one of the maps contained inside a 'LayerStack'
newtype Layer k a = Layer { forall k a. Layer k a -> HashMap k a
unLayer :: M.HashMap k a}
  deriving (Int -> Layer k a -> ShowS
[Layer k a] -> ShowS
Layer k a -> String
(Int -> Layer k a -> ShowS)
-> (Layer k a -> String)
-> ([Layer k a] -> ShowS)
-> Show (Layer k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k a. (Show k, Show a) => Int -> Layer k a -> ShowS
forall k a. (Show k, Show a) => [Layer k a] -> ShowS
forall k a. (Show k, Show a) => Layer k a -> String
$cshowsPrec :: forall k a. (Show k, Show a) => Int -> Layer k a -> ShowS
showsPrec :: Int -> Layer k a -> ShowS
$cshow :: forall k a. (Show k, Show a) => Layer k a -> String
show :: Layer k a -> String
$cshowList :: forall k a. (Show k, Show a) => [Layer k a] -> ShowS
showList :: [Layer k a] -> ShowS
Show, Layer k a -> Layer k a -> Bool
(Layer k a -> Layer k a -> Bool)
-> (Layer k a -> Layer k a -> Bool) -> Eq (Layer k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k a. (Eq k, Eq a) => Layer k a -> Layer k a -> Bool
$c== :: forall k a. (Eq k, Eq a) => Layer k a -> Layer k a -> Bool
== :: Layer k a -> Layer k a -> Bool
$c/= :: forall k a. (Eq k, Eq a) => Layer k a -> Layer k a -> Bool
/= :: Layer k a -> Layer k a -> Bool
Eq, Eq (Layer k a)
Eq (Layer k a) =>
(Layer k a -> Layer k a -> Ordering)
-> (Layer k a -> Layer k a -> Bool)
-> (Layer k a -> Layer k a -> Bool)
-> (Layer k a -> Layer k a -> Bool)
-> (Layer k a -> Layer k a -> Bool)
-> (Layer k a -> Layer k a -> Layer k a)
-> (Layer k a -> Layer k a -> Layer k a)
-> Ord (Layer k a)
Layer k a -> Layer k a -> Bool
Layer k a -> Layer k a -> Ordering
Layer k a -> Layer k a -> Layer k a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k a. (Ord k, Ord a) => Eq (Layer k a)
forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Bool
forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Ordering
forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Layer k a
$ccompare :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Ordering
compare :: Layer k a -> Layer k a -> Ordering
$c< :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Bool
< :: Layer k a -> Layer k a -> Bool
$c<= :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Bool
<= :: Layer k a -> Layer k a -> Bool
$c> :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Bool
> :: Layer k a -> Layer k a -> Bool
$c>= :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Bool
>= :: Layer k a -> Layer k a -> Bool
$cmax :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Layer k a
max :: Layer k a -> Layer k a -> Layer k a
$cmin :: forall k a. (Ord k, Ord a) => Layer k a -> Layer k a -> Layer k a
min :: Layer k a -> Layer k a -> Layer k a
Ord, (forall a b. (a -> b) -> Layer k a -> Layer k b)
-> (forall a b. a -> Layer k b -> Layer k a) -> Functor (Layer k)
forall a b. a -> Layer k b -> Layer k a
forall a b. (a -> b) -> Layer k a -> Layer k b
forall k a b. a -> Layer k b -> Layer k a
forall k a b. (a -> b) -> Layer k a -> Layer 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) -> Layer k a -> Layer k b
fmap :: forall a b. (a -> b) -> Layer k a -> Layer k b
$c<$ :: forall k a b. a -> Layer k b -> Layer k a
<$ :: forall a b. a -> Layer k b -> Layer k a
Functor, (forall m. Monoid m => Layer k m -> m)
-> (forall m a. Monoid m => (a -> m) -> Layer k a -> m)
-> (forall m a. Monoid m => (a -> m) -> Layer k a -> m)
-> (forall a b. (a -> b -> b) -> b -> Layer k a -> b)
-> (forall a b. (a -> b -> b) -> b -> Layer k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Layer k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Layer k a -> b)
-> (forall a. (a -> a -> a) -> Layer k a -> a)
-> (forall a. (a -> a -> a) -> Layer k a -> a)
-> (forall a. Layer k a -> [a])
-> (forall a. Layer k a -> Bool)
-> (forall a. Layer k a -> Int)
-> (forall a. Eq a => a -> Layer k a -> Bool)
-> (forall a. Ord a => Layer k a -> a)
-> (forall a. Ord a => Layer k a -> a)
-> (forall a. Num a => Layer k a -> a)
-> (forall a. Num a => Layer k a -> a)
-> Foldable (Layer k)
forall a. Eq a => a -> Layer k a -> Bool
forall a. Num a => Layer k a -> a
forall a. Ord a => Layer k a -> a
forall m. Monoid m => Layer k m -> m
forall a. Layer k a -> Bool
forall a. Layer k a -> Int
forall a. Layer k a -> [a]
forall a. (a -> a -> a) -> Layer k a -> a
forall k a. Eq a => a -> Layer k a -> Bool
forall k a. Num a => Layer k a -> a
forall k a. Ord a => Layer k a -> a
forall m a. Monoid m => (a -> m) -> Layer k a -> m
forall k m. Monoid m => Layer k m -> m
forall k a. Layer k a -> Bool
forall k a. Layer k a -> Int
forall k a. Layer k a -> [a]
forall b a. (b -> a -> b) -> b -> Layer k a -> b
forall a b. (a -> b -> b) -> b -> Layer k a -> b
forall k a. (a -> a -> a) -> Layer k a -> a
forall k m a. Monoid m => (a -> m) -> Layer k a -> m
forall k b a. (b -> a -> b) -> b -> Layer k a -> b
forall k a b. (a -> b -> b) -> b -> Layer 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 => Layer k m -> m
fold :: forall m. Monoid m => Layer k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> Layer k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Layer k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> Layer k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Layer k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> Layer k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Layer k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> Layer k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Layer k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> Layer k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Layer k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> Layer k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Layer k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> Layer k a -> a
foldr1 :: forall a. (a -> a -> a) -> Layer k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> Layer k a -> a
foldl1 :: forall a. (a -> a -> a) -> Layer k a -> a
$ctoList :: forall k a. Layer k a -> [a]
toList :: forall a. Layer k a -> [a]
$cnull :: forall k a. Layer k a -> Bool
null :: forall a. Layer k a -> Bool
$clength :: forall k a. Layer k a -> Int
length :: forall a. Layer k a -> Int
$celem :: forall k a. Eq a => a -> Layer k a -> Bool
elem :: forall a. Eq a => a -> Layer k a -> Bool
$cmaximum :: forall k a. Ord a => Layer k a -> a
maximum :: forall a. Ord a => Layer k a -> a
$cminimum :: forall k a. Ord a => Layer k a -> a
minimum :: forall a. Ord a => Layer k a -> a
$csum :: forall k a. Num a => Layer k a -> a
sum :: forall a. Num a => Layer k a -> a
$cproduct :: forall k a. Num a => Layer k a -> a
product :: forall a. Num a => Layer k a -> a
Foldable, Functor (Layer k)
Foldable (Layer k)
(Functor (Layer k), Foldable (Layer k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Layer k a -> f (Layer k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Layer k (f a) -> f (Layer k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Layer k a -> m (Layer k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Layer k (m a) -> m (Layer k a))
-> Traversable (Layer k)
forall k. Functor (Layer k)
forall k. Foldable (Layer k)
forall k (m :: * -> *) a. Monad m => Layer k (m a) -> m (Layer k a)
forall k (f :: * -> *) a.
Applicative f =>
Layer k (f a) -> f (Layer k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Layer k a -> m (Layer k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Layer k a -> f (Layer 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 => Layer k (m a) -> m (Layer k a)
forall (f :: * -> *) a.
Applicative f =>
Layer k (f a) -> f (Layer k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Layer k a -> m (Layer k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Layer k a -> f (Layer k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Layer k a -> f (Layer k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Layer k a -> f (Layer k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
Layer k (f a) -> f (Layer k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Layer k (f a) -> f (Layer k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Layer k a -> m (Layer k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Layer k a -> m (Layer k b)
$csequence :: forall k (m :: * -> *) a. Monad m => Layer k (m a) -> m (Layer k a)
sequence :: forall (m :: * -> *) a. Monad m => Layer k (m a) -> m (Layer k a)
Traversable)

-- | Create a new 'Layer' from a 'Foldable' of key-value pairs
mkLayer :: (Foldable t, CanKey k) => t (k, a) -> Layer k a
mkLayer :: forall (t :: * -> *) k a.
(Foldable t, CanKey k) =>
t (k, a) -> Layer k a
mkLayer = HashMap k a -> Layer k a
forall k a. HashMap k a -> Layer k a
Layer (HashMap k a -> Layer k a)
-> (t (k, a) -> HashMap k a) -> t (k, a) -> Layer k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> HashMap k a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(k, a)] -> HashMap k a)
-> (t (k, a) -> [(k, a)]) -> t (k, a) -> HashMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t (k, a) -> [(k, a)]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | A 'LayerStack' is a named collection of maps and a sequence of maps to use
-- for lookup.
data LayerStack l k a = LayerStack
  { forall l k a. LayerStack l k a -> [l]
_stack :: ![l]                  -- ^ The current stack of layers
  , forall l k a. LayerStack l k a -> HashSet l
_maps  :: !(S.HashSet l)        -- ^ A set of all 'Layer' names
  , forall l k a. LayerStack l k a -> HashMap (l, k) a
_items :: !(M.HashMap (l, k) a) -- ^ The map of all the bindings
  } deriving (Int -> LayerStack l k a -> ShowS
[LayerStack l k a] -> ShowS
LayerStack l k a -> String
(Int -> LayerStack l k a -> ShowS)
-> (LayerStack l k a -> String)
-> ([LayerStack l k a] -> ShowS)
-> Show (LayerStack l k a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall l k a.
(Show l, Show k, Show a) =>
Int -> LayerStack l k a -> ShowS
forall l k a.
(Show l, Show k, Show a) =>
[LayerStack l k a] -> ShowS
forall l k a.
(Show l, Show k, Show a) =>
LayerStack l k a -> String
$cshowsPrec :: forall l k a.
(Show l, Show k, Show a) =>
Int -> LayerStack l k a -> ShowS
showsPrec :: Int -> LayerStack l k a -> ShowS
$cshow :: forall l k a.
(Show l, Show k, Show a) =>
LayerStack l k a -> String
show :: LayerStack l k a -> String
$cshowList :: forall l k a.
(Show l, Show k, Show a) =>
[LayerStack l k a] -> ShowS
showList :: [LayerStack l k a] -> ShowS
Show, LayerStack l k a -> LayerStack l k a -> Bool
(LayerStack l k a -> LayerStack l k a -> Bool)
-> (LayerStack l k a -> LayerStack l k a -> Bool)
-> Eq (LayerStack l k a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall l k a.
(Eq l, Eq k, Eq a) =>
LayerStack l k a -> LayerStack l k a -> Bool
$c== :: forall l k a.
(Eq l, Eq k, Eq a) =>
LayerStack l k a -> LayerStack l k a -> Bool
== :: LayerStack l k a -> LayerStack l k a -> Bool
$c/= :: forall l k a.
(Eq l, Eq k, Eq a) =>
LayerStack l k a -> LayerStack l k a -> Bool
/= :: LayerStack l k a -> LayerStack l k a -> Bool
Eq, (forall a b. (a -> b) -> LayerStack l k a -> LayerStack l k b)
-> (forall a b. a -> LayerStack l k b -> LayerStack l k a)
-> Functor (LayerStack l k)
forall a b. a -> LayerStack l k b -> LayerStack l k a
forall a b. (a -> b) -> LayerStack l k a -> LayerStack l k b
forall l k a b. a -> LayerStack l k b -> LayerStack l k a
forall l k a b. (a -> b) -> LayerStack l k a -> LayerStack l 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 l k a b. (a -> b) -> LayerStack l k a -> LayerStack l k b
fmap :: forall a b. (a -> b) -> LayerStack l k a -> LayerStack l k b
$c<$ :: forall l k a b. a -> LayerStack l k b -> LayerStack l k a
<$ :: forall a b. a -> LayerStack l k b -> LayerStack l k a
Functor)
makeLenses ''LayerStack


-- | Create a new 'LayerStack' from a foldable of foldables.
mkLayerStack :: (Foldable t1, Foldable t2, CanKey k, CanKey l)
  => t1 (l, t2 (k, a)) -- ^ The /alist/ of /alists/ describing the mapping
  -> LayerStack l k a
mkLayerStack :: forall (t1 :: * -> *) (t2 :: * -> *) k l a.
(Foldable t1, Foldable t2, CanKey k, CanKey l) =>
t1 (l, t2 (k, a)) -> LayerStack l k a
mkLayerStack t1 (l, t2 (k, a))
nestMaps = let
  -- Create a HashMap l (Layer k a) from the list-likes
  hms :: HashMap l (Layer k a)
hms = [(l, Layer k a)] -> HashMap l (Layer k a)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(l, Layer k a)] -> HashMap l (Layer k a))
-> ([(l, t2 (k, a))] -> [(l, Layer k a)])
-> [(l, t2 (k, a))]
-> HashMap l (Layer k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((l, t2 (k, a)) -> (l, Layer k a))
-> [(l, t2 (k, a))] -> [(l, Layer k a)]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (l, t2 (k, a)) (l, Layer k a) (t2 (k, a)) (Layer k a)
-> (t2 (k, a) -> Layer k a) -> (l, t2 (k, a)) -> (l, Layer k a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (l, t2 (k, a)) (l, Layer k a) (t2 (k, a)) (Layer k a)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (l, t2 (k, a)) (l, Layer k a) (t2 (k, a)) (Layer k a)
_2 t2 (k, a) -> Layer k a
forall (t :: * -> *) k a.
(Foldable t, CanKey k) =>
t (k, a) -> Layer k a
mkLayer) ([(l, t2 (k, a))] -> HashMap l (Layer k a))
-> [(l, t2 (k, a))] -> HashMap l (Layer k a)
forall a b. (a -> b) -> a -> b
$ t1 (l, t2 (k, a)) -> [(l, t2 (k, a))]
forall a. t1 a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t1 (l, t2 (k, a))
nestMaps
--   -- Create a HashMap (l, k) a from `hms`
  its :: HashMap (l, k) a
its = [((l, k), a)] -> HashMap (l, k) a
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([((l, k), a)] -> HashMap (l, k) a)
-> [((l, k), a)] -> HashMap (l, k) a
forall a b. (a -> b) -> a -> b
$ HashMap l (Layer k a)
hms HashMap l (Layer k a)
-> IndexedGetting
     (l, k) (Endo [((l, k), a)]) (HashMap l (Layer k a)) a
-> [((l, k), a)]
forall s i a. s -> IndexedGetting i (Endo [(i, a)]) s a -> [(i, a)]
^@.. Indexed l (Layer k a) (Const (Endo [((l, k), a)]) (Layer k a))
-> HashMap l (Layer k a)
-> Const (Endo [((l, k), a)]) (HashMap l (Layer k a))
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
IndexedFold l (HashMap l (Layer k a)) (Layer k a)
ifolded (Indexed l (Layer k a) (Const (Endo [((l, k), a)]) (Layer k a))
 -> HashMap l (Layer k a)
 -> Const (Endo [((l, k), a)]) (HashMap l (Layer k a)))
-> (Indexed k a (Const (Endo [((l, k), a)]) a)
    -> Layer k a -> Const (Endo [((l, k), a)]) (Layer k a))
-> IndexedGetting
     (l, k) (Endo [((l, k), a)]) (HashMap l (Layer k a)) a
forall i j (p :: * -> * -> *) s t r a b.
Indexable (i, j) p =>
(Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r
<.> ((Layer k a -> HashMap k a)
-> (HashMap k a -> Const (Endo [((l, k), a)]) (HashMap k a))
-> Layer k a
-> Const (Endo [((l, k), a)]) (Layer k a)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Layer k a -> HashMap k a
forall k a. Layer k a -> HashMap k a
unLayer ((HashMap k a -> Const (Endo [((l, k), a)]) (HashMap k a))
 -> Layer k a -> Const (Endo [((l, k), a)]) (Layer k a))
-> (Indexed k a (Const (Endo [((l, k), a)]) a)
    -> HashMap k a -> Const (Endo [((l, k), a)]) (HashMap k a))
-> Indexed k a (Const (Endo [((l, k), a)]) a)
-> Layer k a
-> Const (Endo [((l, k), a)]) (Layer k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed k a (Const (Endo [((l, k), a)]) a)
-> HashMap k a -> Const (Endo [((l, k), a)]) (HashMap k a)
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
IndexedFold k (HashMap k a) a
ifolded)
--   -- Create a HashSet of keys from `its`
  kys :: HashSet l
kys = [l] -> HashSet l
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([l] -> HashSet l)
-> (HashMap l (Layer k a) -> [l])
-> HashMap l (Layer k a)
-> HashSet l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap l (Layer k a) -> [l]
forall k v. HashMap k v -> [k]
M.keys (HashMap l (Layer k a) -> HashSet l)
-> HashMap l (Layer k a) -> HashSet l
forall a b. (a -> b) -> a -> b
$ HashMap l (Layer k a)
hms
  in [l] -> HashSet l -> HashMap (l, k) a -> LayerStack l k a
forall l k a.
[l] -> HashSet l -> HashMap (l, k) a -> LayerStack l k a
LayerStack [] HashSet l
kys HashMap (l, k) a
its

--------------------------------------------------------------------------------
-- $ops

-- | Return a fold of all the items currently mapped to the item-key
--
-- This can be used with 'toListOf' to get an overview of all the items
-- currently mapped to an item-key, or more usefully, with 'firstOf' to simply
-- try a lookup like this: `stack^? atKey KeyA`
atKey :: (CanKey l, CanKey k) => k -> Fold (LayerStack l k a) a
atKey :: forall l k a.
(CanKey l, CanKey k) =>
k -> Fold (LayerStack l k a) a
atKey k
c = (LayerStack l k a -> [a]) -> Fold (LayerStack l k a) a
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ((LayerStack l k a -> [a]) -> Fold (LayerStack l k a) a)
-> (LayerStack l k a -> [a]) -> Fold (LayerStack l k a) a
forall a b. (a -> b) -> a -> b
$ \LayerStack l k a
m -> LayerStack l k a
m LayerStack l k a -> Getting (Endo [a]) (LayerStack l k a) a -> [a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([l] -> Const (Endo [a]) [l])
-> LayerStack l k a -> Const (Endo [a]) (LayerStack l k a)
forall l k a (f :: * -> *).
Functor f =>
([l] -> f [l]) -> LayerStack l k a -> f (LayerStack l k a)
stack (([l] -> Const (Endo [a]) [l])
 -> LayerStack l k a -> Const (Endo [a]) (LayerStack l k a))
-> ((a -> Const (Endo [a]) a) -> [l] -> Const (Endo [a]) [l])
-> Getting (Endo [a]) (LayerStack l k a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l -> Const (Endo [a]) l) -> [l] -> Const (Endo [a]) [l]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [l] l
folded ((l -> Const (Endo [a]) l) -> [l] -> Const (Endo [a]) [l])
-> ((a -> Const (Endo [a]) a) -> l -> Const (Endo [a]) l)
-> (a -> Const (Endo [a]) a)
-> [l]
-> Const (Endo [a]) [l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (l -> [a]) -> Optic' (->) (Const (Endo [a])) l [a]
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (LayerStack l k a -> l -> [a]
getK LayerStack l k a
m) Optic' (->) (Const (Endo [a])) l [a]
-> ((a -> Const (Endo [a]) a) -> [a] -> Const (Endo [a]) [a])
-> (a -> Const (Endo [a]) a)
-> l
-> Const (Endo [a]) l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (Endo [a]) a) -> [a] -> Const (Endo [a]) [a]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [a] a
folded
  where getK :: LayerStack l k a -> l -> [a]
getK LayerStack l k a
m l
n = [a] -> (a -> [a]) -> Maybe a -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] a -> [a]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((l, k) -> HashMap (l, k) a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup (l
n, k
c) (LayerStack l k a
mLayerStack l k a
-> Getting (HashMap (l, k) a) (LayerStack l k a) (HashMap (l, k) a)
-> HashMap (l, k) a
forall s a. s -> Getting a s a -> a
^.Getting (HashMap (l, k) a) (LayerStack l k a) (HashMap (l, k) a)
forall l k a k a (f :: * -> *).
Functor f =>
(HashMap (l, k) a -> f (HashMap (l, k) a))
-> LayerStack l k a -> f (LayerStack l k a)
items))

-- | Try to look up a key in a specific layer, regardless of the stack
inLayer :: (CanKey l, CanKey k) => l -> k -> Fold (LayerStack l k a) a
inLayer :: forall l k a.
(CanKey l, CanKey k) =>
l -> k -> Fold (LayerStack l k a) a
inLayer l
l k
c = (LayerStack l k a -> Maybe a) -> Fold (LayerStack l k a) a
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding ((LayerStack l k a -> Maybe a) -> Fold (LayerStack l k a) a)
-> (LayerStack l k a -> Maybe a) -> Fold (LayerStack l k a) a
forall a b. (a -> b) -> a -> b
$ \LayerStack l k a
m -> LayerStack l k a
m LayerStack l k a
-> Getting (First a) (LayerStack l k a) a -> Maybe a
forall s a. s -> Getting (First a) s a -> Maybe a
^? (HashMap (l, k) a -> Const (First a) (HashMap (l, k) a))
-> LayerStack l k a -> Const (First a) (LayerStack l k a)
forall l k a k a (f :: * -> *).
Functor f =>
(HashMap (l, k) a -> f (HashMap (l, k) a))
-> LayerStack l k a -> f (LayerStack l k a)
items ((HashMap (l, k) a -> Const (First a) (HashMap (l, k) a))
 -> LayerStack l k a -> Const (First a) (LayerStack l k a))
-> ((a -> Const (First a) a)
    -> HashMap (l, k) a -> Const (First a) (HashMap (l, k) a))
-> Getting (First a) (LayerStack l k a) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap (l, k) a)
-> Traversal' (HashMap (l, k) a) (IxValue (HashMap (l, k) a))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (l
l, k
c)

-- | Add a layer to the front of the stack and return the new 'LayerStack'.
--
-- If the 'Layer' does not exist, return a 'LayerStackError'. If the 'Layer' is
-- already on the stack, bring it to the front.
--
pushLayer :: (CanKey l, CanKey k)
  => l
  -> LayerStack l k a
  -> Either (LayerStackError l) (LayerStack l k a)
pushLayer :: forall l k a.
(CanKey l, CanKey k) =>
l
-> LayerStack l k a
-> Either (LayerStackError l) (LayerStack l k a)
pushLayer l
n LayerStack l k a
keymap = if l
n l -> HashSet l -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LayerStack l k a
keymapLayerStack l k a
-> Getting (HashSet l) (LayerStack l k a) (HashSet l) -> HashSet l
forall s a. s -> Getting a s a -> a
^.Getting (HashSet l) (LayerStack l k a) (HashSet l)
forall l k a (f :: * -> *).
Functor f =>
(HashSet l -> f (HashSet l))
-> LayerStack l k a -> f (LayerStack l k a)
maps
  then LayerStack l k a -> Either (LayerStackError l) (LayerStack l k a)
forall a b. b -> Either a b
Right (LayerStack l k a -> Either (LayerStackError l) (LayerStack l k a))
-> LayerStack l k a
-> Either (LayerStackError l) (LayerStack l k a)
forall a b. (a -> b) -> a -> b
$ LayerStack l k a
keymap LayerStack l k a
-> (LayerStack l k a -> LayerStack l k a) -> LayerStack l k a
forall a b. a -> (a -> b) -> b
& ([l] -> Identity [l])
-> LayerStack l k a -> Identity (LayerStack l k a)
forall l k a (f :: * -> *).
Functor f =>
([l] -> f [l]) -> LayerStack l k a -> f (LayerStack l k a)
stack (([l] -> Identity [l])
 -> LayerStack l k a -> Identity (LayerStack l k a))
-> ([l] -> [l]) -> LayerStack l k a -> LayerStack l k a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ l -> [l] -> [l]
forall {a}. Eq a => a -> [a] -> [a]
addFront l
n
  else LayerStackError l -> Either (LayerStackError l) (LayerStack l k a)
forall a b. a -> Either a b
Left  (LayerStackError l
 -> Either (LayerStackError l) (LayerStack l k a))
-> LayerStackError l
-> Either (LayerStackError l) (LayerStack l k a)
forall a b. (a -> b) -> a -> b
$ l -> LayerStackError l
forall l. l -> LayerStackError l
LayerDoesNotExist l
n
  where addFront :: a -> [a] -> [a]
addFront a
a [a]
as = case (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) [a]
as of
          ([a]
frnt, a
a':[a]
rest) -> a
a'a -> [a] -> [a]
forall a. a -> [a] -> [a]
:([a]
frnt [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
rest)
          ([a]
frnt, [])      -> a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
frnt

-- | Remove a layer from the stack. If the layer index does not exist on the
-- stack, return a 'LayerNotOnStack', if the layer index does not exist at all
-- in the 'LayerStack', return a 'LayerDoesNotExist'.
popLayer :: (CanKey l, CanKey k)
  => l
  -> LayerStack l k a
  -> Either (LayerStackError l) (LayerStack l k a)
popLayer :: forall l k a.
(CanKey l, CanKey k) =>
l
-> LayerStack l k a
-> Either (LayerStackError l) (LayerStack l k a)
popLayer l
n LayerStack l k a
keymap = if
  | l
n l -> [l] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LayerStack l k a
keymapLayerStack l k a -> Getting [l] (LayerStack l k a) [l] -> [l]
forall s a. s -> Getting a s a -> a
^.Getting [l] (LayerStack l k a) [l]
forall l k a (f :: * -> *).
Functor f =>
([l] -> f [l]) -> LayerStack l k a -> f (LayerStack l k a)
stack -> LayerStack l k a -> Either (LayerStackError l) (LayerStack l k a)
forall a b. b -> Either a b
Right (LayerStack l k a -> Either (LayerStackError l) (LayerStack l k a))
-> LayerStack l k a
-> Either (LayerStackError l) (LayerStack l k a)
forall a b. (a -> b) -> a -> b
$ LayerStack l k a
keymap LayerStack l k a
-> (LayerStack l k a -> LayerStack l k a) -> LayerStack l k a
forall a b. a -> (a -> b) -> b
& ([l] -> Identity [l])
-> LayerStack l k a -> Identity (LayerStack l k a)
forall l k a (f :: * -> *).
Functor f =>
([l] -> f [l]) -> LayerStack l k a -> f (LayerStack l k a)
stack (([l] -> Identity [l])
 -> LayerStack l k a -> Identity (LayerStack l k a))
-> ([l] -> [l]) -> LayerStack l k a -> LayerStack l k a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ l -> [l] -> [l]
forall {a}. Eq a => a -> [a] -> [a]
delete l
n
  | l
n l -> HashSet l -> Bool
forall a. Eq a => a -> HashSet a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LayerStack l k a
keymapLayerStack l k a
-> Getting (HashSet l) (LayerStack l k a) (HashSet l) -> HashSet l
forall s a. s -> Getting a s a -> a
^.Getting (HashSet l) (LayerStack l k a) (HashSet l)
forall l k a (f :: * -> *).
Functor f =>
(HashSet l -> f (HashSet l))
-> LayerStack l k a -> f (LayerStack l k a)
maps  -> LayerStackError l -> Either (LayerStackError l) (LayerStack l k a)
forall a b. a -> Either a b
Left  (LayerStackError l
 -> Either (LayerStackError l) (LayerStack l k a))
-> LayerStackError l
-> Either (LayerStackError l) (LayerStack l k a)
forall a b. (a -> b) -> a -> b
$ l -> LayerStackError l
forall l. l -> LayerStackError l
LayerNotOnStack   l
n
  | Bool
otherwise              -> LayerStackError l -> Either (LayerStackError l) (LayerStack l k a)
forall a b. a -> Either a b
Left  (LayerStackError l
 -> Either (LayerStackError l) (LayerStack l k a))
-> LayerStackError l
-> Either (LayerStackError l) (LayerStack l k a)
forall a b. (a -> b) -> a -> b
$ l -> LayerStackError l
forall l. l -> LayerStackError l
LayerDoesNotExist l
n