module Halogen.Svg.Attributes (module Halogen.Svg.Attributes) where

import Clay hiding (Baseline, attr, map, max)
import Data.Coerce
import Data.Row
import Data.Text qualified as T
import GHC.Show qualified
import Halogen.HTML.Core qualified as H
import Halogen.HTML.Properties (IProp, attr, attrNS)
import Protolude

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

data Align
  = Min
  | Mid
  | Max
  deriving (Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
/= :: Align -> Align -> Bool
Eq, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Align -> ShowS
showsPrec :: Int -> Align -> ShowS
$cshow :: Align -> String
show :: Align -> String
$cshowList :: [Align] -> ShowS
showList :: [Align] -> ShowS
Show)

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

data Baseline
  = Auto
  | UseScript
  | NoChange
  | ResetSize
  | Ideographic
  | Alphabetic
  | Hanging
  | Mathematical
  | Central
  | BaselineMiddle
  | TextAfterEdge
  | TextBeforeEdge
  deriving (Baseline -> Baseline -> Bool
(Baseline -> Baseline -> Bool)
-> (Baseline -> Baseline -> Bool) -> Eq Baseline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Baseline -> Baseline -> Bool
== :: Baseline -> Baseline -> Bool
$c/= :: Baseline -> Baseline -> Bool
/= :: Baseline -> Baseline -> Bool
Eq, Int -> Baseline -> ShowS
[Baseline] -> ShowS
Baseline -> String
(Int -> Baseline -> ShowS)
-> (Baseline -> String) -> ([Baseline] -> ShowS) -> Show Baseline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Baseline -> ShowS
showsPrec :: Int -> Baseline -> ShowS
$cshow :: Baseline -> String
show :: Baseline -> String
$cshowList :: [Baseline] -> ShowS
showList :: [Baseline] -> ShowS
Show)

printBaseline :: Baseline -> Text
printBaseline :: Baseline -> Text
printBaseline = \case
  Baseline
Auto -> Text
"auto"
  Baseline
UseScript -> Text
"use-script"
  Baseline
NoChange -> Text
"no-change"
  Baseline
ResetSize -> Text
"reset-size"
  Baseline
Ideographic -> Text
"ideographic"
  Baseline
Alphabetic -> Text
"alphabetic"
  Baseline
Hanging -> Text
"hanging"
  Baseline
Mathematical -> Text
"mathematical"
  Baseline
Central -> Text
"central"
  Baseline
BaselineMiddle -> Text
"middle"
  Baseline
TextAfterEdge -> Text
"text-after-edge"
  Baseline
TextBeforeEdge -> Text
"text-before-edge"

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

newtype PathCommand = PathCommand Text
  deriving newtype (PathCommand -> PathCommand -> Bool
(PathCommand -> PathCommand -> Bool)
-> (PathCommand -> PathCommand -> Bool) -> Eq PathCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathCommand -> PathCommand -> Bool
== :: PathCommand -> PathCommand -> Bool
$c/= :: PathCommand -> PathCommand -> Bool
/= :: PathCommand -> PathCommand -> Bool
Eq)

instance Show PathCommand where
  show :: PathCommand -> String
show (PathCommand Text
txt) = Text -> String
forall a b. ConvertText a b => a -> b
toS Text
txt

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

data Duration = Duration
  { Duration -> Maybe Double
hours :: Maybe Double
  , Duration -> Maybe Double
minutes :: Maybe Double
  , Duration -> Maybe Double
seconds :: Maybe Double
  , Duration -> Maybe Double
milliseconds :: Maybe Double
  }

defaultDuration :: Duration
defaultDuration :: Duration
defaultDuration =
  Duration
    { hours :: Maybe Double
hours = Maybe Double
forall a. Maybe a
Nothing
    , minutes :: Maybe Double
minutes = Maybe Double
forall a. Maybe a
Nothing
    , seconds :: Maybe Double
seconds = Maybe Double
forall a. Maybe a
Nothing
    , milliseconds :: Maybe Double
milliseconds = Maybe Double
forall a. Maybe a
Nothing
    }

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

data FillState
  = Freeze
  | Remove
  deriving (FillState -> FillState -> Bool
(FillState -> FillState -> Bool)
-> (FillState -> FillState -> Bool) -> Eq FillState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FillState -> FillState -> Bool
== :: FillState -> FillState -> Bool
$c/= :: FillState -> FillState -> Bool
/= :: FillState -> FillState -> Bool
Eq, Int -> FillState -> ShowS
[FillState] -> ShowS
FillState -> String
(Int -> FillState -> ShowS)
-> (FillState -> String)
-> ([FillState] -> ShowS)
-> Show FillState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FillState -> ShowS
showsPrec :: Int -> FillState -> ShowS
$cshow :: FillState -> String
show :: FillState -> String
$cshowList :: [FillState] -> ShowS
showList :: [FillState] -> ShowS
Show)

printFillState :: FillState -> Text
printFillState :: FillState -> Text
printFillState = \case
  FillState
Freeze -> Text
"freeze"
  FillState
Remove -> Text
"remove"

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

