A sketch for a new typed svg library for elm

Example.elm

module Example exposing (main)

import Svg exposing (svg, stroke, fill, path, pattern, viewBox, rgb255)
import Svg.Path as Path

funnyRed = 
    rgb255 200 20 70

drawing = 
    svg [ viewBox 0 0 400 400 ] 
        [ path [ stroke funnyRed, fill tiledTriangles ] 
            [ Path.rect 10 10 380 380 ]
        ]

tiledTriangles : Svg.Paint
tiledTriangles = 
    pattern [ viewBox 0 0 10 10 ]
        [ path [ fill funnyRed ] 
            [ Path.moveTo 0 0 
                [ Path.lineTo 10 5 
                , Path.LineTo 0 10 ] 
                |> Path.close
            ] 
        ]

main =
    drawing

Svg.elm

module Svg exposing (Element, Attribute, Supported, svg, path, stroke, fill, Paint, rgb255, c, pattern, g)

{-| This module implements an SVG library geared towards being used in applications with a virtural DOM.
As such, its goals are:

  - **Typesafe:** You should be prevented from common errors at compile time. Also required arguments are just arguments, not simply attributes you must pass.
  - **Convenient:** Expressing things should not be singificantly more effor that writing raw SVG. However, using Elm values should feal natural. That means numbers should be numbers and no `String.fromFloat` calls.
  - **Composable:** SVG often needs to declare elements and then reference them later by ID to get many common things done (like using gradients, patterns, arrowheads, etc.). This can break composition, since the caller than is responsible for managing uniqueness of IDs as well as the declarations themselves. This library solves this problem entirely by allowing you to pass these elements into attributes, then generating content based hash ids transparently for you.
  - **Expressive:** This is just SVG and what you can do in SVG, you can do here. All of the commonly supported features should be included.
  - **Documented:** None of the other SVG libraries include much documentation on what any of the options do. This means one has to often cross-search multiple places to get a clue. Not so here.

However, as a tradeoff, this library may be slighly slower than some alternatives. YMMV and you should measure this if it matters in your case.

That aside, let's get to it. SVG stands for scalable vector graphics and as such the goal here is to draw stuff on the screen.


## Getting started

@docs svg, Element, Attribute, Supported


## Coordinates and Units

TODO Basically, the idea is to use SVG "units" (i.e. unitless numbers) rather than px or em or cm. They are mostly what you want and are supported in most contexts. Optionally, we could expose an advanced module that would expose similar functions that would accept numbers in particular units.


## Drawing

@docs path


#### Relevant attributes

@docs stroke, fill


## Text

TODO


## Paint (strokes/fills)

@docs Paint, rgb255, c, pattern, gradient

## Composition

@docs g

## Filters

TODO


## Animation

TODO


## Arrow heads (i.e. Markers)

@docs marker, markerStart, markerMiddle, markerEnd


## Common attributes

@docs id, class, title, ...

## Escape hatches

These functions are useful if this library is missing some features or if you need to inter-operate with some other vdom based library.

@docs fromSvgFragment, toSvgFragment

-}

import Dict exposing (Dict)
import Hash
import Json.Encode exposing (Value)
import VirtualDom
import Svg.Path exposing (Path)


type Element msg
    = Element String (List (InternalAttribute msg)) (List (Element msg))


type Supported
    = Supported


type InternalAttribute msg
    = Attribute String String
    | Property String Value
    | Fancy (Dict String (VirtualDom.Node Never)) (List (VirtualDom.Node msg)) String String String
    | Listener (VirtualDom.Attribute msg)


type Attribute tipe msg
    = Wrapper (InternalAttribute msg)


node =
    VirtualDom.nodeNS "http://www.w3.org/2000/svg"


walkMerge child ( defs0, vdom0 ) =
    let
        ( defs1, vdom1 ) =
            walk child
    in
    ( Dict.union defs1 defs0, vdom1 :: vdom0 )


walk (Element name attributes kids) =
    let
        ( myDefs0, descendants0 ) =
            List.foldr walkMerge ( Dict.empty, [] ) kids

        ( myDefs1, myAttrs, descendants1 ) =
            List.foldr
                (\attr ( defs, attrs, vdoms ) ->
                    case attr of
                        Attribute key val ->
                            ( defs, VirtualDom.attribute key val :: attrs, vdoms )

                        Property key val ->
                            ( defs, VirtualDom.property key val :: attrs, vdoms )

                        Fancy def extraChildren hash key val ->
                            ( Dict.union def defs, VirtualDom.attribute key val :: attrs, extraChildren ++ vdoms )

                        Listener att ->
                            ( defs, att :: attrs, vdoms )
                )
                ( Dict.empty, [], [] )
                attributes
    in
    ( Dict.union myDefs0 myDefs1, node name myAttrs (descendants1 ++ descendants0) )


nodeHelper name attrs children =
    Element name (List.map (\(Wrapper att) -> att) attrs) children


computeHash element =
    Hash.fromString (computeHashHelp element)


computeHashHelp (Element name attrs children) =
    name ++ (List.map (attributeHash attrs) |> String.join "") ++ (List.map (computeHashHelp children) |> String.join "")


