{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} module Graphics.Rendering.Rect.CSS(RectStyle(..), colour, border) where import Stylist (PropertyParser(..)) import Graphics.Rendering.Rect.CSS.Colour (ColourPallet(foreground)) import Graphics.Rendering.Rect.CSS.Backgrounds (Backgrounds(..)) import Graphics.Rendering.Rect.CSS.Border (Border(..)) import Data.Text (Text) import Data.Colour(AlphaColour) data RectStyle img = RectStyle { colours :: ColourPallet, backgrounds :: Backgrounds img, border' :: Border } deriving (Eq, Show, Read) colour :: RectStyle img -> AlphaColour Float colour = foreground . colours border :: RectStyle img -> Border border self = (border' self) { borderPallet = colours self } instance PropertyParser (RectStyle Text) where temp = RectStyle { colours = temp, backgrounds = temp, border' = temp } inherit RectStyle {..} = RectStyle { colours = inherit colours, backgrounds = temp, border' = temp } priority RectStyle {..} = priority colours ++ priority backgrounds ++ priority border' shorthand self key value | ret@(_:_) <- shorthand (backgrounds self) key value = ret | ret@(_:_) <- shorthand (border self) key value = ret | Just _ <- longhand self self key value = [(key, value)] | otherwise = [] longhand parent self key value | Just ret <- longhand (backgrounds parent) { pallet = colours self } (backgrounds self) { pallet = colours self } key value = Just self { backgrounds = ret } | Just ret <- longhand (colours parent) (colours self) key value = Just self { colours = ret } | Just ret <- longhand (border parent) (border self) key value = Just self { border' = ret } | otherwise = Nothing