data FontStretch
  = StretchNormal
  | StretchUltraCondensed
  | StretchExtraCondensed
  | StretchCondensed
  | StretchSemiCondensed
  | StretchSemiExpanded
  | StretchExpanded
  | StretchExtraExpanded
  | StretchUltraExpanded
  | StretchPercent Number
  deriving (FontStretch -> FontStretch -> Bool
(FontStretch -> FontStretch -> Bool)
-> (FontStretch -> FontStretch -> Bool) -> Eq FontStretch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontStretch -> FontStretch -> Bool
== :: FontStretch -> FontStretch -> Bool
$c/= :: FontStretch -> FontStretch -> Bool
/= :: FontStretch -> FontStretch -> Bool
Eq, Int -> FontStretch -> ShowS
[FontStretch] -> ShowS
FontStretch -> String
(Int -> FontStretch -> ShowS)
-> (FontStretch -> String)
-> ([FontStretch] -> ShowS)
-> Show FontStretch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontStretch -> ShowS
showsPrec :: Int -> FontStretch -> ShowS
$cshow :: FontStretch -> String
show :: FontStretch -> String
$cshowList :: [FontStretch] -> ShowS
showList :: [FontStretch] -> ShowS
Show)

printFontStretch :: FontStretch -> Text
printFontStretch :: FontStretch -> Text
printFontStretch = \case
  FontStretch
StretchNormal -> Text
"normal"
  FontStretch
StretchUltraCondensed -> Text
"ultra-condensed"
  FontStretch
StretchExtraCondensed -> Text
"extra-condensed"
  FontStretch
StretchCondensed -> Text
"condensed"
  FontStretch
StretchSemiCondensed -> Text
"semi-condensed"
  FontStretch
StretchSemiExpanded -> Text
"semi-expanded"
  FontStretch
StretchExpanded -> Text
"expanded"
  FontStretch
StretchExtraExpanded -> Text
"extra-expanded"
  FontStretch
StretchUltraExpanded -> Text
"ultra-expanded"
  StretchPercent Number
n -> Number -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Number
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%"

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

data MarkerUnit
  = UserSpaceOnUse
  | StrokeWidth
  deriving (MarkerUnit -> MarkerUnit -> Bool
(MarkerUnit -> MarkerUnit -> Bool)
-> (MarkerUnit -> MarkerUnit -> Bool) -> Eq MarkerUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkerUnit -> MarkerUnit -> Bool
== :: MarkerUnit -> MarkerUnit -> Bool
$c/= :: MarkerUnit -> MarkerUnit -> Bool
/= :: MarkerUnit -> MarkerUnit -> Bool
Eq, Int -> MarkerUnit -> ShowS
[MarkerUnit] -> ShowS
MarkerUnit -> String
(Int -> MarkerUnit -> ShowS)
-> (MarkerUnit -> String)
-> ([MarkerUnit] -> ShowS)
-> Show MarkerUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkerUnit -> ShowS
showsPrec :: Int -> MarkerUnit -> ShowS
$cshow :: MarkerUnit -> String
show :: MarkerUnit -> String
$cshowList :: [MarkerUnit] -> ShowS
showList :: [MarkerUnit] -> ShowS
Show)

printMarkerUnit :: MarkerUnit -> Text
printMarkerUnit :: MarkerUnit -> Text
printMarkerUnit = \case
  MarkerUnit
UserSpaceOnUse -> Text
"userSpaceOnUse"
  MarkerUnit
StrokeWidth -> Text
"strokeWidth"

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

data MaskUnit
  = UserSpaceOnUse_
  | ObjectBoundingBox
  deriving (MaskUnit -> MaskUnit -> Bool
(MaskUnit -> MaskUnit -> Bool)
-> (MaskUnit -> MaskUnit -> Bool) -> Eq MaskUnit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaskUnit -> MaskUnit -> Bool
== :: MaskUnit -> MaskUnit -> Bool
$c/= :: MaskUnit -> MaskUnit -> Bool
/= :: MaskUnit -> MaskUnit -> Bool
Eq, Int -> MaskUnit -> ShowS
[MaskUnit] -> ShowS
MaskUnit -> String
(Int -> MaskUnit -> ShowS)
-> (MaskUnit -> String) -> ([MaskUnit] -> ShowS) -> Show MaskUnit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaskUnit -> ShowS
showsPrec :: Int -> MaskUnit -> ShowS
$cshow :: MaskUnit -> String
show :: MaskUnit -> String
$cshowList :: [MaskUnit] -> ShowS
showList :: [MaskUnit] -> ShowS
Show)

-- This instance of Show is currently identical to printMaskUnit. That is
-- likely to change so don't rely on it

printMaskUnit :: MaskUnit -> Text
printMaskUnit :: MaskUnit -> Text
printMaskUnit = \case
  MaskUnit
UserSpaceOnUse_ -> Text
"userSpaceOnUse"
  MaskUnit
ObjectBoundingBox -> Text
"objectBoundingBox"

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

