BlazeHtml: a question about API design

Hey web-devel mailing list, I'm currently working on the BlazeHtml HTML combinator library, and currently a bit stuck on a piece of API design, for which I need some community feedback. I'll try to explain the problem here as clear as possible. The base idea is, for an HTML combinator library, that you provide combinators that the end user can use to "combine" his document. More specifically, we would have combinators for every HTML element. So, say you have the regular div tag. This would be, in our library, Text.Blaze.Html.Strict.div. That makes sense, but it seems possible that a user wants to use a div as a leaf node (e.g. `<div />`). So there are two possible signatures for `div`: div :: Html -- An empty div element. div :: Html -> Html -- The argument is the content of the div element. I'm not sure what we want to do in that case. I so far see two major options: Option 1: We can provide leaf and non-leaf combinators for every tag. I'm not sure if this is overkill or not, but it is, for example not forbidden to have content in an `<img>` tag. We could have these functions in Text.Blaze.Html.Strict and Text.Blaze.Html.Strict.Leaf, for instance. But it must be kind of annoying for the end user to have to write `L.div` instead of just `div`. On the other hand, if we put the *common* uses for the tags (e.g. `img` as leaf, `div` as non-leaf) in the main module, we would get a very inconsistent mess, I assume. So this solution would include: - a module of html combinators as non-leaf elements - a module of html combinators as leaf-elements - the possibility for the end-user to import and qualify them as he/she sees fit; or - add a module with the most common uses and re-export the combinators Option 2: We could only support parent nodes (of the type `Html -> Html`), and introduce another combinator: (/>) :: Html (/>) = mempty I have chosen `/>` here because it resembles the end of a leaf HTML tag (e.g. `<img />`). Then, we would introduce a custom rule. {-# RULES "tag/empty" forall x y. tag x y (/>) = leaf x #-} The `y` here is the closing tag, we pass it as an argument for performance reasons, and you can safely ignore it. This code results in the fact that if we write img (/>) somewhere in our template, it would be rendered to `<img></img>` when we don't pass `-fenable-rewrite-rules` to the compiler, and `<img />` otherwise. Note that `-O` implies `-fenable-rewrite-rules`. I'm not sure about this solution either, because it sort of feels like a (slightly elegant) hack. I have my doubts with both options, but I would tend to go for (1), because (2) feels more unstable. Anyway, feedback and more ideas would be appreciated :-) Kind regards, Jasper Van der Jeugt

2010/4/25 Jasper Van der Jeugt
Hey web-devel mailing list,
I'm currently working on the BlazeHtml HTML combinator library, and currently a bit stuck on a piece of API design, for which I need some community feedback. I'll try to explain the problem here as clear as possible.
The base idea is, for an HTML combinator library, that you provide combinators that the end user can use to "combine" his document. More specifically, we would have combinators for every HTML element.
So, say you have the regular div tag. This would be, in our library, Text.Blaze.Html.Strict.div. That makes sense, but it seems possible that a user wants to use a div as a leaf node (e.g. `<div />`). So there are two possible signatures for `div`:
div :: Html -- An empty div element. div :: Html -> Html -- The argument is the content of the div element.
I'm not sure what we want to do in that case. I so far see two major options:
Option 1: We can provide leaf and non-leaf combinators for every tag. I'm not sure if this is overkill or not, but it is, for example not forbidden to have content in an `<img>` tag. We could have these functions in Text.Blaze.Html.Strict and Text.Blaze.Html.Strict.Leaf, for instance. But it must be kind of annoying for the end user to have to write `L.div` instead of just `div`. On the other hand, if we put the *common* uses for the tags (e.g. `img` as leaf, `div` as non-leaf) in the main module, we would get a very inconsistent mess, I assume.
So this solution would include: - a module of html combinators as non-leaf elements - a module of html combinators as leaf-elements - the possibility for the end-user to import and qualify them as he/she sees fit; or - add a module with the most common uses and re-export the combinators
Option 2: We could only support parent nodes (of the type `Html -> Html`), and introduce another combinator:
(/>) :: Html (/>) = mempty
I have chosen `/>` here because it resembles the end of a leaf HTML tag (e.g. `<img />`). Then, we would introduce a custom rule.
{-# RULES "tag/empty" forall x y. tag x y (/>) = leaf x #-}
The `y` here is the closing tag, we pass it as an argument for performance reasons, and you can safely ignore it. This code results in the fact that if we write
img (/>)
somewhere in our template, it would be rendered to `<img></img>` when we don't pass `-fenable-rewrite-rules` to the compiler, and `<img />` otherwise. Note that `-O` implies `-fenable-rewrite-rules`. I'm not sure about this solution either, because it sort of feels like a (slightly elegant) hack.
I have my doubts with both options, but I would tend to go for (1), because (2) feels more unstable. Anyway, feedback and more ideas would be appreciated :-)
Kind regards, Jasper Van der Jeugt _______________________________________________ web-devel mailing list web-devel@haskell.org http://www.haskell.org/mailman/listinfo/web-devel
I like the idea of having a definition for (/>) but at the same time I think you're overthinking this. I would just append an apostrophe to the names of functions that are "self-closing". div = "<div></div>" div' = "<div/>" etc. -- Deniz Dogan

Why not use classes? class DivType a where div :: a instance DivType Html where ... class IsHtml a where ... instance IsHtml Html where ... instance IsHtml a => DivType (a -> a) where ... Or, maybe better: class DivContents a where div :: a -> Html instance DivContents Html where ... instance DivContents String where ... instance DivContents () where ... and use "div ()" instead of just "div" for empty tag. On 25 Apr 2010, at 12:54, Jasper Van der Jeugt wrote:
Hey web-devel mailing list,
I'm currently working on the BlazeHtml HTML combinator library, and currently a bit stuck on a piece of API design, for which I need some community feedback. I'll try to explain the problem here as clear as possible.
The base idea is, for an HTML combinator library, that you provide combinators that the end user can use to "combine" his document. More specifically, we would have combinators for every HTML element.
So, say you have the regular div tag. This would be, in our library, Text.Blaze.Html.Strict.div. That makes sense, but it seems possible that a user wants to use a div as a leaf node (e.g. `<div />`). So there are two possible signatures for `div`:
div :: Html -- An empty div element. div :: Html -> Html -- The argument is the content of the div element.
I'm not sure what we want to do in that case. I so far see two major options:
Option 1: We can provide leaf and non-leaf combinators for every tag. I'm not sure if this is overkill or not, but it is, for example not forbidden to have content in an `<img>` tag. We could have these functions in Text.Blaze.Html.Strict and Text.Blaze.Html.Strict.Leaf, for instance. But it must be kind of annoying for the end user to have to write `L.div` instead of just `div`. On the other hand, if we put the *common* uses for the tags (e.g. `img` as leaf, `div` as non-leaf) in the main module, we would get a very inconsistent mess, I assume.
So this solution would include: - a module of html combinators as non-leaf elements - a module of html combinators as leaf-elements - the possibility for the end-user to import and qualify them as he/she sees fit; or - add a module with the most common uses and re-export the combinators
Option 2: We could only support parent nodes (of the type `Html -> Html`), and introduce another combinator:
(/>) :: Html (/>) = mempty
I have chosen `/>` here because it resembles the end of a leaf HTML tag (e.g. `<img />`). Then, we would introduce a custom rule.
{-# RULES "tag/empty" forall x y. tag x y (/>) = leaf x #-}
The `y` here is the closing tag, we pass it as an argument for performance reasons, and you can safely ignore it. This code results in the fact that if we write
img (/>)
somewhere in our template, it would be rendered to `<img></img>` when we don't pass `-fenable-rewrite-rules` to the compiler, and `<img />` otherwise. Note that `-O` implies `-fenable-rewrite-rules`. I'm not sure about this solution either, because it sort of feels like a (slightly elegant) hack.
I have my doubts with both options, but I would tend to go for (1), because (2) feels more unstable. Anyway, feedback and more ideas would be appreciated :-)
Kind regards, Jasper Van der Jeugt _______________________________________________ web-devel mailing list web-devel@haskell.org http://www.haskell.org/mailman/listinfo/web-devel

Hey,
The apostrophe approach might work out. The reason I'm not using
classes is efficiency. We had a Html-class approach in the past, but
we didn't manage to get all the overhead compiled away, so we couldn't
get our solution fast enough using classes (unfortunately). (By fast
enough, we mean really really fast).
We might add an abstraction layer again later (using classes), but we
first need a good performance baseline.
Kind regards,
Jasper Van der Jeugt
On Sun, Apr 25, 2010 at 11:08 AM, Miguel Mitrofanov
Why not use classes?
class DivType a where div :: a instance DivType Html where ... class IsHtml a where ... instance IsHtml Html where ... instance IsHtml a => DivType (a -> a) where ...
Or, maybe better:
class DivContents a where div :: a -> Html instance DivContents Html where ... instance DivContents String where ... instance DivContents () where ...
and use "div ()" instead of just "div" for empty tag.
On 25 Apr 2010, at 12:54, Jasper Van der Jeugt wrote:
Hey web-devel mailing list,
I'm currently working on the BlazeHtml HTML combinator library, and currently a bit stuck on a piece of API design, for which I need some community feedback. I'll try to explain the problem here as clear as possible.
The base idea is, for an HTML combinator library, that you provide combinators that the end user can use to "combine" his document. More specifically, we would have combinators for every HTML element.
So, say you have the regular div tag. This would be, in our library, Text.Blaze.Html.Strict.div. That makes sense, but it seems possible that a user wants to use a div as a leaf node (e.g. `<div />`). So there are two possible signatures for `div`:
div :: Html -- An empty div element. div :: Html -> Html -- The argument is the content of the div element.
I'm not sure what we want to do in that case. I so far see two major options:
Option 1: We can provide leaf and non-leaf combinators for every tag. I'm not sure if this is overkill or not, but it is, for example not forbidden to have content in an `<img>` tag. We could have these functions in Text.Blaze.Html.Strict and Text.Blaze.Html.Strict.Leaf, for instance. But it must be kind of annoying for the end user to have to write `L.div` instead of just `div`. On the other hand, if we put the *common* uses for the tags (e.g. `img` as leaf, `div` as non-leaf) in the main module, we would get a very inconsistent mess, I assume.
So this solution would include: - a module of html combinators as non-leaf elements - a module of html combinators as leaf-elements - the possibility for the end-user to import and qualify them as he/she sees fit; or - add a module with the most common uses and re-export the combinators
Option 2: We could only support parent nodes (of the type `Html -> Html`), and introduce another combinator:
(/>) :: Html (/>) = mempty
I have chosen `/>` here because it resembles the end of a leaf HTML tag (e.g. `<img />`). Then, we would introduce a custom rule.
{-# RULES "tag/empty" forall x y. tag x y (/>) = leaf x #-}
The `y` here is the closing tag, we pass it as an argument for performance reasons, and you can safely ignore it. This code results in the fact that if we write
img (/>)
somewhere in our template, it would be rendered to `<img></img>` when we don't pass `-fenable-rewrite-rules` to the compiler, and `<img />` otherwise. Note that `-O` implies `-fenable-rewrite-rules`. I'm not sure about this solution either, because it sort of feels like a (slightly elegant) hack.
I have my doubts with both options, but I would tend to go for (1), because (2) feels more unstable. Anyway, feedback and more ideas would be appreciated :-)
Kind regards, Jasper Van der Jeugt _______________________________________________ web-devel mailing list web-devel@haskell.org http://www.haskell.org/mailman/listinfo/web-devel

All of the ideas mentioned so far have already been implemented in some form on hackage. It's worthwhile to browse through and look them over. The classic approach is in the html and xhtml packages. They are basically Jasper's combinator idea, together with Miguel's class idea. There are a few other approaches, but I like your ideas the best. One problem is that these are based on plain String, so it's easy to generate invalid output due to problems with entities and encodings. Also, one would hope that the type system could constrain the document structure to conform to the DTD. But both of those turn out to add a lot of complexity. See the haxml and hxt packages, and Henning's wrapper for them xml-basic, for some ideas. Regards, Yitz

On Sun, Apr 25, 2010 at 10:54 AM, Jasper Van der Jeugt
So, say you have the regular div tag. This would be, in our library, Text.Blaze.Html.Strict.div. That makes sense, but it seems possible that a user wants to use a div as a leaf node (e.g. `<div />`). So there are two possible signatures for `div`:
div :: Html -- An empty div element. div :: Html -> Html -- The argument is the content of the div element.
Note that the far most common use of empty elements like this is when you later want to populate the element using from JavaScript.
I'm not sure what we want to do in that case. I so far see two major options:
Option 1: We can provide leaf and non-leaf combinators for every tag. I'm not sure if this is overkill or not, but it is, for example not forbidden to have content in an `<img>` tag.
I'm afraid I was wrong when I told you this was the case. The "img" tag (and several others, like "br") must not have any content. Check the HTML spec or try it out in w3's HTML validator. Your problem still remains for tags that may have content, like "div".
I have my doubts with both options, but I would tend to go for (1), because (2) feels more unstable. Anyway, feedback and more ideas would be appreciated :-)
Given that this problem is quite rare I'd just have the user provide some empty contents in the cases where an empty tag is called for div (text "") With OverloadedStrings it's even shorter: div "" If you care about the distinction between "<tag></tag>" and "<tag />" you can postpone outputting the start tag until you produced some content and output the different tag form in case you detect that no content was added. This avoid introducing new operators, type classes or doubling the number of combinators. Cheers, Johan
participants (5)
-
Deniz Dogan
-
Jasper Van der Jeugt
-
Johan Tibell
-
Miguel Mitrofanov
-
Yitzchak Gale