{-# LANGUAGE Safe, MultiParamTypeClasses, FlexibleInstances #-}

{- |
    Module      :  SDP.HashSet
    Copyright   :  (c) Andrey Mulik 2020
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  portable
  
    @SDP.HashSet@ provides 'HashSet' - unordered set with 'Hashable' keys.
-}
module SDP.HashSet
(
  -- * Exports
  module SDP.Hashable,
  module SDP.Linear,
  module SDP.Set,
  
  -- * Hash set
  HashSet
)
where

import Prelude ()
import SDP.SafePrelude
import SDP.Hashable
import SDP.Linear
import SDP.Set

import qualified Data.HashSet as H
import Data.HashSet ( HashSet )

default ()

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

{- Nullable, Estimate and Bordered instances. -}

instance Nullable (HashSet e)
  where
    isNull :: HashSet e -> Bool
isNull = HashSet e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    lzero :: HashSet e
lzero  = HashSet e
forall e. HashSet e
H.empty

instance Estimate (HashSet e)
  where
    <==> :: Compare (HashSet e)
(<==>) = (Int -> Int -> Ordering)
-> (HashSet e -> Int) -> Compare (HashSet e)
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<=. :: HashSet e -> HashSet e -> Bool
(.<=.) = (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> HashSet e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>=. :: HashSet e -> HashSet e -> Bool
(.>=.) = (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> HashSet e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>. :: HashSet e -> HashSet e -> Bool
(.>.)  = (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> HashSet e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)   HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<. :: HashSet e -> HashSet e -> Bool
(.<.)  = (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> HashSet e -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)   HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    
    <.=> :: HashSet e -> Int -> Ordering
(<.=>) = Int -> Int -> Ordering
forall o. Ord o => Compare o
(<=>) (Int -> Int -> Ordering)
-> (HashSet e -> Int) -> HashSet e -> Int -> Ordering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .>= :: HashSet e -> Int -> Bool
(.>=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=)  (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .<= :: HashSet e -> Int -> Bool
(.<=)  = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=)  (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .> :: HashSet e -> Int -> Bool
(.>)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>)   (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf
    .< :: HashSet e -> Int -> Bool
(.<)   = Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<)   (Int -> Int -> Bool)
-> (HashSet e -> Int) -> HashSet e -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> Int
forall b i. Bordered b i => b -> Int
sizeOf

instance Bordered (HashSet e) Int
  where
    sizeOf :: HashSet e -> Int
sizeOf = HashSet e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
    
    upper :: HashSet e -> Int
upper HashSet e
xs = HashSet e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashSet e
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    lower :: HashSet e -> Int
lower  HashSet e
_ = Int
0

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

instance (Eq e, Hashable e) => Set (HashSet e) e
  where
    set :: HashSet e -> HashSet e
set    = HashSet e -> HashSet e
forall a. a -> a
id -- always correct
    member :: e -> HashSet e -> Bool
member = e -> HashSet e -> Bool
forall e. (Eq e, Hashable e) => e -> HashSet e -> Bool
H.member
    insert :: e -> HashSet e -> HashSet e
insert = e -> HashSet e -> HashSet e
forall e. (Eq e, Hashable e) => e -> HashSet e -> HashSet e
H.insert
    delete :: e -> HashSet e -> HashSet e
delete = e -> HashSet e -> HashSet e
forall e. (Eq e, Hashable e) => e -> HashSet e -> HashSet e
H.delete
    
    unions :: f (HashSet e) -> HashSet e
unions        = (HashSet e -> HashSet e -> HashSet e) -> f (HashSet e) -> HashSet e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
(\/)
    symdiffs :: f (HashSet e) -> HashSet e
symdiffs      = (HashSet e -> HashSet e -> HashSet e) -> f (HashSet e) -> HashSet e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
(\^/)
    differences :: f (HashSet e) -> HashSet e
differences   = (HashSet e -> HashSet e -> HashSet e) -> f (HashSet e) -> HashSet e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
(/\)
    intersections :: f (HashSet e) -> HashSet e
intersections = (HashSet e -> HashSet e -> HashSet e) -> f (HashSet e) -> HashSet e
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
(\\)
    
    /\ :: HashSet e -> HashSet e -> HashSet e
(/\) = HashSet e -> HashSet e -> HashSet e
forall e. (Eq e, Hashable e) => HashSet e -> HashSet e -> HashSet e
H.intersection
    \\ :: HashSet e -> HashSet e -> HashSet e
(\\) = HashSet e -> HashSet e -> HashSet e
forall e. (Eq e, Hashable e) => HashSet e -> HashSet e -> HashSet e
H.difference
    \/ :: HashSet e -> HashSet e -> HashSet e
(\/) = HashSet e -> HashSet e -> HashSet e
forall e. (Eq e, Hashable e) => HashSet e -> HashSet e -> HashSet e
H.union
    
    HashSet e
xs \^/ :: HashSet e -> HashSet e -> HashSet e
\^/ HashSet e
ys = (HashSet e
xs HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
\/ HashSet e
ys) HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
\\ (HashSet e
xs HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
/\ HashSet e
ys)
    HashSet e
xs \+/ :: HashSet e -> HashSet e -> Bool
\+/ HashSet e
ys = HashSet e -> Bool
forall e. Nullable e => e -> Bool
isNull (HashSet e
ys HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
\\ HashSet e
xs)
    HashSet e
xs /?\ :: HashSet e -> HashSet e -> Bool
/?\ HashSet e
ys = HashSet e -> Bool
forall e. Nullable e => e -> Bool
isNull (HashSet e
xs HashSet e -> HashSet e -> HashSet e
forall s o. Set s o => s -> s -> s
/\ HashSet e
ys)
    HashSet e
xs \?/ :: HashSet e -> HashSet e -> Bool
\?/ HashSet e
ys = Bool -> Bool
not (HashSet e
xs HashSet e -> HashSet e -> Bool
forall s o. Set s o => s -> s -> Bool
/?\ HashSet e
ys)
    
    lookupLT :: e -> HashSet e -> Maybe e
lookupLT e
e = e -> [e] -> Maybe e
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLT e
e ([e] -> Maybe e) -> (HashSet e -> [e]) -> HashSet e -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> [e]
forall a. HashSet a -> [a]
H.toList
    lookupGT :: e -> HashSet e -> Maybe e
lookupGT e
e = e -> [e] -> Maybe e
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGT e
e ([e] -> Maybe e) -> (HashSet e -> [e]) -> HashSet e -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> [e]
forall a. HashSet a -> [a]
H.toList
    lookupLE :: e -> HashSet e -> Maybe e
lookupLE e
e = e -> [e] -> Maybe e
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupLE e
e ([e] -> Maybe e) -> (HashSet e -> [e]) -> HashSet e -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> [e]
forall a. HashSet a -> [a]
H.toList
    lookupGE :: e -> HashSet e -> Maybe e
lookupGE e
e = e -> [e] -> Maybe e
forall s o. (Set s o, Ord o) => o -> s -> Maybe o
lookupGE e
e ([e] -> Maybe e) -> (HashSet e -> [e]) -> HashSet e -> Maybe e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet e -> [e]
forall a. HashSet a -> [a]
H.toList