data Orient
  = AutoOrient
  | AutoStartReverse
  deriving (Orient -> Orient -> Bool
(Orient -> Orient -> Bool)
-> (Orient -> Orient -> Bool) -> Eq Orient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orient -> Orient -> Bool
== :: Orient -> Orient -> Bool
$c/= :: Orient -> Orient -> Bool
/= :: Orient -> Orient -> Bool
Eq, Eq Orient
Eq Orient =>
(Orient -> Orient -> Ordering)
-> (Orient -> Orient -> Bool)
-> (Orient -> Orient -> Bool)
-> (Orient -> Orient -> Bool)
-> (Orient -> Orient -> Bool)
-> (Orient -> Orient -> Orient)
-> (Orient -> Orient -> Orient)
-> Ord Orient
Orient -> Orient -> Bool
Orient -> Orient -> Ordering
Orient -> Orient -> Orient
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Orient -> Orient -> Ordering
compare :: Orient -> Orient -> Ordering
$c< :: Orient -> Orient -> Bool
< :: Orient -> Orient -> Bool
$c<= :: Orient -> Orient -> Bool
<= :: Orient -> Orient -> Bool
$c> :: Orient -> Orient -> Bool
> :: Orient -> Orient -> Bool
$c>= :: Orient -> Orient -> Bool
>= :: Orient -> Orient -> Bool
$cmax :: Orient -> Orient -> Orient
max :: Orient -> Orient -> Orient
$cmin :: Orient -> Orient -> Orient
min :: Orient -> Orient -> Orient
Ord)

printOrient :: Orient -> Text
printOrient :: Orient -> Text
printOrient = \case
  Orient
AutoOrient -> Text
"auto"
  Orient
AutoStartReverse -> Text
"auto-start-reverse"

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

data TextAnchor
  = AnchorStart
  | AnchorMiddle
  | AnchorEnd
  deriving (TextAnchor -> TextAnchor -> Bool
(TextAnchor -> TextAnchor -> Bool)
-> (TextAnchor -> TextAnchor -> Bool) -> Eq TextAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextAnchor -> TextAnchor -> Bool
== :: TextAnchor -> TextAnchor -> Bool
$c/= :: TextAnchor -> TextAnchor -> Bool
/= :: TextAnchor -> TextAnchor -> Bool
Eq, Int -> TextAnchor -> ShowS
[TextAnchor] -> ShowS
TextAnchor -> String
(Int -> TextAnchor -> ShowS)
-> (TextAnchor -> String)
-> ([TextAnchor] -> ShowS)
-> Show TextAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextAnchor -> ShowS
showsPrec :: Int -> TextAnchor -> ShowS
$cshow :: TextAnchor -> String
show :: TextAnchor -> String
$cshowList :: [TextAnchor] -> ShowS
showList :: [TextAnchor] -> ShowS
Show)

printTextAnchor :: TextAnchor -> Text
printTextAnchor :: TextAnchor -> Text
printTextAnchor = \case
  TextAnchor
AnchorStart -> Text
"start"
  TextAnchor
AnchorMiddle -> Text
"middle"
  TextAnchor
AnchorEnd -> Text
"end"

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

data MeetOrSlice
  = Meet
  | Slice
  deriving (MeetOrSlice -> MeetOrSlice -> Bool
(MeetOrSlice -> MeetOrSlice -> Bool)
-> (MeetOrSlice -> MeetOrSlice -> Bool) -> Eq MeetOrSlice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MeetOrSlice -> MeetOrSlice -> Bool
== :: MeetOrSlice -> MeetOrSlice -> Bool
$c/= :: MeetOrSlice -> MeetOrSlice -> Bool
/= :: MeetOrSlice -> MeetOrSlice -> Bool
Eq, Int -> MeetOrSlice -> ShowS
[MeetOrSlice] -> ShowS
MeetOrSlice -> String
(Int -> MeetOrSlice -> ShowS)
-> (MeetOrSlice -> String)
-> ([MeetOrSlice] -> ShowS)
-> Show MeetOrSlice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MeetOrSlice -> ShowS
showsPrec :: Int -> MeetOrSlice -> ShowS
$cshow :: MeetOrSlice -> String
show :: MeetOrSlice -> String
$cshowList :: [MeetOrSlice] -> ShowS
showList :: [MeetOrSlice] -> ShowS
Show)

printMeetOrSlice :: MeetOrSlice -> Text
printMeetOrSlice :: MeetOrSlice -> Text
printMeetOrSlice = \case
  MeetOrSlice
Meet -> Text
"meet"
  MeetOrSlice
Slice -> Text
"slice"

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

data StrokeLineCap
  = LineCapButt
  | LineCapSquare
  | LineCapRound
  deriving (StrokeLineCap -> StrokeLineCap -> Bool
(StrokeLineCap -> StrokeLineCap -> Bool)
-> (StrokeLineCap -> StrokeLineCap -> Bool) -> Eq StrokeLineCap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrokeLineCap -> StrokeLineCap -> Bool
== :: StrokeLineCap -> StrokeLineCap -> Bool
$c/= :: StrokeLineCap -> StrokeLineCap -> Bool
/= :: StrokeLineCap -> StrokeLineCap -> Bool
Eq, Int -> StrokeLineCap -> ShowS
[StrokeLineCap] -> ShowS
StrokeLineCap -> String
(Int -> StrokeLineCap -> ShowS)
-> (StrokeLineCap -> String)
-> ([StrokeLineCap] -> ShowS)
-> Show StrokeLineCap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrokeLineCap -> ShowS
showsPrec :: Int -> StrokeLineCap -> ShowS
$cshow :: StrokeLineCap -> String
show :: StrokeLineCap -> String
$cshowList :: [StrokeLineCap] -> ShowS
showList :: [StrokeLineCap] -> ShowS
Show)

