{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
module Clay.Border
(
-- * Stroke type, used for border-style and outline-style.
  Stroke
, solid, dotted, dashed, double, wavy, groove, ridge, inset, outset

-- * Border properties.

, border, borderTop, borderLeft, borderBottom, borderRight
, borderColor4, borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor
, borderStyle4, borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle
, borderWidth4, borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth

-- * Outline properties.

, outline, outlineTop, outlineLeft, outlineBottom, outlineRight
, outlineColor4, outlineColor, outlineLeftColor, outlineRightColor, outlineTopColor, outlineBottomColor
, outlineStyle4, outlineStyle, outlineLeftStyle, outlineRightStyle, outlineTopStyle, outlineBottomStyle
, outlineWidth4, outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth
, outlineOffset

-- * Border radius.

, borderRadius
, borderTopLeftRadius, borderTopRightRadius
, borderBottomLeftRadius, borderBottomRightRadius

-- * Collapsing borders model for a table
, borderCollapse
, borderSpacing, borderSpacing2
)
where

import Clay.Property
import Clay.Stylesheet
import Clay.Color
import Clay.Common
import Clay.Size
import Clay.Display

newtype Stroke = Stroke Value
  deriving (Stroke -> Value
(Stroke -> Value) -> Val Stroke
forall a. (a -> Value) -> Val a
value :: Stroke -> Value
$cvalue :: Stroke -> Value
Val, Value -> Stroke
(Value -> Stroke) -> Other Stroke
forall a. (Value -> a) -> Other a
other :: Value -> Stroke
$cother :: Value -> Stroke
Other, Stroke
Stroke -> Inherit Stroke
forall a. a -> Inherit a
inherit :: Stroke
$cinherit :: Stroke
Inherit, Stroke
Stroke -> Auto Stroke
forall a. a -> Auto a
auto :: Stroke
$cauto :: Stroke
Auto, Stroke
Stroke -> None Stroke
forall a. a -> None a
none :: Stroke
$cnone :: Stroke
None)

solid, dotted, dashed, double, wavy, groove, ridge, inset, outset :: Stroke

solid :: Stroke
solid  = Value -> Stroke
Stroke Value
"solid"
dotted :: Stroke
dotted = Value -> Stroke
Stroke Value
"dotted"
dashed :: Stroke
dashed = Value -> Stroke
Stroke Value
"dashed"
double :: Stroke
double = Value -> Stroke
Stroke Value
"double"
wavy :: Stroke
wavy   = Value -> Stroke
Stroke Value
"wavy"
groove :: Stroke
groove = Value -> Stroke
Stroke Value
"groove"
ridge :: Stroke
ridge  = Value -> Stroke
Stroke Value
"ridge"
inset :: Stroke
inset  = Value -> Stroke
Stroke Value
"inset"
outset :: Stroke
outset = Value -> Stroke
Stroke Value
"outset"

-------------------------------------------------------------------------------

border, borderTop, borderLeft, borderBottom, borderRight :: Size LengthUnit -> Stroke -> Color -> Css

border :: Size LengthUnit -> Stroke -> Color -> Css
border        Size LengthUnit
a Stroke
b Color
c = Key (Size LengthUnit, (Stroke, Color))
-> (Size LengthUnit, (Stroke, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit, (Stroke, Color))
"border"        (Size LengthUnit
a Size LengthUnit
-> (Stroke, Color) -> (Size LengthUnit, (Stroke, Color))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> Color -> (Stroke, Color)
forall a b. a -> b -> (a, b)
! Color
c)
borderTop :: Size LengthUnit -> Stroke -> Color -> Css
borderTop     Size LengthUnit
a Stroke
b Color
c = Key (Size LengthUnit, (Stroke, Color))
-> (Size LengthUnit, (Stroke, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit, (Stroke, Color))
"border-top"    (Size LengthUnit
a Size LengthUnit
-> (Stroke, Color) -> (Size LengthUnit, (Stroke, Color))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> Color -> (Stroke, Color)
forall a b. a -> b -> (a, b)
! Color
c)
borderLeft :: Size LengthUnit -> Stroke -> Color -> Css
borderLeft    Size LengthUnit
a Stroke
b Color
c = Key (Size LengthUnit, (Stroke, Color))
-> (Size LengthUnit, (Stroke, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit, (Stroke, Color))
"border-left"   (Size LengthUnit
a Size LengthUnit
-> (Stroke, Color) -> (Size LengthUnit, (Stroke, Color))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> Color -> (Stroke, Color)
forall a b. a -> b -> (a, b)
! Color
c)
borderBottom :: Size LengthUnit -> Stroke -> Color -> Css
borderBottom  Size LengthUnit
a Stroke
b Color
c = Key (Size LengthUnit, (Stroke, Color))
-> (Size LengthUnit, (Stroke, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit, (Stroke, Color))
"border-bottom" (Size LengthUnit
a Size LengthUnit
-> (Stroke, Color) -> (Size LengthUnit, (Stroke, Color))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> Color -> (Stroke, Color)
forall a b. a -> b -> (a, b)
! Color
c)
borderRight :: Size LengthUnit -> Stroke -> Color -> Css
borderRight   Size LengthUnit
a Stroke
b Color
c = Key (Size LengthUnit, (Stroke, Color))
-> (Size LengthUnit, (Stroke, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit, (Stroke, Color))
"border-right"  (Size LengthUnit
a Size LengthUnit
-> (Stroke, Color) -> (Size LengthUnit, (Stroke, Color))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> Color -> (Stroke, Color)
forall a b. a -> b -> (a, b)
! Color
c)

borderColor4 :: Color -> Color -> Color -> Color -> Css
borderColor4 :: Color -> Color -> Color -> Color -> Css
borderColor4 Color
a Color
b Color
c Color
d = Key (Color, (Color, (Color, Color)))
-> (Color, (Color, (Color, Color))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Color, (Color, (Color, Color)))
"border-color" (Color
a Color
-> (Color, (Color, Color)) -> (Color, (Color, (Color, Color)))
forall a b. a -> b -> (a, b)
! Color
b Color -> (Color, Color) -> (Color, (Color, Color))
forall a b. a -> b -> (a, b)
! Color
c Color -> Color -> (Color, Color)
forall a b. a -> b -> (a, b)
! Color
d)

borderColor, borderLeftColor, borderRightColor, borderTopColor, borderBottomColor :: Color -> Css

borderColor :: Color -> Css
borderColor       = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"border-color"
borderLeftColor :: Color -> Css
borderLeftColor   = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"border-left-color"
borderRightColor :: Color -> Css
borderRightColor  = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"border-right-color"
borderTopColor :: Color -> Css
borderTopColor    = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"border-top-color"
borderBottomColor :: Color -> Css
borderBottomColor = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"border-bottom-color"

borderStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css
borderStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css
borderStyle4 Stroke
a Stroke
b Stroke
c Stroke
d = Key (Stroke, (Stroke, (Stroke, Stroke)))
-> (Stroke, (Stroke, (Stroke, Stroke))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Stroke, (Stroke, Stroke)))
"border-style" (Stroke
a Stroke
-> (Stroke, (Stroke, Stroke))
-> (Stroke, (Stroke, (Stroke, Stroke)))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> (Stroke, Stroke) -> (Stroke, (Stroke, Stroke))
forall a b. a -> b -> (a, b)
! Stroke
c Stroke -> Stroke -> (Stroke, Stroke)
forall a b. a -> b -> (a, b)
! Stroke
d)

borderStyle, borderLeftStyle, borderRightStyle, borderTopStyle, borderBottomStyle :: Stroke -> Css

borderStyle :: Stroke -> Css
borderStyle       = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"border-style"
borderLeftStyle :: Stroke -> Css
borderLeftStyle   = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"border-left-style"
borderRightStyle :: Stroke -> Css
borderRightStyle  = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"border-right-style"
borderTopStyle :: Stroke -> Css
borderTopStyle    = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"border-top-style"
borderBottomStyle :: Stroke -> Css
borderBottomStyle = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"border-bottom-style"

borderWidth4 :: Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
borderWidth4 :: Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
borderWidth4 Size LengthUnit
a Size LengthUnit
b Size LengthUnit
c Size LengthUnit
d = Key
  (Size LengthUnit,
   (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
-> (Size LengthUnit,
    (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
-> Css
forall a. Val a => Key a -> a -> Css
key Key
  (Size LengthUnit,
   (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
"border-width" (Size LengthUnit
a Size LengthUnit
-> (Size LengthUnit, (Size LengthUnit, Size LengthUnit))
-> (Size LengthUnit,
    (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit
-> (Size LengthUnit, Size LengthUnit)
-> (Size LengthUnit, (Size LengthUnit, Size LengthUnit))
forall a b. a -> b -> (a, b)
! Size LengthUnit
c Size LengthUnit
-> Size LengthUnit -> (Size LengthUnit, Size LengthUnit)
forall a b. a -> b -> (a, b)
! Size LengthUnit
d)

borderWidth, borderLeftWidth, borderRightWidth, borderTopWidth, borderBottomWidth :: Size LengthUnit -> Css

borderWidth :: Size LengthUnit -> Css
borderWidth       = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"border-width"
borderLeftWidth :: Size LengthUnit -> Css
borderLeftWidth   = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"border-left-width"
borderRightWidth :: Size LengthUnit -> Css
borderRightWidth  = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"border-right-width"
borderTopWidth :: Size LengthUnit -> Css
borderTopWidth    = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"border-top-width"
borderBottomWidth :: Size LengthUnit -> Css
borderBottomWidth = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"border-bottom-width"

-------------------------------------------------------------------------------

outline, outlineTop, outlineLeft, outlineBottom, outlineRight :: Stroke -> Size LengthUnit -> Color -> Css

outline :: Stroke -> Size LengthUnit -> Color -> Css
outline        Stroke
a Size LengthUnit
b Color
c = Key (Stroke, (Size LengthUnit, Color))
-> (Stroke, (Size LengthUnit, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Size LengthUnit, Color))
"outline"        (Stroke
a Stroke
-> (Size LengthUnit, Color) -> (Stroke, (Size LengthUnit, Color))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit -> Color -> (Size LengthUnit, Color)
forall a b. a -> b -> (a, b)
! Color
c)
outlineTop :: Stroke -> Size LengthUnit -> Color -> Css
outlineTop     Stroke
a Size LengthUnit
b Color
c = Key (Stroke, (Size LengthUnit, Color))
-> (Stroke, (Size LengthUnit, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Size LengthUnit, Color))
"outline-top"    (Stroke
a Stroke
-> (Size LengthUnit, Color) -> (Stroke, (Size LengthUnit, Color))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit -> Color -> (Size LengthUnit, Color)
forall a b. a -> b -> (a, b)
! Color
c)
outlineLeft :: Stroke -> Size LengthUnit -> Color -> Css
outlineLeft    Stroke
a Size LengthUnit
b Color
c = Key (Stroke, (Size LengthUnit, Color))
-> (Stroke, (Size LengthUnit, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Size LengthUnit, Color))
"outline-left"   (Stroke
a Stroke
-> (Size LengthUnit, Color) -> (Stroke, (Size LengthUnit, Color))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit -> Color -> (Size LengthUnit, Color)
forall a b. a -> b -> (a, b)
! Color
c)
outlineBottom :: Stroke -> Size LengthUnit -> Color -> Css
outlineBottom  Stroke
a Size LengthUnit
b Color
c = Key (Stroke, (Size LengthUnit, Color))
-> (Stroke, (Size LengthUnit, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Size LengthUnit, Color))
"outline-bottom" (Stroke
a Stroke
-> (Size LengthUnit, Color) -> (Stroke, (Size LengthUnit, Color))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit -> Color -> (Size LengthUnit, Color)
forall a b. a -> b -> (a, b)
! Color
c)
outlineRight :: Stroke -> Size LengthUnit -> Color -> Css
outlineRight   Stroke
a Size LengthUnit
b Color
c = Key (Stroke, (Size LengthUnit, Color))
-> (Stroke, (Size LengthUnit, Color)) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Size LengthUnit, Color))
"outline-right"  (Stroke
a Stroke
-> (Size LengthUnit, Color) -> (Stroke, (Size LengthUnit, Color))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit -> Color -> (Size LengthUnit, Color)
forall a b. a -> b -> (a, b)
! Color
c)

outlineColor4 :: Color -> Color -> Color -> Color -> Css
outlineColor4 :: Color -> Color -> Color -> Color -> Css
outlineColor4 Color
a Color
b Color
c Color
d = Key (Color, (Color, (Color, Color)))
-> (Color, (Color, (Color, Color))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Color, (Color, (Color, Color)))
"outline-color" (Color
a Color
-> (Color, (Color, Color)) -> (Color, (Color, (Color, Color)))
forall a b. a -> b -> (a, b)
! Color
b Color -> (Color, Color) -> (Color, (Color, Color))
forall a b. a -> b -> (a, b)
! Color
c Color -> Color -> (Color, Color)
forall a b. a -> b -> (a, b)
! Color
d)

outlineColor, outlineLeftColor, outlineRightColor, outlineTopColor, outlineBottomColor :: Color -> Css

outlineColor :: Color -> Css
outlineColor       = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"outline-color"
outlineLeftColor :: Color -> Css
outlineLeftColor   = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"outline-left-color"
outlineRightColor :: Color -> Css
outlineRightColor  = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"outline-right-color"
outlineTopColor :: Color -> Css
outlineTopColor    = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"outline-top-color"
outlineBottomColor :: Color -> Css
outlineBottomColor = Key Color -> Color -> Css
forall a. Val a => Key a -> a -> Css
key Key Color
"outline-bottom-color"

outlineStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css
outlineStyle4 :: Stroke -> Stroke -> Stroke -> Stroke -> Css
outlineStyle4 Stroke
a Stroke
b Stroke
c Stroke
d = Key (Stroke, (Stroke, (Stroke, Stroke)))
-> (Stroke, (Stroke, (Stroke, Stroke))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Stroke, (Stroke, (Stroke, Stroke)))
"outline-style" (Stroke
a Stroke
-> (Stroke, (Stroke, Stroke))
-> (Stroke, (Stroke, (Stroke, Stroke)))
forall a b. a -> b -> (a, b)
! Stroke
b Stroke -> (Stroke, Stroke) -> (Stroke, (Stroke, Stroke))
forall a b. a -> b -> (a, b)
! Stroke
c Stroke -> Stroke -> (Stroke, Stroke)
forall a b. a -> b -> (a, b)
! Stroke
d)

outlineStyle, outlineLeftStyle, outlineRightStyle, outlineTopStyle, outlineBottomStyle :: Stroke -> Css

outlineStyle :: Stroke -> Css
outlineStyle       = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"outline-style"
outlineLeftStyle :: Stroke -> Css
outlineLeftStyle   = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"outline-left-style"
outlineRightStyle :: Stroke -> Css
outlineRightStyle  = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"outline-right-style"
outlineTopStyle :: Stroke -> Css
outlineTopStyle    = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"outline-top-style"
outlineBottomStyle :: Stroke -> Css
outlineBottomStyle = Key Stroke -> Stroke -> Css
forall a. Val a => Key a -> a -> Css
key Key Stroke
"outline-bottom-style"

outlineWidth4 :: Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
outlineWidth4 :: Size LengthUnit
-> Size LengthUnit -> Size LengthUnit -> Size LengthUnit -> Css
outlineWidth4 Size LengthUnit
a Size LengthUnit
b Size LengthUnit
c Size LengthUnit
d = Key
  (Size LengthUnit,
   (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
-> (Size LengthUnit,
    (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
-> Css
forall a. Val a => Key a -> a -> Css
key Key
  (Size LengthUnit,
   (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
"outline-width" (Size LengthUnit
a Size LengthUnit
-> (Size LengthUnit, (Size LengthUnit, Size LengthUnit))
-> (Size LengthUnit,
    (Size LengthUnit, (Size LengthUnit, Size LengthUnit)))
forall a b. a -> b -> (a, b)
! Size LengthUnit
b Size LengthUnit
-> (Size LengthUnit, Size LengthUnit)
-> (Size LengthUnit, (Size LengthUnit, Size LengthUnit))
forall a b. a -> b -> (a, b)
! Size LengthUnit
c Size LengthUnit
-> Size LengthUnit -> (Size LengthUnit, Size LengthUnit)
forall a b. a -> b -> (a, b)
! Size LengthUnit
d)

outlineWidth, outlineLeftWidth, outlineRightWidth, outlineTopWidth, outlineBottomWidth :: Size LengthUnit -> Css

outlineWidth :: Size LengthUnit -> Css
outlineWidth       = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-width"
outlineLeftWidth :: Size LengthUnit -> Css
outlineLeftWidth   = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-left-width"
outlineRightWidth :: Size LengthUnit -> Css
outlineRightWidth  = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-right-width"
outlineTopWidth :: Size LengthUnit -> Css
outlineTopWidth    = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-top-width"
outlineBottomWidth :: Size LengthUnit -> Css
outlineBottomWidth = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-bottom-width"

outlineOffset :: Size LengthUnit -> Css
outlineOffset :: Size LengthUnit -> Css
outlineOffset = Key (Size LengthUnit) -> Size LengthUnit -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size LengthUnit)
"outline-offset"

-------------------------------------------------------------------------------

borderRadius :: Size a -> Size a -> Size a -> Size a -> Css
borderRadius :: Size a -> Size a -> Size a -> Size a -> Css
borderRadius Size a
a Size a
b Size a
c Size a
d = Key (Size a, (Size a, (Size a, Size a)))
-> (Size a, (Size a, (Size a, Size a))) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, (Size a, (Size a, Size a)))
"border-radius" (Size a
a Size a
-> (Size a, (Size a, Size a))
-> (Size a, (Size a, (Size a, Size a)))
forall a b. a -> b -> (a, b)
! Size a
b Size a -> (Size a, Size a) -> (Size a, (Size a, Size a))
forall a b. a -> b -> (a, b)
! Size a
c Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
d)

borderTopLeftRadius, borderTopRightRadius,
  borderBottomLeftRadius, borderBottomRightRadius :: Size a -> Size a -> Css

borderTopLeftRadius :: Size a -> Size a -> Css
borderTopLeftRadius     Size a
a Size a
b = Key (Size a, Size a) -> (Size a, Size a) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, Size a)
"border-top-left-radius"     (Size a
a Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
b)
borderTopRightRadius :: Size a -> Size a -> Css
borderTopRightRadius    Size a
a Size a
b = Key (Size a, Size a) -> (Size a, Size a) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, Size a)
"border-top-right-radius"    (Size a
a Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
b)
borderBottomLeftRadius :: Size a -> Size a -> Css
borderBottomLeftRadius  Size a
a Size a
b = Key (Size a, Size a) -> (Size a, Size a) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, Size a)
"border-bottom-left-radius"  (Size a
a Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
b)
borderBottomRightRadius :: Size a -> Size a -> Css
borderBottomRightRadius Size a
a Size a
b = Key (Size a, Size a) -> (Size a, Size a) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, Size a)
"border-bottom-right-radius" (Size a
a Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
b)

-------------------------------------------------------------------------------

{- newtype Collapse = Collapse Value
  deriving (Val, Initial, Inherit, Other)

collapseCollapse, collapseSeparate :: Collapse

collapseCollapse = Collapse "collapse"
collapseSeparate  = Collapse "separate" -}

{-  Due conflict with Visibility collapse
    Preferred just to add separate to Visibility
    Because (borderCollapse collapseCollapse) sounds bad -}

borderCollapse :: Visibility -> Css
borderCollapse :: Visibility -> Css
borderCollapse = Key Visibility -> Visibility -> Css
forall a. Val a => Key a -> a -> Css
key Key Visibility
"border-collapse"

borderSpacing :: Size a -> Css
borderSpacing :: Size a -> Css
borderSpacing Size a
a = Key (Size a) -> Size a -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a)
"border-spacing" Size a
a

borderSpacing2 :: Size a -> Size a -> Css
borderSpacing2 :: Size a -> Size a -> Css
borderSpacing2 Size a
a Size a
b = Key (Size a, Size a) -> (Size a, Size a) -> Css
forall a. Val a => Key a -> a -> Css
key Key (Size a, Size a)
"border-spacing" (Size a
a Size a -> Size a -> (Size a, Size a)
forall a b. a -> b -> (a, b)
! Size a
b)