attributeHash attr =
    case attr of
        Attribute key val ->
            key ++ val

        Property key val ->
            key ++ Json.Encode.encode 0 val

        Fancy _ _ hash _ _ ->
            hash

        Listener _ ->
            "listener"


{-| -}
svg : List (Attribute tip msg) -> List (Element msg) -> VirtualDom.Node msg
svg attrs children =
    let
        flatAttr attr =
            case attr of
                Attribute key val ->
                    Just (VirtualDom.attribute key val)

                Property key val ->
                    Just (VirtualDom.property key val)

                Fancy _ _ _ _ _ ->
                    Nothing

                Listener att ->
                    Just att

        ( defs, kids ) =
            List.foldr walkMerge ( Dict.empty, [] ) children
    in
    node "svg"
        (List.filterMap flatAttr attrs)
        (node "defs" [] (Dict.values defs) :: kids)


-- Drawing


path : List (Attribute { stroke : Supported } msg) -> List Path -> Element msg
path attrs p =
    nodeHelper "path" (Wrapper (Attribute "d" (List.map Svg.Path.toString p |> String.join " ")) :: attrs) []


stroke : Paint -> Attribute { a | stroke : Supported } msg
stroke paint =
    case paint of
        Simple s ->
            Attribute "stroke" s |> Wrapper

        WithDef id el ->
            Fancy (Dict.insert id el Dict.empty) [] id "stroke" ("ur(#" ++ id ++ ")")


fill : Paint -> Attribute { a | fill : Supported } msg
fill paint =
    case paint of
        Simple s ->
            Attribute "fill" s |> Wrapper

        WithDef id el ->
            Fancy (Dict.insert id el Dict.empty) [] id "fill" ("ur(#" ++ id ++ ")")



-- Organizing things


g : List (Attribute {} msg) -> List (Element msg) -> Element msg
g =
    nodeHelper "g"



-- Patterns


{-| Paint values can be passed to strokes or fills.
-}
type Paint
    = Simple String
    | WithDef String (Element Never)


rgb255 : Int -> Int -> Int -> Paint
rgb255 r g b =
    Simple ("#" ++ Hex.toString r ++ Hex.toString g ++ Hex.toString b)


{-| This is a bit of a hack, but makes working with other people's svg code much simpler, since one can pass in literal strings with ease:

    path [ fill (c "#cf3") ] [ ... ]

-}
c : String -> Paint
c =
    Simple


{-| A pattern is a graphic that is repeated to fill the area.
-}
pattern : List (Attribute {} Never) -> List (Element Never) -> Pattern
pattern attrs children =
    let
        element =
            nodeHelper "pattern" attrs children
    in
    WithDef (computeHash element) element




-- escape hatches

{-| Embed svg from a different source into the document. 

Note: If this fragment will end up in an attribute (say via `pattern`), you should make sure to add a class attribute with a unique string, otherwise you may get surprising results, 
as this custome element is not properly taken into consideration when computing IDs. -}
fromSvgFragment : VirtualDom.Node msg -> Element msg
fromSvgFragment el =
    Element "g" [Fancy Dict.empty [el] "custom" "-x-internal" ""] []


{-| This will produce a tuple, where the first element is a list of things that are needed in the `defs` section of an SVG to produce the correct rendering. 

The second element is the rendition of the element itself. -}
toSvgFragments : Element msg -> ( List (VirtualDom.Node msg), VirtualDom.Node msg )
toSvgFragments element =
    Tuple.mapFirst Dict.values (walk element)

SvgPath.elm

module Svg.Path exposing (Path, moveTo, toString)
{-| Types and functions in this module can be used to model drawing through geometric means. 

    Svg.path [ stroke (c "#000") ] 
        [ moveTo 30 30 
            [ lineTo 60 30 
            , lineTo 60 60 
            , lineTo 30 60 
            ] 
            |> close
        ]

@docs Path, rect, line, polyline
@todo circle

## Lower Level paths

@docs Command, moveTo, close

## Escape Hatches

@docs toString
-}

{-| Represents the geometry of a particular path -}
type Path =
    Path Float Float (List Command) Bool

{-| Draws an axis-aligned rectangle. -}
rect : { x : Float, y : Float, width: Float, height: Float} -> Path
rect {x,y,width, height} =
   Path x y 
        [ lineTo (x + width) y
        , lineTo (x + width) (y + width)
        , lineTo x (y + width)
        ] True

{-| Represents a command -}
type Command =
    LineTo Float Float

{-| Where to initially put the pen tip to. -}
moveTo : Float -> Float -> List Command -> Path
moveTo x y commands =
    Path x y commands False

lineTo : Float -> Float -> Command
lineTo = LineTo

{-| Draw a straight line from the current position to where the initial moveTo was. Also allows the shape to be filled nicely. -}
close : Path -> Path
close (Path x y c _) = (Path x y c True)


toString : Path -> String
toString (Path x y commands isClosed) =
    "M" ++ String.fromFloat x ++ " " ++ String.fromFloat y ++ " " ++ (List.map commandToString commands |> String.join " ") ++ (if isClosed then "Z" else "")

commandToString c =
    case c of 
        LineTo x y ->
            "L" ++ String.fromFloat x ++ " " ++ String.fromFloat y