printStrokeLineCap :: StrokeLineCap -> Text
printStrokeLineCap :: StrokeLineCap -> Text
printStrokeLineCap = \case
  StrokeLineCap
LineCapButt -> Text
"butt"
  StrokeLineCap
LineCapSquare -> Text
"square"
  StrokeLineCap
LineCapRound -> Text
"round"

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

data StrokeLineJoin
  = LineJoinArcs
  | LineJoinBevel
  | LineJoinMiter
  | LineJoinMiterClip
  | LineJoinRound
  deriving (StrokeLineJoin -> StrokeLineJoin -> Bool
(StrokeLineJoin -> StrokeLineJoin -> Bool)
-> (StrokeLineJoin -> StrokeLineJoin -> Bool) -> Eq StrokeLineJoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrokeLineJoin -> StrokeLineJoin -> Bool
== :: StrokeLineJoin -> StrokeLineJoin -> Bool
$c/= :: StrokeLineJoin -> StrokeLineJoin -> Bool
/= :: StrokeLineJoin -> StrokeLineJoin -> Bool
Eq, Int -> StrokeLineJoin -> ShowS
[StrokeLineJoin] -> ShowS
StrokeLineJoin -> String
(Int -> StrokeLineJoin -> ShowS)
-> (StrokeLineJoin -> String)
-> ([StrokeLineJoin] -> ShowS)
-> Show StrokeLineJoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrokeLineJoin -> ShowS
showsPrec :: Int -> StrokeLineJoin -> ShowS
$cshow :: StrokeLineJoin -> String
show :: StrokeLineJoin -> String
$cshowList :: [StrokeLineJoin] -> ShowS
showList :: [StrokeLineJoin] -> ShowS
Show)

printStrokeLineJoin :: StrokeLineJoin -> Text
printStrokeLineJoin :: StrokeLineJoin -> Text
printStrokeLineJoin = \case
  StrokeLineJoin
LineJoinArcs -> Text
"arcs"
  StrokeLineJoin
LineJoinBevel -> Text
"bevel"
  StrokeLineJoin
LineJoinMiter -> Text
"miter"
  StrokeLineJoin
LineJoinMiterClip -> Text
"miter-clip"
  StrokeLineJoin
LineJoinRound -> Text
"round"

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

renderValue :: forall a. (Val a) => a -> Text
renderValue :: forall a. Val a => a -> Text
renderValue = Prefixed -> Text
plain (Prefixed -> Text) -> (a -> Prefixed) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Prefixed
forall a b. Coercible a b => a -> b
coerce (Value -> Prefixed) -> (a -> Value) -> a -> Prefixed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. Val a => a -> Value
value

attributeName :: forall r i. (HasType "attributeName" Text r) => Text -> IProp r i
attributeName :: forall (r :: Row (*)) i.
HasType "attributeName" Text r =>
Text -> IProp r i
attributeName = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"attributeName")

-- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/begin
begin :: forall r i. (HasType "begin" Text r) => Text -> IProp r i
begin :: forall (r :: Row (*)) i.
HasType "begin" Text r =>
Text -> IProp r i
begin = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"begin")

class_ :: forall r i. (HasType "class" Text r) => H.ClassName -> IProp r i
class_ :: forall (r :: Row (*)) i.
HasType "class" Text r =>
ClassName -> IProp r i
class_ = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"class") (Text -> IProp r i)
-> (ClassName -> Text) -> ClassName -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClassName -> Text
forall a b. Coercible a b => a -> b
coerce

classes :: forall r i. (HasType "class" Text r) => [H.ClassName] -> IProp r i
classes :: forall (r :: Row (*)) i.
HasType "class" Text r =>
[ClassName] -> IProp r i
classes = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"class") (Text -> IProp r i)
-> ([ClassName] -> Text) -> [ClassName] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text) -> ([ClassName] -> [Text]) -> [ClassName] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ClassName] -> [Text]
forall a b. Coercible a b => a -> b
coerce

cx :: forall r i. (HasType "cx" Double r) => Double -> IProp r i
cx :: forall (r :: Row (*)) i.
HasType "cx" Double r =>
Double -> IProp r i
cx = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"cx") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

cy :: forall r i. (HasType "cy" Double r) => Double -> IProp r i
cy :: forall (r :: Row (*)) i.
HasType "cy" Double r =>
Double -> IProp r i
cy = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"cy") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

d :: forall r i. (HasType "d" Text r) => [PathCommand] -> IProp r i
d :: forall (r :: Row (*)) i.
HasType "d" Text r =>
[PathCommand] -> IProp r i
d = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"d") (Text -> IProp r i)
-> ([PathCommand] -> Text) -> [PathCommand] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text)
-> ([PathCommand] -> [Text]) -> [PathCommand] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PathCommand] -> [Text]
forall a b. Coercible a b => a -> b
coerce

