{-# LANGUAGE
  UnicodeSyntax,
  MultiParamTypeClasses,
  FlexibleInstances,
  FunctionalDependencies,
  TypeSynonymInstances,
  NoImplicitPrelude
 #-}

module Data.SetOps (
  Member (member), (∈), (∉), (∋), (∌),
  ProperSubsetOf (isProperSubsetOf), (⊂), (⊄), (⊃), (⊅),
  SubsetOf (isSubsetOf), (⊆), (⊈), (⊇), (⊉),
  Union (union), (∪),
  Intersection (intersection), (∩),
  Empty (empty), (∅),
  Singleton(singleton),
  Insert(insert)
) where

import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.IntSet as IntSet
import qualified Data.IntMap as IntMap
import Data.Set (Set)
import Data.Map (Map)
import Data.IntSet (IntSet)
import Data.IntMap (IntMap)

import Prelude (Eq, Ord, Bool, Int, flip, uncurry, not, (.))

class Member a b | b → a where member :: a → b → Bool
class ProperSubsetOf a where isProperSubsetOf :: a → a → Bool
class SubsetOf a where isSubsetOf :: a → a → Bool
class Union a where union :: a → a → a
class Intersection a where intersection :: a → a → a
class Empty a where empty :: a
class Singleton a b | b → a where singleton :: a → b
class Insert a b | b → a where insert :: a → b → b

(∈), (∉) :: Member a b ⇒ a → b → Bool
(∈) = member
(∉) x = not . (x ∈)

(∋), (∌) :: Member a b ⇒ b → a → Bool
(∋) = flip (∈)
(∌) = flip (∉)

(⊂), (⊄), (⊃), (⊅) :: ProperSubsetOf a ⇒ a → a → Bool
(⊂) = isProperSubsetOf
(⊄) x = not . (x ⊂)
(⊃) = flip (⊂)
(⊅) = flip (⊄)

(⊆), (⊈), (⊇), (⊉) :: SubsetOf a ⇒ a → a → Bool
(⊆) = isSubsetOf
(⊈) x = not . (x ⊆)
(⊇) = flip (⊆)
(⊉) = flip (⊈)

(∪) :: Union a ⇒ a → a → a
(∪) = union

(∩) :: Intersection a ⇒ a → a → a
(∩) = intersection

-- | .

-- The above is a workaround; without at least one Haddock-commented
-- function, Haddock does not generate a synopsis.

(∅) :: Empty a ⇒ a
(∅) = empty

{- We don't let ∉ be specialized independently, because it does not make sense to
 have a ∉ that is faster than ∈. After all, in that case, one should have defined ∈ as
 the negation of ∉ and have it be as fast. The same argument applies to ⊄ and ⊈. -}

-- Fixities:

infix 4 ∈
infix 4 ∉
infix 4 ∋
infix 4 ∌
infix 4 ⊆
infix 4 ⊈
infix 4 ⊇
infix 4 ⊉
infix 4 ⊂
infix 4 ⊄
infix 4 ⊃
infix 4 ⊅
infixl 6 ∪
infixr 6 ∩

-- Instances:

instance Eq a ⇒ Member a [a] where member = List.elem
instance Ord a ⇒ Member a (Set a) where member = Set.member
instance Ord k ⇒ Member k (Map k v) where member = Map.member
instance Member Int IntSet where member = IntSet.member
instance Member IntMap.Key (IntMap v) where member = IntMap.member

instance Ord a ⇒ ProperSubsetOf (Set a) where isProperSubsetOf = Set.isProperSubsetOf
instance (Ord k, Eq v) ⇒ ProperSubsetOf (Map k v) where isProperSubsetOf = Map.isProperSubmapOf
instance ProperSubsetOf IntSet where isProperSubsetOf = IntSet.isProperSubsetOf
instance Eq v ⇒ ProperSubsetOf (IntMap v) where isProperSubsetOf = IntMap.isProperSubmapOf

instance Ord a ⇒ SubsetOf (Set a) where isSubsetOf = Set.isSubsetOf
instance (Ord k, Eq v) ⇒ SubsetOf (Map k v) where isSubsetOf = Map.isSubmapOf
instance SubsetOf IntSet where isSubsetOf = IntSet.isSubsetOf
instance Eq v ⇒ SubsetOf (IntMap v) where isSubsetOf = IntMap.isSubmapOf

instance Eq a ⇒ Union [a] where union = List.union
instance Ord a ⇒ Union (Set a) where union = Set.union
instance Ord k ⇒ Union (Map k v) where union = Map.union
instance Union IntSet where union = IntSet.union
instance Union (IntMap v) where union = IntMap.union

instance Eq a ⇒ Intersection [a] where intersection = List.intersect
instance Ord a ⇒ Intersection (Set a) where intersection = Set.intersection
instance Ord k ⇒ Intersection (Map k v) where intersection = Map.intersection
instance Intersection IntSet where intersection = IntSet.intersection
instance Intersection (IntMap v) where intersection = IntMap.intersection

instance Ord a ⇒ Insert a [a] where insert = List.insert
instance Ord a ⇒ Insert a (Set a) where insert = Set.insert
instance Ord k ⇒ Insert (k, v) (Map k v) where insert = uncurry Map.insert
instance Insert Int IntSet where insert = IntSet.insert
instance Insert (IntMap.Key, v) (IntMap v) where insert = uncurry IntMap.insert

instance Empty [a] where empty = []
instance Empty (Set a) where empty = Set.empty
instance Empty (Map k v) where empty = Map.empty
instance Empty IntSet where empty = IntSet.empty
instance Empty (IntMap v) where empty = IntMap.empty

instance Singleton a [a] where singleton = (:[])
instance Ord a ⇒ Singleton a (Set a) where singleton = Set.singleton
instance Ord k ⇒ Singleton (k, v) (Map k v) where singleton = uncurry Map.singleton
instance Singleton Int IntSet where singleton = IntSet.singleton
instance Singleton (IntMap.Key, v) (IntMap v) where singleton = uncurry IntMap.singleton