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

module Yaya.Containers.Pattern.IntSet
  ( IntSetF (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.Functor.Classes
  ( Eq1 (liftEq),
    Ord1 (liftCompare),
    Read1 (liftReadPrec),
    Show1 (liftShowsPrec),
  )
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 (readPrec), expectP, parens)
import "base" Text.ParserCombinators.ReadPrec (prec, step)
import qualified "base" Text.Read.Lex as Lex
import "base" Text.Show (Show (showsPrec), showParen, showString)
import qualified "containers" Data.IntSet.Internal as IntSet
import "yaya" Yaya.Fold
  ( Projectable (project),
    Recursive (cata),
    Steppable (embed),
  )
import "base" Prelude (Num ((+)))

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

instance Projectable (->) IntSet.IntSet IntSetF where
  project :: Coalgebra (->) IntSetF IntSet
project IntSet
IntSet.Nil = IntSetF IntSet
forall r. IntSetF r
NilF
  project (IntSet.Tip Prefix
prefix BitMap
bm) = Prefix -> BitMap -> IntSetF IntSet
forall r. Prefix -> BitMap -> IntSetF r
TipF Prefix
prefix BitMap
bm
  project (IntSet.Bin Prefix
prefix Prefix
mask IntSet
l IntSet
r) = Prefix -> Prefix -> IntSet -> Coalgebra (->) IntSetF IntSet
forall r. Prefix -> Prefix -> r -> r -> IntSetF r
BinF Prefix
prefix Prefix
mask IntSet
l IntSet
r

instance Recursive (->) IntSet.IntSet IntSetF where
  cata :: forall a. Algebra (->) IntSetF a -> IntSet -> a
cata Algebra (->) IntSetF a
φ = Algebra (->) IntSetF a
φ Algebra (->) IntSetF a -> (IntSet -> IntSetF a) -> IntSet -> 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
. (IntSet -> a) -> IntSetF IntSet -> IntSetF a
forall a b. (a -> b) -> IntSetF a -> IntSetF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Algebra (->) IntSetF a -> IntSet -> a
forall a. Algebra (->) IntSetF a -> IntSet -> 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 (->) IntSetF a
φ) (IntSetF IntSet -> IntSetF a)
-> Coalgebra (->) IntSetF IntSet -> IntSet -> IntSetF 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
. Coalgebra (->) IntSetF IntSet
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project

instance Steppable (->) IntSet.IntSet IntSetF where
  embed :: Algebra (->) IntSetF IntSet
embed IntSetF IntSet
NilF = IntSet
IntSet.Nil
  embed (TipF Prefix
prefix BitMap
bm) = Prefix -> BitMap -> IntSet
IntSet.Tip Prefix
prefix BitMap
bm
  embed (BinF Prefix
prefix Prefix
mask IntSet
l IntSet
r) = Prefix -> Prefix -> IntSet -> IntSet -> IntSet
IntSet.Bin Prefix
prefix Prefix
mask IntSet
l IntSet
r

instance Eq1 IntSetF where
  liftEq :: forall a b. (a -> b -> Bool) -> IntSetF a -> IntSetF b -> Bool
liftEq a -> b -> Bool
f = ((IntSetF a, IntSetF b) -> Bool) -> IntSetF a -> IntSetF b -> Bool
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((IntSetF a, IntSetF b) -> Bool)
 -> IntSetF a -> IntSetF b -> Bool)
