{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK not-home #-}

-- |
-- Module      : Data.Set.NonEmpty.Internal
-- Copyright   : (c) Justin Le 2018
-- License     : BSD3
--
-- Maintainer  : [email protected]
-- Stability   : experimental
-- Portability : non-portable
--
-- Unsafe internal-use functions used in the implementation of
-- "Data.Set.NonEmpty".  These functions can potentially be used to break
-- the abstraction of 'NESet' and produce unsound sets, so be wary!
module Data.Set.NonEmpty.Internal (
  NESet (..),
  nonEmptySet,
  withNonEmpty,
  toSet,
  singleton,
  fromList,
  toList,
  size,
  union,
  unions,
  foldr,
  foldl,
  foldr',
  foldl',
  MergeNESet (..),
  merge,
  valid,
  insertMinSet,
  insertMaxSet,
) where

import Control.DeepSeq
import Control.Monad
import qualified Data.Aeson as A
import Data.Data
import qualified Data.Foldable as F
import Data.Function
import Data.Functor.Classes
import Data.List.NonEmpty (NonEmpty (..))
import Data.Semigroup
import Data.Semigroup.Foldable (Foldable1)
import qualified Data.Semigroup.Foldable as F1
import qualified Data.Set as S
import Data.Set.Internal (Set (..))
import qualified Data.Set.Internal as S
import Text.Read
import Prelude hiding (Foldable (..))

-- | A non-empty (by construction) set of values @a@.  At least one value
-- exists in an @'NESet' a@ at all times.
--
-- Functions that /take/ an 'NESet' can safely operate on it with the
-- assumption that it has at least one item.
--
-- Functions that /return/ an 'NESet' provide an assurance that the result
-- has at least one item.
--
-- "Data.Set.NonEmpty" re-exports the API of "Data.Set", faithfully
-- reproducing asymptotics, typeclass constraints, and semantics.
-- Functions that ensure that input and output sets are both non-empty
-- (like 'Data.Set.NonEmpty.insert') return 'NESet', but functions that
-- might potentially return an empty map (like 'Data.Set.NonEmpty.delete')
-- return a 'Set' instead.
--
-- You can directly construct an 'NESet' with the API from
-- "Data.Set.NonEmpty"; it's more or less the same as constructing a normal
-- 'Set', except you don't have access to 'Data.Set.empty'.  There are also
-- a few ways to construct an 'NESet' from a 'Set':
--
-- 1.  The 'nonEmptySet' smart constructor will convert a @'Set' a@ into
--     a @'Maybe' ('NESet' a)@, returning 'Nothing' if the original 'Set'
--     was empty.
-- 2.  You can use the 'Data.Set.NonEmpty.insertSet' family of functions to
--     insert a value into a 'Set' to create a guaranteed 'NESet'.
-- 3.  You can use the 'Data.Set.NonEmpty.IsNonEmpty' and
--     'Data.Set.NonEmpty.IsEmpty' patterns to "pattern match" on a 'Set'
--     to reveal it as either containing a 'NESet' or an empty map.
-- 4.  'withNonEmpty' offers a continuation-based interface for
--     deconstructing a 'Set' and treating it as if it were an 'NESet'.
--
-- You can convert an 'NESet' into a 'Set' with 'toSet' or
-- 'Data.Set.NonEmpty.IsNonEmpty', essentially "obscuring" the non-empty
-- property from the type.
data NESet a
  = NESet
  { forall a. NESet a -> a
nesV0 :: !a
  -- ^ invariant: must be smaller than smallest value in set
  , forall a. NESet a -> Set a
nesSet :: !(Set a)
  }
  deriving (Typeable)

instance Eq a => Eq (NESet a) where
  NESet a
t1 == :: NESet a -> NESet a -> Bool
== NESet a
t2 =
    Set a -> Int
forall a. Set a -> Int
S.size (NESet a -> Set a
forall a. NESet a -> Set a
nesSet NESet a
t1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Int
forall a. Set a -> Int
S.size (NESet a -> Set a
forall a. NESet a -> Set a
nesSet NESet a
t2)
      Bool -> Bool -> Bool
&& NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
t1 NonEmpty a -> NonEmpty a -> Bool
forall a. Eq a => a -> a -> Bool
== NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
t2

instance Ord a => Ord (NESet a) where
  compare :: NESet a -> NESet a -> Ordering
compare = NonEmpty a -> NonEmpty a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NonEmpty a -> NonEmpty a -> Ordering)
-> (NESet a -> NonEmpty a) -> NESet a -> NESet a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
  < :: NESet a -> NESet a -> Bool
(<) = NonEmpty a -> NonEmpty a -> Bool
forall a. Ord a => a -> a -> Bool
(<) (NonEmpty a -> NonEmpty a -> Bool)
-> (NESet a -> NonEmpty a) -> NESet a -> NESet a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
  > :: NESet a -> NESet a -> Bool
(>) = NonEmpty a -> NonEmpty a -> Bool
forall a. Ord a => a -> a -> Bool
(>) (NonEmpty a -> NonEmpty a -> Bool)
-> (NESet a -> NonEmpty a) -> NESet a -> NESet a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
  <= :: NESet a -> NESet a -> Bool
(<=) = NonEmpty a -> NonEmpty a -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (NonEmpty a -> NonEmpty a -> Bool)
-> (NESet a -> NonEmpty a) -> NESet a -> NESet a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
  >= :: NESet a -> NESet a -> Bool
(>=) = NonEmpty a -> NonEmpty a -> Bool
forall a. Ord a => a -> a -> Bool
(>=) (NonEmpty a -> NonEmpty a -> Bool)
-> (NESet a -> NonEmpty a) -> NESet a -> NESet a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList

instance Show a => Show (NESet a) where
  showsPrec :: Int -> NESet a -> ShowS
showsPrec Int
p NESet a
xs =
    Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"fromList (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> ShowS
forall a. Show a => a -> ShowS
shows (NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
xs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")"

instance (Read a, Ord a) => Read (NESet a) where
  readPrec :: ReadPrec (NESet a)
readPrec = ReadPrec (NESet a) -> ReadPrec (NESet a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NESet a) -> ReadPrec (NESet a))
-> ReadPrec (NESet a) -> ReadPrec (NESet a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (NESet a) -> ReadPrec (NESet a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (NESet a) -> ReadPrec (NESet a))
-> ReadPrec (NESet a) -> ReadPrec (NESet a)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"fromList" <- ReadPrec Lexeme
lexP
    NonEmpty a
xs <- ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a))
-> (ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a))
-> ReadPrec (NonEmpty a)
-> ReadPrec (NonEmpty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a))
-> ReadPrec (NonEmpty a) -> ReadPrec (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ ReadPrec (NonEmpty a)
forall a. Read a => ReadPrec a
readPrec
    NESet a -> ReadPrec (NESet a)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty a -> NESet a
forall a. Ord a => NonEmpty a -> NESet a
fromList NonEmpty a
xs)

  readListPrec :: ReadPrec [NESet a]