dominantBaseline :: forall r i. (HasType "dominantBaseline" Text r) => Baseline -> IProp r i
dominantBaseline :: forall (r :: Row (*)) i.
HasType "dominantBaseline" Text r =>
Baseline -> IProp r i
dominantBaseline = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"dominant-baseline") (Text -> IProp r i) -> (Baseline -> Text) -> Baseline -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baseline -> Text
printBaseline

dur :: forall r i. (HasType "dur" Text r) => Duration -> IProp r i
dur :: forall (r :: Row (*)) i.
HasType "dur" Text r =>
Duration -> IProp r i
dur = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"dur") (Text -> IProp r i) -> (Duration -> Text) -> Duration -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Text
printDuration
  where
    printDuration :: Duration -> Text
    printDuration :: Duration -> Text
printDuration (Duration {Maybe Double
hours :: Duration -> Maybe Double
hours :: Maybe Double
hours, Maybe Double
minutes :: Duration -> Maybe Double
minutes :: Maybe Double
minutes, Maybe Double
seconds :: Duration -> Maybe Double
seconds :: Maybe Double
seconds, Maybe Double
milliseconds :: Duration -> Maybe Double
milliseconds :: Maybe Double
milliseconds}) =
      Text -> Maybe Double -> Text
forall {b} {a}.
(IsString b, Semigroup b, Show a, StringConv String b) =>
b -> Maybe a -> b
f Text
"h" Maybe Double
hours Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Double -> Text
forall {b} {a}.
(IsString b, Semigroup b, Show a, StringConv String b) =>
b -> Maybe a -> b
f Text
"m" Maybe Double
minutes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Double -> Text
forall {b} {a}.
(IsString b, Semigroup b, Show a, StringConv String b) =>
b -> Maybe a -> b
f Text
"s" Maybe Double
seconds Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Double -> Text
forall {b} {a}.
(IsString b, Semigroup b, Show a, StringConv String b) =>
b -> Maybe a -> b
f Text
"i" Maybe Double
milliseconds

    f :: b -> Maybe a -> b
f b
unit_ = b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
"" (\a
val -> a -> b
forall a b. (Show a, StringConv String b) => a -> b
show a
val b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
unit_)

fill :: forall r i. (HasType "fill" Text r) => Color -> IProp r i
fill :: forall (r :: Row (*)) i.
HasType "fill" Text r =>
Color -> IProp r i
fill = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"fill") (Text -> IProp r i) -> (Color -> Text) -> Color -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text
forall a. Val a => a -> Text
renderValue

-- Note: same as 'fill' but that function is already specialised to Color
fillAnim :: forall r i. (HasType "fill" Text r) => FillState -> IProp r i
fillAnim :: forall (r :: Row (*)) i.
HasType "fill" Text r =>
FillState -> IProp r i
fillAnim = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"fill") (Text -> IProp r i)
-> (FillState -> Text) -> FillState -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FillState -> Text
printFillState

fillOpacity :: forall r i. (HasType "fillOpacity" Double r) => Double -> IProp r i
fillOpacity :: forall (r :: Row (*)) i.
HasType "fillOpacity" Double r =>
Double -> IProp r i
fillOpacity = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"fill-opacity") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

fontFamily :: forall r i. (HasType "fontFamily" Text r) => Text -> IProp r i
fontFamily :: forall (r :: Row (*)) i.
HasType "fontFamily" Text r =>
Text -> IProp r i
fontFamily = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-family")

fontSize :: forall r i. (HasType "fontSize" Text r) => FontSize -> IProp r i
fontSize :: forall (r :: Row (*)) i.
HasType "fontSize" Text r =>
FontSize -> IProp r i
fontSize = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-size") (Text -> IProp r i) -> (FontSize -> Text) -> FontSize -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontSize -> Text
forall a. Val a => a -> Text
renderValue

fontSizeAdjust :: forall r i. (HasType "fontSizeAdjust" Text r) => Double -> IProp r i
fontSizeAdjust :: forall (r :: Row (*)) i.
HasType "fontSizeAdjust" Text r =>
Double -> IProp r i
fontSizeAdjust = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-size-adjust") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

fontStretch :: forall r i. (HasType "fontStretch" Text r) => FontStretch -> IProp r i
fontStretch :: forall (r :: Row (*)) i.
HasType "fontStretch" Text r =>
FontStretch -> IProp r i
fontStretch = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-stretch") (Text -> IProp r i)
-> (FontStretch -> Text) -> FontStretch -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStretch -> Text
printFontStretch

fontStyle :: forall r i. (HasType "fontStyle" Text r) => FontStyle -> IProp r i
fontStyle :: forall (r :: Row (*)) i.
HasType "fontStyle" Text r =>
FontStyle -> IProp r i
fontStyle = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-style") (Text -> IProp r i)
-> (FontStyle -> Text) -> FontStyle -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontStyle -> Text
forall a. Val a => a -> Text
renderValue

fontVariant :: forall r i. (HasType "fontVariant" Text r) => Text -> IProp r i
fontVariant :: forall (r :: Row (*)) i.
HasType "fontVariant" Text r =>
Text -> IProp r i
fontVariant = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-variant")

