-- | (Import this module qualified)
module Unimap
  ( Changed (..)
  , maybeChanged
  , Equiv (..)
  , emptyEquiv
  , Entry (..)
  , filterRootEntries
  , MergeOne
  , MergeMany
  , adaptMergeOne
  , foldMergeOne
  , foldMergeMany
  , concatMergeOne
  , concatMergeMany
  , UnionMap (unUnionMap)
  , UnionMapLens
  , empty
  , singleton
  , size
  , member
  , toList
  , values
  , AddRes (..)
  , AddVal (..)
  , add
  , addLM
  , addM
  , TraceRes (..)
  , trace
  , LookupRes (..)
  , LookupVal (..)
  , lookup
  , lookupLM
  , lookupM
  , equiv
  , equivLM
  , equivM
  , compact
  , compactLM
  , compactM
  , canonicalize
  , canonicalizeLM
  , canonicalizeM
  , UpdateRes (..)
  , UpdateVal (..)
  , update
  , updateLM
  , updateM
  , MergeRes (..)
  , MergeVal (..)
  , mergeOne
  , mergeOneLM
  , mergeOneM
  , mergeMany
  , mergeManyLM
  , mergeManyM
  , extract
  , extractLM
  , extractM
  )
where

import Control.Monad.Except (Except, MonadError (..), runExcept)
import Control.Monad.State.Strict (MonadState, StateT, get, put, runStateT, state)
import Data.Coerce (Coercible)
import Data.Foldable (fold, foldl')
import Data.Foldable qualified as F
import Data.Maybe (fromMaybe, mapMaybe)
import IntLike.Map (IntLikeMap)
import IntLike.Map qualified as ILM
import IntLike.Set (IntLikeSet)
import IntLike.Set qualified as ILS
import Optics (Lens', Traversal', equality', over, set, view)
import Prelude hiding (lookup)

-- Private util

mayStateLens :: (MonadState s m) => Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens :: forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens Lens' s x
l x -> (a, Maybe x)
f = (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> m a
forall a b. (a -> b) -> a -> b
$ \s
s ->
  let u :: x
u = Lens' s x -> s -> x
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' s x
l s
s
      (a
a, Maybe x
mu') = x -> (a, Maybe x)
f x
u
  in  case Maybe x
mu' of
        Maybe x
Nothing -> (a
a, s
s)
        Just x
u' ->
          let s' :: s
s' = Lens' s x -> x -> s -> s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' s x
l x
u' s
s
          in  (a
a, s
s')

stateLens :: (MonadState s m) => Lens' s x -> (x -> (a, x)) -> m a
stateLens :: forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, x)) -> m a
stateLens Lens' s x
l x -> (a, x)
f = (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> m a
forall a b. (a -> b) -> a -> b
$ \s
s ->
  let u :: x
u = Lens' s x -> s -> x
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Lens' s x
l s
s
      (a
a, x
u') = x -> (a, x)
f x
u
      s' :: s
s' = Lens' s x -> x -> s -> s
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Lens' s x
l x
u' s
s
  in  (a
a, s
s')

newtype DropM e s a = DropM {forall e s a. DropM e s a -> StateT s (Except e) a
unDropM :: StateT s (Except e) a}
  deriving newtype ((forall a b. (a -> b) -> DropM e s a -> DropM e s b)
-> (forall a b. a -> DropM e s b -> DropM e s a)
-> Functor (DropM e s)
forall a b. a -> DropM e s b -> DropM e s a
forall a b. (a -> b) -> DropM e s a -> DropM e s b
forall e s a b. a -> DropM e s b -> DropM e s a
forall e s a b. (a -> b) -> DropM e s a -> DropM e s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e s a b. (a -> b) -> DropM e s a -> DropM e s b
fmap :: forall a b. (a -> b) -> DropM e s a -> DropM e s b
$c<$ :: forall e s a b. a -> DropM e s b -> DropM e s a
<$ :: forall a b. a -> DropM e s b -> DropM e s a
Functor, Functor (DropM e s)
Functor (DropM e s) =>
(forall a. a -> DropM e s a)
-> (forall a b. DropM e s (a -> b) -> DropM e s a -> DropM e s b)
-> (forall a b c.
    (a -> b -> c) -> DropM e s a -> DropM e s b -> DropM e s c)
-> (forall a b. DropM e s a -> DropM e s b -> DropM e s b)
-> (forall a b. DropM e s a -> DropM e s b -> DropM e s a)
-> Applicative (DropM e s)
forall a. a -> DropM e s a
forall e s. Functor (DropM e s)
forall a b. DropM e s a -> DropM e s b -> DropM e s a
forall a b. DropM e s a -> DropM e s b -> DropM e s b
forall a b. DropM e s (a -> b) -> DropM e s a -> DropM e s b
forall e s a. a -> DropM e s a
forall a b c.
(a -> b -> c) -> DropM e s a -> DropM e s b -> DropM e s c
forall e s a b. DropM e s a -> DropM e s b -> DropM e s a
forall e s a b. DropM e s a -> DropM e s b -> DropM e s b
forall e s a b. DropM e s (a -> b) -> DropM e s a -> DropM e s b
forall e s a b c.
(a -> b -> c) -> DropM e s a -> DropM e s b -> DropM e s c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall e s a. a -> DropM e s a
pure :: forall a. a -> DropM e s a
$c<*> :: forall e s a b. DropM e s (a -> b) -> DropM e s a -> DropM e s b
<*> :: forall a b. DropM e s (a -> b) -> DropM e s a -> DropM e s b
$cliftA2 :: forall e s a b c.
(a -> b -> c) -> DropM e s a -> DropM e s b -> DropM e s c
liftA2 :: forall a b c.
(a -> b -> c) -> DropM e s a -> DropM e s b -> DropM e s c
$c*> :: forall e s a b. DropM e s a -> DropM e s b -> DropM e s b
*> :: forall a b. DropM e s a -> DropM e s b -> DropM e s b
$c<* :: forall e s a b. DropM e s a -> DropM e s b -> DropM e s a
<* :: forall a b. DropM e s a -> DropM e s b -> DropM e s a
Applicative, Applicative (DropM e s)
Applicative (DropM e s) =>
(forall a b. DropM e s a -> (a -> DropM e s b) -> DropM e s b)
-> (forall a b. DropM e s a -> DropM e s b -> DropM e s b)
-> (forall a. a -> DropM e s a)
-> Monad (DropM e s)
forall a. a -> DropM e s a
forall e s. Applicative (DropM e s)
forall a b. DropM e s a -> DropM e s b -> DropM e s b
forall a b. DropM e s a -> (a -> DropM e s b) -> DropM e s b
forall e s a. a -> DropM e s a
forall e s a b. DropM e s a -> DropM e s b -> DropM e s b
forall e s a b. DropM e s a -> (a -> DropM e s b) -> DropM e s b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall e s a b. DropM e s a -> (a -> DropM e s b) -> DropM e s b
>>= :: forall a b. DropM e s a -> (a -> DropM e s b) -> DropM e s b
$c>> :: forall e s a b. DropM e s a -> DropM e s b -> DropM e s b
>> :: forall a b. DropM e s a -> DropM e s b -> DropM e s b
$creturn :: forall e s a. a -> DropM e s a
return :: forall a. a -> DropM e s a
Monad, MonadState s, MonadError e)

runDropM :: DropM e s a -> s -> Either e (a, s)
runDropM :: forall e s a. DropM e s a -> s -> Either e (a, s)
runDropM DropM e s a
it s
s = Except e (a, s) -> Either e (a, s)
forall e a. Except e a -> Either e a
runExcept (StateT s (ExceptT e Identity) a -> s -> Except e (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (DropM e s a -> StateT s (ExceptT e Identity) a
forall e s a. DropM e s a -> StateT s (Except e) a
unDropM DropM e s a
it) s
s)

safeTail :: [a] -> [a]
safeTail :: forall a. [a] -> [a]
safeTail [a]
xs =
  case [a]
xs of
    [] -> [a]
xs
    a
_ : [a]
ys -> [a]
ys

-- The real stuff

data Changed
  = ChangedYes
  | ChangedNo
  deriving stock (Changed -> Changed -> Bool
(Changed -> Changed -> Bool)
-> (Changed -> Changed -> Bool) -> Eq Changed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Changed -> Changed -> Bool
== :: Changed -> Changed -> Bool
$c/= :: Changed -> Changed -> Bool
/= :: Changed -> Changed -> Bool
Eq, Int -> Changed -> ShowS
[Changed] -> ShowS
Changed -> String
(Int -> Changed -> ShowS)
-> (Changed -> String) -> ([Changed] -> ShowS) -> Show Changed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Changed -> ShowS
showsPrec :: Int -> Changed -> ShowS
$cshow :: Changed -> String
show :: Changed -> String
$cshowList :: [Changed] -> ShowS
showList :: [Changed] -> ShowS
Show)

maybeChanged :: Maybe a -> Changed
maybeChanged :: forall a. Maybe a -> Changed
maybeChanged = \case
  Maybe a
Nothing -> Changed
ChangedNo
  Just a
_ -> Changed
ChangedYes

data Equiv k = Equiv
  { forall k. Equiv k -> IntLikeMap k (IntLikeSet k)
equivFwd :: !(IntLikeMap k (IntLikeSet k))
  , forall k. Equiv k -> IntLikeMap k k
equivBwd :: !(IntLikeMap k k)
  }
  deriving stock (Equiv k -> Equiv k -> Bool
(Equiv k -> Equiv k -> Bool)
-> (Equiv k -> Equiv k -> Bool) -> Eq (Equiv k)
forall k. Eq k => Equiv k -> Equiv k -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall k. Eq k => Equiv k -> Equiv k -> Bool
== :: Equiv k -> Equiv k -> Bool
$c/= :: forall k. Eq k => Equiv k -> Equiv k -> Bool
/= :: Equiv k -> Equiv k -> Bool
Eq, Int -> Equiv k -> ShowS
[Equiv k] -> ShowS
Equiv k -> String
(Int -> Equiv k -> ShowS)
-> (Equiv k -> String) -> ([Equiv k] -> ShowS) -> Show (Equiv k)
forall k. Show k => Int -> Equiv k -> ShowS
forall k. Show k => [Equiv k] -> ShowS
forall k. Show k => Equiv k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> Equiv k -> ShowS
showsPrec :: Int -> Equiv k -> ShowS
$cshow :: forall k. Show k => Equiv k -> String
show :: Equiv k -> String
$cshowList :: forall k. Show k => [Equiv k] -> ShowS
showList :: [Equiv k] -> ShowS
Show)

emptyEquiv :: Equiv k
emptyEquiv :: forall k. Equiv k
emptyEquiv = IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
forall k. IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
Equiv IntLikeMap k (IntLikeSet k)
forall x a. IntLikeMap x a
ILM.empty IntLikeMap k k
forall x a. IntLikeMap x a
ILM.empty

data Entry k v
  = EntryLink !k
  | EntryValue !v
  deriving stock (Entry k v -> Entry k v -> Bool
(Entry k v -> Entry k v -> Bool)
-> (Entry k v -> Entry k v -> Bool) -> Eq (Entry k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Entry k v -> Entry k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Entry k v -> Entry k v -> Bool
== :: Entry k v -> Entry k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Entry k v -> Entry k v -> Bool
/= :: Entry k v -> Entry k v -> Bool
Eq, Int -> Entry k v -> ShowS
[Entry k v] -> ShowS
Entry k v -> String
(Int -> Entry k v -> ShowS)
-> (Entry k v -> String)
-> ([Entry k v] -> ShowS)
-> Show (Entry k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> Entry k v -> ShowS
forall k v. (Show k, Show v) => [Entry k v] -> ShowS
forall k v. (Show k, Show v) => Entry k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> Entry k v -> ShowS
showsPrec :: Int -> Entry k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => Entry k v -> String
show :: Entry k v -> String
$cshowList :: forall k v. (Show k, Show v) => [Entry k v] -> ShowS
showList :: [Entry k v] -> ShowS
Show, Eq (Entry k v)
Eq (Entry k v) =>
(Entry k v -> Entry k v -> Ordering)
-> (Entry k v -> Entry k v -> Bool)
-> (Entry k v -> Entry k v -> Bool)
-> (Entry k v -> Entry k v -> Bool)
-> (Entry k v -> Entry k v -> Bool)
-> (Entry k v -> Entry k v -> Entry k v)
-> (Entry k v -> Entry k v -> Entry k v)
-> Ord (Entry k v)
Entry k v -> Entry k v -> Bool
Entry k v -> Entry k v -> Ordering
Entry k v -> Entry k v -> Entry k v
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 v. (Ord k, Ord v) => Eq (Entry k v)
forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Bool
forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Ordering
forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Entry k v
$ccompare :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Ordering
compare :: Entry k v -> Entry k v -> Ordering
$c< :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Bool
< :: Entry k v -> Entry k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Bool
<= :: Entry k v -> Entry k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Bool
> :: Entry k v -> Entry k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Bool
>= :: Entry k v -> Entry k v -> Bool
$cmax :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Entry k v
max :: Entry k v -> Entry k v -> Entry k v
$cmin :: forall k v. (Ord k, Ord v) => Entry k v -> Entry k v -> Entry k v
min :: Entry k v -> Entry k v -> Entry k v
Ord, (forall a b. (a -> b) -> Entry k a -> Entry k b)
-> (forall a b. a -> Entry k b -> Entry k a) -> Functor (Entry k)
forall a b. a -> Entry k b -> Entry k a
forall a b. (a -> b) -> Entry k a -> Entry k b
forall k a b. a -> Entry k b -> Entry k a
forall k a b. (a -> b) -> Entry k a -> Entry 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) -> Entry k a -> Entry k b
fmap :: forall a b. (a -> b) -> Entry k a -> Entry k b
$c<$ :: forall k a b. a -> Entry k b -> Entry k a
<$ :: forall a b. a -> Entry k b -> Entry k a
Functor, (forall m. Monoid m => Entry k m -> m)
-> (forall m a. Monoid m => (a -> m) -> Entry k a -> m)
-> (forall m a. Monoid m => (a -> m) -> Entry k a -> m)
-> (forall a b. (a -> b -> b) -> b -> Entry k a -> b)
-> (forall a b. (a -> b -> b) -> b -> Entry k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Entry k a -> b)
-> (forall b a. (b -> a -> b) -> b -> Entry k a -> b)
-> (forall a. (a -> a -> a) -> Entry k a -> a)
-> (forall a. (a -> a -> a) -> Entry k a -> a)
-> (forall a. Entry k a -> [a])
-> (forall a. Entry k a -> Bool)
-> (forall a. Entry k a -> Int)
-> (forall a. Eq a => a -> Entry k a -> Bool)
-> (forall a. Ord a => Entry k a -> a)
-> (forall a. Ord a => Entry k a -> a)
-> (forall a. Num a => Entry k a -> a)
-> (forall a. Num a => Entry k a -> a)
-> Foldable (Entry k)
forall a. Eq a => a -> Entry k a -> Bool
forall a. Num a => Entry k a -> a
forall a. Ord a => Entry k a -> a
forall m. Monoid m => Entry k m -> m
forall a. Entry k a -> Bool
forall a. Entry k a -> Int
forall a. Entry k a -> [a]
forall a. (a -> a -> a) -> Entry k a -> a
forall k a. Eq a => a -> Entry k a -> Bool
forall k a. Num a => Entry k a -> a
forall k a. Ord a => Entry k a -> a
forall m a. Monoid m => (a -> m) -> Entry k a -> m
forall k m. Monoid m => Entry k m -> m
forall k a. Entry k a -> Bool
forall k a. Entry k a -> Int
forall k a. Entry k a -> [a]
forall b a. (b -> a -> b) -> b -> Entry k a -> b
forall a b. (a -> b -> b) -> b -> Entry k a -> b
forall k a. (a -> a -> a) -> Entry k a -> a
forall k m a. Monoid m => (a -> m) -> Entry k a -> m
forall k b a. (b -> a -> b) -> b -> Entry k a -> b
forall k a b. (a -> b -> b) -> b -> Entry 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 => Entry k m -> m
fold :: forall m. Monoid m => Entry k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> Entry k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Entry k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> Entry k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Entry k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> Entry k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Entry k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> Entry k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Entry k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> Entry k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Entry k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> Entry k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Entry k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> Entry k a -> a
foldr1 :: forall a. (a -> a -> a) -> Entry k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> Entry k a -> a
foldl1 :: forall a. (a -> a -> a) -> Entry k a -> a
$ctoList :: forall k a. Entry k a -> [a]
toList :: forall a. Entry k a -> [a]
$cnull :: forall k a. Entry k a -> Bool
null :: forall a. Entry k a -> Bool
$clength :: forall k a. Entry k a -> Int
length :: forall a. Entry k a -> Int
$celem :: forall k a. Eq a => a -> Entry k a -> Bool
elem :: forall a. Eq a => a -> Entry k a -> Bool
$cmaximum :: forall k a. Ord a => Entry k a -> a
maximum :: forall a. Ord a => Entry k a -> a
$cminimum :: forall k a. Ord a => Entry k a -> a
minimum :: forall a. Ord a => Entry k a -> a
$csum :: forall k a. Num a => Entry k a -> a
sum :: forall a. Num a => Entry k a -> a
$cproduct :: forall k a. Num a => Entry k a -> a
product :: forall a. Num a => Entry k a -> a
Foldable, Functor (Entry k)
Foldable (Entry k)
(Functor (Entry k), Foldable (Entry k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Entry k a -> f (Entry k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Entry k (f a) -> f (Entry k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Entry k a -> m (Entry k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Entry k (m a) -> m (Entry k a))
-> Traversable (Entry k)
forall k. Functor (Entry k)
forall k. Foldable (Entry k)
forall k (m :: * -> *) a. Monad m => Entry k (m a) -> m (Entry k a)
forall k (f :: * -> *) a.
Applicative f =>
Entry k (f a) -> f (Entry k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Entry k a -> m (Entry k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Entry k a -> f (Entry 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 => Entry k (m a) -> m (Entry k a)
forall (f :: * -> *) a.
Applicative f =>
Entry k (f a) -> f (Entry k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Entry k a -> m (Entry k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Entry k a -> f (Entry k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Entry k a -> f (Entry k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Entry k a -> f (Entry k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
Entry k (f a) -> f (Entry k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Entry k (f a) -> f (Entry k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Entry k a -> m (Entry k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Entry k a -> m (Entry k b)
$csequence :: forall k (m :: * -> *) a. Monad m => Entry k (m a) -> m (Entry k a)
sequence :: forall (m :: * -> *) a. Monad m => Entry k (m a) -> m (Entry k a)
Traversable)

filterRootEntries :: (Coercible k Int) => IntLikeMap k (Entry k v) -> IntLikeMap k v
filterRootEntries :: forall k v.
Coercible k Int =>
IntLikeMap k (Entry k v) -> IntLikeMap k v
filterRootEntries = [(k, v)] -> IntLikeMap k v
forall x a. Coercible x Int => [(x, a)] -> IntLikeMap x a
ILM.fromList ([(k, v)] -> IntLikeMap k v)
-> (IntLikeMap k (Entry k v) -> [(k, v)])
-> IntLikeMap k (Entry k v)
-> IntLikeMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, Entry k v) -> Maybe (k, v)) -> [(k, Entry k v)] -> [(k, v)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((k -> Entry k v -> Maybe (k, v)) -> (k, Entry k v) -> Maybe (k, v)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> Entry k v -> Maybe (k, v)
forall {a} {k} {b}. a -> Entry k b -> Maybe (a, b)
go) ([(k, Entry k v)] -> [(k, v)])
-> (IntLikeMap k (Entry k v) -> [(k, Entry k v)])
-> IntLikeMap k (Entry k v)
-> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLikeMap k (Entry k v) -> [(k, Entry k v)]
forall x a. Coercible x Int => IntLikeMap x a -> [(x, a)]
ILM.toList
 where
  go :: a -> Entry k b -> Maybe (a, b)
go a
k = \case
    EntryLink k
_ -> Maybe (a, b)
forall a. Maybe a
Nothing
    EntryValue b
v -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
k, b
v)

type MergeOne e v r = Maybe v -> v -> Either e (r, v)

type MergeMany f e v r = Maybe v -> f v -> Either e (r, v)

adaptMergeOne :: (v -> f v) -> MergeMany f e v r -> MergeOne e v r
adaptMergeOne :: forall v (f :: * -> *) e r.
(v -> f v) -> MergeMany f e v r -> MergeOne e v r
adaptMergeOne v -> f v
h MergeMany f e v r
g Maybe v
mv = MergeMany f e v r
g Maybe v
mv (f v -> Either e (r, v)) -> (v -> f v) -> v -> Either e (r, v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> f v
h

foldMergeOne :: (Monoid r) => (v -> v -> Either e (r, v)) -> MergeOne e v r
foldMergeOne :: forall r v e.
Monoid r =>
(v -> v -> Either e (r, v)) -> MergeOne e v r
foldMergeOne v -> v -> Either e (r, v)
g Maybe v
mv v
v =
  case Maybe v
mv of
    Maybe v
Nothing -> (r, v) -> Either e (r, v)
forall a b. b -> Either a b
Right (r
forall a. Monoid a => a
mempty, v
v)
    Just v
w -> v -> v -> Either e (r, v)
g v
w v
v

foldMergeMany :: (Foldable f, Monoid r) => Either e v -> (v -> v -> Either e (r, v)) -> MergeMany f e v r
foldMergeMany :: forall (f :: * -> *) r e v.
(Foldable f, Monoid r) =>
Either e v -> (v -> v -> Either e (r, v)) -> MergeMany f e v r
foldMergeMany Either e v
onE v -> v -> Either e (r, v)
g Maybe v
mv f v
fv = Either e (r, v)
start
 where
  start :: Either e (r, v)
start =
    let vs :: [v]
vs = f v -> [v]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f v
fv
    in  case [v] -> (v -> [v]) -> Maybe v -> [v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [v]
vs (v -> [v] -> [v]
forall a. a -> [a] -> [a]
: [v]
vs) Maybe v
mv of
          [] -> (v -> (r, v)) -> Either e v -> Either e (r, v)
forall a b. (a -> b) -> Either e a -> Either e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (r
forall a. Monoid a => a
mempty,) Either e v
onE
          v
y : [v]
ys -> r -> v -> [v] -> Either e (r, v)
go r
forall a. Monoid a => a
mempty v
y [v]
ys
  go :: r -> v -> [v] -> Either e (r, v)
go !r
r !v
v = \case
    [] -> (r, v) -> Either e (r, v)
forall a b. b -> Either a b
Right (r
r, v
v)
    v
w : [v]
ws ->
      case v -> v -> Either e (r, v)
g v
v v
w of
        Right (r
s, v
u) -> r -> v -> [v] -> Either e (r, v)
go (r
r r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
s) v
u [v]
ws
        e :: Either e (r, v)
e@(Left e
_) -> Either e (r, v)
e

concatMergeOne :: (Semigroup v) => MergeOne e v ()
concatMergeOne :: forall v e. Semigroup v => MergeOne e v ()
concatMergeOne Maybe v
mv v
v = ((), v) -> Either e ((), v)
forall a b. b -> Either a b
Right ((), v -> (v -> v) -> Maybe v -> v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe v
v (v -> v -> v
forall a. Semigroup a => a -> a -> a
<> v
v) Maybe v
mv)

concatMergeMany :: (Foldable f, Monoid v) => MergeMany f e v ()
concatMergeMany :: forall (f :: * -> *) v e.
(Foldable f, Monoid v) =>
MergeMany f e v ()
concatMergeMany Maybe v
mv f v
vs = MergeOne e v ()
forall v e. Semigroup v => MergeOne e v ()
concatMergeOne Maybe v
mv (f v -> v
forall m. Monoid m => f m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold f v
vs)

newtype UnionMap k v = UnionMap {forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap :: IntLikeMap k (Entry k v)}
  deriving stock (UnionMap k v -> UnionMap k v -> Bool
(UnionMap k v -> UnionMap k v -> Bool)
-> (UnionMap k v -> UnionMap k v -> Bool) -> Eq (UnionMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => UnionMap k v -> UnionMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => UnionMap k v -> UnionMap k v -> Bool
== :: UnionMap k v -> UnionMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => UnionMap k v -> UnionMap k v -> Bool
/= :: UnionMap k v -> UnionMap k v -> Bool
Eq, Int -> UnionMap k v -> ShowS
[UnionMap k v] -> ShowS
UnionMap k v -> String
(Int -> UnionMap k v -> ShowS)
-> (UnionMap k v -> String)
-> ([UnionMap k v] -> ShowS)
-> Show (UnionMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> UnionMap k v -> ShowS
forall k v. (Show k, Show v) => [UnionMap k v] -> ShowS
forall k v. (Show k, Show v) => UnionMap k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> UnionMap k v -> ShowS
showsPrec :: Int -> UnionMap k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => UnionMap k v -> String
show :: UnionMap k v -> String
$cshowList :: forall k v. (Show k, Show v) => [UnionMap k v] -> ShowS
showList :: [UnionMap k v] -> ShowS
Show, (forall a b. (a -> b) -> UnionMap k a -> UnionMap k b)
-> (forall a b. a -> UnionMap k b -> UnionMap k a)
-> Functor (UnionMap k)
forall a b. a -> UnionMap k b -> UnionMap k a
forall a b. (a -> b) -> UnionMap k a -> UnionMap k b
forall k a b. a -> UnionMap k b -> UnionMap k a
forall k a b. (a -> b) -> UnionMap k a -> UnionMap 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) -> UnionMap k a -> UnionMap k b
fmap :: forall a b. (a -> b) -> UnionMap k a -> UnionMap k b
$c<$ :: forall k a b. a -> UnionMap k b -> UnionMap k a
<$ :: forall a b. a -> UnionMap k b -> UnionMap k a
Functor, (forall m. Monoid m => UnionMap k m -> m)
-> (forall m a. Monoid m => (a -> m) -> UnionMap k a -> m)
-> (forall m a. Monoid m => (a -> m) -> UnionMap k a -> m)
-> (forall a b. (a -> b -> b) -> b -> UnionMap k a -> b)
-> (forall a b. (a -> b -> b) -> b -> UnionMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnionMap k a -> b)
-> (forall b a. (b -> a -> b) -> b -> UnionMap k a -> b)
-> (forall a. (a -> a -> a) -> UnionMap k a -> a)
-> (forall a. (a -> a -> a) -> UnionMap k a -> a)
-> (forall a. UnionMap k a -> [a])
-> (forall a. UnionMap k a -> Bool)
-> (forall a. UnionMap k a -> Int)
-> (forall a. Eq a => a -> UnionMap k a -> Bool)
-> (forall a. Ord a => UnionMap k a -> a)
-> (forall a. Ord a => UnionMap k a -> a)
-> (forall a. Num a => UnionMap k a -> a)
-> (forall a. Num a => UnionMap k a -> a)
-> Foldable (UnionMap k)
forall a. Eq a => a -> UnionMap k a -> Bool
forall a. Num a => UnionMap k a -> a
forall a. Ord a => UnionMap k a -> a
forall m. Monoid m => UnionMap k m -> m
forall a. UnionMap k a -> Bool
forall a. UnionMap k a -> Int
forall a. UnionMap k a -> [a]
forall a. (a -> a -> a) -> UnionMap k a -> a
forall k a. Eq a => a -> UnionMap k a -> Bool
forall k a. Num a => UnionMap k a -> a
forall k a. Ord a => UnionMap k a -> a
forall m a. Monoid m => (a -> m) -> UnionMap k a -> m
forall k m. Monoid m => UnionMap k m -> m
forall k a. UnionMap k a -> Bool
forall k a. UnionMap k a -> Int
forall k a. UnionMap k a -> [a]
forall b a. (b -> a -> b) -> b -> UnionMap k a -> b
forall a b. (a -> b -> b) -> b -> UnionMap k a -> b
forall k a. (a -> a -> a) -> UnionMap k a -> a
forall k m a. Monoid m => (a -> m) -> UnionMap k a -> m
forall k b a. (b -> a -> b) -> b -> UnionMap k a -> b
forall k a b. (a -> b -> b) -> b -> UnionMap 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 => UnionMap k m -> m
fold :: forall m. Monoid m => UnionMap k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> UnionMap k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> UnionMap k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> UnionMap k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> UnionMap k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> UnionMap k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> UnionMap k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> UnionMap k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> UnionMap k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> UnionMap k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> UnionMap k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> UnionMap k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> UnionMap k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> UnionMap k a -> a
foldr1 :: forall a. (a -> a -> a) -> UnionMap k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> UnionMap k a -> a
foldl1 :: forall a. (a -> a -> a) -> UnionMap k a -> a
$ctoList :: forall k a. UnionMap k a -> [a]
toList :: forall a. UnionMap k a -> [a]
$cnull :: forall k a. UnionMap k a -> Bool
null :: forall a. UnionMap k a -> Bool
$clength :: forall k a. UnionMap k a -> Int
length :: forall a. UnionMap k a -> Int
$celem :: forall k a. Eq a => a -> UnionMap k a -> Bool
elem :: forall a. Eq a => a -> UnionMap k a -> Bool
$cmaximum :: forall k a. Ord a => UnionMap k a -> a
maximum :: forall a. Ord a => UnionMap k a -> a
$cminimum :: forall k a. Ord a => UnionMap k a -> a
minimum :: forall a. Ord a => UnionMap k a -> a
$csum :: forall k a. Num a => UnionMap k a -> a
sum :: forall a. Num a => UnionMap k a -> a
$cproduct :: forall k a. Num a => UnionMap k a -> a
product :: forall a. Num a => UnionMap k a -> a
Foldable, Functor (UnionMap k)
Foldable (UnionMap k)
(Functor (UnionMap k), Foldable (UnionMap k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> UnionMap k a -> f (UnionMap k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    UnionMap k (f a) -> f (UnionMap k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> UnionMap k a -> m (UnionMap k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    UnionMap k (m a) -> m (UnionMap k a))
-> Traversable (UnionMap k)
forall k. Functor (UnionMap k)
forall k. Foldable (UnionMap k)
forall k (m :: * -> *) a.
Monad m =>
UnionMap k (m a) -> m (UnionMap k a)
forall k (f :: * -> *) a.
Applicative f =>
UnionMap k (f a) -> f (UnionMap k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnionMap k a -> m (UnionMap k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnionMap k a -> f (UnionMap 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 =>
UnionMap k (m a) -> m (UnionMap k a)
forall (f :: * -> *) a.
Applicative f =>
UnionMap k (f a) -> f (UnionMap k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnionMap k a -> m (UnionMap k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnionMap k a -> f (UnionMap k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnionMap k a -> f (UnionMap k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> UnionMap k a -> f (UnionMap k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
UnionMap k (f a) -> f (UnionMap k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
UnionMap k (f a) -> f (UnionMap k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnionMap k a -> m (UnionMap k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> UnionMap k a -> m (UnionMap k b)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
UnionMap k (m a) -> m (UnionMap k a)
sequence :: forall (m :: * -> *) a.
Monad m =>
UnionMap k (m a) -> m (UnionMap k a)
Traversable)

type UnionMapLens s k v = Lens' s (UnionMap k v)

empty :: UnionMap k v
empty :: forall k v. UnionMap k v
empty = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap IntLikeMap k (Entry k v)
forall x a. IntLikeMap x a
ILM.empty

singleton :: (Coercible k Int) => k -> v -> UnionMap k v
singleton :: forall k v. Coercible k Int => k -> v -> UnionMap k v
singleton k
k v
v = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k -> Entry k v -> IntLikeMap k (Entry k v)
forall x a. Coercible x Int => x -> a -> IntLikeMap x a
ILM.singleton k
k (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
v))

size :: UnionMap k v -> Int
size :: forall k a. UnionMap k a -> Int
size = IntLikeMap k (Entry k v) -> Int
forall x a. IntLikeMap x a -> Int
ILM.size (IntLikeMap k (Entry k v) -> Int)
-> (UnionMap k v -> IntLikeMap k (Entry k v))
-> UnionMap k v
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap

member :: (Coercible k Int) => k -> UnionMap k v -> Bool
member :: forall k v. Coercible k Int => k -> UnionMap k v -> Bool
member k
k = k -> IntLikeMap k (Entry k v) -> Bool
forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member k
k (IntLikeMap k (Entry k v) -> Bool)
-> (UnionMap k v -> IntLikeMap k (Entry k v))
-> UnionMap k v
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap

toList :: (Coercible k Int) => UnionMap k v -> [(k, Entry k v)]
toList :: forall k v. Coercible k Int => UnionMap k v -> [(k, Entry k v)]
toList = IntLikeMap k (Entry k v) -> [(k, Entry k v)]
forall x a. Coercible x Int => IntLikeMap x a -> [(x, a)]
ILM.toList (IntLikeMap k (Entry k v) -> [(k, Entry k v)])
-> (UnionMap k v -> IntLikeMap k (Entry k v))
-> UnionMap k v
-> [(k, Entry k v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap

values :: (Coercible k Int) => UnionMap k v -> IntLikeMap k v
values :: forall k v. Coercible k Int => UnionMap k v -> IntLikeMap k v
values = (IntLikeMap k v -> (k, Entry k v) -> IntLikeMap k v)
-> IntLikeMap k v -> [(k, Entry k v)] -> IntLikeMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' IntLikeMap k v -> (k, Entry k v) -> IntLikeMap k v
forall {x} {a} {k}.
Coercible x Int =>
IntLikeMap x a -> (x, Entry k a) -> IntLikeMap x a
go IntLikeMap k v
forall x a. IntLikeMap x a
ILM.empty ([(k, Entry k v)] -> IntLikeMap k v)
-> (UnionMap k v -> [(k, Entry k v)])
-> UnionMap k v
-> IntLikeMap k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionMap k v -> [(k, Entry k v)]
forall k v. Coercible k Int => UnionMap k v -> [(k, Entry k v)]
toList
 where
  go :: IntLikeMap x a -> (x, Entry k a) -> IntLikeMap x a
go IntLikeMap x a
m (x
k, Entry k a
ue) =
    case Entry k a
ue of
      EntryValue a
v -> x -> a -> IntLikeMap x a -> IntLikeMap x a
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert x
k a
v IntLikeMap x a
m
      Entry k a
_ -> IntLikeMap x a
m

data AddRes k v
  = AddResAdded !(UnionMap k v)
  | AddResDuplicate
  deriving stock (AddRes k v -> AddRes k v -> Bool
(AddRes k v -> AddRes k v -> Bool)
-> (AddRes k v -> AddRes k v -> Bool) -> Eq (AddRes k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => AddRes k v -> AddRes k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => AddRes k v -> AddRes k v -> Bool
== :: AddRes k v -> AddRes k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => AddRes k v -> AddRes k v -> Bool
/= :: AddRes k v -> AddRes k v -> Bool
Eq, Int -> AddRes k v -> ShowS
[AddRes k v] -> ShowS
AddRes k v -> String
(Int -> AddRes k v -> ShowS)
-> (AddRes k v -> String)
-> ([AddRes k v] -> ShowS)
-> Show (AddRes k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> AddRes k v -> ShowS
forall k v. (Show k, Show v) => [AddRes k v] -> ShowS
forall k v. (Show k, Show v) => AddRes k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> AddRes k v -> ShowS
showsPrec :: Int -> AddRes k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => AddRes k v -> String
show :: AddRes k v -> String
$cshowList :: forall k v. (Show k, Show v) => [AddRes k v] -> ShowS
showList :: [AddRes k v] -> ShowS
Show)

add :: (Coercible k Int) => k -> v -> UnionMap k v -> AddRes k v
add :: forall k v. Coercible k Int => k -> v -> UnionMap k v -> AddRes k v
add k
k v
v (UnionMap IntLikeMap k (Entry k v)
m) =
  case k -> IntLikeMap k (Entry k v) -> Maybe (Entry k v)
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup k
k IntLikeMap k (Entry k v)
m of
    Maybe (Entry k v)
Nothing -> UnionMap k v -> AddRes k v
forall k v. UnionMap k v -> AddRes k v
AddResAdded (IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
k (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
v) IntLikeMap k (Entry k v)
m))
    Just Entry k v
_ -> AddRes k v
forall k v. AddRes k v
AddResDuplicate

data AddVal
  = AddValAdded
  | AddValDuplicate
  deriving stock (AddVal -> AddVal -> Bool
(AddVal -> AddVal -> Bool)
-> (AddVal -> AddVal -> Bool) -> Eq AddVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddVal -> AddVal -> Bool
== :: AddVal -> AddVal -> Bool
$c/= :: AddVal -> AddVal -> Bool
/= :: AddVal -> AddVal -> Bool
Eq, Int -> AddVal -> ShowS
[AddVal] -> ShowS
AddVal -> String
(Int -> AddVal -> ShowS)
-> (AddVal -> String) -> ([AddVal] -> ShowS) -> Show AddVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddVal -> ShowS
showsPrec :: Int -> AddVal -> ShowS
$cshow :: AddVal -> String
show :: AddVal -> String
$cshowList :: [AddVal] -> ShowS
showList :: [AddVal] -> ShowS
Show)

addLM :: (Coercible k Int, MonadState s m) => UnionMapLens s k v -> k -> v -> m AddVal
addLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> k -> v -> m AddVal
addLM UnionMapLens s k v
l k
k v
v = UnionMapLens s k v
-> (UnionMap k v -> (AddVal, Maybe (UnionMap k v))) -> m AddVal
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l ((UnionMap k v -> (AddVal, Maybe (UnionMap k v))) -> m AddVal)
-> (UnionMap k v -> (AddVal, Maybe (UnionMap k v))) -> m AddVal
forall a b. (a -> b) -> a -> b
$ \UnionMap k v
u ->
  case k -> v -> UnionMap k v -> AddRes k v
forall k v. Coercible k Int => k -> v -> UnionMap k v -> AddRes k v
add k
k v
v UnionMap k v
u of
    AddResAdded UnionMap k v
w -> (AddVal
AddValAdded, UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just UnionMap k v
w)
    AddRes k v
AddResDuplicate -> (AddVal
AddValDuplicate, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)

addM :: (Coercible k Int, MonadState (UnionMap k v) m) => k -> v -> m AddVal
addM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
k -> v -> m AddVal
addM = UnionMapLens (UnionMap k v) k v -> k -> v -> m AddVal
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> k -> v -> m AddVal
addLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

data TraceRes k v
  = TraceResMissing !k
  | TraceResFound !k !v ![k]
  deriving stock (TraceRes k v -> TraceRes k v -> Bool
(TraceRes k v -> TraceRes k v -> Bool)
-> (TraceRes k v -> TraceRes k v -> Bool) -> Eq (TraceRes k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => TraceRes k v -> TraceRes k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => TraceRes k v -> TraceRes k v -> Bool
== :: TraceRes k v -> TraceRes k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => TraceRes k v -> TraceRes k v -> Bool
/= :: TraceRes k v -> TraceRes k v -> Bool
Eq, Int -> TraceRes k v -> ShowS
[TraceRes k v] -> ShowS
TraceRes k v -> String
(Int -> TraceRes k v -> ShowS)
-> (TraceRes k v -> String)
-> ([TraceRes k v] -> ShowS)
-> Show (TraceRes k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> TraceRes k v -> ShowS
forall k v. (Show k, Show v) => [TraceRes k v] -> ShowS
forall k v. (Show k, Show v) => TraceRes k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> TraceRes k v -> ShowS
showsPrec :: Int -> TraceRes k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => TraceRes k v -> String
show :: TraceRes k v -> String
$cshowList :: forall k v. (Show k, Show v) => [TraceRes k v] -> ShowS
showList :: [TraceRes k v] -> ShowS
Show)

trace :: (Coercible k Int) => k -> UnionMap k v -> TraceRes k v
trace :: forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace k
k (UnionMap IntLikeMap k (Entry k v)
m) = [k] -> k -> TraceRes k v
go [] k
k
 where
  go :: [k] -> k -> TraceRes k v
go ![k]
acc k
j =
    case k -> IntLikeMap k (Entry k v) -> Maybe (Entry k v)
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup k
j IntLikeMap k (Entry k v)
m of
      Maybe (Entry k v)
Nothing -> k -> TraceRes k v
forall k v. k -> TraceRes k v
TraceResMissing k
j
      Just Entry k v
link -> case Entry k v
link of
        EntryLink k
kx -> [k] -> k -> TraceRes k v
go (k
j k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
acc) k
kx
        EntryValue v
v -> k -> v -> [k] -> TraceRes k v
forall k v. k -> v -> [k] -> TraceRes k v
TraceResFound k
j v
v [k]
acc

data LookupRes k v
  = LookupResMissing !k
  | LookupResFound !k !v !(Maybe (UnionMap k v))
  deriving stock (LookupRes k v -> LookupRes k v -> Bool
(LookupRes k v -> LookupRes k v -> Bool)
-> (LookupRes k v -> LookupRes k v -> Bool) -> Eq (LookupRes k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => LookupRes k v -> LookupRes k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => LookupRes k v -> LookupRes k v -> Bool
== :: LookupRes k v -> LookupRes k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => LookupRes k v -> LookupRes k v -> Bool
/= :: LookupRes k v -> LookupRes k v -> Bool
Eq, Int -> LookupRes k v -> ShowS
[LookupRes k v] -> ShowS
LookupRes k v -> String
(Int -> LookupRes k v -> ShowS)
-> (LookupRes k v -> String)
-> ([LookupRes k v] -> ShowS)
-> Show (LookupRes k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> LookupRes k v -> ShowS
forall k v. (Show k, Show v) => [LookupRes k v] -> ShowS
forall k v. (Show k, Show v) => LookupRes k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> LookupRes k v -> ShowS
showsPrec :: Int -> LookupRes k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => LookupRes k v -> String
show :: LookupRes k v -> String
$cshowList :: forall k v. (Show k, Show v) => [LookupRes k v] -> ShowS
showList :: [LookupRes k v] -> ShowS
Show)

lookup :: (Coercible k Int) => k -> UnionMap k v -> LookupRes k v
lookup :: forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k UnionMap k v
u = case k -> UnionMap k v -> TraceRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace k
k UnionMap k v
u of
  TraceResMissing k
kx -> k -> LookupRes k v
forall k v. k -> LookupRes k v
LookupResMissing k
kx
  TraceResFound k
kr v
vr [k]
acc ->
    let mu :: Maybe (UnionMap k v)
mu =
          if [k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [k]
acc
            then Maybe (UnionMap k v)
forall a. Maybe a
Nothing
            else UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just ((UnionMap k v -> k -> UnionMap k v)
-> UnionMap k v -> [k] -> UnionMap k v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(UnionMap IntLikeMap k (Entry k v)
n) k
kx -> IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
kx (k -> Entry k v
forall k v. k -> Entry k v
EntryLink k
kr) IntLikeMap k (Entry k v)
n)) UnionMap k v
u ([k] -> [k]
forall a. [a] -> [a]
safeTail [k]
acc))
    in  k -> v -> Maybe (UnionMap k v) -> LookupRes k v
forall k v. k -> v -> Maybe (UnionMap k v) -> LookupRes k v
LookupResFound k
kr v
vr Maybe (UnionMap k v)
mu

data LookupVal k v
  = LookupValMissing !k
  | LookupValOk !k !v !Changed
  deriving stock (LookupVal k v -> LookupVal k v -> Bool
(LookupVal k v -> LookupVal k v -> Bool)
-> (LookupVal k v -> LookupVal k v -> Bool) -> Eq (LookupVal k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => LookupVal k v -> LookupVal k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => LookupVal k v -> LookupVal k v -> Bool
== :: LookupVal k v -> LookupVal k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => LookupVal k v -> LookupVal k v -> Bool
/= :: LookupVal k v -> LookupVal k v -> Bool
Eq, Int -> LookupVal k v -> ShowS
[LookupVal k v] -> ShowS
LookupVal k v -> String
(Int -> LookupVal k v -> ShowS)
-> (LookupVal k v -> String)
-> ([LookupVal k v] -> ShowS)
-> Show (LookupVal k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> LookupVal k v -> ShowS
forall k v. (Show k, Show v) => [LookupVal k v] -> ShowS
forall k v. (Show k, Show v) => LookupVal k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> LookupVal k v -> ShowS
showsPrec :: Int -> LookupVal k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => LookupVal k v -> String
show :: LookupVal k v -> String
$cshowList :: forall k v. (Show k, Show v) => [LookupVal k v] -> ShowS
showList :: [LookupVal k v] -> ShowS
Show)

lookupLM :: (Coercible k Int, MonadState s m) => UnionMapLens s k v -> k -> m (LookupVal k v)
lookupLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> k -> m (LookupVal k v)
lookupLM UnionMapLens s k v
l k
k = UnionMapLens s k v
-> (UnionMap k v -> (LookupVal k v, Maybe (UnionMap k v)))
-> m (LookupVal k v)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l ((UnionMap k v -> (LookupVal k v, Maybe (UnionMap k v)))
 -> m (LookupVal k v))
-> (UnionMap k v -> (LookupVal k v, Maybe (UnionMap k v)))
-> m (LookupVal k v)
forall a b. (a -> b) -> a -> b
$ \UnionMap k v
u ->
  case k -> UnionMap k v -> LookupRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k UnionMap k v
u of
    LookupResMissing k
x -> (k -> LookupVal k v
forall k v. k -> LookupVal k v
LookupValMissing k
x, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    LookupResFound k
x v
y Maybe (UnionMap k v)
mw -> (k -> v -> Changed -> LookupVal k v
forall k v. k -> v -> Changed -> LookupVal k v
LookupValOk k
x v
y (Maybe (UnionMap k v) -> Changed
forall a. Maybe a -> Changed
maybeChanged Maybe (UnionMap k v)
mw), Maybe (UnionMap k v)
mw)

lookupM :: (Coercible k Int, MonadState (UnionMap k v) m) => k -> m (LookupVal k v)
lookupM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
k -> m (LookupVal k v)
lookupM = UnionMapLens (UnionMap k v) k v -> k -> m (LookupVal k v)
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> k -> m (LookupVal k v)
lookupLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

equiv :: (Coercible k Int) => UnionMap k v -> (Equiv k, Maybe (UnionMap k v))
equiv :: forall k v.
Coercible k Int =>
UnionMap k v -> (Equiv k, Maybe (UnionMap k v))
equiv UnionMap k v
u = ((Equiv k, Maybe (UnionMap k v))
 -> (k, Entry k v) -> (Equiv k, Maybe (UnionMap k v)))
-> (Equiv k, Maybe (UnionMap k v))
-> [(k, Entry k v)]
-> (Equiv k, Maybe (UnionMap k v))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Equiv k, Maybe (UnionMap k v))
-> (k, Entry k v) -> (Equiv k, Maybe (UnionMap k v))
go (Equiv k
forall k. Equiv k
emptyEquiv, Maybe (UnionMap k v)
forall a. Maybe a
Nothing) (UnionMap k v -> [(k, Entry k v)]
forall k v. Coercible k Int => UnionMap k v -> [(k, Entry k v)]
toList UnionMap k v
u)
 where
  go :: (Equiv k, Maybe (UnionMap k v))
-> (k, Entry k v) -> (Equiv k, Maybe (UnionMap k v))
go (Equiv IntLikeMap k (IntLikeSet k)
fwd IntLikeMap k k
bwd, Maybe (UnionMap k v)
mw) (k
k, Entry k v
ue) =
    case Entry k v
ue of
      EntryValue v
_ ->
        let fwd' :: IntLikeMap k (IntLikeSet k)
fwd' = (Maybe (IntLikeSet k) -> Maybe (IntLikeSet k))
-> k -> IntLikeMap k (IntLikeSet k) -> IntLikeMap k (IntLikeSet k)
forall x a.
Coercible x Int =>
(Maybe a -> Maybe a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.alter (IntLikeSet k -> Maybe (IntLikeSet k)
forall a. a -> Maybe a
Just (IntLikeSet k -> Maybe (IntLikeSet k))
-> (Maybe (IntLikeSet k) -> IntLikeSet k)
-> Maybe (IntLikeSet k)
-> Maybe (IntLikeSet k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLikeSet k -> Maybe (IntLikeSet k) -> IntLikeSet k
forall a. a -> Maybe a -> a
fromMaybe IntLikeSet k
forall x. IntLikeSet x
ILS.empty) k
k IntLikeMap k (IntLikeSet k)
fwd
        in  (IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
forall k. IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
Equiv IntLikeMap k (IntLikeSet k)
fwd' IntLikeMap k k
bwd, Maybe (UnionMap k v)
mw)
      EntryLink k
_ ->
        case k -> UnionMap k v -> LookupRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k (UnionMap k v -> Maybe (UnionMap k v) -> UnionMap k v
forall a. a -> Maybe a -> a
fromMaybe UnionMap k v
u Maybe (UnionMap k v)
mw) of
          LookupResMissing k
_ -> String -> (Equiv k, Maybe (UnionMap k v))
forall a. HasCallStack => String -> a
error String
"impossible"
          LookupResFound k
r v
_ Maybe (UnionMap k v)
mw' ->
            let fwd' :: IntLikeMap k (IntLikeSet k)
fwd' = (Maybe (IntLikeSet k) -> Maybe (IntLikeSet k))
-> k -> IntLikeMap k (IntLikeSet k) -> IntLikeMap k (IntLikeSet k)
forall x a.
Coercible x Int =>
(Maybe a -> Maybe a) -> x -> IntLikeMap x a -> IntLikeMap x a
ILM.alter (IntLikeSet k -> Maybe (IntLikeSet k)
forall a. a -> Maybe a
Just (IntLikeSet k -> Maybe (IntLikeSet k))
-> (Maybe (IntLikeSet k) -> IntLikeSet k)
-> Maybe (IntLikeSet k)
-> Maybe (IntLikeSet k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntLikeSet k
-> (IntLikeSet k -> IntLikeSet k)
-> Maybe (IntLikeSet k)
-> IntLikeSet k
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (k -> IntLikeSet k
forall x. Coercible x Int => x -> IntLikeSet x
ILS.singleton k
k) (k -> IntLikeSet k -> IntLikeSet k
forall x. Coercible x Int => x -> IntLikeSet x -> IntLikeSet x
ILS.insert k
k)) k
r IntLikeMap k (IntLikeSet k)
fwd
                bwd' :: IntLikeMap k k
bwd' = k -> k -> IntLikeMap k k -> IntLikeMap k k
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
k k
r IntLikeMap k k
bwd
            in  (IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
forall k. IntLikeMap k (IntLikeSet k) -> IntLikeMap k k -> Equiv k
Equiv IntLikeMap k (IntLikeSet k)
fwd' IntLikeMap k k
bwd', Maybe (UnionMap k v)
mw')

equivLM :: (Coercible k Int, MonadState s m) => UnionMapLens s k v -> m (Equiv k)
equivLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> m (Equiv k)
equivLM UnionMapLens s k v
l = UnionMapLens s k v
-> (UnionMap k v -> (Equiv k, Maybe (UnionMap k v))) -> m (Equiv k)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l UnionMap k v -> (Equiv k, Maybe (UnionMap k v))
forall k v.
Coercible k Int =>
UnionMap k v -> (Equiv k, Maybe (UnionMap k v))
equiv

equivM :: (Coercible k Int, MonadState (UnionMap k v) m) => m (Equiv k)
equivM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
m (Equiv k)
equivM = UnionMapLens (UnionMap k v) k v -> m (Equiv k)
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> m (Equiv k)
equivLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

-- | Compresses all paths so there is never more than one jump to the root of each class
-- Retains all keys in the map but returns a mapping of non-root -> root keys
compact :: (Coercible k Int) => UnionMap k v -> (IntLikeMap k k, UnionMap k v)
compact :: forall k v.
Coercible k Int =>
UnionMap k v -> (IntLikeMap k k, UnionMap k v)
compact UnionMap k v
u = ((IntLikeMap k k, UnionMap k v)
 -> (k, Entry k v) -> (IntLikeMap k k, UnionMap k v))
-> (IntLikeMap k k, UnionMap k v)
-> [(k, Entry k v)]
-> (IntLikeMap k k, UnionMap k v)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntLikeMap k k, UnionMap k v)
-> (k, Entry k v) -> (IntLikeMap k k, UnionMap k v)
forall {a} {v} {k} {v}.
Coercible a Int =>
(IntLikeMap a a, UnionMap a v)
-> (a, Entry k v) -> (IntLikeMap a a, UnionMap a v)
go (IntLikeMap k k
forall x a. IntLikeMap x a
ILM.empty, UnionMap k v
u) (UnionMap k v -> [(k, Entry k v)]
forall k v. Coercible k Int => UnionMap k v -> [(k, Entry k v)]
toList UnionMap k v
u)
 where
  go :: (IntLikeMap a a, UnionMap a v)
-> (a, Entry k v) -> (IntLikeMap a a, UnionMap a v)
go mw :: (IntLikeMap a a, UnionMap a v)
mw@(IntLikeMap a a
m, UnionMap a v
w) (a
k, Entry k v
ue) =
    if a -> IntLikeMap a a -> Bool
forall x a. Coercible x Int => x -> IntLikeMap x a -> Bool
ILM.member a
k IntLikeMap a a
m
      then (IntLikeMap a a, UnionMap a v)
mw
      else case Entry k v
ue of
        EntryValue v
_ -> (IntLikeMap a a, UnionMap a v)
mw
        EntryLink k
_ ->
          case a -> UnionMap a v -> TraceRes a v
forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace a
k UnionMap a v
w of
            TraceResMissing a
_ -> String -> (IntLikeMap a a, UnionMap a v)
forall a. HasCallStack => String -> a
error String
"impossible"
            TraceResFound a
r v
_ [a]
kacc ->
              ((IntLikeMap a a, UnionMap a v)
 -> a -> (IntLikeMap a a, UnionMap a v))
-> (IntLikeMap a a, UnionMap a v)
-> [a]
-> (IntLikeMap a a, UnionMap a v)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(IntLikeMap a a
m', UnionMap a v
w') a
j -> (a -> a -> IntLikeMap a a -> IntLikeMap a a
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert a
j a
r IntLikeMap a a
m', IntLikeMap a (Entry a v) -> UnionMap a v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (a
-> Entry a v
-> IntLikeMap a (Entry a v)
-> IntLikeMap a (Entry a v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert a
j (a -> Entry a v
forall k v. k -> Entry k v
EntryLink a
r) (UnionMap a v -> IntLikeMap a (Entry a v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap a v
w')))) (IntLikeMap a a, UnionMap a v)
mw [a]
kacc

compactLM :: (Coercible k Int, MonadState s m) => UnionMapLens s k v -> m (IntLikeMap k k)
compactLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> m (IntLikeMap k k)
compactLM UnionMapLens s k v
l = UnionMapLens s k v
-> (UnionMap k v -> (IntLikeMap k k, UnionMap k v))
-> m (IntLikeMap k k)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, x)) -> m a
stateLens UnionMapLens s k v
l UnionMap k v -> (IntLikeMap k k, UnionMap k v)
forall k v.
Coercible k Int =>
UnionMap k v -> (IntLikeMap k k, UnionMap k v)
compact

compactM :: (Coercible k Int, MonadState (UnionMap k v) m) => m (IntLikeMap k k)
compactM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
m (IntLikeMap k k)
compactM = UnionMapLens (UnionMap k v) k v -> m (IntLikeMap k k)
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> m (IntLikeMap k k)
compactLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

-- | Compacts and rewrites all values with canonical keys.
-- Retains all keys in the map and again returns a mapping of non-root -> root keys.
-- TODO remove non-canonical keys?
canonicalize :: (Coercible k Int) => Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
canonicalize :: forall k v.
Coercible k Int =>
Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
canonicalize Traversal' v k
t UnionMap k v
u = (IntLikeMap k k, UnionMap k v)
res
 where
  res :: (IntLikeMap k k, UnionMap k v)
res = let (IntLikeMap k k
m, UnionMap IntLikeMap k (Entry k v)
w) = UnionMap k v -> (IntLikeMap k k, UnionMap k v)
forall k v.
Coercible k Int =>
UnionMap k v -> (IntLikeMap k k, UnionMap k v)
compact UnionMap k v
u in (IntLikeMap k k
m, IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap ((Entry k v -> Entry k v)
-> IntLikeMap k (Entry k v) -> IntLikeMap k (Entry k v)
forall a b. (a -> b) -> IntLikeMap k a -> IntLikeMap k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IntLikeMap k k -> Entry k v -> Entry k v
go IntLikeMap k k
m) IntLikeMap k (Entry k v)
w))
  go :: IntLikeMap k k -> Entry k v -> Entry k v
go IntLikeMap k k
m Entry k v
ue =
    case Entry k v
ue of
      EntryLink k
_ -> Entry k v
ue
      EntryValue v
fk -> v -> Entry k v
forall k v. v -> Entry k v
EntryValue (Traversal' v k -> (k -> k) -> v -> v
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
over Traversal' v k
t (\k
j -> k -> k -> IntLikeMap k k -> k
forall x a. Coercible x Int => a -> x -> IntLikeMap x a -> a
ILM.findWithDefault k
j k
j IntLikeMap k k
m) v
fk)

canonicalizeLM
  :: (Coercible k Int, MonadState s m) => UnionMapLens s k v -> Traversal' v k -> m (IntLikeMap k k)
canonicalizeLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> Traversal' v k -> m (IntLikeMap k k)
canonicalizeLM UnionMapLens s k v
l Traversal' v k
t = UnionMapLens s k v
-> (UnionMap k v -> (IntLikeMap k k, UnionMap k v))
-> m (IntLikeMap k k)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, x)) -> m a
stateLens UnionMapLens s k v
l (Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
forall k v.
Coercible k Int =>
Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
canonicalize Traversal' v k
t)

canonicalizeM :: (Coercible k Int, MonadState (UnionMap k v) m) => Traversal' v k -> m (IntLikeMap k k)
canonicalizeM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
Traversal' v k -> m (IntLikeMap k k)
canonicalizeM = UnionMapLens (UnionMap k v) k v
-> Traversal' v k -> m (IntLikeMap k k)
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v -> Traversal' v k -> m (IntLikeMap k k)
canonicalizeLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

data UpdateRes e k v r
  = UpdateResMissing !k
  | UpdateResEmbed !e
  | UpdateResAdded !v !r !(UnionMap k v)
  | UpdateResUpdated !k !v !r !(UnionMap k v)
  deriving stock (UpdateRes e k v r -> UpdateRes e k v r -> Bool
(UpdateRes e k v r -> UpdateRes e k v r -> Bool)
-> (UpdateRes e k v r -> UpdateRes e k v r -> Bool)
-> Eq (UpdateRes e k v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateRes e k v r -> UpdateRes e k v r -> Bool
$c== :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateRes e k v r -> UpdateRes e k v r -> Bool
== :: UpdateRes e k v r -> UpdateRes e k v r -> Bool
$c/= :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateRes e k v r -> UpdateRes e k v r -> Bool
/= :: UpdateRes e k v r -> UpdateRes e k v r -> Bool
Eq, Int -> UpdateRes e k v r -> ShowS
[UpdateRes e k v r] -> ShowS
UpdateRes e k v r -> String
(Int -> UpdateRes e k v r -> ShowS)
-> (UpdateRes e k v r -> String)
-> ([UpdateRes e k v r] -> ShowS)
-> Show (UpdateRes e k v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> UpdateRes e k v r -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
[UpdateRes e k v r] -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
UpdateRes e k v r -> String
$cshowsPrec :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> UpdateRes e k v r -> ShowS
showsPrec :: Int -> UpdateRes e k v r -> ShowS
$cshow :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
UpdateRes e k v r -> String
show :: UpdateRes e k v r -> String
$cshowList :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
[UpdateRes e k v r] -> ShowS
showList :: [UpdateRes e k v r] -> ShowS
Show)

update :: (Coercible k Int, Eq k) => MergeOne e v r -> k -> v -> UnionMap k v -> UpdateRes e k v r
update :: forall k e v r.
(Coercible k Int, Eq k) =>
MergeOne e v r -> k -> v -> UnionMap k v -> UpdateRes e k v r
update MergeOne e v r
g k
k v
v u :: UnionMap k v
u@(UnionMap IntLikeMap k (Entry k v)
m) = UpdateRes e k v r
goLookupK
 where
  goLookupK :: UpdateRes e k v r
goLookupK = case k -> UnionMap k v -> LookupRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k UnionMap k v
u of
    LookupResMissing k
kx ->
      if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx
        then UpdateRes e k v r
goAdd
        else k -> UpdateRes e k v r
forall e k v r. k -> UpdateRes e k v r
UpdateResMissing k
kx
    LookupResFound k
kr v
vr Maybe (UnionMap k v)
mu -> k -> v -> UnionMap k v -> UpdateRes e k v r
goMerge k
kr v
vr (UnionMap k v -> Maybe (UnionMap k v) -> UnionMap k v
forall a. a -> Maybe a -> a
fromMaybe UnionMap k v
u Maybe (UnionMap k v)
mu)
  goAdd :: UpdateRes e k v r
goAdd =
    case MergeOne e v r
g Maybe v
forall a. Maybe a
Nothing v
v of
      Left e
e -> e -> UpdateRes e k v r
forall e k v r. e -> UpdateRes e k v r
UpdateResEmbed e
e
      Right (r
r, v
vg) -> v -> r -> UnionMap k v -> UpdateRes e k v r
forall e k v r. v -> r -> UnionMap k v -> UpdateRes e k v r
UpdateResAdded v
vg r
r (IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
k (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
v) IntLikeMap k (Entry k v)
m))
  goMerge :: k -> v -> UnionMap k v -> UpdateRes e k v r
goMerge k
kr v
vr (UnionMap IntLikeMap k (Entry k v)
mr) =
    case MergeOne e v r
g (v -> Maybe v
forall a. a -> Maybe a
Just v
vr) v
v of
      Left e
e -> e -> UpdateRes e k v r
forall e k v r. e -> UpdateRes e k v r
UpdateResEmbed e
e
      Right (r
r, v
vg) -> k -> v -> r -> UnionMap k v -> UpdateRes e k v r
forall e k v r. k -> v -> r -> UnionMap k v -> UpdateRes e k v r
UpdateResUpdated k
kr v
vg r
r (IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
kr (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
vg) IntLikeMap k (Entry k v)
mr))

data UpdateVal e k v r
  = UpdateValMissing !k
  | UpdateValEmbed !e
  | UpdateValAdded !v !r
  | UpdateValUpdated !k !v !r
  deriving stock (UpdateVal e k v r -> UpdateVal e k v r -> Bool
(UpdateVal e k v r -> UpdateVal e k v r -> Bool)
-> (UpdateVal e k v r -> UpdateVal e k v r -> Bool)
-> Eq (UpdateVal e k v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateVal e k v r -> UpdateVal e k v r -> Bool
$c== :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateVal e k v r -> UpdateVal e k v r -> Bool
== :: UpdateVal e k v r -> UpdateVal e k v r -> Bool
$c/= :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
UpdateVal e k v r -> UpdateVal e k v r -> Bool
/= :: UpdateVal e k v r -> UpdateVal e k v r -> Bool
Eq, Int -> UpdateVal e k v r -> ShowS
[UpdateVal e k v r] -> ShowS
UpdateVal e k v r -> String
(Int -> UpdateVal e k v r -> ShowS)
-> (UpdateVal e k v r -> String)
-> ([UpdateVal e k v r] -> ShowS)
-> Show (UpdateVal e k v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> UpdateVal e k v r -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
[UpdateVal e k v r] -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
UpdateVal e k v r -> String
$cshowsPrec :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> UpdateVal e k v r -> ShowS
showsPrec :: Int -> UpdateVal e k v r -> ShowS
$cshow :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
UpdateVal e k v r -> String
show :: UpdateVal e k v r -> String
$cshowList :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
[UpdateVal e k v r] -> ShowS
showList :: [UpdateVal e k v r] -> ShowS
Show)

updateLM
  :: (Coercible k Int, Eq k, MonadState s m) => UnionMapLens s k v -> MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
updateLM :: forall k s (m :: * -> *) v e r.
(Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
updateLM UnionMapLens s k v
l MergeOne e v r
g k
k v
v = UnionMapLens s k v
-> (UnionMap k v -> (UpdateVal e k v r, Maybe (UnionMap k v)))
-> m (UpdateVal e k v r)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l ((UnionMap k v -> (UpdateVal e k v r, Maybe (UnionMap k v)))
 -> m (UpdateVal e k v r))
-> (UnionMap k v -> (UpdateVal e k v r, Maybe (UnionMap k v)))
-> m (UpdateVal e k v r)
forall a b. (a -> b) -> a -> b
$ \UnionMap k v
u ->
  case MergeOne e v r -> k -> v -> UnionMap k v -> UpdateRes e k v r
forall k e v r.
(Coercible k Int, Eq k) =>
MergeOne e v r -> k -> v -> UnionMap k v -> UpdateRes e k v r
update MergeOne e v r
g k
k v
v UnionMap k v
u of
    UpdateResMissing k
x -> (k -> UpdateVal e k v r
forall e k v r. k -> UpdateVal e k v r
UpdateValMissing k
x, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    UpdateResEmbed e
e -> (e -> UpdateVal e k v r
forall e k v r. e -> UpdateVal e k v r
UpdateValEmbed e
e, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    UpdateResAdded v
y r
r UnionMap k v
w -> (v -> r -> UpdateVal e k v r
forall e k v r. v -> r -> UpdateVal e k v r
UpdateValAdded v
y r
r, UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just UnionMap k v
w)
    UpdateResUpdated k
x v
y r
r UnionMap k v
w -> (k -> v -> r -> UpdateVal e k v r
forall e k v r. k -> v -> r -> UpdateVal e k v r
UpdateValUpdated k
x v
y r
r, UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just UnionMap k v
w)

updateM :: (Coercible k Int, Eq k, MonadState (UnionMap k v) m) => MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
updateM :: forall k v (m :: * -> *) e r.
(Coercible k Int, Eq k, MonadState (UnionMap k v) m) =>
MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
updateM = UnionMapLens (UnionMap k v) k v
-> MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
forall k s (m :: * -> *) v e r.
(Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeOne e v r -> k -> v -> m (UpdateVal e k v r)
updateLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

data MergeRes e k v r
  = MergeResMissing !k
  | MergeResEmbed !e
  | MergeResMerged !k !v !r !(UnionMap k v)
  deriving stock (MergeRes e k v r -> MergeRes e k v r -> Bool
(MergeRes e k v r -> MergeRes e k v r -> Bool)
-> (MergeRes e k v r -> MergeRes e k v r -> Bool)
-> Eq (MergeRes e k v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeRes e k v r -> MergeRes e k v r -> Bool
$c== :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeRes e k v r -> MergeRes e k v r -> Bool
== :: MergeRes e k v r -> MergeRes e k v r -> Bool
$c/= :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeRes e k v r -> MergeRes e k v r -> Bool
/= :: MergeRes e k v r -> MergeRes e k v r -> Bool
Eq, Int -> MergeRes e k v r -> ShowS
[MergeRes e k v r] -> ShowS
MergeRes e k v r -> String
(Int -> MergeRes e k v r -> ShowS)
-> (MergeRes e k v r -> String)
-> ([MergeRes e k v r] -> ShowS)
-> Show (MergeRes e k v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> MergeRes e k v r -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
[MergeRes e k v r] -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
MergeRes e k v r -> String
$cshowsPrec :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> MergeRes e k v r -> ShowS
showsPrec :: Int -> MergeRes e k v r -> ShowS
$cshow :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
MergeRes e k v r -> String
show :: MergeRes e k v r -> String
$cshowList :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
[MergeRes e k v r] -> ShowS
showList :: [MergeRes e k v r] -> ShowS
Show)

mergeOne :: (Coercible k Int, Eq k) => MergeOne e v r -> k -> k -> UnionMap k v -> MergeRes e k v r
mergeOne :: forall k e v r.
(Coercible k Int, Eq k) =>
MergeOne e v r -> k -> k -> UnionMap k v -> MergeRes e k v r
mergeOne MergeOne e v r
g k
k k
j UnionMap k v
u = MergeRes e k v r
goLookupK
 where
  doCompactCheck :: a -> a -> UnionMap a v -> [a] -> UnionMap a v
doCompactCheck a
kr a
jr UnionMap a v
w [a]
jacc = a -> UnionMap a v -> [a] -> UnionMap a v
forall {k} {t :: * -> *} {v}.
(Coercible k Int, Foldable t) =>
k -> UnionMap k v -> t k -> UnionMap k v
doCompact a
kr UnionMap a v
w (if a
kr a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
jr then [a] -> [a]
forall a. [a] -> [a]
safeTail [a]
jacc else a
jr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
jacc)
  doCompact :: k -> UnionMap k v -> t k -> UnionMap k v
doCompact k
kr UnionMap k v
w t k
acc = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap ((IntLikeMap k (Entry k v) -> k -> IntLikeMap k (Entry k v))
-> IntLikeMap k (Entry k v) -> t k -> IntLikeMap k (Entry k v)
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntLikeMap k (Entry k v)
m k
x -> k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
x (k -> Entry k v
forall k v. k -> Entry k v
EntryLink k
kr) IntLikeMap k (Entry k v)
m) (UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap k v
w) t k
acc)
  doRoot :: k -> v -> UnionMap k v -> UnionMap k v
doRoot k
kr v
gv UnionMap k v
w = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
kr (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
gv) (UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap k v
w))
  goLookupK :: MergeRes e k v r
goLookupK = case k -> UnionMap k v -> LookupRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k UnionMap k v
u of
    LookupResMissing k
kx -> if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx then MergeRes e k v r
goAssign else k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
kx
    LookupResFound k
kr v
kv Maybe (UnionMap k v)
mw -> k -> v -> UnionMap k v -> MergeRes e k v r
goLookupJ k
kr v
kv (UnionMap k v -> Maybe (UnionMap k v) -> UnionMap k v
forall a. a -> Maybe a -> a
fromMaybe UnionMap k v
u Maybe (UnionMap k v)
mw)
  goAssign :: MergeRes e k v r
goAssign = case k -> UnionMap k v -> TraceRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace k
j UnionMap k v
u of
    TraceResMissing k
jx -> k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
jx
    TraceResFound k
jr v
jv [k]
jacc -> k -> Maybe v -> v -> UnionMap k v -> MergeRes e k v r
goMerge k
k Maybe v
forall a. Maybe a
Nothing v
jv (k -> k -> UnionMap k v -> [k] -> UnionMap k v
forall {a} {v}.
(Coercible a Int, Eq a) =>
a -> a -> UnionMap a v -> [a] -> UnionMap a v
doCompactCheck k
k k
jr UnionMap k v
u [k]
jacc)
  goLookupJ :: k -> v -> UnionMap k v -> MergeRes e k v r
goLookupJ k
kr v
kv UnionMap k v
w = case k -> UnionMap k v -> TraceRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace k
j UnionMap k v
w of
    TraceResMissing k
jx -> k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
jx
    TraceResFound k
jr v
jv [k]
jacc -> k -> Maybe v -> v -> UnionMap k v -> MergeRes e k v r
goMerge k
kr (v -> Maybe v
forall a. a -> Maybe a
Just v
kv) v
jv (k -> k -> UnionMap k v -> [k] -> UnionMap k v
forall {a} {v}.
(Coercible a Int, Eq a) =>
a -> a -> UnionMap a v -> [a] -> UnionMap a v
doCompactCheck k
kr k
jr UnionMap k v
w [k]
jacc)
  goMerge :: k -> Maybe v -> v -> UnionMap k v -> MergeRes e k v r
goMerge k
kr Maybe v
mkv v
jv UnionMap k v
w1 =
    case MergeOne e v r
g Maybe v
mkv v
jv of
      Left e
e -> e -> MergeRes e k v r
forall e k v r. e -> MergeRes e k v r
MergeResEmbed e
e
      Right (r
r, v
gv) ->
        let w2 :: UnionMap k v
w2 = k -> v -> UnionMap k v -> UnionMap k v
forall {k} {v}.
Coercible k Int =>
k -> v -> UnionMap k v -> UnionMap k v
doRoot k
kr v
gv UnionMap k v
w1
        in  k -> v -> r -> UnionMap k v -> MergeRes e k v r
forall e k v r. k -> v -> r -> UnionMap k v -> MergeRes e k v r
MergeResMerged k
kr v
gv r
r UnionMap k v
w2

data MergeVal e k v r
  = MergeValMissing !k
  | MergeValEmbed !e
  | MergeValMerged !k !v !r
  deriving stock (MergeVal e k v r -> MergeVal e k v r -> Bool
(MergeVal e k v r -> MergeVal e k v r -> Bool)
-> (MergeVal e k v r -> MergeVal e k v r -> Bool)
-> Eq (MergeVal e k v r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeVal e k v r -> MergeVal e k v r -> Bool
$c== :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeVal e k v r -> MergeVal e k v r -> Bool
== :: MergeVal e k v r -> MergeVal e k v r -> Bool
$c/= :: forall e k v r.
(Eq e, Eq k, Eq v, Eq r) =>
MergeVal e k v r -> MergeVal e k v r -> Bool
/= :: MergeVal e k v r -> MergeVal e k v r -> Bool
Eq, Int -> MergeVal e k v r -> ShowS
[MergeVal e k v r] -> ShowS
MergeVal e k v r -> String
(Int -> MergeVal e k v r -> ShowS)
-> (MergeVal e k v r -> String)
-> ([MergeVal e k v r] -> ShowS)
-> Show (MergeVal e k v r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> MergeVal e k v r -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
[MergeVal e k v r] -> ShowS
forall e k v r.
(Show e, Show k, Show v, Show r) =>
MergeVal e k v r -> String
$cshowsPrec :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
Int -> MergeVal e k v r -> ShowS
showsPrec :: Int -> MergeVal e k v r -> ShowS
$cshow :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
MergeVal e k v r -> String
show :: MergeVal e k v r -> String
$cshowList :: forall e k v r.
(Show e, Show k, Show v, Show r) =>
[MergeVal e k v r] -> ShowS
showList :: [MergeVal e k v r] -> ShowS
Show)

mergeOneLM
  :: (Coercible k Int, Eq k, MonadState s m) => UnionMapLens s k v -> MergeOne e v r -> k -> k -> m (MergeVal e k v r)
mergeOneLM :: forall k s (m :: * -> *) v e r.
(Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeOne e v r -> k -> k -> m (MergeVal e k v r)
mergeOneLM UnionMapLens s k v
l MergeOne e v r
g k
k k
j = UnionMapLens s k v
-> (UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
-> m (MergeVal e k v r)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l ((UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
 -> m (MergeVal e k v r))
-> (UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
-> m (MergeVal e k v r)
forall a b. (a -> b) -> a -> b
$ \UnionMap k v
u ->
  case MergeOne e v r -> k -> k -> UnionMap k v -> MergeRes e k v r
forall k e v r.
(Coercible k Int, Eq k) =>
MergeOne e v r -> k -> k -> UnionMap k v -> MergeRes e k v r
mergeOne MergeOne e v r
g k
k k
j UnionMap k v
u of
    MergeResMissing k
x -> (k -> MergeVal e k v r
forall e k v r. k -> MergeVal e k v r
MergeValMissing k
x, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    MergeResEmbed e
e -> (e -> MergeVal e k v r
forall e k v r. e -> MergeVal e k v r
MergeValEmbed e
e, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    MergeResMerged k
x v
y r
r UnionMap k v
w -> (k -> v -> r -> MergeVal e k v r
forall e k v r. k -> v -> r -> MergeVal e k v r
MergeValMerged k
x v
y r
r, UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just UnionMap k v
w)

mergeOneM :: (Coercible k Int, Eq k, MonadState (UnionMap k v) m) => MergeOne e v r -> k -> k -> m (MergeVal e k v r)
mergeOneM :: forall k v (m :: * -> *) e r.
(Coercible k Int, Eq k, MonadState (UnionMap k v) m) =>
MergeOne e v r -> k -> k -> m (MergeVal e k v r)
mergeOneM = UnionMapLens (UnionMap k v) k v
-> MergeOne e v r -> k -> k -> m (MergeVal e k v r)
forall k s (m :: * -> *) v e r.
(Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeOne e v r -> k -> k -> m (MergeVal e k v r)
mergeOneLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

mergeMany :: (Traversable f, Coercible k Int, Eq k) => MergeMany f e v r -> k -> f k -> UnionMap k v -> MergeRes e k v r
mergeMany :: forall (f :: * -> *) k e v r.
(Traversable f, Coercible k Int, Eq k) =>
MergeMany f e v r -> k -> f k -> UnionMap k v -> MergeRes e k v r
mergeMany MergeMany f e v r
g k
k f k
js UnionMap k v
u = MergeRes e k v r
goLookupK
 where
  doCompactCheck :: a -> a -> UnionMap a v -> [a] -> UnionMap a v
doCompactCheck a
kr a
jr UnionMap a v
w [a]
jacc = a -> UnionMap a v -> [a] -> UnionMap a v
forall {k} {t :: * -> *} {v}.
(Coercible k Int, Foldable t) =>
k -> UnionMap k v -> t k -> UnionMap k v
doCompact a
kr UnionMap a v
w (if a
kr a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
jr then [a] -> [a]
forall a. [a] -> [a]
safeTail [a]
jacc else a
jr a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
jacc)
  doCompact :: k -> UnionMap k v -> t k -> UnionMap k v
doCompact k
kr UnionMap k v
w t k
acc = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap ((IntLikeMap k (Entry k v) -> k -> IntLikeMap k (Entry k v))
-> IntLikeMap k (Entry k v) -> t k -> IntLikeMap k (Entry k v)
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntLikeMap k (Entry k v)
m k
x -> k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
x (k -> Entry k v
forall k v. k -> Entry k v
EntryLink k
kr) IntLikeMap k (Entry k v)
m) (UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap k v
w) t k
acc)
  doRoot :: k -> v -> UnionMap k v -> UnionMap k v
doRoot k
kr v
gv UnionMap k v
w = IntLikeMap k (Entry k v) -> UnionMap k v
forall k v. IntLikeMap k (Entry k v) -> UnionMap k v
UnionMap (k
-> Entry k v
-> IntLikeMap k (Entry k v)
-> IntLikeMap k (Entry k v)
forall x a.
Coercible x Int =>
x -> a -> IntLikeMap x a -> IntLikeMap x a
ILM.insert k
kr (v -> Entry k v
forall k v. v -> Entry k v
EntryValue v
gv) (UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap k v
w))
  doTraceJ :: a -> a -> m b
doTraceJ a
kr a
y = do
    UnionMap a b
w <- m (UnionMap a b)
forall s (m :: * -> *). MonadState s m => m s
get
    case a -> UnionMap a b -> TraceRes a b
forall k v. Coercible k Int => k -> UnionMap k v -> TraceRes k v
trace a
y UnionMap a b
w of
      TraceResMissing a
jx -> a -> m b
forall a. a -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a
jx
      TraceResFound a
jr b
jv [a]
jacc -> do
        UnionMap a b -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (a -> a -> UnionMap a b -> [a] -> UnionMap a b
forall {a} {v}.
(Coercible a Int, Eq a) =>
a -> a -> UnionMap a v -> [a] -> UnionMap a v
doCompactCheck a
kr a
jr UnionMap a b
w [a]
jacc)
        b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
jv
  doTraceJs :: k -> UnionMap k v -> Either k (f v, UnionMap k v)
doTraceJs k
kr = DropM k (UnionMap k v) (f v)
-> UnionMap k v -> Either k (f v, UnionMap k v)
forall e s a. DropM e s a -> s -> Either e (a, s)
runDropM ((k -> DropM k (UnionMap k v) v)
-> f k -> DropM k (UnionMap k v) (f v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse (k -> k -> DropM k (UnionMap k v) v
forall {a} {b} {m :: * -> *}.
(Coercible a Int, MonadState (UnionMap a b) m, MonadError a m,
 Eq a) =>
a -> a -> m b
doTraceJ k
kr) f k
js)
  goLookupK :: MergeRes e k v r
goLookupK = case k -> UnionMap k v -> LookupRes k v
forall k v. Coercible k Int => k -> UnionMap k v -> LookupRes k v
lookup k
k UnionMap k v
u of
    LookupResMissing k
kx -> if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
kx then MergeRes e k v r
goAssign else k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
kx
    LookupResFound k
kr v
kv Maybe (UnionMap k v)
mw -> k -> v -> UnionMap k v -> MergeRes e k v r
goLookupJs k
kr v
kv (UnionMap k v -> Maybe (UnionMap k v) -> UnionMap k v
forall a. a -> Maybe a -> a
fromMaybe UnionMap k v
u Maybe (UnionMap k v)
mw)
  goAssign :: MergeRes e k v r
goAssign =
    case k -> UnionMap k v -> Either k (f v, UnionMap k v)
doTraceJs k
k UnionMap k v
u of
      Left k
jx -> k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
jx
      Right (f v
jvs, UnionMap k v
w1) -> k -> Maybe v -> f v -> UnionMap k v -> MergeRes e k v r
goMerge k
k Maybe v
forall a. Maybe a
Nothing f v
jvs UnionMap k v
w1
  goLookupJs :: k -> v -> UnionMap k v -> MergeRes e k v r
goLookupJs k
kr v
kv UnionMap k v
w =
    case k -> UnionMap k v -> Either k (f v, UnionMap k v)
doTraceJs k
kr UnionMap k v
w of
      Left k
jx -> k -> MergeRes e k v r
forall e k v r. k -> MergeRes e k v r
MergeResMissing k
jx
      Right (f v
jvs, UnionMap k v
w1) -> k -> Maybe v -> f v -> UnionMap k v -> MergeRes e k v r
goMerge k
kr (v -> Maybe v
forall a. a -> Maybe a
Just v
kv) f v
jvs UnionMap k v
w1
  goMerge :: k -> Maybe v -> f v -> UnionMap k v -> MergeRes e k v r
goMerge k
kr Maybe v
mkv f v
jvs UnionMap k v
w1 =
    case MergeMany f e v r
g Maybe v
mkv f v
jvs of
      Left e
e -> e -> MergeRes e k v r
forall e k v r. e -> MergeRes e k v r
MergeResEmbed e
e
      Right (r
r, v
gv) ->
        let w2 :: UnionMap k v
w2 = k -> v -> UnionMap k v -> UnionMap k v
forall {k} {v}.
Coercible k Int =>
k -> v -> UnionMap k v -> UnionMap k v
doRoot k
kr v
gv UnionMap k v
w1
        in  k -> v -> r -> UnionMap k v -> MergeRes e k v r
forall e k v r. k -> v -> r -> UnionMap k v -> MergeRes e k v r
MergeResMerged k
kr v
gv r
r UnionMap k v
w2

mergeManyLM
  :: (Traversable f, Coercible k Int, Eq k, MonadState s m)
  => UnionMapLens s k v
  -> MergeMany f e v r
  -> k
  -> f k
  -> m (MergeVal e k v r)
mergeManyLM :: forall (f :: * -> *) k s (m :: * -> *) v e r.
(Traversable f, Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeMany f e v r -> k -> f k -> m (MergeVal e k v r)
mergeManyLM UnionMapLens s k v
l MergeMany f e v r
g k
k f k
js = UnionMapLens s k v
-> (UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
-> m (MergeVal e k v r)
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, Maybe x)) -> m a
mayStateLens UnionMapLens s k v
l ((UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
 -> m (MergeVal e k v r))
-> (UnionMap k v -> (MergeVal e k v r, Maybe (UnionMap k v)))
-> m (MergeVal e k v r)
forall a b. (a -> b) -> a -> b
$ \UnionMap k v
u ->
  case MergeMany f e v r -> k -> f k -> UnionMap k v -> MergeRes e k v r
forall (f :: * -> *) k e v r.
(Traversable f, Coercible k Int, Eq k) =>
MergeMany f e v r -> k -> f k -> UnionMap k v -> MergeRes e k v r
mergeMany MergeMany f e v r
g k
k f k
js UnionMap k v
u of
    MergeResMissing k
x -> (k -> MergeVal e k v r
forall e k v r. k -> MergeVal e k v r
MergeValMissing k
x, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    MergeResEmbed e
e -> (e -> MergeVal e k v r
forall e k v r. e -> MergeVal e k v r
MergeValEmbed e
e, Maybe (UnionMap k v)
forall a. Maybe a
Nothing)
    MergeResMerged k
x v
y r
r UnionMap k v
w -> (k -> v -> r -> MergeVal e k v r
forall e k v r. k -> v -> r -> MergeVal e k v r
MergeValMerged k
x v
y r
r, UnionMap k v -> Maybe (UnionMap k v)
forall a. a -> Maybe a
Just UnionMap k v
w)

mergeManyM
  :: (Traversable f, Coercible k Int, Eq k, MonadState (UnionMap k v) m)
  => MergeMany f e v r
  -> k
  -> f k
  -> m (MergeVal e k v r)
mergeManyM :: forall (f :: * -> *) k v (m :: * -> *) e r.
(Traversable f, Coercible k Int, Eq k,
 MonadState (UnionMap k v) m) =>
MergeMany f e v r -> k -> f k -> m (MergeVal e k v r)
mergeManyM = UnionMapLens (UnionMap k v) k v
-> MergeMany f e v r -> k -> f k -> m (MergeVal e k v r)
forall (f :: * -> *) k s (m :: * -> *) v e r.
(Traversable f, Coercible k Int, Eq k, MonadState s m) =>
UnionMapLens s k v
-> MergeMany f e v r -> k -> f k -> m (MergeVal e k v r)
mergeManyLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'

-- | Return the subgraph accessible from a given key.
extract :: (Coercible k Int) => Traversal' v k -> k -> UnionMap k v -> (Maybe (k, IntLikeMap k v), UnionMap k v)
extract :: forall k v.
Coercible k Int =>
Traversal' v k
-> k -> UnionMap k v -> (Maybe (k, IntLikeMap k v), UnionMap k v)
extract Traversal' v k
t k
k0 UnionMap k v
u =
  let (IntLikeMap k k
m, UnionMap k v
w) = Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
forall k v.
Coercible k Int =>
Traversal' v k -> UnionMap k v -> (IntLikeMap k k, UnionMap k v)
canonicalize Traversal' v k
t UnionMap k v
u
      n :: IntLikeMap k v
n = IntLikeMap k (Entry k v) -> IntLikeMap k v
forall k v.
Coercible k Int =>
IntLikeMap k (Entry k v) -> IntLikeMap k v
filterRootEntries (UnionMap k v -> IntLikeMap k (Entry k v)
forall k v. UnionMap k v -> IntLikeMap k (Entry k v)
unUnionMap UnionMap k v
w)
      mk1 :: Maybe k
mk1 = case k -> IntLikeMap k k -> Maybe k
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup k
k0 IntLikeMap k k
m of
        Maybe k
Nothing -> k
k0 k -> Maybe v -> Maybe k
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ k -> IntLikeMap k v -> Maybe v
forall x a. Coercible x Int => x -> IntLikeMap x a -> Maybe a
ILM.lookup k
k0 IntLikeMap k v
n
        Just k
k1 -> k -> Maybe k
forall a. a -> Maybe a
Just k
k1
      mp :: Maybe (k, IntLikeMap k v)
mp = (k -> (k, IntLikeMap k v)) -> Maybe k -> Maybe (k, IntLikeMap k v)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,IntLikeMap k v
n) Maybe k
mk1
  in  (Maybe (k, IntLikeMap k v)
mp, UnionMap k v
w)

extractLM
  :: (Coercible k Int, MonadState s m)
  => UnionMapLens s k v
  -> Traversal' v k
  -> k
  -> m (Maybe (k, IntLikeMap k v))
extractLM :: forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v
-> Traversal' v k -> k -> m (Maybe (k, IntLikeMap k v))
extractLM UnionMapLens s k v
l Traversal' v k
t k
k = UnionMapLens s k v
-> (UnionMap k v -> (Maybe (k, IntLikeMap k v), UnionMap k v))
-> m (Maybe (k, IntLikeMap k v))
forall s (m :: * -> *) x a.
MonadState s m =>
Lens' s x -> (x -> (a, x)) -> m a
stateLens UnionMapLens s k v
l (Traversal' v k
-> k -> UnionMap k v -> (Maybe (k, IntLikeMap k v), UnionMap k v)
forall k v.
Coercible k Int =>
Traversal' v k
-> k -> UnionMap k v -> (Maybe (k, IntLikeMap k v), UnionMap k v)
extract Traversal' v k
t k
k)

extractM
  :: (Coercible k Int, MonadState (UnionMap k v) m)
  => Traversal' v k
  -> k
  -> m (Maybe (k, IntLikeMap k v))
extractM :: forall k v (m :: * -> *).
(Coercible k Int, MonadState (UnionMap k v) m) =>
Traversal' v k -> k -> m (Maybe (k, IntLikeMap k v))
extractM = UnionMapLens (UnionMap k v) k v
-> Traversal' v k -> k -> m (Maybe (k, IntLikeMap k v))
forall k s (m :: * -> *) v.
(Coercible k Int, MonadState s m) =>
UnionMapLens s k v
-> Traversal' v k -> k -> m (Maybe (k, IntLikeMap k v))
extractLM UnionMapLens (UnionMap k v) k v
forall a b. Lens a b a b
equality'