{-| Module  : WeakSets
Description : Weak sets are sets of objects which do not have to be orderable. They are homogeneous, they can only contain a single type of object. They are more flexible than Data.Set but slower.
Copyright   : Guillaume Sabbagh 2022
License     : LGPL-3.0-or-later
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Weak sets are sets of objects which do not have to be orderable. They are homogeneous, they can only contain a single type of object.

They are more flexible than Data.Set, they are quicker at insertion but slower at retrieving elements because the datatype only assumes its components are equatable.

We use this datatype because most of the datatypes we care about are not orderable. It also allows to define a Functor, Applicative and Monad structure on sets.

Almost all Data.WeakSet functions are implemented so that you can replace a Data.Set import such as 

> import Data.Set (Set)
> import qualified Data.Set as Set

by a Data.WeakSet import such as

> import Data.WeakSet (Set)
> import qualified Data.WeakSet as Set

without breaking anything in your code.

The only functions for which this would fail are the functions converting sets back into list (they require the Eq typeclass unlike in Data.Set). `size` is one of them.

If a function really requires the Ord typeclass to even make sense, then it is not defined in this package, you should use Data.Set.

Note that, just like in Data.Set, the implementation is generally left-biased. Functions that take two sets as arguments and combine them, such as union and intersection, prefer the entries in the first argument to those in the second. 

Functions with non colliding names are defined in Data.WeakSet.Safe. Inline functions are written between pipes @|@.

This module is intended to be imported qualified, to avoid name clashes with Prelude functions, except for functions in Data.WeakSet.Safe, e.g.

> import           Data.WeakSet         (Set)
> import qualified Data.WeakSet       as Set
> import           Data.WeakSet.Safe

Unlike Data.Set, we defer the removing of duplicate elements to the conversion back to a list. It is therefore a valid Functor, Applicative and Monad. This allows to create weak sets by comprehension if you include the MonadComprehensions pragma at the beginning of your file.

Beware if the set is supposed to contain a lot of duplicate elements, you should purge them yourself by transforming the set into a list and back into a set. The time complexity is always given in function of the number of elements in the set including the duplicate elements.

-}

module Data.WeakSet
(
      Set

    -- * Construction

    , empty
    , singleton
    , set
    , fromList
    , fromAscList
    , fromDescList
    , fromDistinctAscList
    , fromDistinctDescList
    , powerSet

    -- * Operators

    , (|&|)
    , (|||)
    , (|*|)
    , (|+|)
    , (|-|)
    , (|^|)
    
    -- * Insertion

    , insert

    -- * Deletion

    , delete

    -- * Generalized insertion/deletion


    , alterF

    -- -- * Query

    , null
    , isIn
    , member
    , notMember
    , cardinal
    , size
    , isIncludedIn
    , isSubsetOf
    , isProperSubsetOf
    , disjoint

    -- * Combine

    , union
    , unions
    , difference
    , (\\)
    , intersection
    , cartesianProduct
    , disjointUnion

    -- * Filter

    , filter
    , partition

    -- * Indexed /!\

    -- ** Beware if you use these functions as a 'Set' is not ordered, no guaranty is given on which element will be returned.

    , lookupIndex
    , findIndex
    , elemAt
    , deleteAt
    , take
    , drop
    , splitAt

    -- * Map

    , map
    , mapMonotonic

    -- * Folds

    , foldr
    , foldl
    
    -- ** Strict folds

    , foldr'
    , foldl'
    
    -- * Fold related functions

    , length
    , elem
    , maximum
    , minimum
    , sum
    , product
    , concat
    , concat2
    , concatMap
    , and
    , or
    , any
    , all
    , maximumBy
    , minimumBy
    , notElem
    , find
    
    -- * Conversion


    -- ** List

    , setToList
    , toList
    , nubSetBy

    -- * Maybe interaction

    , setToMaybe
    , maybeToSet
    , catMaybes
    , mapMaybe
    
    -- * Either interaction

    , mapEither
    , catEither
    
    -- * Others

    , traverseSet
    , sequenceSet
    , anElement
    , cartesianProductOfSets
    
) where
import              Prelude         hiding (filter, splitAt, drop, take, map, foldr, foldl, length, elem, maximum, minimum, sum, product, concat, concatMap, and, or, any, all, maximumBy, minimumBy, notElem, find, null)
import  qualified   Data.List       as      L
import  qualified   Data.Maybe      as      M
import              Control.Applicative    (liftA2, Alternative, (<|>))
import  qualified   Control.Applicative as  Applicative
import  qualified   Data.Foldable as     Foldable

-- | A weak set is a list of values such that the duplicate elements and the order of the elements are disregarded.

--

-- To force these constraints, the `Set` constructor is abstract and is not exported. The only way to construct a set is to use the smart constructor `fromList` or `set` which ensures the previous conditions.

data Set a = Set [a]

    
instance (Eq a) => Eq (Set a) where
    Set a
x == :: Set a -> Set a -> Bool
== Set a
y = Set a
x Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
y Bool -> Bool -> Bool
&& Set a
y Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
x
    
