minesweeper-0.9: Core/SetContainer.lhs

> {-# 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)]