readListPrec = ReadPrec [NESet a]
forall a. Read a => ReadPrec [a]
readListPrecDefault

instance Eq1 NESet where
  liftEq :: forall a b. (a -> b -> Bool) -> NESet a -> NESet b -> Bool
liftEq a -> b -> Bool
eq NESet a
m NESet b
n =
    NESet a -> Int
forall a. NESet a -> Int
size NESet a
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NESet b -> Int
forall a. NESet a -> Int
size NESet b
n Bool -> Bool -> Bool
&& (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall a b. (a -> b -> Bool) -> NonEmpty a -> NonEmpty b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
m) (NESet b -> NonEmpty b
forall a. NESet a -> NonEmpty a
toList NESet b
n)

instance Ord1 NESet where
  liftCompare :: forall a b. (a -> b -> Ordering) -> NESet a -> NESet b -> Ordering
liftCompare a -> b -> Ordering
cmp NESet a
m NESet b
n =
    (a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall a b.
(a -> b -> Ordering) -> NonEmpty a -> NonEmpty b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
m) (NESet b -> NonEmpty b
forall a. NESet a -> NonEmpty a
toList NESet b
n)

instance Show1 NESet where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NESet a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d NESet a
m =
    (Int -> NonEmpty a -> ShowS)
-> String -> Int -> NonEmpty a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> NonEmpty a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"fromList" Int
d (NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
m)

instance NFData a => NFData (NESet a) where
  rnf :: NESet a -> ()
rnf (NESet a
x Set a
s) = a -> ()
forall a. NFData a => a -> ()
rnf a
x () -> () -> ()
forall a b. a -> b -> b
`seq` Set a -> ()
forall a. NFData a => a -> ()
rnf Set a
s