instance Semigroup (Set a) where
    (Set [a]
xs) <> :: Set a -> Set a -> Set a
<> (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
ys
    
instance Monoid (Set a) where
    mempty :: Set a
mempty = [a] -> Set a
forall a. [a] -> Set a
Set []

instance Functor Set where
    fmap :: forall a b. (a -> b) -> Set a -> Set b
fmap a -> b
f (Set [a]
xs) = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs

instance Applicative Set where
    pure :: forall a. a -> Set a
pure a
x = [a] -> Set a
forall a. [a] -> Set a
Set [a
x]
    <*> :: forall a b. Set (a -> b) -> Set a -> Set b
(<*>) (Set [a -> b]
fs) (Set [a]
xs) = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ [a -> b]
fs [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [a]
xs

instance Monad Set where
    >>= :: forall a b. Set a -> (a -> Set b) -> Set b
(>>=) (Set [a]
xs) a -> Set b
f = [b] -> Set b
forall a. [a] -> Set a
Set ([b] -> Set b) -> [b] -> Set b
forall a b. (a -> b) -> a -> b
$ [a]
xs [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Set b -> [b]
forall a. Set a -> [a]
unsafeSetToList(Set b -> [b]) -> (a -> Set b) -> a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Set b
f)

instance Alternative Set where
    <|> :: forall a. Set a -> Set a -> Set a
(<|>) = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
(|||)
    empty :: forall a. Set a
empty = Set a
forall a. Monoid a => a
mempty

instance (Show a) => Show (Set a) where
    show :: Set a -> String
show (Set [a]
xs) = String
"(set "String -> ShowS
forall a. [a] -> [a] -> [a]
++[a] -> String
forall a. Show a => a -> String
show [a]
xsString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"

    
-- Construction



-- | Alias of mempty. Defined for backward compatibility with Data.Set.

empty :: Set a
empty :: forall a. Set a
empty = Set a
forall a. Monoid a => a
mempty

-- | Alias of pure. Defined for backward compatibility with Data.Set.

singleton :: a -> Set a
singleton :: forall a. a -> Set a
singleton = a -> Set a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | /O(1)/. The smart constructor of sets. This is the only way of instantiating a `Set` with `fromList`.

--

-- We prefer the smart constructor `set` because its name does not collide with other data structures.

set :: [a] -> Set a
set :: forall a. [a] -> Set a
set = [a] -> Set a
forall a. [a] -> Set a
Set

-- | /O(1)/. This smart constructor is provided to allow backward compatibility with Data.Set.

fromList :: [a] -> Set a
fromList :: forall a. [a] -> Set a
fromList = [a] -> Set a
forall a. [a] -> Set a
set

-- | /O(1)/. Defined for backward compatibility with Data.Set.

fromAscList :: [a] -> Set a
fromAscList :: forall a. [a] -> Set a
fromAscList = [a] -> Set a
forall a. [a] -> Set a
set

-- | /O(1)/. Defined for backward compatibility with Data.Set.

fromDescList :: [a] -> Set a
fromDescList :: forall a. [a] -> Set a
fromDescList = [a] -> Set a
forall a. [a] -> Set a
set

-- | /O(1)/. Defined for backward compatibility with Data.Set.

fromDistinctAscList :: [a] -> Set a
fromDistinctAscList :: forall a. [a] -> Set a
fromDistinctAscList = [a] -> Set a
forall a. [a] -> Set a
set

-- | /O(1)/. Defined for backward compatibility with Data.Set.

fromDistinctDescList :: [a] -> Set a
fromDistinctDescList :: forall a. [a] -> Set a
fromDistinctDescList = [a] -> Set a
forall a. [a] -> Set a
set

-- | Return the set of all subsets of a given set.

--

-- Example :

--

-- @

--  ghci> powerSet $ set [1,2,3]

-- (set [(set []),(set [1]),(set [2]),(set [1,2]),(set [3]),(set [1,3]),(set [2,3]),(set [1,2,3])])

-- @

powerSet :: Set a -> Set (Set a)
powerSet :: forall a. Set a -> Set (Set a)
powerSet (Set [a]
xs) = [Set a] -> Set (Set a)
forall a. [a] -> Set a
Set ([Set a] -> Set (Set a)) -> [Set a] -> Set (Set a)
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [[a]] -> [Set a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. [a] -> [[a]]
L.subsequences [a]
xs

    
-- Insertion



-- | O(1). Insert an element in a set. If the set already contains an element equal to the given value, it is replaced with the new value.

insert :: a -> Set a -> Set a
insert :: forall a. a -> Set a -> Set a
insert a
x (Set [a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

    
-- Deletion



-- | O(n). Delete an element from a set.

delete :: Eq a => a -> Set a -> Set a 
delete :: forall a. Eq a => a -> Set a -> Set a
delete a
x (Set [a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x) [a]
xs

    
-- Generalized deletion/insertion



-- | O(n). @(alterF f x s)@ can delete or insert x in s depending on whether an equal element is found in s.

--

-- Note that unlike insert, alterF will not replace an element equal to the given value.

alterF :: (Eq a, Functor f) => (Bool -> f Bool) -> a -> Set a -> f (Set a) 
alterF :: forall a (f :: * -> *).
(Eq a, Functor f) =>
(Bool -> f Bool) -> a -> Set a -> f (Set a)
alterF Bool -> f Bool
f a
x Set a
s
    | a
x a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set a
s = (\Bool
b -> if Bool
b then Set a
s else a -> Set a -> Set a
forall a. Eq a => a -> Set a -> Set a
delete a
x Set a
s) (Bool -> Set a) -> f Bool -> f (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> f Bool
f Bool
True)
    | Bool
otherwise = (\Bool
b -> if Bool
b then a -> Set a -> Set a
forall a. a -> Set a -> Set a
insert a
x Set a
s else Set a
s) (Bool -> Set a) -> f Bool -> f (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bool -> f Bool
f Bool
False)

    
-- Query


-- | /O(1)/. Return wether the set is empty.

null :: Set a -> Bool
null :: forall a. Set a -> Bool
null (Set [a]
xs) = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null [a]
xs

-- | /O(n)/. Return wether an element is in a set.

isIn :: (Eq a) => a -> Set a -> Bool
isIn :: forall a. Eq a => a -> Set a -> Bool
isIn a
x = (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Foldable.elem a
x)([a] -> Bool) -> (Set a -> [a]) -> Set a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n)/. Alias of `isIn`. Defined for backward compatibility with Data.Set.

member :: Eq a => a -> Set a -> Bool
member :: forall a. Eq a => a -> Set a -> Bool
member = a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
isIn

-- | /O(n)/. Negation of `member`. Defined for backward compatibility with Data.Set.

notMember :: Eq a => a -> Set a -> Bool
notMember :: forall a. Eq a => a -> Set a -> Bool
notMember a
x Set a
s = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
member a
x Set a
s

-- | /O(n^2)/. Size of a set.

cardinal :: (Eq a) => Set a -> Int
cardinal :: forall a. Eq a => Set a -> Int
cardinal = ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length)([a] -> Int) -> (Set a -> [a]) -> Set a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList

-- | /O(n)/. Size of a set.

size :: (Eq a) => Set a -> Int
size :: forall a. Eq a => Set a -> Int
size = Set a -> Int
forall a. Eq a => Set a -> Int
cardinal

-- | /O(n^2)/. Return a boolean indicating if a `Set` is included in another one.

isIncludedIn :: (Eq a) => Set a -> Set a -> Bool
(Set []) isIncludedIn :: forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
_ = Bool
True
(Set (a
x:[a]
xs)) `isIncludedIn` (Set [a]
ys)
    | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Foldable.elem` [a]
ys = ([a] -> Set a
forall a. [a] -> Set a
Set [a]
xs) Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` ([a] -> Set a
forall a. [a] -> Set a
Set [a]
ys)
    | Bool
otherwise = Bool
False

-- | /O(n^2)/. Return a boolean indicating if a `Set` is included in another one.

isSubsetOf :: (Eq a) => Set a -> Set a -> Bool
isSubsetOf :: forall a. Eq a => Set a -> Set a -> Bool
isSubsetOf = Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
isIncludedIn

-- | /O(n^2)/. x is a proper subset of y if x is included in y and x is different from y. 

isProperSubsetOf :: (Eq a) => Set a -> Set a -> Bool
isProperSubsetOf :: forall a. Eq a => Set a -> Set a -> Bool
isProperSubsetOf Set a
x Set a
y = Set a
x Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
/= Set a
y Bool -> Bool -> Bool
&& Set a
x Set a -> Set a -> Bool
forall a. Eq a => Set a -> Set a -> Bool
`isIncludedIn` Set a
y

-- | /O(n^2)/. Check whether two sets are disjoint (i.e., their intersection is empty).

disjoint :: (Eq a) => Set a -> Set a -> Bool
disjoint :: forall a. Eq a => Set a -> Set a -> Bool
disjoint Set a
x Set a
y = Set a -> Bool
forall a. Set a -> Bool
null (Set a -> Bool) -> Set a -> Bool
forall a b. (a -> b) -> a -> b
$ Set a
x Set a -> Set a -> Set a
forall a. Eq a => Set a -> Set a -> Set a
`intersection` Set a
y


-- Combine



-- | /O(n)/. The union of two sets, preferring the first set when equal elements are encountered.

union ::  Set a -> Set a -> Set a
union :: forall a. Set a -> Set a -> Set a
union (Set [a]
xs) (Set [a]
ys) = [a] -> Set a
forall a. [a] -> Set a
Set ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys)

-- | The union of the sets in a Foldable structure.

unions :: (Foldable f) => f (Set a) -> Set a 
unions :: forall (f :: * -> *) a. Foldable f => f (Set a) -> Set a
unions = (Set a -> Set a -> Set a) -> Set a -> f (Set a) -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
union Set a
forall a. Set a
empty

-- | /O(n*m)/. Difference of two sets.

difference :: (Eq a) => Set a -> Set a -> Set a 
difference :: forall a. Eq a => Set a -> Set a -> Set a
difference (Set [a]
xs) Set a
y = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not(Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set a
y)) [a]
xs

-- | See difference.

(\\) :: (Eq a) => Set a -> Set a -> Set a 
\\ :: forall a. Eq a => Set a -> Set a -> Set a
(\\) = Set a -> Set a -> Set a
forall a. Eq a => Set a -> Set a -> Set a
difference

-- | /O(m*n)/. Return the intersection of two sets. Elements of the result come from the first set.

intersection :: (Eq a) => Set a -> Set a -> Set a
intersection :: forall a. Eq a => Set a -> Set a -> Set a
intersection (Set [a]
xs) Set a
y = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` Set a
y) [a]
xs

-- | /O(m*n)/. Return the cartesian product of two sets.

cartesianProduct :: Set a -> Set b -> Set (a,b)
cartesianProduct :: forall a b. Set a -> Set b -> Set (a, b)
cartesianProduct (Set [a]
xs) (Set [b]
ys) = [(a, b)] -> Set (a, b)
forall a. [a] -> Set a
Set ([(a, b)] -> Set (a, b)) -> [(a, b)] -> Set (a, b)
forall a b. (a -> b) -> a -> b
$ [(a
x,b
y) | a
x <- [a]
xs, b
y <- [b]
ys]

-- | /O(n)/. Return the disjoint union of two sets.

disjointUnion :: Set a -> Set b -> Set (Either a b)
disjointUnion :: forall a b. Set a -> Set b -> Set (Either a b)
disjointUnion (Set [a]
xs) (Set [b]
ys) = [Either a b] -> Set (Either a b)
forall a. [a] -> Set a
Set ([Either a b] -> Set (Either a b))
-> [Either a b] -> Set (Either a b)
forall a b. (a -> b) -> a -> b
$ [a -> Either a b
forall a b. a -> Either a b
Left a
x | a
x <- [a]
xs] [Either a b] -> [Either a b] -> [Either a b]
forall a. [a] -> [a] -> [a]
++ [b -> Either a b
forall a b. b -> Either a b
Right b
y | b
y <- [b]
ys]


-- Filter



-- | O(n). Filter all elements that satisfy the predicate.

filter :: (a -> Bool) -> Set a -> Set a
filter :: forall a. (a -> Bool) -> Set a -> Set a
filter a -> Bool
p (Set [a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p [a]
xs

-- | O(n). Partition the set into two sets, one with all elements that satisfy the predicate and one with all elements that don't satisfy the predicate. See also `split`.

partition :: (a -> Bool) -> Set a -> (Set a, Set a)
partition :: forall a. (a -> Bool) -> Set a -> (Set a, Set a)
partition a -> Bool
p (Set [a]
xs) = ([a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter a -> Bool
p [a]
xs, [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not(Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Bool
p) [a]
xs)


-- Indexed



-- | O(n^2). Lookup the index of an element, which is its zero-based index in the sorted sequence of elements. The index is a number from 0 up to, but not including, the size of the set.

lookupIndex :: (Eq a) => a -> Set a -> Maybe Int
lookupIndex :: forall a. Eq a => a -> Set a -> Maybe Int
lookupIndex a
k Set a
x = a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
L.elemIndex a
k (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
x)

-- | O(n^2). Return the index of an element, which is its zero-based index in the sorted sequence of elements. The index is a number from 0 up to, but not including, the size of the set. Calls error when the element is not a member of the set.

findIndex :: (Eq a) => a -> Set a -> Int
findIndex :: forall a. Eq a => a -> Set a -> Int
findIndex a
k Set a
x
    | Maybe Int -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null Maybe Int
index = String -> Int
forall a. HasCallStack => String -> a
error String
"WeakSet.findIndex: element is not in the set"
    | Bool
otherwise = Int
i
    where
        index :: Maybe Int
index = a -> Set a -> Maybe Int
forall a. Eq a => a -> Set a -> Maybe Int
lookupIndex a
k Set a
x
        Just Int
i = Maybe Int
index
        
-- | O(n^2). Retrieve an element by its index, i.e. by its zero-based index in the sorted sequence of elements. If the index is out of range (less than zero, greater or equal to size of the set), `error` is called.

elemAt :: (Eq a) => Int -> Set a -> a 
elemAt :: forall a. Eq a => Int -> Set a -> a
elemAt Int
i Set a
s
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Foldable.length [a]
xs) = String -> a
forall a. HasCallStack => String -> a
error String
"WeakSet.elemAt: index out of range"
    | Bool
otherwise = [a] -> Int -> a
forall a. [a] -> Int -> a
(L.!!) [a]
xs Int
i
    where
        xs :: [a]
xs = Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
s

-- | O(n). Delete the element at index, i.e. by its zero-based index in the sorted sequence of elements. If the index is out of range (less than zero, greater or equal to size of the set), error is called. 

deleteAt :: (Eq a) => Int -> Set a -> Set a 
deleteAt :: forall a. Eq a => Int -> Set a -> Set a
deleteAt Int
i Set a
s = (a -> Bool) -> Set a -> Set a
forall a. (a -> Bool) -> Set a -> Set a
filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int -> Set a -> a
forall a. Eq a => Int -> Set a -> a
elemAt Int
i Set a
s)) Set a
s

-- | O(n^2). Take a given number of elements in order.

take :: (Eq a) => Int -> Set a -> Set a 
take :: forall a. Eq a => Int -> Set a -> Set a
take Int
i Set a
s = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
i (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
s)

-- | O(n^2). Drop a given number of elements in order.

drop :: (Eq a) => Int -> Set a -> Set a 
drop :: forall a. Eq a => Int -> Set a -> Set a
drop Int
i Set a
s = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop Int
i (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
s)

-- | O(n^2). Split a set at a particular index.

splitAt :: (Eq a) => Int -> Set a -> (Set a, Set a) 
splitAt :: forall a. Eq a => Int -> Set a -> (Set a, Set a)
splitAt Int
i Set a
s = ([a] -> Set a
forall a. [a] -> Set a
Set [a]
x, [a] -> Set a
forall a. [a] -> Set a
Set [a]
y)
    where
        ([a]
x,[a]
y) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
i (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
s)


-- Map



-- | /O(n)/. Alias of `fmap` for backward compatibility with Data.Set. Note that a WeakSet is a functor.

map :: (a -> b) -> Set a -> Set b
map :: forall a b. (a -> b) -> Set a -> Set b
map = (a -> b) -> Set a -> Set b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 

-- | /O(n)/. Alias of `fmap` for backward compatibility with Data.Set.

mapMonotonic :: (a -> b) -> Set a -> Set b
mapMonotonic :: forall a b. (a -> b) -> Set a -> Set b
mapMonotonic = (a -> b) -> Set a -> Set b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap


-- Folds



-- | Strict foldr.

foldr' :: (a -> b -> b) -> b -> Set a -> b 
foldr' :: forall a b. (a -> b -> b) -> b -> Set a -> b
foldr' a -> b -> b
f b
d (Set [a]
xs) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr' a -> b -> b
f b
d [a]
xs

-- | Strict foldl.

foldl' :: (a -> b -> a) -> a -> Set b -> a 
foldl' :: forall a b. (a -> b -> a) -> a -> Set b -> a
foldl' a -> b -> a
f a
d (Set [b]
xs) = (a -> b -> a) -> a -> [b] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' a -> b -> a
f a
d [b]
xs


-- Conversion



-- | /O(1)/. Gives the underlying list of a set without removing duplicates, this function is not exported.

unsafeSetToList :: Set a -> [a]
unsafeSetToList :: forall a. Set a -> [a]
unsafeSetToList (Set [a]
xs) = [a]
xs

-- | /O(n^2)/. Transform a `Set` back into a list, the list returned does not have duplicate elements, the order of the original list holds.

setToList :: (Eq a) => Set a -> [a]
setToList :: forall a. Eq a => Set a -> [a]
setToList (Set [a]
xs) = [a] -> [a]
forall a. Eq a => [a] -> [a]
L.nub [a]
xs

-- | /O(n^2)/. Alias of `setToList` for backward compatibility with Data.Set.

toList :: (Eq a) => Set a -> [a]
toList :: forall a. Eq a => Set a -> [a]
toList = Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList


-- Maybe interactions



-- | /O(1)/. Set version of listToMaybe.

setToMaybe :: Set a -> Maybe a
setToMaybe :: forall a. Set a -> Maybe a
setToMaybe = ([a] -> Maybe a
forall a. [a] -> Maybe a
M.listToMaybe)([a] -> Maybe a) -> (Set a -> [a]) -> Set a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(1)/. Set version of maybeToList.

maybeToSet :: Maybe a -> Set a
maybeToSet :: forall a. Maybe a -> Set a
maybeToSet Maybe a
x = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ (Maybe a -> [a]
forall a. Maybe a -> [a]
M.maybeToList) Maybe a
x

-- | /O(n)/. Set version of catMaybes. Only keeps the Just values of a set and extract them.

catMaybes :: Set (Maybe a) -> Set a
catMaybes :: forall a. Set (Maybe a) -> Set a
catMaybes = [a] -> Set a
forall a. [a] -> Set a
set([a] -> Set a) -> (Set (Maybe a) -> [a]) -> Set (Maybe a) -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Maybe a] -> [a]
forall a. [Maybe a] -> [a]
M.catMaybes)([Maybe a] -> [a])
-> (Set (Maybe a) -> [Maybe a]) -> Set (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set (Maybe a) -> [Maybe a]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n)/. Set version of mapMaybe. A map which throws out elements which are mapped to nothing.

mapMaybe :: (a -> Maybe b) -> Set a -> Set b
mapMaybe :: forall a b. (a -> Maybe b) -> Set a -> Set b
mapMaybe a -> Maybe b
f = [b] -> Set b
forall a. [a] -> Set a
set([b] -> Set b) -> (Set a -> [b]) -> Set a -> Set b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((a -> Maybe b) -> [a] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
M.mapMaybe a -> Maybe b
f)([a] -> [b]) -> (Set a -> [a]) -> Set a -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList


-- Either interactions



-- | /O(n)/. Take a set of Either and separate Left and Right values.

catEither :: Set (Either a b) -> (Set a, Set b)
catEither :: forall a b. Set (Either a b) -> (Set a, Set b)
catEither (Set []) = (Set a
forall a. Set a
empty,Set b
forall a. Set a
empty)
catEither (Set (Either a b
x:[Either a b]
xs))
    | Either a b -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null Either a b
x = (a -> Set a -> Set a
forall a. a -> Set a -> Set a
insert a
l Set a
ls, Set b
rs)
    | Bool
otherwise = (Set a
ls, b -> Set b -> Set b
forall a. a -> Set a -> Set a
insert b
r Set b
rs)
    where
        (Set a
ls,Set b
rs) = Set (Either a b) -> (Set a, Set b)
forall a b. Set (Either a b) -> (Set a, Set b)
catEither ([Either a b] -> Set (Either a b)
forall a. [a] -> Set a
Set [Either a b]
xs)
        Right b
r = Either a b
x
        Left a
l = Either a b
x


-- | /O(n)/. Map a function to a set, return a couple composed of the set of left elements and the set of right elements.

mapEither :: (a -> Either b c) -> Set a -> (Set b, Set c)
mapEither :: forall a b c. (a -> Either b c) -> Set a -> (Set b, Set c)
mapEither a -> Either b c
_ (Set []) = (Set b
forall a. Set a
empty, Set c
forall a. Set a
empty)
mapEither a -> Either b c
f (Set (a
x:[a]
xs))
    | Either b c -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null Either b c
result = (b -> Set b -> Set b
forall a. a -> Set a -> Set a
insert b
l Set b
ls, Set c
rs)
    | Bool
otherwise = (Set b
ls, c -> Set c -> Set c
forall a. a -> Set a -> Set a
insert c
r Set c
rs)
    where
        (Set b
ls,Set c
rs) = (a -> Either b c) -> Set a -> (Set b, Set c)
forall a b c. (a -> Either b c) -> Set a -> (Set b, Set c)
mapEither a -> Either b c
f ([a] -> Set a
forall a. [a] -> Set a
Set [a]
xs)
        result :: Either b c
result = a -> Either b c
f a
x
        Left b
l = Either b c
result
        Right c
r = Either b c
result


-- Other



-- | /O(n^2)/. Remove duplicates in the set using your own equality function.

nubSetBy :: (a -> a -> Bool) -> Set a -> [a]
nubSetBy :: forall a. (a -> a -> Bool) -> Set a -> [a]
nubSetBy a -> a -> Bool
f (Set [a]
xs) = (a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
L.nubBy a -> a -> Bool
f [a]
xs


-- Operators



-- | Alias of `intersection`.

(|&|) :: (Eq a) => Set a -> Set a -> Set a
|&| :: forall a. Eq a => Set a -> Set a -> Set a
(|&|) = Set a -> Set a -> Set a
forall a. Eq a => Set a -> Set a -> Set a
intersection

-- | Alias of `union`.

(|||) ::  Set a -> Set a -> Set a
||| :: forall a. Set a -> Set a -> Set a
(|||) = Set a -> Set a -> Set a
forall a. Set a -> Set a -> Set a
union

-- | Alias of `cartesianProduct`.

(|*|) ::  Set a -> Set b -> Set (a,b)
|*| :: forall a b. Set a -> Set b -> Set (a, b)
(|*|) = Set a -> Set b -> Set (a, b)
forall a b. Set a -> Set b -> Set (a, b)
cartesianProduct

-- | Alias of `disjointUnion`.

(|+|) :: Set a -> Set b -> Set (Either a b)
|+| :: forall a b. Set a -> Set b -> Set (Either a b)
(|+|) = Set a -> Set b -> Set (Either a b)
forall a b. Set a -> Set b -> Set (Either a b)
disjointUnion

-- | Returns the cartesian product of a set with itself n times.

(|^|) :: (Eq a) => Set a -> Int -> Set [a]
|^| :: forall a. Eq a => Set a -> Int -> Set [a]
(|^|) Set a
_ Int
0 = [[a]] -> Set [a]
forall a. [a] -> Set a
Set [[]]
(|^|) Set a
s Int
n = (:) (a -> [a] -> [a]) -> Set a -> Set ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a
s Set ([a] -> [a]) -> Set [a] -> Set [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Set a
s Set a -> Int -> Set [a]
forall a. Eq a => Set a -> Int -> Set [a]
|^| (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))

-- | Alias of `difference`.

(|-|) :: (Eq a) => Set a -> Set a -> Set a
|-| :: forall a. Eq a => Set a -> Set a -> Set a
(|-|) = Set a -> Set a -> Set a
forall a. Eq a => Set a -> Set a -> Set a
difference

-- | Set is not a Traversable because of the Eq typeclass requirement.

traverseSet :: (Applicative f, Eq a) => (a -> f b) -> Set a -> f (Set b)
traverseSet :: forall (f :: * -> *) a b.
(Applicative f, Eq a) =>
(a -> f b) -> Set a -> f (Set b)
traverseSet a -> f b
f Set a
s = (a -> f (Set b) -> f (Set b)) -> f (Set b) -> Set a -> f (Set b)
forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
foldr (\a
x f (Set b)
ys -> (b -> Set b -> Set b) -> f b -> f (Set b) -> f (Set b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> Set b -> Set b
forall a. a -> Set a -> Set a
insert (a -> f b
f a
x) f (Set b)
ys) (Set b -> f (Set b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set b
forall a. Monoid a => a
mempty) ([a] -> Set a
forall a. [a] -> Set a
set([a] -> Set a) -> (Set a -> [a]) -> Set a -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList (Set a -> Set a) -> Set a -> Set a
forall a b. (a -> b) -> a -> b
$ Set a
s)

-- | Set is not a Traversable because of the Eq typeclass requirement.

sequenceSet :: (Applicative f, Eq (f a)) => Set (f a) -> f (Set a)
sequenceSet :: forall (f :: * -> *) a.
(Applicative f, Eq (f a)) =>
Set (f a) -> f (Set a)
sequenceSet (Set [f a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> f [a] -> f (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f a] -> f [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([f a] -> [f a]
forall a. Eq a => [a] -> [a]
L.nub [f a]
xs)


-- | /O(1)/. Return an element of the set if it is not empty, throw an error otherwise.

anElement :: Set a -> a
anElement :: forall a. Set a -> a
anElement (Set []) = String -> a
forall a. HasCallStack => String -> a
error String
"Data.WeakSet.anElement: empty set"
anElement (Set (a
x:[a]
xs)) = a
x

-- | Return the cartesian product of a collection of sets.

cartesianProductOfSets :: (Monoid (m a), Monad m, Foldable m, Eq a) => m (Set a) -> Set (m a)
cartesianProductOfSets :: forall (m :: * -> *) a.
(Monoid (m a), Monad m, Foldable m, Eq a) =>
m (Set a) -> Set (m a)
cartesianProductOfSets m (Set a)
t = (Set a -> Set (m a) -> Set (m a))
-> Set (m a) -> m (Set a) -> Set (m a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr (\Set a
s Set (m a)
result -> (m a -> m a -> m a
forall a. Semigroup a => a -> a -> a
(<>)(m a -> m a -> m a) -> (a -> m a) -> a -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a -> m a) -> Set a -> Set (m a -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a
s) Set (m a -> m a) -> Set (m a) -> Set (m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set (m a)
result) ([m a] -> Set (m a)
forall a. [a] -> Set a
set ([m a] -> Set (m a)) -> [m a] -> Set (m a)
forall a b. (a -> b) -> a -> b
$ m a -> [m a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> [m a]) -> m a -> [m a]
forall a b. (a -> b) -> a -> b
$ m a
forall a. Monoid a => a
mempty) m (Set a)
t 

-- | /O(n^2)/. Fold the elements in the set using the given right-associative binary operator.

--

-- Note that an Eq constraint must be added.

foldr :: (Eq a) => (a -> b -> b) -> b -> Set a -> b
foldr :: forall a b. Eq a => (a -> b -> b) -> b -> Set a -> b
foldr a -> b -> b
f b
d Set a
s = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr a -> b -> b
f b
d (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList Set a
s)

-- | /O(n^2)/. Fold the elements in the set using the given right-associative binary operator.

--

-- Note that an Eq constraint must be added.

foldl :: (Eq b) => (a -> b -> a) -> a -> Set b -> a
foldl :: forall b a. Eq b => (a -> b -> a) -> a -> Set b -> a
foldl a -> b -> a
f a
d Set b
s = (a -> b -> a) -> a -> [b] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl a -> b -> a
f a
d (Set b -> [b]
forall a. Eq a => Set a -> [a]
setToList Set b
s)

-- | /O(n^2)/. Alias of `cardinal`.

length :: (Eq a) => Set a -> Int
length :: forall a. Eq a => Set a -> Int
length = Set a -> Int
forall a. Eq a => Set a -> Int
cardinal

-- | /O(n)/. Return wether an element is in the 'Set'.

elem :: (Eq a) => a -> Set a -> Bool
elem :: forall a. Eq a => a -> Set a -> Bool
elem a
a (Set [a]
xs) = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Foldable.elem a
a [a]
xs

-- | /O(n)/. Return the maximum value of a 'Set'. 

maximum :: (Ord a) => Set a -> a
maximum :: forall a. Ord a => Set a -> a
maximum = ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.maximum)([a] -> a) -> (Set a -> [a]) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n)/. Return the minimum value of a 'Set'. 

minimum :: (Ord a) => Set a -> a
minimum :: forall a. Ord a => Set a -> a
minimum = ([a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.minimum)([a] -> a) -> (Set a -> [a]) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n^2)/. Return the sum of values in a 'Set'.

sum :: (Eq a, Num a) => Set a -> a
sum :: forall a. (Eq a, Num a) => Set a -> a
sum = ([a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.sum)([a] -> a) -> (Set a -> [a]) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList

-- | /O(n^2)/. Return the product of values in a 'Set'.

product :: (Eq a, Num a) => Set a -> a
product :: forall a. (Eq a, Num a) => Set a -> a
product = ([a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Foldable.product)([a] -> a) -> (Set a -> [a]) -> Set a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList

-- | /O(n^2)/. Flatten a set of lists into a list.

--

-- Example : @concat set [[1,2,3],[1,2,3],[1,2]] == [1,2,3,1,2]@

concat :: (Eq a) => Set [a] -> [a]
concat :: forall a. Eq a => Set [a] -> [a]
concat = ([[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
Foldable.concat)([[a]] -> [a]) -> (Set [a] -> [[a]]) -> Set [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set [a] -> [[a]]
forall a. Eq a => Set a -> [a]
setToList

-- | /O(n)/. Flatten a set of sets into a set.

--

-- Example : @concat set [set [1,2,3], set [1,2,3], set [1,2]] == set [1,2,3]@

concat2 :: Set (Set a) -> Set a
concat2 :: forall a. Set (Set a) -> Set a
concat2 (Set [Set a]
xs) = [a] -> Set a
forall a. [a] -> Set a
Set ([a] -> Set a) -> [a] -> Set a
forall a b. (a -> b) -> a -> b
$ [a
x | Set a
s <- [Set a]
xs, a
x <- (Set a -> [a]
forall a. Set a -> [a]
unsafeSetToList Set a
s)]

-- | /O(n^2)/. Map a function over all the elements of a 'Set' and concatenate the resulting lists.

concatMap :: (Eq b) => (a -> [b]) -> Set a -> [b]
concatMap :: forall b a. Eq b => (a -> [b]) -> Set a -> [b]
concatMap a -> [b]
f Set a
s = Set [b] -> [b]
forall a. Eq a => Set [a] -> [a]
concat (Set [b] -> [b]) -> Set [b] -> [b]
forall a b. (a -> b) -> a -> b
$ a -> [b]
f (a -> [b]) -> Set a -> Set [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a
s 

-- | /O(n)/. Return the conjonction of a 'Set' of booleans. 

and :: Set Bool -> Bool
and :: Set Bool -> Bool
and = ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Foldable.and)([Bool] -> Bool) -> (Set Bool -> [Bool]) -> Set Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set Bool -> [Bool]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n)/. Return the disjunction of a 'Set' of booleans. 

or :: Set Bool -> Bool
or :: Set Bool -> Bool
or = ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
Foldable.or)([Bool] -> Bool) -> (Set Bool -> [Bool]) -> Set Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set Bool -> [Bool]
forall a. Set a -> [a]
unsafeSetToList

-- | /O(n)/. Determines whether any element of the 'Set' satisfies the predicate.

any :: (a -> Bool) -> Set a -> Bool
any :: forall a. (a -> Bool) -> Set a -> Bool
any a -> Bool
f (Set [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.any a -> Bool
f ([a]
xs)

-- | /O(n)/. Determines whether all elements of the 'Set' satisfy the predicate.

all :: (a -> Bool) -> Set a -> Bool
all :: forall a. (a -> Bool) -> Set a -> Bool
all a -> Bool
f (Set [a]
xs) = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
Foldable.all a -> Bool
f ([a]
xs)

-- | /O(n)/. The largest element of a non-empty 'Set' with respect to the given comparison function.

maximumBy ::  (a -> a -> Ordering) -> Set a -> a
maximumBy :: forall a. (a -> a -> Ordering) -> Set a -> a
maximumBy a -> a -> Ordering
f (Set [a]
xs) = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Foldable.maximumBy a -> a -> Ordering
f [a]
xs


-- | /O(n)/. The smallest element of a non-empty 'Set' with respect to the given comparison function.

minimumBy ::  (a -> a -> Ordering) -> Set a -> a
minimumBy :: forall a. (a -> a -> Ordering) -> Set a -> a
minimumBy a -> a -> Ordering
f (Set [a]
xs) = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
Foldable.minimumBy a -> a -> Ordering
f [a]
xs

-- | /O(n)/. Negation of 'elem'.

notElem :: (Eq a) => a -> Set a -> Bool
notElem :: forall a. Eq a => a -> Set a -> Bool
notElem a
x Set a
s = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Set a -> Bool
forall a. Eq a => a -> Set a -> Bool
elem a
x Set a
s

-- | /O(n)/. The 'find' function takes a predicate and a 'Set' and returns an element of the 'Set' matching the predicate, or Nothing if there is no such element.

find :: (a -> Bool) -> Set a -> Maybe a 
find :: forall a. (a -> Bool) -> Set a -> Maybe a
find a -> Bool
f (Set [a]
xs) = (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Foldable.find a -> Bool
f [a]
xs