3 import Data.List (nub, (\\), deleteBy)
6 import Text.Parse as Parse
10 type ShapeName = String
11 data Palette a = Palette [ (ShapeName, (Shape, Ports, Maybe a)) ]
12 deriving (Eq, Show, Read)
14 shapes :: Palette a -> [ (ShapeName,(Shape, Ports, Maybe a)) ]
15 shapes (Palette p) = p
17 join :: Eq a => Palette a -> Palette a -> Palette a
18 join (Palette p) (Palette q) = Palette (nub (p++q))
20 delete :: Eq a => Palette a -> Palette a -> Palette a
21 delete (Palette p) (Palette q) = Palette (p\\q)
23 deleteShape :: String -> Palette a -> Palette a
24 deleteShape name (Palette p) = Palette $ deleteBy equal (name, undefined) p
25 where equal (name1,_) (name2,_) = name1 == name2
27 -- cannot be completely empty, always one default shape
29 empty = Palette [("circle", (Shape.circle, [], Nothing))]
31 shapesNames :: Palette a -> [ShapeName]
32 shapesNames = map fst . shapes
34 instance Functor Palette where
35 fmap _ (Palette p) = Palette (map (\ (n,(s,a,_))-> (n,(s,a,Nothing))) p)
37 instance Parse a => Parse (Palette a) where
38 parse = do{ isWord "Palette"; fmap Palette $ parse }
40 getSymbol :: ShapeName -> Palette a -> Maybe (Shape, Ports, Maybe a)
41 getSymbol shapeName = lookup shapeName . shapes