{-# 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 {
    RectStyle img -> ColourPallet
colours :: ColourPallet,
    RectStyle img -> Backgrounds img
backgrounds :: Backgrounds img,
    RectStyle img -> Border
border' :: Border
} deriving (RectStyle img -> RectStyle img -> Bool
(RectStyle img -> RectStyle img -> Bool)
-> (RectStyle img -> RectStyle img -> Bool) -> Eq (RectStyle img)
forall img. Eq img => RectStyle img -> RectStyle img -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RectStyle img -> RectStyle img -> Bool
$c/= :: forall img. Eq img => RectStyle img -> RectStyle img -> Bool
== :: RectStyle img -> RectStyle img -> Bool
$c== :: forall img. Eq img => RectStyle img -> RectStyle img -> Bool
Eq, Int -> RectStyle img -> ShowS
[RectStyle img] -> ShowS
RectStyle img -> String
(Int -> RectStyle img -> ShowS)
-> (RectStyle img -> String)
-> ([RectStyle img] -> ShowS)
-> Show (RectStyle img)
forall img. Show img => Int -> RectStyle img -> ShowS
forall img. Show img => [RectStyle img] -> ShowS
forall img. Show img => RectStyle img -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RectStyle img] -> ShowS
$cshowList :: forall img. Show img => [RectStyle img] -> ShowS
show :: RectStyle img -> String
$cshow :: forall img. Show img => RectStyle img -> String
showsPrec :: Int -> RectStyle img -> ShowS
$cshowsPrec :: forall img. Show img => Int -> RectStyle img -> ShowS
Show, ReadPrec [RectStyle img]
ReadPrec (RectStyle img)
Int -> ReadS (RectStyle img)
ReadS [RectStyle img]
(Int -> ReadS (RectStyle img))
-> ReadS [RectStyle img]
-> ReadPrec (RectStyle img)
-> ReadPrec [RectStyle img]
-> Read (RectStyle img)
forall img. Read img => ReadPrec [RectStyle img]
forall img. Read img => ReadPrec (RectStyle img)
forall img. Read img => Int -> ReadS (RectStyle img)
forall img. Read img => ReadS [RectStyle img]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RectStyle img]
$creadListPrec :: forall img. Read img => ReadPrec [RectStyle img]
readPrec :: ReadPrec (RectStyle img)
$creadPrec :: forall img. Read img => ReadPrec (RectStyle img)
readList :: ReadS [RectStyle img]
$creadList :: forall img. Read img => ReadS [RectStyle img]
readsPrec :: Int -> ReadS (RectStyle img)
$creadsPrec :: forall img. Read img => Int -> ReadS (RectStyle img)
Read)
colour :: RectStyle img -> AlphaColour Float
colour :: RectStyle img -> AlphaColour Float
colour = ColourPallet -> AlphaColour Float
foreground (ColourPallet -> AlphaColour Float)
-> (RectStyle img -> ColourPallet)
-> RectStyle img
-> AlphaColour Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RectStyle img -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours
border :: RectStyle img -> Border
border :: RectStyle img -> Border
border self :: RectStyle img
self = (RectStyle img -> Border
forall img. RectStyle img -> Border
border' RectStyle img
self) { borderPallet :: ColourPallet
borderPallet = RectStyle img -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours RectStyle img
self }

instance PropertyParser (RectStyle Text) where
    temp :: RectStyle Text
temp = RectStyle :: forall img.
ColourPallet -> Backgrounds img -> Border -> RectStyle img
RectStyle { colours :: ColourPallet
colours = ColourPallet
forall a. PropertyParser a => a
temp, backgrounds :: Backgrounds Text
backgrounds = Backgrounds Text
forall a. PropertyParser a => a
temp, border' :: Border
border' = Border
forall a. PropertyParser a => a
temp }
    inherit :: RectStyle Text -> RectStyle Text
