On Wed, 01 Mar 2006 17:46:47 +0900, <[EMAIL PROTECTED]> wrote:
We demonstrate that Haskell as it is, with no TH or other
pre-processors, can rather concisely represent semi-structured
documents and the rules of their processing. In short, Haskell can
implement SXML (ssax.sourceforge.net), right in its syntax and with
the *open* and extensible set of `tags'. The benefit of Haskell is of
course in static type guarantees, such as prohibiting an H1 element to
appear in the character content of other elements. It also seems that
the specification of various pre-post-order and context-sensitive
traversals is more concise in Haskell compared to Scheme. Again, we
are talking about the existing Haskell, i.e., Haskell98 plus common
extensions. No Template Haskell or even overlapping instances are
required.
It's Great!
But ... replacing my HTML Generator from SXML, I face s problems.
We should note that |title| -- which can be either an element or an
attribute -- is indeed rendered differently depending on the context.
Just to emphasize the extensibility of the framework, we show how easy
it is to add new elements. For example, the `tags' |longdash|, |a|, |div|
and |title| are not defined in the base file HSXML.hs. We add these
tags in sample1c.hs, as follows:
Let us start with an abbreviation for the long dash. It may appear in
the character content of an element or an attribute
data LongDash = LongDash deriving Show
longdash :: Check_ia LongDash ct => HW ct LongDash
longdash = HW LongDash
-- and how to render it in HTML
instance RenderInline (HW ct LongDash) where
render_inline f _ = emit_lit "—" >> return f
Actually, the latter instance describes rendering of longdash in any
|MonadRender m| -- any monad that defines morphisms |emit|,
|emit_elem| and |emit_attr|.
Anchor is an inline element with an inline content
data Anchor a b = Anchor a b deriving Show
a attrs body =
build (as_inline . HW . Anchor (as_block attrs) . rev'apppend HNil)
nil_inline body
instance (Render a, RenderInline b) =>RenderInline (HW ct (Anchor a b))
where
render_inline f (HW (Anchor attrs body)) =
emit_elem "a" [] (Just (render attrs)) (render_ib body)
>> return False
Title can be either
- a block-level element whose content is CT_inline
- an attribute (whose content is, therefore, CT_attr)
newtype Title a = Title a deriving Show
title x = build ((`as_ctx` co) . HW . Title . rev'apppend HNil) nil_ab
x
where nil_ab = HW HNil `as_ctx` ci
(ci,co) = title_ctx
class Check_ia (Title ()) i => TitleCtx i o | i -> o, o -> i where
title_ctx :: (HW i a, HW o a) ; title_ctx = undefined
instance TitleCtx CT_attr CT_battr
instance TitleCtx CT_inline CT_block
It can be rendered context-sensitively:
instance RenderInline a => Render (HW CT_battr (Title a)) where
render (HW (Title x)) = emit_attr "title"
((render_inline False x) >> return ())
instance RenderInline a => Render (HW CT_block (Title a)) where
render (HW (Title x)) = emit_elem "title" [Hint_nl] Nothing
(render_ib x)
Okay, I know how to add element, attribute and Character Entity
References ... but how to write placeholder - pseudo element and
pseudo attribute in HSXML?
SXML can add useful function for macro, like this;
(define (M:link keyword url)
`(a (@ (href ,url)) ,keyword))
(define (M:link_amazon keyword asin)
(M:link keyword
`("http://www.amazon.co.jp/exec/obidos/ASIN/" ,asin "/someone_id/")))
(define (M:book keyword urn)
`((cite ,(M:link keyword `("urn:isbn:" ,urn)))
" (" ,(M:link_amazon "Amazon" urn) ") "))
and M:link can use SXML code in its parameter any place;
,(M:link `("SXML " (em "can write") " this.") "http://foo.bar/")
But if use HSXML, I must write rest of List in last parameter,
link url keyword = a (attr [href url]) keyword
linkToAmazon asin keyword = link (URL $ concat
["http://www.amazon.co.jp/exec/obidos/ASIN/", asin, "/someone_id/"])
keyword
and can't write part of code. So I must wirte code like this form,
book urn first rest keyword = p first [[link (URL $ concat ["urn:isbn:",
urn]) keyword]] "(" [[linkToAmazon urn "Amazon"]] ")" rest
I think this is less convenient than SXML.
--
shelarcy <shelarcy capella.freemail.ne.jp>
http://page.freett.com/shelarcy/
_______________________________________________
Haskell mailing list
Haskell@haskell.org
http://www.haskell.org/mailman/listinfo/haskell