-> ((IntSetF a, IntSetF b) -> Bool)
-> IntSetF a
-> IntSetF b
-> Bool
forall a b. (a -> b) -> a -> b
$ \case
    (IntSetF a
NilF, IntSetF b
NilF) -> Bool
True
    (TipF Prefix
prefix BitMap
bm, TipF Prefix
prefix' BitMap
bm') -> Prefix
prefix Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
prefix' Bool -> Bool -> Bool
&& BitMap
bm BitMap -> BitMap -> Bool
forall a. Eq a => a -> a -> Bool
== BitMap
bm'
    (BinF Prefix
prefix Prefix
mask a
l a
r, BinF Prefix
prefix' Prefix
mask' b
l' b
r') ->
      Prefix
prefix Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
prefix' Bool -> Bool -> Bool
&& Prefix
mask Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
== Prefix
mask' Bool -> Bool -> Bool
&& a -> b -> Bool
f a
l b
l' Bool -> Bool -> Bool
&& a -> b -> Bool
f a
r b
r'
    (IntSetF a
_, IntSetF b
_) -> Bool
False

instance Ord1 IntSetF where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> IntSetF a -> IntSetF b -> Ordering
liftCompare a -> b -> Ordering
f = ((IntSetF a, IntSetF b) -> Ordering)
-> IntSetF a -> IntSetF b -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
Tuple.curry (((IntSetF a, IntSetF b) -> Ordering)
 -> IntSetF a -> IntSetF b -> Ordering)
-> ((IntSetF a, IntSetF b) -> Ordering)
-> IntSetF a
-> IntSetF b
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (IntSetF a
NilF, IntSetF b
NilF) -> Ordering
EQ
    (IntSetF a
NilF, IntSetF b
_) -> Ordering
LT
    (TipF {}, IntSetF b
NilF) -> Ordering
GT
    (TipF Prefix
prefix BitMap
bm, TipF Prefix
prefix' BitMap
bm') ->
      Prefix -> Prefix -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Prefix
prefix Prefix
prefix' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> BitMap -> BitMap -> Ordering
forall a. Ord a => a -> a -> Ordering
compare BitMap
bm BitMap
bm'
    (TipF {}, BinF {}) -> Ordering
LT
    (BinF Prefix
prefix Prefix
mask a
l a
r, BinF Prefix
prefix' Prefix
mask' b
l' b
r') ->
      Prefix -> Prefix -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Prefix
prefix Prefix
prefix' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Prefix -> Prefix -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Prefix
mask Prefix
mask' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
f a
l b
l' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> a -> b -> Ordering
f a
r b
r'
    (BinF {}, IntSetF b
_) -> Ordering
GT

-- | @since 0.1.2.0
instance Read1 IntSetF where
  liftReadPrec :: forall a. ReadPrec a -> ReadPrec [a] -> ReadPrec (IntSetF a)
liftReadPrec ReadPrec a
readPrecR ReadPrec [a]
_ =
    let appPrec :: a
appPrec = a
10
     in ReadPrec (IntSetF a) -> ReadPrec (IntSetF a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (IntSetF a) -> ReadPrec (IntSetF a))
-> (ReadPrec (IntSetF a) -> ReadPrec (IntSetF a))
-> ReadPrec (IntSetF a)
-> ReadPrec (IntSetF 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
. Prefix -> ReadPrec (IntSetF a) -> ReadPrec (IntSetF a)
forall a. Prefix -> ReadPrec a -> ReadPrec a
prec Prefix
forall {a}. Num a => a
appPrec (ReadPrec (IntSetF a) -> ReadPrec (IntSetF a))
-> ReadPrec (IntSetF a) -> ReadPrec (IntSetF a)
forall a b. (a -> b) -> a -> b
$
          IntSetF a
forall r. IntSetF r
NilF
            IntSetF a -> ReadPrec () -> ReadPrec (IntSetF a)
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 (IntSetF a)
-> ReadPrec (IntSetF a) -> ReadPrec (IntSetF a)
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 (IntSetF a) -> ReadPrec (IntSetF a)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Prefix -> BitMap -> IntSetF a
forall r. Prefix -> BitMap -> IntSetF r
TipF (Prefix -> BitMap -> IntSetF a)
-> ReadPrec Prefix -> ReadPrec (BitMap -> IntSetF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Prefix -> ReadPrec Prefix
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Prefix
forall a. Read a => ReadPrec a
readPrec ReadPrec (BitMap -> IntSetF a)
-> ReadPrec BitMap -> ReadPrec (IntSetF a)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec BitMap -> ReadPrec BitMap
forall a. ReadPrec a -> ReadPrec a
step ReadPrec BitMap
forall a. Read a => ReadPrec a
readPrec)
            ReadPrec (IntSetF a)
-> ReadPrec (IntSetF a) -> ReadPrec (IntSetF a)
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 (IntSetF a) -> ReadPrec (IntSetF a)
forall a b. ReadPrec a -> ReadPrec b -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( Prefix -> Prefix -> a -> a -> IntSetF a
forall r. Prefix -> Prefix -> r -> r -> IntSetF r
BinF
                     (Prefix -> Prefix -> a -> a -> IntSetF a)
-> ReadPrec Prefix -> ReadPrec (Prefix -> a -> a -> IntSetF a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec Prefix -> ReadPrec Prefix
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Prefix
forall a. Read a => ReadPrec a
readPrec
                     ReadPrec (Prefix -> a -> a -> IntSetF a)
-> ReadPrec Prefix -> ReadPrec (a -> a -> IntSetF a)
forall a b. ReadPrec (a -> b) -> ReadPrec a -> ReadPrec b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec Prefix -> ReadPrec Prefix
forall a. ReadPrec a -> ReadPrec a
step ReadPrec Prefix
forall a. Read a => ReadPrec a
readPrec
                     ReadPrec (a -> a -> IntSetF a)
-> ReadPrec a -> ReadPrec (a -> IntSetF a)
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
readPrecR
                     ReadPrec (a -> IntSetF a) -> ReadPrec a -> ReadPrec (IntSetF a)
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
readPrecR
                 )

instance Show1 IntSetF where
  liftShowsPrec :: forall a.
(Prefix -> a -> ShowS)
-> ([a] -> ShowS) -> Prefix -> IntSetF a -> ShowS
liftShowsPrec Prefix -> a -> ShowS
showsPrecR [a] -> ShowS
_ Prefix
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
          IntSetF a
NilF -> String -> ShowS
showString String
"NilF"
          TipF Prefix
prefix BitMap
bm ->
            Bool -> ShowS -> ShowS
showParen (Prefix
forall {a}. Num a => a
nextPrec Prefix -> Prefix -> Bool
forall a. Ord a => a -> a -> Bool
<= Prefix
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
. Prefix -> Prefix -> ShowS
forall a. Show a => Prefix -> a -> ShowS
showsPrec Prefix
forall {a}. Num a => a
nextPrec Prefix
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
. Prefix -> BitMap -> ShowS
forall a. Show a => Prefix -> a -> ShowS
showsPrec Prefix
forall {a}. Num a => a
nextPrec BitMap
bm
          BinF Prefix
prefix Prefix
mask a
l a
r ->
            Bool -> ShowS -> ShowS
showParen (Prefix
forall {a}. Num a => a
nextPrec Prefix -> Prefix -> Bool
forall a. Ord a => a -> a -> Bool
<= Prefix
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
. Prefix -> Prefix -> ShowS
forall a. Show a => Prefix -> a -> ShowS
showsPrec Prefix
forall {a}. Num a => a
nextPrec Prefix
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
. Prefix -> Prefix -> ShowS
forall a. Show a => Prefix -> a -> ShowS
showsPrec Prefix
forall {a}. Num a => a
nextPrec Prefix
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
. Prefix -> a -> ShowS
showsPrecR Prefix
forall {a}. Num a => a
nextPrec a
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
. Prefix -> a -> ShowS
showsPrecR Prefix
forall {a}. Num a => a
nextPrec a
r