{-# 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  : justin@jle.im
-- 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
  , disjointSet
  , powerSetSet
  , disjointUnionSet
  , cartesianProductSet
  ) where

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

#if !MIN_VERSION_containers(0,5,11)
import           Utils.Containers.Internal.StrictPair
#endif

-- | 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  = forall a. Set a -> Int
S.size (forall a. NESet a -> Set a
nesSet NESet a
t1) forall a. Eq a => a -> a -> Bool
== forall a. Set a -> Int
S.size (forall a. NESet a -> Set a
nesSet NESet a
t2)
             Bool -> Bool -> Bool
&& forall a. NESet a -> NonEmpty a
toList NESet a
t1 forall a. Eq a => a -> a -> Bool
== forall a. NESet a -> NonEmpty a
toList NESet a
t2

instance Ord a => Ord (NESet a) where
    compare :: NESet a -> NESet a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. NESet a -> NonEmpty a
toList
    < :: NESet a -> NESet a -> Bool
(<)     = forall a. Ord a => a -> a -> Bool
(<) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. NESet a -> NonEmpty a
toList
    > :: NESet a -> NESet a -> Bool
(>)     = forall a. Ord a => a -> a -> Bool
(>) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. NESet a -> NonEmpty a
toList
    <= :: NESet a -> NESet a -> Bool
(<=)    = forall a. Ord a => a -> a -> Bool
(<=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. NESet a -> NonEmpty a
toList
    >= :: NESet a -> NESet a -> Bool
(>=)    = forall a. Ord a => a -> a -> Bool
(>=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"fromList (" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. NESet a -> NonEmpty a
toList NESet a
xs) 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 = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
      Ident String
"fromList" <- ReadPrec Lexeme
lexP
      NonEmpty a
xs <- forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadPrec a
readPrec
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Ord a => NonEmpty a -> NESet a
fromList NonEmpty a
xs)

    readListPrec :: ReadPrec [NESet a]
readListPrec = 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 =
        forall a. NESet a -> Int
size NESet a
m forall a. Eq a => a -> a -> Bool
== forall a. NESet a -> Int
size NESet b
n Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq (forall a. NESet a -> NonEmpty a
toList NESet a
m) (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 =
        forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp (forall a. NESet a -> NonEmpty a
toList NESet a
m) (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 =
        forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith (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 (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) = forall a. NFData a => a -> ()
rnf a
x seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Set a
s

-- Data instance code from Data.Set.Internal
--
-- Copyright   :  (c) Daan Leijen 2002
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 = forall g. g -> c g
z forall a. Ord a => NonEmpty a -> NESet a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` 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 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. Ord a => NonEmpty a -> NESet a
fromList)
    Int
_ -> 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 forall d. Data d => c (t d)
f    = 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 forall d. Data d => c (t d)
f

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     = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESet a -> Set a
toSet
    toEncoding :: NESet a -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
A.toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESet a -> Set a
toSet

instance (A.FromJSON a, Ord a) => A.FromJSON (NESet a) where
    parseJSON :: Value -> Parser (NESet a)
parseJSON = forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure
            forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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 = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) forall a. a -> Set a -> NESet a
NESet forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
    :: r                  -- ^ value to return if set is empty
    -> (NESet a -> r)     -- ^ function to apply if set is not empty
    -> Set a
    -> r
withNonEmpty :: forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty r
def NESet a -> r
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe r
def NESet a -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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 = forall a. a -> Set a -> NESet a
NESet a
x 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) = forall r a. r -> (NESet a -> r) -> Set a -> r
withNonEmpty (forall a. a -> NESet a
singleton a
x) (forall a. Semigroup a => a -> a -> a
<> forall a. a -> NESet a
singleton a
x)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList
                  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 forall a. a -> [a] -> NonEmpty 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 forall a. Num a => a -> a -> a
+ 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` 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 = 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) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a -> a -> a
f a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr a -> a -> a
f))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Maybe (a, Set a)
S.maxView
                     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) = 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) = 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) = 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 forall a. Ord a => a -> a -> Ordering
compare a
x1 a
x2 of
    Ordering
LT -> forall a. a -> Set a -> NESet a
NESet a
x1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESet a -> Set a
toSet forall a b. (a -> b) -> a -> b
$ NESet a
n2
    Ordering
EQ -> forall a. a -> Set a -> NESet a
NESet a
x1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
s1         forall a b. (a -> b) -> a -> b
$ Set a
s2
    Ordering
