{-# OPTIONS_GHC -XTypeSynonymInstances -XFlexibleInstances -XMultiParamTypeClasses #-}

module Data.Collections.RangedSetsInstances where

import Prelude hiding (lookup)
import Data.Collections
import qualified Data.Ranged as Ranged
import Data.Ranged (DiscreteOrdered)

type RangedSet = Ranged.RSet

instance DiscreteOrdered a => Unfoldable (RangedSet a) a where
    insert x =  Ranged.rSetUnion (Ranged.rSingleton x)
    singleton = Ranged.rSingleton
    empty = Ranged.rSetEmpty

instance DiscreteOrdered a => Map (RangedSet a) a () where
    isSubset = Ranged.rSetIsSubset
    isSubmapBy f x y = isSubset x y && (f () () || Ranged.rSetIsEmpty (intersection x y))
    member = flip Ranged.rSetHas
    union = Ranged.rSetUnion
    difference = Ranged.rSetDifference
    intersection = Ranged.rSetIntersection
    delete = flip Ranged.rSetDifference . Ranged.rSingleton
    insertWith _f k () = insert k
    unionWith _f = union
    intersectionWith _f = intersection
    differenceWith f s1 s2 = if f () () == Nothing then difference s1 s2 else s1
    lookup k l = if member k l then return () else fail "element not found"
    alter f k m = case f (lookup k m) of
                      Just _ -> insert k m
                      Nothing -> delete k m
    mapWithKey _f = id 

instance DiscreteOrdered a => Set (RangedSet a) a where
    haddock_candy = haddock_candy