Implémenter un DSL de HTML, en Haskell

Voir aussi : video youtube - video peertube - code source

Cet article résume et illustre les notions vues dans les articles précédents sur un exemple concret, implémenter un DSL pour générer du HTML simplifié. Il présente notamment l’approche monadique utilisée dans la bibliothèque Lucid.

Rappel sur le HTML

Pour rappel, le HTML est le langage permettant d’écrire des pages web. Il définit des balises (div, h1, b…) permettant d’écrire des documents selon une structure arborescente (une balise peut contenir des données ou d’autres balises). Une balise peut aussi avoir des attributs mais on les ignorera ici, pour simplifier.

<div>
    <h1>mypage</h1>
    <div>
        this is mypage 
        <b>in haskell</b>
    </div>
</div>

Avec des types algébriques

Une première approche consiste à définir un type Term pour représenter les différentes balises. On définit également une fonction renderTerm pour générer le nom associé à chaque type de balise.

data Term
    = TermH1
    | TermB
    | TermDiv
    deriving Show

renderTerm :: Term -> String
renderTerm TermH1 = "h1"
renderTerm TermB = "b"
renderTerm TermDiv = "div"

Enfin, on implémente un type Html récursif pour représenter un document HTML, avec sa structure arborescente. Une fonction récursive render permet de générer le code HTML correspondant.

data Html 
    = HtmlNode Term [Html]
    | HtmlData String 
    deriving Show

render :: Html -> String
render (HtmlData str) = str
render (HtmlNode t nodes)
    = "<" ++ renderTerm t ++ ">" ++ concatMap render nodes ++ "</" ++ renderTerm t ++ ">"

On peut alors écrire un document en utilisant les types algébriques précédents.

mypage :: Html
mypage =
    HtmlNode TermDiv 
        [ HtmlNode TermH1 [HtmlData "mypage"]
        , HtmlNode TermDiv
            [ HtmlData "this is mypage "
            , HtmlNode TermB [HtmlData "in haskell"]
            ]
        ]

Et générer son code HTML en appelant la fonction render.

$ ghci myhtml0.hs 

*Main> render mypage 
"<div><h1>mypage</h1><div>this is mypage <b>in haskell</b></div></div>"

Avec des types algébriques + valeurs

Dans cette deuxième approche, on définit Term non plus comme un type somme de tous les types de balise HTML mais comme un wrapper sur String (le nom de la balise). Les types de balises sont alors implémentés comme des valeurs du type Term.

newtype Term = Term { unTerm :: String }
    deriving Show

termB, termH1, termDiv :: Term
termB = Term "b"
termH1 = Term "h1"
termDiv = Term "div"

Au niveau du document HTML, le type Html ne change pas mais il faut changer la fonction de rendu pour récupérer le nom de la balise via le champ de Term.

data Html 
...

render :: Html -> String
render (HtmlData str) = str
render (HtmlNode t nodes)
    = "<" ++ unTerm t ++ ">" ++ concatMap render nodes ++ "</" ++ unTerm t ++ ">"

Avec des classes de types

Enfin, l’approche utilisée par Lucid, consiste à implémenter les balises HTML non plus par un type somme ou par un wrapper mais par une classe Term. Cette classe utilise deux paramètres (avec une dépendance fonctionnelle), ce qui permet de représenter la structure arborescente du document HTML. On peut alors définir des balises HTML comme des constructeurs respectant la classe Term.

{-# LANGUAGE FunctionalDependencies, FlexibleInstances #-}

class Term arg result | result -> arg where
    term :: String -> arg -> result 

b_, h1_, div_ :: Term arg result => arg -> result
b_ = term "b"
h1_ = term "h1"
div_ = term "div"

On définit ensuite un type Html comme un wrapper contenant le code HTML produit ainsi qu’une valeur résultat (de type paramétrique). On instancie la classe Term pour Html de façon à générer le code HTML en parcourant l’aborscence du document. Enfin, la fonction toHtml construit une valeur Html de base et la fonction render lance le rendu général.

newtype Html a = Html { runHtml :: (String, a) }
    deriving (Show)

instance Term (Html a) (Html a) where
    term name (Html (x,a)) = Html (y, a)
        where y = "<" <> name <> ">" <> x <> "</" <> name <> ">"

toHtml :: String -> Html ()
toHtml str = Html (str, ())

render :: Html () -> String
render = fst . runHtml

L’intérêt de cette approche est également de pouvoir définir le type Html comme une monde. Pour cela, on instancie les classes Functor, Applicative et Monad.

instance Functor Html where
    -- fmap :: (a -> b) -> Html a -> Html b
    fmap f (Html xa) = Html $ f <$> xa

instance Applicative Html where
    -- pure :: a -> Html a
    pure a = Html ("", a)
    -- (<*>) :: Html (a -> b) -> Html a -> Html b
    (Html (sx, ax)) <*> (Html (sy, ay)) = Html (sx <> sy, ax ay)

instance Monad Html where
    -- (>>=) :: Html a -> (a -> Html b) -> Html b
    (Html (sx, ax)) >>= f =
        let (Html (sy, ay)) = f ax
        in Html (sx <> sy, ay)

On peut désormais définir des documents HTML avec ce DSL et en utilisant la notation do.

mypage :: Html ()
mypage = div_ $ do
    h1_ $ toHtml "mypage"
    div_ $ do
        toHtml "this is mypage "
        b_ $ toHtml "in haskell"

Conclusion

Haskell propose toute une panoplie d’outils pour implémenter des DSL : types algébriques, classes de types, foncteurs, monades… Avec des types algébriques basiques, on peut implémenter une approche “initial encoding”. Avec des classes de types plus évoluées, on peut implémenter une approche “tagless final” plus pratique à utiliser.