GT -> forall a. a -> Set a -> NESet a
NESet a
x2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Set a -> Set a -> Set a
S.union (forall a. NESet a -> Set a
toSet NESet a
n1) 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 (forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
F1.toNonEmpty->(NESet a
s :| [NESet a]
ss)) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' 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
(<>) = forall a. Ord a => NESet a -> NESet a -> NESet a
union
    {-# INLINE (<>) #-}
    sconcat :: NonEmpty (NESet a) -> NESet a
sconcat = 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.
instance F.Foldable NESet where
#if MIN_VERSION_base(4,11,0)
    fold :: forall m. Monoid m => NESet m -> m
fold      (NESet m
x Set m
s) = m
x forall a. Semigroup a => a -> a -> a
<> 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 forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap a -> m
f Set a
s
    {-# INLINE foldMap #-}
#else
    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 #-}
#endif
    foldr :: forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr   = 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'  = forall a b. (a -> b -> b) -> b -> NESet a -> b
foldr'
    {-# INLINE foldr' #-}
    foldr1 :: forall a. (a -> a -> a) -> NESet a -> a
foldr1  = forall a. (a -> a -> a) -> NESet a -> a
foldr1
    {-# INLINE foldr1 #-}
    foldl :: forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl   = 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'  = forall a b. (a -> b -> a) -> a -> NESet b -> a
foldl'
    {-# INLINE foldl' #-}
    foldl1 :: forall a. (a -> a -> a) -> NESet a -> a
foldl1  = 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  = 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) = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
F.elem a
x Set a
s
                       Bool -> Bool -> Bool
|| a
x 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) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Maybe (a, Set a)
S.maxView forall a b. (a -> b) -> a -> b
$ Set a
s
    {-# INLINE maximum #-}
    -- TODO: use build
    toList :: forall a. NESet a -> [a]
toList  = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NESet a -> NonEmpty a
toList
    {-# INLINE toList #-}

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


-- | 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 = forall a. NESet a -> MergeNESet a
MergeNESet (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 = forall a. a -> Set a -> NESet a
NESet a
x1 forall a b. (a -> b) -> a -> b
$ Set a
s1 forall a. Set a -> Set a -> Set a
`S.merge` 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) = forall a. Ord a => Set a -> Bool
S.valid Set a
s
                  Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a
x forall a. Ord a => a -> a -> Bool
<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (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         -> forall a. a -> Set a
S.singleton a
x
    Bin Int
_ a
y Set a
l Set a
r -> forall a. a -> Set a -> Set a -> Set a
balanceL a
y (forall a. a -> Set a -> Set a
insertMinSet a
x Set a
l) Set a
r
{-# INLINABLE 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         -> forall a. a -> Set a
S.singleton a
x
    Bin Int
_ a
y Set a
l Set a
r -> forall a. a -> Set a -> Set a -> Set a
balanceR a
y Set a
l (forall a. a -> Set a -> Set a
insertMaxSet a
x Set a
r)
{-# INLINABLE insertMaxSet #-}

-- ---------------------------------------------
-- | CPP for new functions not in old containers
-- ---------------------------------------------

-- | Comptability layer for 'Data.Set.disjoint'.
disjointSet :: Ord a => Set a -> Set a -> Bool
#if MIN_VERSION_containers(0,5,11)
disjointSet :: forall a. Ord a => Set a -> Set a -> Bool
disjointSet = forall a. Ord a => Set a -> Set a -> Bool
S.disjoint
#else
disjointSet xs = S.null . S.intersection xs
#endif
{-# INLINE disjointSet #-}

-- | Comptability layer for 'Data.Set.powerSet'.
powerSetSet :: Set a -> Set (Set a)
#if MIN_VERSION_containers(0,5,11)
powerSetSet :: forall a. Set a -> Set (Set a)
powerSetSet = forall a. Set a -> Set (Set a)
S.powerSet
{-# INLINE powerSetSet #-}
#else
powerSetSet xs0 = insertMinSet S.empty (S.foldr' step' Tip xs0) where
  step' x pxs = insertMinSet (S.singleton x) (insertMinSet x `S.mapMonotonic` pxs) `glue` pxs
{-# INLINABLE powerSetSet #-}

minViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
minViewSure = go
  where
    go x Tip r = x :*: r
    go x (Bin _ xl ll lr) r =
      case go xl ll lr of
        xm :*: l' -> xm :*: balanceR x l' r

maxViewSure :: a -> Set a -> Set a -> StrictPair a (Set a)
maxViewSure = go
  where
    go x l Tip = x :*: l
    go x l (Bin _ xr rl rr) =
      case go xr rl rr of
        xm :*: r' -> xm :*: balanceL x l r'

glue :: Set a -> Set a -> Set a
glue Tip r = r
glue l Tip = l
glue l@(Bin sl xl ll lr) r@(Bin sr xr rl rr)
  | sl > sr = let !(m :*: l') = maxViewSure xl ll lr in balanceR m l' r
  | otherwise = let !(m :*: r') = minViewSure xr rl rr in balanceL m l r'
#endif

-- | Comptability layer for 'Data.Set.disjointUnion'.
disjointUnionSet :: Set a -> Set b -> Set (Either a b)
#if MIN_VERSION_containers(0,5,11)
disjointUnionSet :: forall a b. Set a -> Set b -> Set (Either a b)
disjointUnionSet = forall a b. Set a -> Set b -> Set (Either a b)
S.disjointUnion
#else
disjointUnionSet as bs = S.merge (S.mapMonotonic Left as) (S.mapMonotonic Right bs)
#endif
{-# INLINE disjointUnionSet #-}

-- | Comptability layer for 'Data.Set.cartesianProduct'.
cartesianProductSet :: Set a -> Set b -> Set (a, b)
#if MIN_VERSION_containers(0,5,11)
cartesianProductSet :: forall a b. Set a -> Set b -> Set (a, b)
cartesianProductSet = forall a b. Set a -> Set b -> Set (a, b)
S.cartesianProduct
#else
cartesianProductSet as bs =
  getMergeSet $ foldMap (\a -> MergeSet $ S.mapMonotonic ((,) a) bs) as

newtype MergeSet a = MergeSet { getMergeSet :: Set a }

instance Semigroup (MergeSet a) where
    MergeSet xs <> MergeSet ys = MergeSet (S.merge xs ys)

instance Monoid (MergeSet a) where
    mempty = MergeSet S.empty
    mappend = (<>)
#endif
{-# INLINE cartesianProductSet #-}



-- ------------------------------------------
-- | 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 -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
      Bin Int
_ a
_ Set a
Tip Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x forall a. Set a
Tip Set a
r
      Bin Int
_ a
rx Set a
Tip rr :: Set a
rr@Bin{} -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip) Set a
rr
      Bin Int
_ a
rx (Bin Int
_ a
rlx Set a
_ Set a
_) Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
rx forall a. Set a
Tip 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 forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
rrs -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rls) a
x forall a. Set a
Tip Set a
rl) Set a
rr
        | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
rll) a
x forall a. Set a
Tip Set a
rll) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rrsforall a. Num a => a -> a -> a
+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 -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
x Set a
l forall a. Set a
Tip
      Bin Int
rs a
rx Set a
rl Set a
rr
         | Int
rs forall a. Ord a => a -> a -> Bool
> Int
deltaforall 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 forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
rrs -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
rx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rls) a
x Set a
l Set a
rl) Set a
rr
                | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
rlx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
rll) a
x Set a
l Set a
rll) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rrsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
rlr) a
rx Set a
rlr Set a
rr)
              (Set a
_, Set a
_) -> forall a. HasCallStack => String -> a
error String
"Failure in Data.Map.balanceR"
                | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall 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 -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip
      Bin Int
_ a
_ Set a
Tip Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
2 a
x Set a
l forall a. Set a
Tip
      Bin Int
_ a
lx Set a
Tip (Bin Int
_ a
lrx Set a
_ Set a
_) -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
lx forall a. Set a
Tip forall a. Set a
Tip) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip forall a. Set a
Tip)
      Bin Int
_ a
lx ll :: Set a
ll@Bin{} Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
3 a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin Int
1 a
x forall a. Set a
Tip 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 forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
lls -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr forall a. Set a
Tip)
        | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
ls) a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
llsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
lrl) a
lx Set a
ll Set a
lrl) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
lrr) a
x Set a
lrr forall a. Set a
Tip)
    Bin Int
rs a
_ Set a
_ Set a
_ -> case Set a
l of
             Set a
Tip -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rs) a
x forall a. Set a
Tip Set a
r
             Bin Int
ls a
lx Set a
ll Set a
lr
                | Int
ls forall a. Ord a => a -> a -> Bool
> Int
deltaforall 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 forall a. Ord a => a -> a -> Bool
< Int
ratioforall a. Num a => a -> a -> a
*Int
lls -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
lx Set a
ll (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rsforall a. Num a => a -> a -> a
+Int
lrs) a
x Set a
lr Set a
r)
                       | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall a. Num a => a -> a -> a
+Int
rs) a
lrx (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
llsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
lrl) a
lx Set a
ll Set a
lrl) (forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
rsforall a. Num a => a -> a -> a
+forall a. Set a -> Int
S.size Set a
lrr) a
x Set a
lrr Set a
r)
                     (Set a
_, Set a
_) -> forall a. HasCallStack => String -> a
error String
"Failure in Data.Set.NonEmpty.Internal.balanceL"
                | Bool
otherwise -> forall a. Int -> a -> Set a -> Set a -> Set a
Bin (Int
1forall a. Num a => a -> a -> a
+Int
lsforall 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