-- Data instance code from Data.Set.Internal
--
-- Copyright   :  (c) Daan Leijen 2002
#if MIN_VERSION_base(4,16,0)
instance (Data a, Ord a) => Data (NESet a) where
  gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NESet a -> c (NESet a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z NESet a
set = (NonEmpty a -> NESet a) -> c (NonEmpty a -> NESet a)
forall g. g -> c g
z NonEmpty a -> NESet a
forall a. Ord a => NonEmpty a -> NESet a
fromList c (NonEmpty a -> NESet a) -> NonEmpty a -> c (NESet a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList NESet a
set
  toConstr :: NESet a -> Constr
toConstr NESet a
_ = Constr
fromListConstr
  gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (NESet a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c (NonEmpty a -> NESet a) -> c (NESet a)
forall b r. Data b => c (b -> r) -> c r
k ((NonEmpty a -> NESet a) -> c (NonEmpty a -> NESet a)
forall r. r -> c r
z NonEmpty a -> NESet a
forall a. Ord a => NonEmpty a -> NESet a
fromList)
    Int
_ -> String -> c (NESet a)
forall a. HasCallStack => String -> a
error String
"gunfold"
  dataTypeOf :: NESet a -> DataType
dataTypeOf NESet a
_ = DataType
setDataType
  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (NESet a))
dataCast1 = c (t a) -> Maybe (c (NESet a))
(forall d. Data d => c (t d)) -> Maybe (c (NESet a))
forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1
#else
#ifndef __HLINT__
instance (Data a, Ord a) => Data (NESet a) where
  gfoldl f z set = z fromList `f` toList set
  toConstr _ = fromListConstr
  gunfold k z c = case constrIndex c of
    1 -> k (z fromList)
    _ -> error "gunfold"
  dataTypeOf _ = setDataType
  dataCast1 f = gcast1 f
#endif
#endif

fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
setDataType String
"fromList" [] Fixity
Prefix

setDataType :: DataType
setDataType :: DataType
setDataType = String -> [Constr] -> DataType
mkDataType String
"Data.Set.NonEmpty.Internal.NESet" [Constr
fromListConstr]

instance A.ToJSON a => A.ToJSON (NESet a) where
  toJSON :: NESet a -> Value
toJSON = Set a -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Set a -> Value) -> (NESet a -> Set a) -> NESet a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet a -> Set a
forall a. NESet a -> Set a
toSet
  toEncoding :: NESet a -> Encoding
toEncoding = Set a -> Encoding
forall a. ToJSON a => a -> Encoding
A.toEncoding (Set a -> Encoding) -> (NESet a -> Set a) -> NESet a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet a -> Set a
forall a. NESet a -> Set a
toSet

instance (A.FromJSON a, Ord a) => A.FromJSON (NESet a) where
  parseJSON :: Value -> Parser (NESet a)
parseJSON =
    Parser (NESet a)
-> (NESet a -> Parser (NESet a)) -> Set a -> Parser (NESet a)
forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty (String -> Parser (NESet a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) NESet a -> Parser (NESet a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Set a -> Parser (NESet a))
-> (Value -> Parser (Set a)) -> Value -> Parser (NESet a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Value -> Parser (Set a)
forall a. FromJSON a => Value -> Parser a
A.parseJSON
    where
      err :: String
err = String
"NESet: Non-empty set expected, but empty set found"

-- | /O(log n)/. Smart constructor for an 'NESet' from a 'Set'.  Returns
-- 'Nothing' if the 'Set' was originally actually empty, and @'Just' n@
-- with an 'NESet', if the 'Set' was not empty.
--
-- 'nonEmptySet' and @'maybe' 'Data.Set.empty' 'toSet'@ form an
-- isomorphism: they are perfect structure-preserving inverses of
-- eachother.
--
-- See 'Data.Set.NonEmpty.IsNonEmpty' for a pattern synonym that lets you
-- "match on" the possiblity of a 'Set' being an 'NESet'.
--
-- > nonEmptySet (Data.Set.fromList [3,5]) == Just (fromList (3:|[5]))
nonEmptySet :: Set a -> Maybe (NESet a)
nonEmptySet :: forall a. Set a -> Maybe (NESet a)
nonEmptySet = (((a, Set a) -> NESet a) -> Maybe (a, Set a) -> Maybe (NESet a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, Set a) -> NESet a) -> Maybe (a, Set a) -> Maybe (NESet a))
-> ((a -> Set a -> NESet a) -> (a, Set a) -> NESet a)
-> (a -> Set a -> NESet a)
-> Maybe (a, Set a)
-> Maybe (NESet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> NESet a) -> (a, Set a) -> NESet a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet (Maybe (a, Set a) -> Maybe (NESet a))
-> (Set a -> Maybe (a, Set a)) -> Set a -> Maybe (NESet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.minView
{-# INLINE nonEmptySet #-}

-- | /O(log n)/. A general continuation-based way to consume a 'Set' as if
-- it were an 'NESet'. @'withNonEmpty' def f@ will take a 'Set'.  If set is
-- empty, it will evaluate to @def@.  Otherwise, a non-empty set 'NESet'
-- will be fed to the function @f@ instead.
--
-- @'nonEmptySet' == 'withNonEmpty' 'Nothing' 'Just'@
withNonEmpty ::
  -- | value to return if set is empty
  r ->
  -- | function to apply if set is not empty
  (NESet a -> r) ->
  Set a ->
  r
withNonEmpty :: forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty r
def NESet a -> r
f = r -> (NESet a -> r) -> Maybe (NESet a) -> r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NESet a -> r
f (Maybe (NESet a) -> r) -> (Set a -> Maybe (NESet a)) -> Set a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Maybe (NESet a)
forall a. Set a -> Maybe (NESet a)
nonEmptySet
{-# INLINE withNonEmpty #-}

-- | /O(log n)/.
-- Convert a non-empty set back into a normal possibly-empty map, for usage
-- with functions that expect 'Set'.
--
-- Can be thought of as "obscuring" the non-emptiness of the set in its
-- type.  See the 'Data.Set.NonEmpty.IsNotEmpty' pattern.
--
-- 'nonEmptySet' and @'maybe' 'Data.Set.empty' 'toSet'@ form an
-- isomorphism: they are perfect structure-preserving inverses of
-- eachother.
--
-- > toSet (fromList ((3,"a") :| [(5,"b")])) == Data.Set.fromList [(3,"a"), (5,"b")]
toSet :: NESet a -> Set a
toSet :: forall a. NESet a -> Set a
toSet (NESet a
x Set a
s) = a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMinSet a
x Set a
s
{-# INLINE toSet #-}

-- | /O(1)/. Create a singleton set.
singleton :: a -> NESet a
singleton :: forall a. a -> NESet a
singleton a
x = a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet a
x Set a
forall a. Set a
S.empty
{-# INLINE singleton #-}

-- | /O(n*log n)/. Create a set from a list of elements.

-- TODO: write manually and optimize to be equivalent to
-- 'fromDistinctAscList' if items are ordered, just like the actual
-- 'S.fromList'.
fromList :: Ord a => NonEmpty a -> NESet a
fromList :: forall a. Ord a => NonEmpty a -> NESet a
fromList (a
x :| [a]
s) =
  NESet a -> (NESet a -> NESet a) -> Set a -> NESet a
forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty (a -> NESet a
forall a. a -> NESet a
singleton a
x) (NESet a -> NESet a -> NESet a
forall a. Semigroup a => a -> a -> a
<> a -> NESet a
forall a. a -> NESet a
singleton a
x)
    (Set a -> NESet a) -> ([a] -> Set a) -> [a] -> NESet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList
    ([a] -> NESet a) -> [a] -> NESet a
forall a b. (a -> b) -> a -> b
$ [a]
s
{-# INLINE fromList #-}

-- | /O(n)/. Convert the set to a non-empty list of elements.
toList :: NESet a -> NonEmpty a
toList :: forall a. NESet a -> NonEmpty a
toList (NESet a
x Set a
s) = a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
s
{-# INLINE toList #-}

-- | /O(1)/. The number of elements in the set.  Guaranteed to be greater
-- than zero.
size :: NESet a -> Int
size :: forall a. NESet a -> Int
size (NESet a
_ Set a
s) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
s
{-# INLINE size #-}

-- | /O(n)/. Fold the elements in the set using the given right-associative
-- binary operator, such that @'foldr' f z == 'Prelude.foldr' f z . 'Data.Set.NonEmpty.toAscList'@.
--
-- For example,
--
-- > elemsList set = foldr (:) [] set
foldr :: (a -> b -> b) -> b -> NESet a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr a -> b -> b
f b
z (NESet a
x Set a
s) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr a -> b -> b
f b
z Set a
s
{-# INLINE foldr #-}

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldr' :: (a -> b -> b) -> b -> NESet a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr' a -> b -> b
f b
z (NESet a
x Set a
s) = a
x a -> b -> b
`f` b
y
  where
    !y :: b
y = (a -> b -> b) -> b -> Set a -> b
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr' a -> b -> b
f b
z Set a
s
{-# INLINE foldr' #-}

-- | /O(n)/. A version of 'foldr' that uses the value at the maximal value
-- in the set as the starting value.
--
-- Note that, unlike 'Data.Foldable.foldr1' for 'Set', this function is
-- total if the input function is total.
foldr1 :: (a -> a -> a) -> NESet a -> a
foldr1 :: forall a. (a -> a -> a) -> NESet a -> a
foldr1 a -> a -> a
f (NESet a
x Set a
s) =
  a -> ((a, Set a) -> a) -> Maybe (a, Set a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a -> a -> a
f a
x (a -> a) -> ((a, Set a) -> a) -> (a, Set a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Set a -> a) -> (a, Set a) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> a -> Set a -> a
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr a -> a -> a
f))
    (Maybe (a, Set a) -> a)
-> (Set a -> Maybe (a, Set a)) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.maxView
    (Set a -> a) -> Set a -> a
forall a b. (a -> b) -> a -> b
$ Set a
s
{-# INLINE foldr1 #-}

-- | /O(n)/. Fold the elements in the set using the given left-associative
-- binary operator, such that @'foldl' f z == 'Prelude.foldl' f z . 'Data.Set.NonEmpty.toAscList'@.
--
-- For example,
--
-- > descElemsList set = foldl (flip (:)) [] set
foldl :: (a -> b -> a) -> a -> NESet b -> a
foldl :: forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl a -> b -> a
f a
z (NESet b
x Set b
s) = (a -> b -> a) -> a -> Set b -> a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl a -> b -> a
f (a -> b -> a
f a
z b
x) Set b
s
{-# INLINE foldl #-}

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
-- evaluated before using the result in the next application. This
-- function is strict in the starting value.
foldl' :: (a -> b -> a) -> a -> NESet b -> a
foldl' :: forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl' a -> b -> a
f a
z (NESet b
x Set b
s) = (a -> b -> a) -> a -> Set b -> a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl' a -> b -> a
f a
y Set b
s
  where
    !y :: a
y = a -> b -> a
f a
z b
x
{-# INLINE foldl' #-}

-- | /O(n)/. A version of 'foldl' that uses the value at the minimal value
-- in the set as the starting value.
--
-- Note that, unlike 'Data.Foldable.foldl1' for 'Set', this function is
-- total if the input function is total.
foldl1 :: (a -> a -> a) -> NESet a -> a
foldl1 :: forall a. (a -> a -> a) -> NESet a -> a
foldl1 a -> a -> a
f (NESet a
x Set a
s) = (a -> a -> a) -> a -> Set a -> a
forall a b. (a -> b -> a) -> a -> Set b -> a
S.foldl a -> a -> a
f a
x Set a
s
{-# INLINE foldl1 #-}

-- | /O(m*log(n\/m + 1)), m <= n/. The union of two sets, preferring the first set when
-- equal elements are encountered.
union ::
  Ord a =>
  NESet a ->
  NESet a ->
  NESet a
union :: forall a. Ord a => NESet a -> NESet a -> NESet a
union n1 :: NESet a
n1@(NESet a
x1 Set a
s1) n2 :: NESet a
n2@(NESet a
x2 Set a
s2) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x1 a
x2 of
  Ordering
LT -> a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet a
x1 (Set a -> NESet a) -> (NESet a -> Set a) -> NESet a -> NESet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1 (Set a -> Set a) -> (NESet a -> Set a) -> NESet a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet a -> Set a
forall a. NESet a -> Set a
toSet (NESet a -> NESet a) -> NESet a -> NESet a
forall a b. (a -> b) -> a -> b
$ NESet a
n2
  Ordering
EQ -> a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet a
x1 (Set a -> NESet a) -> (Set a -> Set a) -> Set a -> NESet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1 (Set a -> NESet a) -> Set a -> NESet a
forall a b. (a -> b) -> a -> b
$ Set a
s2
  Ordering
GT -> a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet a
x2 (Set a -> NESet a) -> (Set a -> Set a) -> Set a -> NESet a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union (NESet a -> Set a
forall a. NESet a -> Set a
toSet NESet a
n1) (Set a -> NESet a) -> Set a -> NESet a
forall a b. (a -> b) -> a -> b
$ Set a
s2
{-# INLINE union #-}

-- | The union of a non-empty list of sets
unions ::
  (Foldable1 f, Ord a) =>
  f (NESet a) ->
  NESet a
unions :: forall (f :: * -> *) a.
(Foldable1 f, Ord a) =>
f (NESet a) -> NESet a
unions (f (NESet a) -> NonEmpty (NESet a)
forall a. f a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty -> (NESet a
s :| [NESet a]
ss)) = (NESet a -> NESet a -> NESet a) -> NESet a -> [NESet a] -> NESet a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' NESet a -> NESet a -> NESet a
forall a. Ord a => NESet a -> NESet a -> NESet a
union NESet a
s [NESet a]
ss
{-# INLINE unions #-}

-- | Left-biased union
instance Ord a => Semigroup (NESet a) where
  <> :: NESet a -> NESet a -> NESet a
(<>) = NESet a -> NESet a -> NESet a
forall a. Ord a => NESet a -> NESet a -> NESet a
union
  {-# INLINE (<>) #-}
  sconcat :: NonEmpty (NESet a) -> NESet a
sconcat = NonEmpty (NESet a) -> NESet a
forall (f :: * -> *) a.
(Foldable1 f, Ord a) =>
f (NESet a) -> NESet a
unions
  {-# INLINE sconcat #-}

-- | Traverses elements in ascending order
--
-- 'Data.Foldable.foldr1', 'Data.Foldable.foldl1', 'Data.Foldable.minimum',
-- 'Data.Foldable.maximum' are all total.
#if MIN_VERSION_base(4,11,0)
instance F.Foldable NESet where
    fold :: forall m. Monoid m => NESet m -> m
fold      (NESet m
x Set m
s) = m
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Set m -> m
forall m. Monoid m => Set m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold Set m
s
    {-# INLINE fold #-}
    foldMap :: forall m a. Monoid m => (a -> m) -> NESet a -> m
foldMap a -> m
f (NESet a
x Set a
s) = a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Set a -> m
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f Set a
s
    {-# INLINE foldMap #-}
    foldr :: forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr = (a -> b -> b) -> b -> NESet a -> b
forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr
    {-# INLINE foldr #-}
    foldr' :: forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr' = (a -> b -> b) -> b -> NESet a -> b
forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr'
    {-# INLINE foldr' #-}
    foldr1 :: forall a. (a -> a -> a) -> NESet a -> a
foldr1 = (a -> a -> a) -> NESet a -> a
forall a. (a -> a -> a) -> NESet a -> a
foldr1
    {-# INLINE foldr1 #-}
    foldl :: forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl = (b -> a -> b) -> b -> NESet a -> b
forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl
    {-# INLINE foldl #-}
    foldl' :: forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl' = (b -> a -> b) -> b -> NESet a -> b
forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl'
    {-# INLINE foldl' #-}
    foldl1 :: forall a. (a -> a -> a) -> NESet a -> a
foldl1 = (a -> a -> a) -> NESet a -> a
forall a. (a -> a -> a) -> NESet a -> a
foldl1
    {-# INLINE foldl1 #-}
    null :: forall a. NESet a -> Bool
null NESet a
_ = Bool
False
    {-# INLINE null #-}
    length :: forall a. NESet a -> Int
length = NESet a -> Int
forall a. NESet a -> Int
size
    {-# INLINE length #-}
    elem :: forall a. Eq a => a -> NESet a -> Bool
elem a
x (NESet a
x0 Set a
s) =
      a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
F.elem a
x Set a
s
        Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x0
    {-# INLINE elem #-}
    minimum :: forall a. Ord a => NESet a -> a
minimum (NESet a
x Set a
_) = a
x
    {-# INLINE minimum #-}
    maximum :: forall a. Ord a => NESet a -> a
maximum (NESet a
x Set a
s) = a -> ((a, Set a) -> a) -> Maybe (a, Set a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a, Set a) -> a
forall a b. (a, b) -> a
fst (Maybe (a, Set a) -> a)
-> (Set a -> Maybe (a, Set a)) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.maxView (Set a -> a) -> Set a -> a
forall a b. (a -> b) -> a -> b
$ Set a
s
    {-# INLINE maximum #-}

    -- TODO: use build
    toList :: forall a. NESet a -> [a]
toList = NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (NonEmpty a -> [a]) -> (NESet a -> NonEmpty a) -> NESet a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
    {-# INLINE toList #-}
#else
instance F.Foldable NESet where
    fold      (NESet x s) = x `mappend` F.fold s
    {-# INLINE fold #-}
    foldMap f (NESet x s) = f x `mappend` F.foldMap f s
    {-# INLINE foldMap #-}
    foldr = foldr
    {-# INLINE foldr #-}
    foldr' = foldr'
    {-# INLINE foldr' #-}
    foldr1 = foldr1
    {-# INLINE foldr1 #-}
    foldl = foldl
    {-# INLINE foldl #-}
    foldl' = foldl'
    {-# INLINE foldl' #-}
    foldl1 = foldl1
    {-# INLINE foldl1 #-}
    null _ = False
    {-# INLINE null #-}
    length = size
    {-# INLINE length #-}
    elem x (NESet x0 s) =
      F.elem x s
        || x == x0
    {-# INLINE elem #-}
    minimum (NESet x _) = x
    {-# INLINE minimum #-}
    maximum (NESet x s) = maybe x fst . S.maxView $ s
    {-# INLINE maximum #-}

    -- TODO: use build
    toList = F.toList . toList
    {-# INLINE toList #-}
#endif

-- | Traverses elements in ascending order
#if MIN_VERSION_base(4,11,0)
instance Foldable1 NESet where
    fold1 :: forall m. Semigroup m => NESet m -> m
fold1 (NESet m
x Set m
s) = m -> (m -> m) -> Maybe m -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m
x (m
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<>)
                      (Maybe m -> m) -> (Set m -> Maybe m) -> Set m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m -> Maybe m) -> Set m -> Maybe m
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap m -> Maybe m
forall a. a -> Maybe a
Just
                      (Set m -> m) -> Set m -> m
forall a b. (a -> b) -> a -> b
$ Set m
s
    {-# INLINE fold1 #-}
    -- TODO: benchmark against maxView-based method
    foldMap1 :: forall m a. Semigroup m => (a -> m) -> NESet a -> m
foldMap1 a -> m
f (NESet a
x Set a
s) = m -> (m -> m) -> Maybe m -> m
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> m
f a
x) (a -> m
f a
x m -> m -> m
forall a. Semigroup a => a -> a -> a
<>)
                           (Maybe m -> m) -> (Set a -> Maybe m) -> Set a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe m) -> Set a -> Maybe m
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (m -> Maybe m
forall a. a -> Maybe a
Just (m -> Maybe m) -> (a -> m) -> a -> Maybe m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m
f)
                           (Set a -> m) -> Set a -> m
forall a b. (a -> b) -> a -> b
$ Set a
s
    {-# INLINE foldMap1 #-}
    toNonEmpty :: forall a. NESet a -> NonEmpty a
toNonEmpty = NESet a -> NonEmpty a
forall a. NESet a -> NonEmpty a
toList
    {-# INLINE toNonEmpty #-}
#else
instance Foldable1 NESet where
    fold1 (NESet x s) = option x (x <>)
                      . F.foldMap (Option . Just)
                      $ s
    {-# INLINE fold1 #-}
    -- TODO: benchmark against maxView-based method
    foldMap1 f (NESet x s) = option (f x) (f x <>)
                           . F.foldMap (Option . Just . f)
                           $ s
    {-# INLINE foldMap1 #-}
    toNonEmpty = toList
    {-# INLINE toNonEmpty #-}
#endif

-- | Used for 'Data.Set.NonEmpty.cartesianProduct'
newtype MergeNESet a = MergeNESet {forall a. MergeNESet a -> NESet a
getMergeNESet :: NESet a}

instance Semigroup (MergeNESet a) where
  MergeNESet NESet a
n1 <> :: MergeNESet a -> MergeNESet a -> MergeNESet a
<> MergeNESet NESet a
n2 = NESet a -> MergeNESet a
forall a. NESet a -> MergeNESet a
MergeNESet (NESet a -> NESet a -> NESet a
forall a. NESet a -> NESet a -> NESet a
merge NESet a
n1 NESet a
n2)
  {-# INLINE (<>) #-}

-- | Unsafely merge two disjoint sets.  Only legal if all items in the
-- first set are less than all items in the second set
merge :: NESet a -> NESet a -> NESet a
merge :: forall a. NESet a -> NESet a -> NESet a
merge (NESet a
x1 Set a
s1) NESet a
n2 = a -> Set a -> NESet a
forall a. a -> Set a -> NESet a
NESet a
x1 (Set a -> NESet a) -> Set a -> NESet a
forall a b. (a -> b) -> a -> b
$ Set a
s1 Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
`S.merge` NESet a -> Set a
forall a. NESet a -> Set a
toSet NESet a
n2

-- | /O(n)/. Test if the internal set structure is valid.
valid :: Ord a => NESet a -> Bool
valid :: forall a. Ord a => NESet a -> Bool
valid (NESet a
x Set a
s) =
  Set a -> Bool
forall a. Ord a => Set a -> Bool
S.valid Set a
s
    Bool -> Bool -> Bool
&& ((a, Set a) -> Bool) -> Maybe (a, Set a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<) (a -> Bool) -> ((a, Set a) -> a) -> (a, Set a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Set a) -> a
forall a b. (a, b) -> a
fst) (Set a -> Maybe (a, Set a)
forall a. Set a -> Maybe (a, Set a)
S.minView Set a
s)

-- | /O(log n)/. Insert new value into a set where values are
-- /strictly greater than/ the new values  That is, the new value must be
-- /strictly less than/ all values present in the 'Set'.  /The precondition
-- is not checked./
--
-- While this has the same asymptotics as @Data.Set.insert@, it saves
-- a constant factor for value comparison (so may be helpful if comparison
-- is expensive) and also does not require an 'Ord' instance for the value
-- type.
insertMinSet :: a -> Set a -> Set a
insertMinSet :: forall a. a -> Set a -> Set a
insertMinSet a
x = \case
  Set a
Tip -> a -> Set a
forall a. a -> Set a
S.singleton a
x
  Bin Int
_ a
y Set a
l Set a
r -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceL a
y (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMinSet a
x Set a
l) Set a
r
{-# INLINEABLE insertMinSet #-}

-- | /O(log n)/. Insert new value into a set where values are /strictly
-- less than/ the new value.  That is, the new value must be /strictly
-- greater than/ all values present in the 'Set'.  /The precondition is not
-- checked./
--
-- While this has the same asymptotics as @Data.Set.insert@, it saves
-- a constant factor for value comparison (so may be helpful if comparison
-- is expensive) and also does not require an 'Ord' instance for the value
-- type.
insertMaxSet :: a -> Set a -> Set a
insertMaxSet :: forall a. a -> Set a -> Set a
insertMaxSet a
x = \case
  Set a
Tip -> a -> Set a
forall a. a -> Set a
S.singleton a
x
  Bin Int
_ a
y Set a
l Set a
r -> a -> Set a -> Set a -> Set a
forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insertMaxSet a
x Set a
r)
{-# INLINEABLE insertMaxSet #-}

-- ------------------------------------------

-- | Unexported code from "Data.Set.Internal"
-- ------------------------------------------
balanceR :: a -> Set a -> Set a -> Set a
balanceR :: forall a. a -> Set a -> Set a -> Set a
balanceR a
x Set a
l Set a
r = case Set a
l of
  Set a
Tip -> case Set a
r of
    Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
    Bin Int
_ a
_ Set a
Tip Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
forall a. Set a
Tip Set a
r
    Bin Int
_ a
rx Set a
Tip rr :: Set a
rr@Bin{} -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) Set a
rr
    Bin Int
_ a
rx (Bin Int
_ a
rlx Set a
_ Set a
_) Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
rx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
    Bin Int
rs a
rx rl :: Set a
rl@(Bin Int
rls a
rlx Set a
rll Set a
rlr) rr :: Set a
rr@(Bin Int
rrs a
_ Set a
_ Set a
_)
      | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rls) a
x Set a
forall a. Set a
Tip Set a
rl) Set a
rr
      | Bool
otherwise ->
          Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
rll) a
x Set a
forall a. Set a
Tip Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
rlr) a
rx Set a
rlr Set a
rr)
  Bin Int
ls a
_ Set a
_ Set a
_ -> case Set a
r of
    Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls) a
x Set a
l Set a
forall a. Set a
Tip
    Bin Int
rs a
rx Set a
rl Set a
rr
      | Int
rs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ls -> case (Set a
rl, Set a
rr) of
          (Bin Int
rls a
rlx Set a
rll Set a
rlr, Bin Int
rrs a
_ Set a
_ Set a
_)
            | Int
rls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rrs -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
rx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rls) a
x Set a
l Set a
rl) Set a
rr
            | Bool
otherwise ->
                Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
rlx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
rll) a
x Set a
l Set a
rll) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rrs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
rlr) a
rx Set a
rlr Set a
rr)
          (Set a
_, Set a
_) -> String -> Set a
forall a. HasCallStack => String -> a
error String
"Failure in Data.Map.balanceR"
      | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
x Set a
l Set a
r
{-# NOINLINE balanceR #-}

balanceL :: a -> Set a -> Set a -> Set a
balanceL :: forall a. a -> Set a -> Set a -> Set a
balanceL a
x Set a
l Set a
r = case Set a
r of
  Set a
Tip -> case Set a
l of
    Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip
    Bin Int
_ a
_ Set a
Tip Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
l Set a
forall a. Set a
Tip
    Bin Int
_ a
lx Set a
Tip (Bin Int
_ a
lrx Set a
_ Set a
_) -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
lx Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
    Bin Int
_ a
lx ll :: Set a
ll@Bin{} Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x Set a
forall a. Set a
Tip Set a
forall a. Set a
Tip)
    Bin Int
ls a
lx ll :: Set a
ll@(Bin Int
lls a
_ Set a
_ Set a
_) lr :: Set a
lr@(Bin Int
lrs a
lrx Set a
lrl Set a
lrr)
      | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lrs) a
x Set a
lr Set a
forall a. Set a
Tip)
      | Bool
otherwise ->
          Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
lrr) a
x Set a
lrr Set a
forall a. Set a
Tip)
  Bin Int
rs a
_ Set a
_ Set a
_ -> case Set a
l of
    Set a
Tip -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
x Set a
forall a. Set a
Tip Set a
r
    Bin Int
ls a
lx Set a
ll Set a
lr
      | Int
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
delta Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rs -> case (Set a
ll, Set a
lr) of
          (Bin Int
lls a
_ Set a
_ Set a
_, Bin Int
lrs a
lrx Set a
lrl Set a
lrr)
            | Int
lrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ratio Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
lls -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
lx Set a
ll (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lrs) a
x Set a
lr Set a
r)
            | Bool
otherwise ->
                Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
lrx (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
lrl) a
lx Set a
ll Set a
lrl) (Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set a -> Int
forall a. Set a -> Int
S.size Set a
lrr) a
x Set a
lrr Set a
r)
          (Set a
_, Set a
_) -> String -> Set a
forall a. HasCallStack => String -> a
error String
"Failure in Data.Set.NonEmpty.Internal.balanceL"
      | Bool
otherwise -> Int -> a -> Set a -> Set a -> Set a
forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rs) a
x Set a
l Set a
r
{-# NOINLINE balanceL #-}

delta, ratio :: Int
delta :: Int
delta = Int
3
ratio :: Int
ratio = Int
2