fontWeight :: forall r i. (HasType "fontWeight" Text r) => FontWeight -> IProp r i
fontWeight :: forall (r :: Row (*)) i.
HasType "fontWeight" Text r =>
FontWeight -> IProp r i
fontWeight = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"font-weight") (Text -> IProp r i)
-> (FontWeight -> Text) -> FontWeight -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FontWeight -> Text
forall a. Val a => a -> Text
renderValue

-- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/from
from :: forall r i. (HasType "from" Text r) => Text -> IProp r i
from :: forall (r :: Row (*)) i. HasType "from" Text r => Text -> IProp r i
from = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"from")

-- https://developer.mozilla.org/en-US/docs/Web/SVG/Attribute/to
to :: forall r i. (HasType "to" Text r) => Text -> IProp r i
to :: forall (r :: Row (*)) i. HasType "to" Text r => Text -> IProp r i
to = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"to")

id :: forall r i. (HasType "id" Text r) => Text -> IProp r i
id :: forall (r :: Row (*)) i. HasType "id" Text r => Text -> IProp r i
id = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"id")

markerStart :: forall r i. (HasType "markerStart" Text r) => Text -> IProp r i
markerStart :: forall (r :: Row (*)) i.
HasType "markerStart" Text r =>
Text -> IProp r i
markerStart = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"marker-start")

markerMid :: forall r i. (HasType "markerMid" Text r) => Text -> IProp r i
markerMid :: forall (r :: Row (*)) i.
HasType "markerMid" Text r =>
Text -> IProp r i
markerMid = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"marker-mid")

markerEnd :: forall r i. (HasType "markerEnd" Text r) => Text -> IProp r i
markerEnd :: forall (r :: Row (*)) i.
HasType "markerEnd" Text r =>
Text -> IProp r i
markerEnd = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"marker-end")

markerUnits :: forall r i. (HasType "markerUnits" Text r) => MarkerUnit -> IProp r i
markerUnits :: forall (r :: Row (*)) i.
HasType "markerUnits" Text r =>
MarkerUnit -> IProp r i
markerUnits = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"markerUnits") (Text -> IProp r i)
-> (MarkerUnit -> Text) -> MarkerUnit -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkerUnit -> Text
printMarkerUnit

markerWidth :: forall r i. (HasType "markerWidth" Double r) => Double -> IProp r i
markerWidth :: forall (r :: Row (*)) i.
HasType "markerWidth" Double r =>
Double -> IProp r i
markerWidth = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"markerWidth") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

markerHeight :: forall r i. (HasType "markerHeight" Double r) => Double -> IProp r i
markerHeight :: forall (r :: Row (*)) i.
HasType "markerHeight" Double r =>
Double -> IProp r i
markerHeight = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"markerHeight") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

mask :: forall r i. (HasType "mask" Text r) => Text -> IProp r i
mask :: forall (r :: Row (*)) i. HasType "mask" Text r => Text -> IProp r i
mask = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"mask")

maskUnits :: forall r i. (HasType "maskUnits" Text r) => MaskUnit -> IProp r i
maskUnits :: forall (r :: Row (*)) i.
HasType "maskUnits" Text r =>
MaskUnit -> IProp r i
maskUnits = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"maskUnits") (Text -> IProp r i) -> (MaskUnit -> Text) -> MaskUnit -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaskUnit -> Text
printMaskUnit

maskContentUnits :: forall r i. (HasType "maskContentUnits" Text r) => MaskUnit -> IProp r i
maskContentUnits :: forall (r :: Row (*)) i.
HasType "maskContentUnits" Text r =>
MaskUnit -> IProp r i
maskContentUnits = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"maskContentUnits") (Text -> IProp r i) -> (MaskUnit -> Text) -> MaskUnit -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaskUnit -> Text
printMaskUnit

orient :: forall r i. (HasType "orient" Text r) => Orient -> IProp r i
orient :: forall (r :: Row (*)) i.
HasType "orient" Text r =>
Orient -> IProp r i
orient = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"orient") (Text -> IProp r i) -> (Orient -> Text) -> Orient -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orient -> Text
printOrient

path :: forall r i. (HasType "path" Text r) => [PathCommand] -> IProp r i
path :: forall (r :: Row (*)) i.
HasType "path" Text r =>
[PathCommand] -> IProp r i
path = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"path") (Text -> IProp r i)
-> ([PathCommand] -> Text) -> [PathCommand] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text)
-> ([PathCommand] -> [Text]) -> [PathCommand] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PathCommand] -> [Text]
forall a b. Coercible a b => a -> b
coerce

-- | An array of x-y value pairs (e.g. `[(x, y)]`).
points :: forall r i. (HasType "points" Text r) => [(Double, Double)] -> IProp r i
points :: forall (r :: Row (*)) i.
HasType "points" Text r =>
[(Double, Double)] -> IProp r i
points = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"points") (Text -> IProp r i)
-> ([(Double, Double)] -> Text) -> [(Double, Double)] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text)
-> ([(Double, Double)] -> [Text]) -> [(Double, Double)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Double) -> Text) -> [(Double, Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\(Double
x_, Double
y_) -> Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Double
x_ Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Double
y_)

pathLength :: forall r i. (HasType "pathLength" Text r) => Double -> IProp r i
pathLength :: forall (r :: Row (*)) i.
HasType "pathLength" Text r =>
Double -> IProp r i
pathLength = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"pathLength") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

