{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Yaya.Containers.Pattern.IntMap
  ( IntMapF (BinF, NilF, TipF),
  )
where

import "base" Control.Applicative (Alternative ((<|>)), Applicative ((<*>)), (*>))
import "base" Control.Category (Category ((.)))
import "base" Data.Bool (Bool (False, True), (&&))
import "base" Data.Eq (Eq ((==)))
import "base" Data.Foldable (Foldable)
import "base" Data.Function (($))
import "base" Data.Functor (Functor (fmap), (<$), (<$>))
import "base" Data.Ord (Ord (compare, (<=)), Ordering (EQ, GT, LT))
import "base" Data.Semigroup ((<>))
import "base" Data.Traversable (Traversable)
import qualified "base" Data.Tuple as Tuple
import "base" GHC.Generics (Generic, Generic1)
import "base" GHC.Read (Read (readListPrec, readPrec), expectP, parens)
import "base" Text.ParserCombinators.ReadPrec (prec, step)
import qualified "base" Text.Read.Lex as Lex
import qualified "containers" Data.IntMap.Internal as IntMap
import "yaya" Yaya.Fold
  ( Projectable (project),
    Recursive (cata),
    Steppable (embed),
  )
import "base" Prelude (Num ((+)))
#if MIN_VERSION_base(4, 18, 0)
import "base" Data.Functor.Classes
  ( Eq1,
    Eq2 (liftEq2),
    Ord2 (liftCompare2),
    Ord1,
    Read1 (liftReadPrec),
    Read2 (liftReadPrec2),
    Show1,
    Show2 (liftShowsPrec2),
  )
import "base" Text.Show (Show (showsPrec), showParen, showString)
#else
import "base" Data.Functor.Classes
  ( Eq1 (liftEq),
    Eq2 (liftEq2),
    Ord1 (liftCompare),
    Ord2 (liftCompare2),
    Read1 (liftReadPrec),
    Read2 (liftReadPrec2),
    Show1 (liftShowsPrec),
    Show2 (liftShowsPrec2),
  )
import "base" Text.Show (Show (showList, showsPrec), showParen, showString)
#endif

data IntMapF a r
  = NilF
  | TipF IntMap.Key a
  | BinF IntMap.Prefix IntMap.Mask r r
  deriving stock
    ( IntMapF a r -> IntMapF a r -> Bool
(IntMapF a r -> IntMapF a r -> Bool)
-> (IntMapF a r -> IntMapF a r -> Bool) -> Eq (IntMapF a r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a r. (Eq a, Eq r) => IntMapF a r -> IntMapF a r -> Bool
$c== :: forall a r. (Eq a, Eq r) => IntMapF a r -> IntMapF a r -> Bool
== :: IntMapF a r -> IntMapF a r -> Bool
$c/= :: forall a r. (Eq a, Eq r) => IntMapF a r -> IntMapF a r -> Bool
/= :: IntMapF a r -> IntMapF a r -> Bool
Eq,
      Eq (IntMapF a r)
Eq (IntMapF a r) =>
(IntMapF a r -> IntMapF a r -> Ordering)
-> (IntMapF a r -> IntMapF a r -> Bool)
-> (IntMapF a r -> IntMapF a r -> Bool)
-> (IntMapF a r -> IntMapF a r -> Bool)
-> (IntMapF a r -> IntMapF a r -> Bool)
-> (IntMapF a r -> IntMapF a r -> IntMapF a r)
-> (IntMapF a r -> IntMapF a r -> IntMapF a r)
-> Ord (IntMapF a r)
IntMapF a r -> IntMapF a r -> Bool
IntMapF a r -> IntMapF a r -> Ordering
IntMapF a r -> IntMapF a r -> IntMapF a r
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 a r. (Ord a, Ord r) => Eq (IntMapF a r)
forall a r. (Ord a, Ord r) => IntMapF a r -> IntMapF a r -> Bool
forall a r.
(Ord a, Ord r) =>
IntMapF a r -> IntMapF a r -> Ordering
forall a r.
(Ord a, Ord r) =>
IntMapF a r -> IntMapF a r -> IntMapF a r
$ccompare :: forall a r.
(Ord a, Ord r) =>
IntMapF a r -> IntMapF a r -> Ordering
compare :: IntMapF a r -> IntMapF a r -> Ordering
$c< :: forall a r. (Ord a, Ord r) => IntMapF a r -> IntMapF a r -> Bool
< :: IntMapF a r -> IntMapF a r -> Bool
$c<= :: forall a r. (Ord a, Ord r) => IntMapF a r -> IntMapF a r -> Bool
<= :: IntMapF a r -> IntMapF a r -> Bool
$c> :: forall a r. (Ord a, Ord r) => IntMapF a r -> IntMapF a r -> Bool
> :: IntMapF a r -> IntMapF a r -> Bool
$c>= :: forall a r. (Ord a, Ord r) => IntMapF a r -> IntMapF a r -> Bool
>= :: IntMapF a r -> IntMapF a r -> Bool
$cmax :: forall a r.
(Ord a, Ord r) =>
IntMapF a r -> IntMapF a r -> IntMapF a r
max :: IntMapF a r -> IntMapF a r -> IntMapF a r
$cmin :: forall a r.
(Ord a, Ord r) =>
IntMapF a r -> IntMapF a r -> IntMapF a r
min :: IntMapF a r -> IntMapF a r -> IntMapF a r
Ord,
      (forall x. IntMapF a r -> Rep (IntMapF a r) x)
-> (forall x. Rep (IntMapF a r) x -> IntMapF a r)
-> Generic (IntMapF a r)
forall x. Rep (IntMapF a r) x -> IntMapF a r
forall x. IntMapF a r -> Rep (IntMapF a r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a r x. Rep (IntMapF a r) x -> IntMapF a r
forall a r x. IntMapF a r -> Rep (IntMapF a r) x
$cfrom :: forall a r x. IntMapF a r -> Rep (IntMapF a r) x
from :: forall x. IntMapF a r -> Rep (IntMapF a r) x
$cto :: forall a r x. Rep (IntMapF a r) x -> IntMapF a r
to :: forall x. Rep (IntMapF a r) x -> IntMapF a r
Generic,
      -- | @since 0.1.2.0
      ReadPrec [IntMapF a r]
ReadPrec (IntMapF a r)
Key -> ReadS (IntMapF a r)
ReadS [IntMapF a r]
(Key -> ReadS (IntMapF a r))
-> ReadS [IntMapF a r]
-> ReadPrec (IntMapF a r)
-> ReadPrec [IntMapF a r]
-> Read (IntMapF a r)
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a r. (Read a, Read r) => ReadPrec [IntMapF a r]
forall a r. (Read a, Read r) => ReadPrec (IntMapF a r)
forall a r. (Read a, Read r) => Key -> ReadS (IntMapF a r)
forall a r. (Read a, Read r) => ReadS [IntMapF a r]
$creadsPrec :: forall a r. (Read a, Read r) => Key -> ReadS (IntMapF a r)
readsPrec :: Key -> ReadS (IntMapF a r)
$creadList :: forall a r. (Read a, Read r) => ReadS [IntMapF a r]
readList :: ReadS [IntMapF a r]
$creadPrec :: forall a r. (Read a, Read r) => ReadPrec (IntMapF a r)
readPrec :: ReadPrec (IntMapF a r)
$creadListPrec :: forall a r. (Read a, Read r) => ReadPrec [IntMapF a r]
readListPrec :: ReadPrec [IntMapF a r]
Read,
      Key -> IntMapF a r -> ShowS
[IntMapF a r] -> ShowS
IntMapF a r -> String
(Key -> IntMapF a r -> ShowS)
-> (IntMapF a r -> String)
-> ([IntMapF a r] -> ShowS)
-> Show (IntMapF a r)
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a r. (Show a, Show r) => Key -> IntMapF a r -> ShowS
forall a r. (Show a, Show r) => [IntMapF a r] -> ShowS
forall a r. (Show a, Show r) => IntMapF a r -> String
$cshowsPrec :: forall a r. (Show a, Show r) => Key -> IntMapF a r -> ShowS
showsPrec :: Key -> IntMapF a r -> ShowS
$cshow :: forall a r. (Show a, Show r) => IntMapF a r -> String
show :: IntMapF a r -> String
$cshowList :: forall a r. (Show a, Show r) => [IntMapF a r] -> ShowS
showList :: [IntMapF a r] -> ShowS
Show,
      (forall m. Monoid m => IntMapF a m -> m)
-> (forall m a. Monoid m => (a -> m) -> IntMapF a a -> m)
-> (forall m a. Monoid m => (a -> m) -> IntMapF a a -> m)
-> (forall a b. (a -> b -> b) -> b -> IntMapF a a -> b)
-> (forall a b. (a -> b -> b) -> b -> IntMapF a a -> b)
-> (forall b a. (b -> a -> b) -> b -> IntMapF a a -> b)
-> (forall b a. (b -> a -> b) -> b -> IntMapF a a -> b)
-> (forall a. (a -> a -> a) -> IntMapF a a -> a)
-> (forall a. (a -> a -> a) -> IntMapF a a -> a)
-> (forall a. IntMapF a a -> [a])
-> (forall a. IntMapF a a -> Bool)
-> (forall a. IntMapF a a -> Key)
-> (forall a. Eq a => a -> IntMapF a a -> Bool)
-> (forall a. Ord a => IntMapF a a -> a)
-> (forall a. Ord a => IntMapF a a -> a)
-> (forall a. Num a => IntMapF a a -> a)
-> (forall a. Num a => IntMapF a a -> a)
-> Foldable (IntMapF a)
forall a. Eq a => a -> IntMapF a a -> Bool
forall a. Num a => IntMapF a a -> a
forall a. Ord a => IntMapF a a -> a
forall m. Monoid m => IntMapF a m -> m
forall a. IntMapF a a -> Bool
forall a. IntMapF a a -> Key
forall a. IntMapF a a -> [a]
forall a. (a -> a -> a) -> IntMapF a a -> a
forall a a. Eq a => a -> IntMapF a a -> Bool
forall a a. Num a => IntMapF a a -> a
forall a a. Ord a => IntMapF a a -> a
forall m a. Monoid m => (a -> m) -> IntMapF a a -> m
forall a m. Monoid m => IntMapF a m -> m
forall a a. IntMapF a a -> Bool
forall a a. IntMapF a a -> Key
forall a a. IntMapF a a -> [a]
forall b a. (b -> a -> b) -> b -> IntMapF a a -> b
forall a b. (a -> b -> b) -> b -> IntMapF a a -> b
forall a a. (a -> a -> a) -> IntMapF a a -> a
forall a m a. Monoid m => (a -> m) -> IntMapF a a -> m
forall a b a. (b -> a -> b) -> b -> IntMapF a a -> b
forall a a b. (a -> b -> b) -> b -> IntMapF a 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 -> Key)
-> (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 a m. Monoid m => IntMapF a m -> m
fold :: forall m. Monoid m => IntMapF a m -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> IntMapF a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> IntMapF a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> IntMapF a a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> IntMapF a a -> m
$cfoldr :: forall a a b. (a -> b -> b) -> b -> IntMapF a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> IntMapF a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> IntMapF a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IntMapF a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> IntMapF a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> IntMapF a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> IntMapF a a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> IntMapF a a -> b
$cfoldr1 :: forall a a. (a -> a -> a) -> IntMapF a a -> a
foldr1 :: forall a. (a -> a -> a) -> IntMapF a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> IntMapF a a -> a
foldl1 :: forall a. (a -> a -> a) -> IntMapF a a -> a
$ctoList :: forall a a. IntMapF a a -> [a]
toList :: forall a. IntMapF a a -> [a]
$cnull :: forall a a. IntMapF a a -> Bool
null :: forall a. IntMapF a a -> Bool
$clength :: forall a a. IntMapF a a -> Key
length :: forall a. IntMapF a a -> Key
$celem :: forall a a. Eq a => a -> IntMapF a a -> Bool
elem :: forall a. Eq a => a -> IntMapF a a -> Bool
$cmaximum :: forall a a. Ord a => IntMapF a a -> a
maximum :: forall a. Ord a => IntMapF a a -> a
$cminimum :: forall a a. Ord a => IntMapF a a -> a
minimum :: forall a. Ord a => IntMapF a a -> a
$csum :: forall a a. Num a => IntMapF a a -> a
sum :: forall a. Num a => IntMapF a a -> a
$cproduct :: forall a a. Num a => IntMapF a a -> a
product :: forall a. Num a => IntMapF a a -> a
Foldable,
      (forall a b. (a -> b) -> IntMapF a a -> IntMapF a b)
-> (forall a b. a -> IntMapF a b -> IntMapF a a)
-> Functor (IntMapF a)
forall a b. a -> IntMapF a b -> IntMapF a a
forall a b. (a -> b) -> IntMapF a a -> IntMapF a b
forall a a b. a -> IntMapF a b -> IntMapF a a
forall a a b. (a -> b) -> IntMapF a a -> IntMapF a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a a b. (a -> b) -> IntMapF a a -> IntMapF a b
fmap :: forall a b. (a -> b) -> IntMapF a a -> IntMapF a b
$c<$ :: forall a a b. a -> IntMapF a b -> IntMapF a a
<$ :: forall a b. a -> IntMapF a b -> IntMapF a a
Functor,
      (forall a. IntMapF a a -> Rep1 (IntMapF a) a)
-> (forall a. Rep1 (IntMapF a) a -> IntMapF a a)
-> Generic1 (IntMapF a)
forall a. Rep1 (IntMapF a) a -> IntMapF a a
forall a. IntMapF a a -> Rep1 (IntMapF a) a
forall a a. Rep1 (IntMapF a) a -> IntMapF a a
forall a a. IntMapF a a -> Rep1 (IntMapF a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a a. IntMapF a a -> Rep1 (IntMapF a) a
from1 :: forall a. IntMapF a a -> Rep1 (IntMapF a) a
$cto1 :: forall a a. Rep1 (IntMapF a) a -> IntMapF a a
to1 :: forall a. Rep1 (IntMapF a) a -> IntMapF a a
Generic1,
      Functor (IntMapF a)
Foldable (IntMapF a)
(Functor (IntMapF a), Foldable (IntMapF a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> IntMapF a a -> f (IntMapF a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IntMapF a (f a) -> f (IntMapF a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IntMapF a a -> m (IntMapF a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IntMapF a (m a) -> m (IntMapF a a))
-> Traversable (IntMapF a)
forall a. Functor (IntMapF a)
forall a. Foldable (IntMapF a)
forall a (m :: * -> *) a.
Monad m =>
IntMapF a (m a) -> m (IntMapF a a)
forall a (f :: * -> *) a.
Applicative f =>
IntMapF a (f a) -> f (IntMapF a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntMapF a a -> m (IntMapF a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMapF a a -> f (IntMapF a 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 =>
IntMapF a (m a) -> m (IntMapF a a)
forall (f :: * -> *) a.
Applicative f =>
IntMapF a (f a) -> f (IntMapF a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntMapF a a -> m (IntMapF a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMapF a a -> f (IntMapF a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMapF a a -> f (IntMapF a b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMapF a a -> f (IntMapF a b)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
IntMapF a (f a) -> f (IntMapF a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
IntMapF a (f a) -> f (IntMapF a a)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntMapF a a -> m (IntMapF a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntMapF a a -> m (IntMapF a b)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
IntMapF a (m a) -> m (IntMapF a a)
sequence :: forall (m :: * -> *) a.
Monad m =>
IntMapF a (m a) -> m (IntMapF a a)
Traversable
    )

instance Projectable (->) (IntMap.IntMap a) (IntMapF a) where
  project :: Coalgebra (->) (IntMapF a) (IntMap a)
project IntMap a
IntMap.Nil = IntMapF a (IntMap a)
forall a r. IntMapF a r
NilF
  project (IntMap.Tip Key
key a
a) = Key -> a -> IntMapF a (IntMap a)
forall a r. Key -> a -> IntMapF a r
TipF Key
key a
a
  project (IntMap.Bin Key
prefix Key
mask IntMap a
l IntMap a
r) = Key -> Key -> IntMap a -> Coalgebra (->) (IntMapF a) (IntMap a)
forall a r. Key -> Key -> r -> r -> IntMapF a r
BinF Key
prefix Key
mask IntMap a
l IntMap a
r

instance Recursive (->) (IntMap.IntMap a) (IntMapF a) where
  cata :: forall a. Algebra (->) (IntMapF a) a -> IntMap a -> a
cata Algebra (->) (IntMapF a) a
φ = Algebra (->) (IntMapF a) a
φ Algebra (->) (IntMapF a) a
-> (IntMap a -> IntMapF a a) -> IntMap a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (IntMap a -> a) -> IntMapF a (IntMap a) -> IntMapF a a
forall a b. (a -> b) -> IntMapF a a -> IntMapF a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Algebra (->) (IntMapF a) a -> IntMap a -> a
forall a. Algebra (->) (IntMapF a) a -> IntMap a -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata Algebra (->) (IntMapF a) a
φ) (IntMapF a (IntMap a) -> IntMapF a a)
-> (IntMap a -> IntMapF a (IntMap a)) -> IntMap a -> IntMapF a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntMap a -> IntMapF a (IntMap a)
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project

instance Steppable (->) (IntMap.IntMap a) (IntMapF a) where
  embed :: Algebra (->) (IntMapF a) (IntMap a)
embed IntMapF a (IntMap a)
NilF = IntMap a
forall a. IntMap a
IntMap.Nil
  embed (TipF Key
key a
a) = Key -> a -> IntMap a
forall a. Key -> a -> IntMap a
IntMap.Tip Key
key a
a
  embed (BinF Key
prefix Key
mask IntMap a
l IntMap a
r) = Key -> Key -> IntMap a -> IntMap a -> IntMap a
forall a. Key -> Key -> IntMap a -> IntMap a -> IntMap a
IntMap.Bin Key
prefix Key
mask IntMap a
l IntMap a
r

#if MIN_VERSION_base(4, 18, 0)
instance (Eq a) => Eq1 (IntMapF a)
#else
instance (Eq a) => Eq1 (IntMapF a) where
  liftEq = liftEq2 (==)
#endif

instance Eq2 IntMapF where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> IntMapF a c -> IntMapF b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g = ((IntMapF a c, IntMapF b d) -> Bool)
-> IntMapF a c -> IntMapF b d -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((IntMapF a c, IntMapF b d) -> Bool)
 -> IntMapF a c -> IntMapF b d -> Bool)
-> ((IntMapF a c, IntMapF b d) -> Bool)
-> IntMapF a c
-> IntMapF b d
-> Bool
forall a b. (a -> b) -> a -> b
$ \case
    (IntMapF a c
NilF, IntMapF b d
NilF) -> Bool
True
    (TipF Key
key a
a, TipF Key
key' b
a') -> Key
key Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
key' Bool -> Bool -> Bool
&& a -> b -> Bool
f a
a b
a'
    (BinF Key
prefix Key
mask c
l c
r, BinF Key
prefix' Key
mask' d
l' d
r') ->
      Key
prefix Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
prefix' Bool -> Bool -> Bool
&& Key
mask Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
mask' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
l d
l' Bool -> Bool -> Bool
&& c -> d -> Bool
g c
r d
r'
    (IntMapF a c
_, IntMapF b d
_) -> Bool
False

#if MIN_VERSION_base(4, 18, 0)
instance (Ord a) => Ord1 (IntMapF a)
#else
instance (Ord a) => Ord1 (IntMapF a) where
  liftCompare = liftCompare2 compare
#endif

instance Ord2 IntMapF where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> IntMapF a c -> IntMapF b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g = ((IntMapF a c, IntMapF b d) -> Ordering)
-> IntMapF a c -> IntMapF b d -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((IntMapF a c, IntMapF b d) -> Ordering)
 -> IntMapF a c -> IntMapF b d -> Ordering)
-> ((IntMapF a c, IntMapF b d) -> Ordering)
-> IntMapF a c
-> IntMapF b d
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (IntMapF a c
NilF, IntMapF b d
NilF) -> Ordering
EQ
    (IntMapF a c
NilF, IntMapF b d
_) -> Ordering
LT
    (TipF {}, IntMapF b d
NilF) -> Ordering
GT
    (TipF Key
key a
a, TipF Key
key' b
a') -> Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key
key Key
key' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
f a
a b
a'
    (TipF {}, BinF {}) -> Ordering
LT
    (BinF Key
prefix Key
mask c
l c
r, BinF Key
prefix' Key
mask' d
l' d
r') ->
      Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key
prefix Key
prefix' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Key
mask Key
mask' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> c -> d -> Ordering
g c
l d
l' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> c -> d -> Ordering
g c
r d
r'
    (BinF {}, IntMapF b d
_) -> Ordering
GT

-- | @since 0.1.2.0
instance (Read a) => Read1 (IntMapF a) where
  liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (IntMapF a a)
liftReadPrec = ReadPrec a
-> ReadPrec [a]
-> ReadPrec a
-> ReadPrec [a]
-> ReadPrec (IntMapF a a)
forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (IntMapF a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
ReadPrec a
-> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (f a b)
liftReadPrec2 ReadPrec a
forall a. Read a => ReadPrec a
readPrec ReadPrec [a]
forall a. Read a => ReadPrec [a]
readListPrec

-- | @since 0.1.2.0
instance Read2 IntMapF where
  liftReadPrec2 :: forall a b.
ReadPrec a
-> ReadPrec [a]
-> ReadPrec b
-> ReadPrec [b]
-> ReadPrec (IntMapF a b)
liftReadPrec2 ReadPrec a
readPrecA ReadPrec [a]
_ ReadPrec b
readPrecR ReadPrec [b]
_ =
    let appPrec :: a
appPrec = a
10
     in ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b))
-> (ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b))
-> ReadPrec (IntMapF a b)
-> ReadPrec (IntMapF a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a. Key -> ReadPrec a -> ReadPrec a
prec Key
forall {a}. Num a => a
appPrec (ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b))
-> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a b. (a -> b) -> a -> b
$
          IntMapF a b
forall a r. IntMapF a r
NilF
            IntMapF a b -> ReadPrec () -> ReadPrec (IntMapF a b)
forall a b. a -> ReadPrec b -> ReadPrec a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Lex.Ident String
"NilF")
            ReadPrec (IntMapF a b)
-> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Lex.Ident String
"TipF")
              ReadPrec () -> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Key -> a -> IntMapF a b
forall a r. Key -> a -> IntMapF a r
TipF (Key -> a -> IntMapF a b)
-> ReadPrec Key -> ReadPrec (a -> IntMapF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Key -> ReadPrec Key
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Key
forall a. Read a => ReadPrec a
readPrec ReadPrec (a -> IntMapF a b) -> ReadPrec a -> ReadPrec (IntMapF a b)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec a -> ReadPrec a
forall a. ReadPrec a -> ReadPrec a
step ReadPrec a
readPrecA)
            ReadPrec (IntMapF a b)
-> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Lexeme -> ReadPrec ()
expectP (String -> Lexeme
Lex.Ident String
"BinF")
              ReadPrec () -> ReadPrec (IntMapF a b) -> ReadPrec (IntMapF a b)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Key -> Key -> b -> b -> IntMapF a b
forall a r. Key -> Key -> r -> r -> IntMapF a r
BinF
                     (Key -> Key -> b -> b -> IntMapF a b)
-> ReadPrec Key -> ReadPrec (Key -> b -> b -> IntMapF a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Key -> ReadPrec Key
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Key
forall a. Read a => ReadPrec a
readPrec
                     ReadPrec (Key -> b -> b -> IntMapF a b)
-> ReadPrec Key -> ReadPrec (b -> b -> IntMapF a b)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec Key -> ReadPrec Key
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Key
forall a. Read a => ReadPrec a
readPrec
                     ReadPrec (b -> b -> IntMapF a b)
-> ReadPrec b -> ReadPrec (b -> IntMapF a b)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec b -> ReadPrec b
forall a. ReadPrec a -> ReadPrec a
step ReadPrec b
readPrecR
                     ReadPrec (b -> IntMapF a b) -> ReadPrec b -> ReadPrec (IntMapF a b)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec b -> ReadPrec b
forall a. ReadPrec a -> ReadPrec a
step ReadPrec b
readPrecR
                 )

#if MIN_VERSION_base(4, 18, 0)
instance (Show a) => Show1 (IntMapF a)
#else
instance (Show a) => Show1 (IntMapF a) where
  liftShowsPrec = liftShowsPrec2 showsPrec showList
#endif

instance Show2 IntMapF where
  liftShowsPrec2 :: forall a b.
(Key -> a -> ShowS)
-> ([a] -> ShowS)
-> (Key -> b -> ShowS)
-> ([b] -> ShowS)
-> Key
-> IntMapF a b
-> ShowS
liftShowsPrec2 Key -> a -> ShowS
showsPrecA [a] -> ShowS
_ Key -> b -> ShowS
showsPrecR [b] -> ShowS
_ Key
p =
    let appPrec :: a
appPrec = a
10
        nextPrec :: a
nextPrec = a
forall {a}. Num a => a
appPrec a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
     in \case
          IntMapF a b
NilF -> String -> ShowS
showString String
"NilF"
          TipF Key
key a
a ->
            Bool -> ShowS -> ShowS
showParen (Key
forall {a}. Num a => a
nextPrec Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
p) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
              String -> ShowS
showString String
"TipF "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Key -> ShowS
forall a. Show a => Key -> a -> ShowS
showsPrec Key
forall {a}. Num a => a
nextPrec Key
key
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> a -> ShowS
showsPrecA Key
forall {a}. Num a => a
nextPrec a
a
          BinF Key
prefix Key
mask b
l b
r ->
            Bool -> ShowS -> ShowS
showParen (Key
forall {a}. Num a => a
nextPrec Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
<= Key
p) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
              String -> ShowS
showString String
"BinF "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Key -> ShowS
forall a. Show a => Key -> a -> ShowS
showsPrec Key
forall {a}. Num a => a
nextPrec Key
prefix
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> Key -> ShowS
forall a. Show a => Key -> a -> ShowS
showsPrec Key
forall {a}. Num a => a
nextPrec Key
mask
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> b -> ShowS
showsPrecR Key
forall {a}. Num a => a
nextPrec b
l
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> ShowS
showString String
" "
                ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Key -> b -> ShowS
showsPrecR Key
forall {a}. Num a => a
nextPrec b
r