module Palette where import Data.List (nub, (\\), deleteBy) import Shape import Math import Text.Parse as Parse import Ports type ShapeName = String data Palette a = Palette [ (ShapeName, (Shape, Ports, Maybe a)) ] deriving (Eq, Show, Read) shapes :: Palette a -> [ (ShapeName,(Shape, Ports, Maybe a)) ] shapes (Palette p) = p join :: Eq a => Palette a -> Palette a -> Palette a join (Palette p) (Palette q) = Palette (nub (p++q)) delete :: Eq a => Palette a -> Palette a -> Palette a delete (Palette p) (Palette q) = Palette (p\\q) deleteShape :: String -> Palette a -> Palette a deleteShape name (Palette p) = Palette $ deleteBy equal (name, undefined) p where equal (name1,_) (name2,_) = name1 == name2 -- cannot be completely empty, always one default shape empty :: Palette a empty = Palette [("circle", (Shape.circle, [], Nothing))] shapesNames :: Palette a -> [ShapeName] shapesNames = map fst . shapes instance Functor Palette where fmap _ (Palette p) = Palette (map (\ (n,(s,a,_))-> (n,(s,a,Nothing))) p) instance Parse a => Parse (Palette a) where parse = do{ isWord "Palette"; fmap Palette $ parse } getSymbol :: ShapeName -> Palette a -> Maybe (Shape, Ports, Maybe a) getSymbol shapeName = lookup shapeName . shapes