minesweeper-0.8.9: Core/SetContainer.lhs

> {-# LANGUAGE TypeFamilies, FlexibleContexts, UndecidableInstances, ScopedTypeVariables, EmptyDataDecls, RankNTypes, ExistentialQuantification #-}

| Core data type for the game.

> module Core.SetContainer
>      where


Import List
-----------

> import Data.Binary
> import Data.DeriveTH
> import Data.Derive.Binary
> import Data.Derive.Functor

> import Data.SetClass

> import Data.Maybe
> import Data.List


------------------------------

> class Set (Domain a) => HasDomain a where

>   type Domain a

>   domain :: a -> Domain a

------------------------------

> class HasDomain (SetContainerElem c) => SetContainer c where
>
>     type SetContainerElem c   
> 
>     emptyC       :: c                
>     decomp       :: c -> [Decomp (SetContainerElem c)]
>     insertL      :: SetContainerElem c -> c -> c     
>     relatedElems :: SetContainerElem c -> c -> [(SetContainerElem c, c)] 

> data Decomp e
>   = OneElem e
>   | forall b. (SetContainer b, SetContainerElem b ~ e) => Dependents (SetContainerElem b) (SetContainerElem b) b

-------------------------------------

> instance HasDomain a => SetContainer [a] where
>
>     type SetContainerElem [a]  = a
>
>     emptyC          = []
>     insertL         = (:)
>     decomp [] = []
>     decomp [a] = [OneElem a]
>     decomp (a:as) = case relatedElems a as of
>       []  -> OneElem a: decomp as
>       (b, c): _ -> [Dependents 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)]