inherit RectStyle {..} = RectStyle :: forall img.
ColourPallet -> Backgrounds img -> Border -> RectStyle img
RectStyle {
        colours :: ColourPallet
colours = ColourPallet -> ColourPallet
forall a. PropertyParser a => a -> a
inherit ColourPallet
colours, backgrounds :: Backgrounds Text
backgrounds = Backgrounds Text
forall a. PropertyParser a => a
temp, border' :: Border
border' = Border
forall a. PropertyParser a => a
temp
    }
    priority :: RectStyle Text -> [Text]
priority RectStyle {..} =
        ColourPallet -> [Text]
forall a. PropertyParser a => a -> [Text]
priority ColourPallet
colours [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Backgrounds Text -> [Text]
forall a. PropertyParser a => a -> [Text]
priority Backgrounds Text
backgrounds [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Border -> [Text]
forall a. PropertyParser a => a -> [Text]
priority Border
border'

    shorthand :: RectStyle Text -> Text -> [Token] -> Props
shorthand self :: RectStyle Text
self key :: Text
key value :: [Token]
value
        | ret :: Props
ret@(_:_) <- Backgrounds Text -> Text -> [Token] -> Props
forall a. PropertyParser a => a -> Text -> [Token] -> Props
shorthand (RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
self) Text
key [Token]
value = Props
ret
        | ret :: Props
ret@(_:_) <- Border -> Text -> [Token] -> Props
forall a. PropertyParser a => a -> Text -> [Token] -> Props
shorthand (RectStyle Text -> Border
forall img. RectStyle img -> Border
border RectStyle Text
self) Text
key [Token]
value = Props
ret
        | Just _ <- RectStyle Text
-> RectStyle Text -> Text -> [Token] -> Maybe (RectStyle Text)
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand RectStyle Text
self RectStyle Text
self Text
key [Token]
value = [(Text
key, [Token]
value)]
        | Bool
otherwise = []
    longhand :: RectStyle Text
-> RectStyle Text -> Text -> [Token] -> Maybe (RectStyle Text)
longhand parent :: RectStyle Text
parent self :: RectStyle Text
self key :: Text
key value :: [Token]
value
        | Just ret :: Backgrounds Text
ret <- Backgrounds Text
-> Backgrounds Text -> Text -> [Token] -> Maybe (Backgrounds Text)
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
parent) { pallet :: ColourPallet
pallet = RectStyle Text -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours RectStyle Text
self }
                (RectStyle Text -> Backgrounds Text
forall img. RectStyle img -> Backgrounds img
backgrounds RectStyle Text
self) { pallet :: ColourPallet
pallet = RectStyle Text -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours RectStyle Text
self } Text
key [Token]
value =
            RectStyle Text -> Maybe (RectStyle Text)
forall a. a -> Maybe a
Just RectStyle Text
self { backgrounds :: Backgrounds Text
backgrounds = Backgrounds Text
ret }
        | Just ret :: ColourPallet
ret <- ColourPallet
-> ColourPallet -> Text -> [Token] -> Maybe ColourPallet
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (RectStyle Text -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours RectStyle Text
parent) (RectStyle Text -> ColourPallet
forall img. RectStyle img -> ColourPallet
colours RectStyle Text
self) Text
key [Token]
value =
            RectStyle Text -> Maybe (RectStyle Text)
forall a. a -> Maybe a
Just RectStyle Text
self { colours :: ColourPallet
colours = ColourPallet
ret }
        | Just ret :: Border
ret <- Border -> Border -> Text -> [Token] -> Maybe Border
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (RectStyle Text -> Border
forall img. RectStyle img -> Border
border RectStyle Text
parent) (RectStyle Text -> Border
forall img. RectStyle img -> Border
border RectStyle Text
self) Text
key [Token]
value =
            RectStyle Text -> Maybe (RectStyle Text)
forall a. a -> Maybe a
Just RectStyle Text
self { border' :: Border
border' = Border
ret }
        | Bool
otherwise = Maybe (RectStyle Text)
forall a. Maybe a
Nothing