module HSX.JMacro where
import Control.Monad.Trans (lift)
import Control.Monad.State (MonadState(get,put))
import HSX.XMLGenerator (XMLGenerator(..), XMLGen(..), EmbedAsChild(..), EmbedAsAttr(..), IsName(..), Attr(..), Name)
import Language.Javascript.JMacro (JStat(..), jsToDoc, jsSaturate, renderJs)
import Text.PrettyPrint.HughesPJ (Style(..), Mode(..), render, renderStyle, style)
class IntegerSupply m where
nextInteger :: m Integer
nextInteger' :: (MonadState Integer m) => m Integer
nextInteger' =
do i <- get
put (succ i)
return i
instance (XMLGenerator m, IntegerSupply m) => EmbedAsChild m JStat where
asChild jstat =
do i <- lift nextInteger
asChild $ genElement (Nothing, "script")
[asAttr ("type" := "text/javascript")]
[asChild (escapeForHtml $ render $ jsToDoc $ jsSaturate (Just ('i' : show i)) jstat)]
where
escapeForHtml :: String -> String
escapeForHtml [] = []
escapeForHtml [c] = [c]
escapeForHtml (b:c:cs)
| b == '<' && c == '/'
= b : '\\' : c : (escapeForHtml cs)
| otherwise = b : escapeForHtml (c : cs)
instance (IntegerSupply m, IsName n, EmbedAsAttr m (Attr Name String)) => EmbedAsAttr m (Attr n JStat) where
asAttr (n := jstat) =
do i <- lift nextInteger
asAttr $ (toName n := (renderStyle lineStyle $ jsToDoc $ jsSaturate (Just ('i' : show i)) jstat))
where
lineStyle = style { mode= OneLineMode }