patternContentUnits :: forall r i. (HasType "patternContentUnits" Text r) => Text -> IProp r i
patternContentUnits :: forall (r :: Row (*)) i.
HasType "patternContentUnits" Text r =>
Text -> IProp r i
patternContentUnits = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"patternContentUnits")

patternTransformation :: forall r i. (HasType "patternTransformation" Text r) => [Transformation] -> IProp r i
patternTransformation :: forall (r :: Row (*)) i.
HasType "patternTransformation" Text r =>
[Transformation] -> IProp r i
patternTransformation = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"patternTransformation") (Text -> IProp r i)
-> ([Transformation] -> Text) -> [Transformation] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text)
-> ([Transformation] -> [Text]) -> [Transformation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transformation -> Text) -> [Transformation] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Transformation -> Text
forall a. Val a => a -> Text
renderValue

patternUnits :: forall r i. (HasType "patternUnits" Text r) => Text -> IProp r i
patternUnits :: forall (r :: Row (*)) i.
HasType "patternUnits" Text r =>
Text -> IProp r i
patternUnits = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"patternUnits")

preserveAspectRatio
  :: forall r i
   . (HasType "preserveAspectRatio" Text r)
  => Maybe (Align, Align)
  -> MeetOrSlice
  -> IProp r i
preserveAspectRatio :: forall (r :: Row (*)) i.
HasType "preserveAspectRatio" Text r =>
Maybe (Align, Align) -> MeetOrSlice -> IProp r i
preserveAspectRatio Maybe (Align, Align)
align MeetOrSlice
slice =
  AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr
    (Text -> AttrName
H.AttrName Text
"preserveAspectRatio")
    (Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
align_str, MeetOrSlice -> Text
printMeetOrSlice MeetOrSlice
slice])
  where
    align_str :: Text
align_str = case Maybe (Align, Align)
align of
      Maybe (Align, Align)
Nothing -> Text
"none"
      Just (Align
x_, Align
y_) -> Text -> [Text] -> Text
T.intercalate Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
"x", Align -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Align
x_, Text
"Y", Align -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Align
y_]

r :: forall r i. (HasType "r" Text r) => Double -> IProp r i
r :: forall (r :: Row (*)) i. HasType "r" Text r => Double -> IProp r i
r = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"r") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

refX :: forall r i. (HasType "refX" Text r) => Double -> IProp r i
refX :: forall (r :: Row (*)) i.
HasType "refX" Text r =>
Double -> IProp r i
refX = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"refX") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

refY :: forall r i. (HasType "refY" Text r) => Double -> IProp r i
refY :: forall (r :: Row (*)) i.
HasType "refY" Text r =>
Double -> IProp r i
refY = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"refY") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

repeatCount :: forall r i. (HasType "repeatCount" Text r) => Text -> IProp r i
repeatCount :: forall (r :: Row (*)) i.
HasType "repeatCount" Text r =>
Text -> IProp r i
repeatCount = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"repeatCount")

rx :: forall r i. (HasType "rx" Text r) => Double -> IProp r i
rx :: forall (r :: Row (*)) i. HasType "rx" Text r => Double -> IProp r i
rx = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"rx") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

ry :: forall r i. (HasType "ry" Text r) => Double -> IProp r i
ry :: forall (r :: Row (*)) i. HasType "ry" Text r => Double -> IProp r i
ry = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"ry") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

stroke :: forall r i. (HasType "stroke" Text r) => Color -> IProp r i
stroke :: forall (r :: Row (*)) i.
HasType "stroke" Text r =>
Color -> IProp r i
stroke = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke") (Text -> IProp r i) -> (Color -> Text) -> Color -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text
forall a. Val a => a -> Text
renderValue

strokeDashArray :: forall r i. (HasType "strokeDashArray" Text r) => Text -> IProp r i
strokeDashArray :: forall (r :: Row (*)) i.
HasType "strokeDashArray" Text r =>
Text -> IProp r i
strokeDashArray = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-dasharray")

strokeDashOffset :: forall r i. (HasType "strokeDashOffset" Text r) => Double -> IProp r i
strokeDashOffset :: forall (r :: Row (*)) i.
HasType "strokeDashOffset" Text r =>
Double -> IProp r i
strokeDashOffset = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-dashoffset") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

strokeLineCap :: forall r i. (HasType "strokeLineCap" Text r) => StrokeLineCap -> IProp r i
strokeLineCap :: forall (r :: Row (*)) i.
HasType "strokeLineCap" Text r =>
StrokeLineCap -> IProp r i
strokeLineCap = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-linecap") (Text -> IProp r i)
-> (StrokeLineCap -> Text) -> StrokeLineCap -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrokeLineCap -> Text
printStrokeLineCap

strokeLineJoin :: forall r i. (HasType "strokeLineJoin" Text r) => StrokeLineJoin -> IProp r i
strokeLineJoin :: forall (r :: Row (*)) i.
HasType "strokeLineJoin" Text r =>
StrokeLineJoin -> IProp r i
strokeLineJoin = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-linejoin") (Text -> IProp r i)
-> (StrokeLineJoin -> Text) -> StrokeLineJoin -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrokeLineJoin -> Text
printStrokeLineJoin

