Skip to content

Instantly share code, notes, and snippets.

@kgadek kgadek/test.hs
Created Aug 31, 2015

Embed
What would you like to do?
{-# 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.