> {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances, ScopedTypeVariables, RankNTypes, ExistentialQuantification #-} > module Core.SetContainer > where Import List ----------- > import Data.List > import Data.SetClass > import Data.Domain ------------------------------ > class HasDomain (SetContainerElem c) => SetContainer c where > > type SetContainerElem c > > empty :: c > components :: c -> [Component (SetContainerElem c)] > insert :: SetContainerElem c -> c -> c > relatedElems :: SetContainerElem c -> c -> [(SetContainerElem c, c)] > data Component e > = OneElem e > | forall b. (SetContainer b, SetContainerElem b ~ e) => > TwoElems (SetContainerElem b) (SetContainerElem b) b ------------------------------------- > instance HasDomain a => SetContainer [a] where > type SetContainerElem [a] = a > empty = [] > insert = (:) > components [] = [] > components [a] = [OneElem a] > components (a:as) = case relatedElems a as of > [] -> OneElem a: components as > (b, c): _ -> [TwoElems a b c] > relatedElems x l = [(y, d) | (y, d) <- takeOut l, not (domain x `disjunct` domain y)] > takeOut l = [(y, xs ++ ys) | (xs, y:ys) <- zip (inits l) (tails l)]