{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}

module Data.Set.List (SetList(..)) where


import Data.Monoid
import qualified Data.List as List
import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap)
import Data.Collections
import Data.Typeable

-- | View a list of as a 'Set' collection.
--
-- This allows to feed sequences into algorithms that require a Set without building a full-fledged Set.
-- Most of the time this will be used only when the parameter list is known to be very small, such that
-- conversion to a Set would be to costly.

--FIXME: Generalize to sequences.
newtype SetList s = SetList {fromSetList :: s}

instance (Eq s, Eq a, Foldable s a) => Eq (SetList s) where
    (SetList l1) == (SetList l2) = l1 == l2 || 
                                   (size l1 == size l2 && all (`elem` l1) l2)


#include "Typeable.h"
INSTANCE_TYPEABLE1(SetList,theTc,"Data.Set.List.SetList")

instance Show l => Show (SetList l) where
    show (SetList l) = "SetList " >< show l

instance Foldable (SetList [a]) a where
    foldr f z (SetList l) = foldr f z l
    null (SetList l) = null l

instance Eq a => Set (SetList [a]) a where
    haddock_candy = haddock_candy

instance Eq a => Monoid (SetList [a]) where
    mempty = empty
    mappend = union

instance Eq a => Unfoldable (SetList [a]) a where
    empty = SetList empty
    insert x (SetList l) = SetList $ if x `elem` l then l else insert x l
    
instance Eq a => Collection (SetList [a]) a where
    filter f (SetList l) = SetList $ filter f l

instance Eq a => Map (SetList [a]) a () where
    isSubmapBy f x y = isSubset x y && (f () () || null (intersection x y))
    insertWith _f k () = insert k
    unionWith _f = union
    intersectionWith _f = intersection
    mapWithKey _f = id
    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"

    (SetList l1) `isSubset` (SetList l2) = all (`elem` l2) l1
    difference (SetList l1) (SetList l2) = SetList $ (List.\\) l1 l2
    delete k (SetList l) = SetList $ filter (not . (k ==)) l
    member k (SetList l) = List.elem k l
    union (SetList l1) (SetList l2) = SetList $ List.union l1 l2
    intersection (SetList l1) (SetList l2) = SetList $ List.intersect l1 l2
    alter f k l = let lk = lookup k l in
        case lk of
           Nothing -> case f lk of
                         Nothing -> l
                         Just _ -> insert k l
           Just _ -> case f lk of
                         Nothing -> delete k l
                         Just _ -> l