idris2-dom
idris2-dom copied to clipboard
Published
20 hours ago •
stefan-hoeck
stefan-hoeck
How to use SVG types?
I see there is some SVG implementation in the library, but looking at
https://github.com/stefan-hoeck/idris2-dom/blob/f717866b5e0e39b6bdaf33ee8f1c0d57f6617724/src/Web/Dom.idr#L294
there is no way to use createElement on SVG element types. Was this intentional? If so, what is the suggested way to create SVG elements?
(Context: I'm hoping to build some sort of DSL for building SVG graphics in Idris).
This was not intentional. This project is still very young, and a lot of stuff is still missing. There are several options here: Use Web.Raw.Dom.createElement or Web.Raw.Dom.createElement' to create a DOM element with the given tag (passed as a String argument). You may also add an SVGElement data type similar to ElementType with additional convenience functions (probably in a new Web.Svg module). Please keep asking, if you need more information on this.
I came across similar issue and created a module, is it worth merging it?:
module Text.SvgNode
import Data.List.TR --mapTR
import Data.String
namespace SvgXml
public export
data ElementType : (tag:String) -> Type where
A : ElementType "a"
Animate : ElementType "animate"
AnimateMotion : ElementType "animateMotion"
AnimateTransform : ElementType "animateTransform"
Circle : ElementType "circle"
ClipPath : ElementType "clipPath"
Defs : ElementType "defs"
Desc : ElementType "desc"
Discard : ElementType "discard"
Ellipse : ElementType "ellipse"
FeBlend : ElementType "feBlend"
FeColorMatrix : ElementType "feColorMatrix"
FeComponentTransfer : ElementType "feComponentTransfer"
FeComposite : ElementType "feComposite"
FeConvolveMatrix : ElementType "feConvolveMatrix"
FeDiffuseLighting : ElementType "feDiffuseLighting"
FeDisplacementMap : ElementType "feDisplacementMap"
FeDistantLight : ElementType "feDistantLight"
FeDropShadow : ElementType "feDropShadow"
FeFlood : ElementType "feFlood"
FeFuncA : ElementType "feFuncA"
FeFuncB : ElementType "feFuncB"
FeFuncG : ElementType "feFuncG"
FeFuncR : ElementType "feFuncR"
FeGaussianBlur : ElementType "feGaussianBlur"
FeImage : ElementType "feImage"
FeMerge : ElementType "feMerge"
FeMergeNode : ElementType "feMergeNode"
FeMorphoogy : ElementType "feMorphology"
FeOffset : ElementType "feOffset"
FePointLight : ElementType "fePointLight"
FeSpecularLighting : ElementType "feSpecularLighting"
FeSpotLight : ElementType "feSpotLight"
FeTile : ElementType "feTile"
FeTurbulence : ElementType "feTurbulence"
Filter : ElementType "filter"
ForeignObject : ElementType "foreignObject"
G : ElementType "g"
Hatch : ElementType "hatch"
Hatchpath : ElementType "hatchpath"
Image : ElementType "image"
Line : ElementType "line"
LineGradient : ElementType "lineGradient"
Marker : ElementType "marker"
Mask : ElementType "mask"
Metadata : ElementType "metadata"
Mpath : ElementType "mpath"
Path : ElementType "path"
Pattern : ElementType "pattern"
Polygon : ElementType "polygon"
Polyline : ElementType "polyline"
RadialGradient : ElementType "radialGradient"
Rect : ElementType "rect"
Script : ElementType "script"
Set : ElementType "set"
Stop : ElementType "stop"
Style : ElementType "style"
Svg : ElementType "svg"
Switch : ElementType "switch"
Symbol : ElementType "symbol"
Text : ElementType "text"
TextPath : ElementType "textPath"
Title : ElementType "title"
Tspan : ElementType "tspan"
Use : ElementType "use"
View : ElementType "view"
show_et : {tag:String} -> (ElementType tag) -> String
show_et {tag} _ = tag
public export
data SvgAttribute : Type where
Id : (value : String) -> SvgAttribute
Str : (name : String) -> (value : String) -> SvgAttribute
Bool : (name : String) -> (value : Bool) -> SvgAttribute
--%runElab derive "SvgXml.SvgAttribute" [Generic, Meta, Eq, Ord, Show]
public export
SvgAttributes : Type
SvgAttributes = List SvgAttribute
export
displaySvgAttribute : SvgAttribute -> String
displaySvgAttribute (Id va) = #"id="\#{va}""#
displaySvgAttribute (Str nm va) = #"\#{nm}="\#{va}""#
displaySvgAttribute (Bool nm True) = #"\#{nm}="1""#
displaySvgAttribute (Bool nm False) = #"\#{nm}="0""#
export
displaySvgAttributes : SvgAttributes -> String
displaySvgAttributes = fastConcat . intersperse " " . map displaySvgAttribute
public export
data SvgNode : Type where
El : {tag : String}
-> (tpe : ElementType tag)
-> List (SvgAttribute)
-> List SvgNode
-> SvgNode
Raw : String -> SvgNode
TextNode : String -> SvgNode
public export
show_SvgNode : SvgNode -> String
show_SvgNode (El tpe xs []) = ""
show_SvgNode (El tpe xs ys) = #"\#{this}"# where
this : String
this = (show_et tpe)
show_SvgNode (Raw str) = str
show_SvgNode (TextNode str) = str
public export
Show SvgNode where
show = show_SvgNode
--------------------------------------------------------------------------------
-- Rendering SvgXml
--------------------------------------------------------------------------------
export
escape : String -> String
escape = fastConcat . mapTR esc . unpack
where esc : Char -> String
esc '<' = "<"
esc '>' = ">"
esc '&' = "&"
esc '"' = """
esc '\'' = "'"
esc '\n' = "\n"
esc '\r' = "\r"
esc '\t' = "\t"
esc c = if c < ' ' then "" else singleton c
public export
attrs : List (SvgAttribute) -> String
attrs as = let s = displaySvgAttributes as in if null s then "" else " " ++ s
export
render : SvgNode -> String
render n = case n of
Raw x => x
TextNode x => escape x
El {tag} _ as ns => #"<\#{tag}\#{attrs as}>\#{go Nil ns}</\#{tag}>"#
where go : List String -> List SvgNode -> String
go ss (n :: ns) = go (render n :: ss) ns
go ss [] = fastConcat $ reverse ss
export
renderMany : List SvgNode -> String
renderMany = fastConcat . mapTR render
-------------------------------------------
namespace Svg
public export
svg : List SvgAttribute -> List SvgNode -> SvgNode
svg xs ns = El Svg xs ns
public export
defs : List SvgNode -> SvgNode
defs ns = El Defs [] ns
public export
style : String -> SvgNode
style s = El Style [] [TextNode s]
public export
marker : List SvgAttribute -> List SvgNode -> SvgNode
marker as ns = El Marker as ns
public export
polygon : List SvgAttribute -> SvgNode
polygon as = El Polygon as []
public export
text : List SvgAttribute -> String -> SvgNode
text as t = El Text as [TextNode t]
public export
line : List SvgAttribute -> SvgNode
line as = El Line as []
public export
style_src : String
style_src = """
.set {
stroke-dasharray: 10, 4;
}
.bold {
font: bold 20px monospace;
}
.text {
font: normal 15px monospace;
}
"""
public export
svgNode : (body:List SvgNode) -> SvgNode
svgNode xs = svg [Str "xmlns" "http://www.w3.org/2000/svg",
Str "width" "1000",
Str "height" "1000"] (dfs::xs) where
dfs : SvgNode
dfs = defs [style style_src,
marker [Id "endarrow",
Str "markerWidth" "10",
Str "markerHeight" "7",
Str "refX" "0",
Str "refY" "3.5",
Str "orient" "auto"]
[polygon [Str "points" "0 0, 10 3.5, 0 7"]]
]
public export
svg_example : SvgNode
svg_example = svg [Str "xmlns" "http://www.w3.org/2000/svg",
Str "width" "1000",
Str "height" "1000"] (dfs::body) where
dfs : SvgNode
dfs = defs [style style_src,
marker [Id "endarrow",
Str "markerWidth" "10",
Str "markerHeight" "7",
Str "refX" "0",
Str "refY" "3.5",
Str "orient" "auto"]
[polygon [Str "points" "0 0, 10 3.5, 0 7"]]
]
body :List SvgNode
body = [text [Id "ex", Str "x" "30", Str "y" "40", Str "class" "bold"] "Ownership"
,line [Str "x1" "100",
Str "y1" "200",
Str "x2" "100",
Str "y2" "80",
Str "stroke" "#000",
Str "class" "set",
Str "stroke-width" "2",
Str "marker-end" "url(#endarrow)"]
]