-- | The `Double` arg must be greater than or equal to 1. Thus, this function
-- | will use `1.0` if given any value less than `1.0`.
strokeMiterLimit :: forall r i. (HasType "strokeMiterLimit" Text r) => Double -> IProp r i
strokeMiterLimit :: forall (r :: Row (*)) i.
HasType "strokeMiterLimit" Text r =>
Double -> IProp r i
strokeMiterLimit = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-miterlimit") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show (Double -> Text) -> (Double -> Double) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1.0

strokeOpacity :: forall r i. (HasType "strokeOpacity" Text r) => Double -> IProp r i
strokeOpacity :: forall (r :: Row (*)) i.
HasType "strokeOpacity" Text r =>
Double -> IProp r i
strokeOpacity = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-opacity") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

strokeWidth :: forall r i. (HasType "strokeWidth" Text r) => Double -> IProp r i
strokeWidth :: forall (r :: Row (*)) i.
HasType "strokeWidth" Text r =>
Double -> IProp r i
strokeWidth = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"stroke-width") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

textAnchor :: forall r i. (HasType "textAnchor" Text r) => TextAnchor -> IProp r i
textAnchor :: forall (r :: Row (*)) i.
HasType "textAnchor" Text r =>
TextAnchor -> IProp r i
textAnchor = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"text-anchor") (Text -> IProp r i)
-> (TextAnchor -> Text) -> TextAnchor -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextAnchor -> Text
printTextAnchor

transformation :: forall r i. (HasType "Transformation" Text r) => [Transformation] -> IProp r i
transformation :: forall (r :: Row (*)) i.
HasType "Transformation" Text r =>
[Transformation] -> IProp r i
transformation = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"Transformation") (Text -> IProp r i)
-> ([Transformation] -> Text) -> [Transformation] -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords ([Text] -> Text)
-> ([Transformation] -> [Text]) -> [Transformation] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transformation -> Text) -> [Transformation] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Transformation -> Text
forall a. Val a => a -> Text
renderValue

viewBox
  :: forall r i
   . (HasType "viewBox" Text r)
  => Double
  -> Double
  -> Double
  -> Double
  -> IProp r i
viewBox :: forall (r :: Row (*)) i.
HasType "viewBox" Text r =>
Double -> Double -> Double -> Double -> IProp r i
viewBox Double
x_ Double
y_ Double
w Double
h_ =
  AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"viewBox") ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Double -> Text) -> [Double] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show [Double
x_, Double
y_, Double
w, Double
h_])

width :: forall r i. (HasType "width" Text r) => Double -> IProp r i
width :: forall (r :: Row (*)) i.
HasType "width" Text r =>
Double -> IProp r i
width = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"width") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

height :: forall r i. (HasType "height" Text r) => Double -> IProp r i
height :: forall (r :: Row (*)) i.
HasType "height" Text r =>
Double -> IProp r i
height = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"height") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

x :: forall r i. (HasType "x" Text r) => Double -> IProp r i
x :: forall (r :: Row (*)) i. HasType "x" Text r => Double -> IProp r i
x = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"x") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

y :: forall r i. (HasType "y" Text r) => Double -> IProp r i
y :: forall (r :: Row (*)) i. HasType "y" Text r => Double -> IProp r i
y = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"y") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

x1 :: forall r i. (HasType "x1" Text r) => Double -> IProp r i
x1 :: forall (r :: Row (*)) i. HasType "x1" Text r => Double -> IProp r i
x1 = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"x1") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

y1 :: forall r i. (HasType "y1" Text r) => Double -> IProp r i
y1 :: forall (r :: Row (*)) i. HasType "y1" Text r => Double -> IProp r i
y1 = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"y1") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

x2 :: forall r i. (HasType "x2" Text r) => Double -> IProp r i
x2 :: forall (r :: Row (*)) i. HasType "x2" Text r => Double -> IProp r i
x2 = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"x2") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

y2 :: forall r i. (HasType "y2" Text r) => Double -> IProp r i
y2 :: forall (r :: Row (*)) i. HasType "y2" Text r => Double -> IProp r i
y2 = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"y2") (Text -> IProp r i) -> (Double -> Text) -> Double -> IProp r i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show

href :: forall r i. (HasType "href" Text r) => Text -> IProp r i
href :: forall (r :: Row (*)) i. HasType "href" Text r => Text -> IProp r i
href = AttrName -> Text -> IProp r i
forall (r :: Row (*)) msg. AttrName -> Text -> IProp r msg
attr (Text -> AttrName
H.AttrName Text
"href")

xlinkHref :: forall r i. (HasType "xlinkHref" Text r) => Text -> IProp r i
xlinkHref :: forall (r :: Row (*)) i.
HasType "xlinkHref" Text r =>
Text -> IProp r i
xlinkHref = Namespace -> AttrName -> Text -> IProp r i
forall (r :: Row (*)) i. Namespace -> AttrName -> Text -> IProp r i
attrNS (Text -> Namespace
H.Namespace Text
"xlink") (Text -> AttrName
H.AttrName Text
"xlink:href")