test.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}

import Data.Monoid
import Data.Proxy


data Colour = Red | Green | Blue deriving (Show)
data Size = Large | Small deriving (Eq, Show)
data Sign = Plus | Minus deriving (Eq, Show)

data Atom (a :: Colour) = Atom Sign Size deriving (Show)

data SubElement = SubElement Sign Colour
                | Neutral
                deriving (Show)
data Element = Element  { red :: Atom Red
                        , green :: Atom Green
                        , blue :: Atom Blue
                        } deriving (Show)


mix :: Element -> Element -> SubElement
mix (Element aR aG aB) (Element bR bG bB) = maybe Neutral (uncurry SubElement) $ getFirst $ mconcat [
      f (Red  ) aR bR
    , f (Green) aG bG
    , f (Blue ) aB bB
    ]
  where
    f :: Colour -> Atom a -> Atom a -> First (Sign, Colour)
    f c (Atom signA sizeA) (Atom signB sizeB)
      | signA == signB && sizeA /= sizeB = First $ Just (signA, c)
      | otherwise = First Nothing


elems :: [Element]
elems = map f [
      (Atom Minus Small, Atom Plus Small, Atom Minus Large)
    , (Atom Plus Small, Atom Minus Small, Atom Plus Large)
    , (Atom Plus Small, Atom Minus Large, Atom Minus Small)
    , (Atom Minus Small, Atom Plus Large, Atom Plus Small)
    , (Atom Minus Large, Atom Minus Small, Atom Plus Small)
    , (Atom Plus Large, Atom Plus Small, Atom Minus Small)
    , (Atom Minus Large, Atom Minus Large, Atom Minus Large)
    , (Atom Plus Large, Atom Plus Large, Atom Plus Large) 
    ]
  where f (a,b,c) = Element a b c