hsx-jmacro 7.0.0 → 7.0.1
raw patch · 5 files changed
+361/−17 lines, 5 filesdep +happstack-hspdep +text
Dependencies added: happstack-hsp, text
Files
- HSX/JMacro.hs +131/−13
- HSX/JMacroT.hs +147/−0
- example.hs +38/−0
- example2.hs +36/−0
- hsx-jmacro.cabal +9/−4
HSX/JMacro.hs view
@@ -1,36 +1,89 @@-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, QuasiQuotes, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}--- | This module provides support for embedding javascript generated by jmacro into HSX.+-- | This module provides support for: --+-- 1. embedding Javascript generated by JMacro into HSX.+--+-- 2. turning XML generated by HSX into a DOM node in Javascript+-- -- It provides the following instances: -- -- > instance (XMLGenerator m, IntegerSupply m) => EmbedAsChild m JStat -- > instance (IntegerSupply m, IsName n, EmbedAsAttr m (Attr Name String)) => EmbedAsAttr m (Attr n JStat)--- +-- > instance ToJExpr XML+-- > instance ToJExpr DOMNode+-- > instance ToJExpr XMLToInnerHTML+-- > instance ToJExpr XMLToDOM+-- -- In order to ensure that each embedded 'JStat' block has unique -- variable names, the monad must supply a source of unique -- names. This is done by adding an instance of 'IntegerSupply' for -- the monad being used with 'XMLGenerator'. ----- For example, an 'IntegerSupply' for 'ServerPartT':+-- For example, we can use 'StateT' to provide an 'IntegerSupply' instance for 'ServerPartT': -- -- > instance IntegerSupply (ServerPartT (StateT Integer IO)) where -- > nextInteger = nextInteger' ----- This variation avoids the use of an extra monad transformer:+-- Alternatively, we can exploit the IO monad to provide an 'IntegerSupply' instance for 'ServerPartT': -- -- > instance IntegerSupply (ServerPartT IO) where -- > nextInteger = fmap (fromIntegral . (`mod` 1024) . hashUnique) (liftIO newUnique) --+-- The @ToJExpr XML@ instance allows you to splice in XML lifted out of an+-- arbitrary monad to generate DOM nodes with JMacro antiquotation:+--+-- > js = do html <- unXMLGenT <p>I'm in a Monad!</p>+-- > return [jmacro| document.getElementById("messages").appendChild(`(html)`); |]+--+-- The @ToJExpr DOMNode@ instance allows you to run HSP in the Identity+-- monad to render JMacro in pure code:+--+-- > html :: DOMNode+-- > html = <p>I'm using <em>JavaScript</em>!</p>+-- > js = [jmacro| var language = `(html)`.getElementsByTagName("em")[0].textContent; |]+--+-- You can see here that you get an actual DOM tree in JavaScript. This is+-- also compatible with libraries such as jQuery and YUI which are able to+-- wrap DOM nodes in their own type, for example with jQuery:+--+-- > js = [jmacro| var languages = $(`(html)`).find("em").text(); |]+--+-- Or with YUI:+--+-- > js = [jmacro| var languages = Y.one(`(html)`).one("em").get("text"); |]+--+-- There are two ways to turn HTML into a a DOM node in the+-- browser. One way is to render the HTML to a string, and pass the+-- string to @element.innerHTML@. The other way is to us the use the+-- DOM functions like @createElement@, @setAttribute@, to+-- programatically create the DOM on the client.+--+-- In webkit-based browsers like Chrome and Safari, the DOM method+-- appears to be slightly faster. In other browsers, the @innerHTML@+-- method appears to be faster. The @innerHTML@ method will almost+-- always required fewer bytes to be transmitted. Additionally, if+-- your XML/HTML contains pre-escaped content, you are required to use+-- @innerHTML@ anyway.+--+-- So, by default the 'ToJExpr' 'XML' instance uses the @innerHTML@+-- method. Though, that could change in the future. If you care about+-- using one method over the other you can use the @newtype@ wrappers+-- 'XMLToInnerHTML' or 'XMLToDOM' to select which method to use.+ 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, renderPrefixJs)-import Text.PrettyPrint.HughesPJ (Style(..), Mode(..), renderStyle, style)+import Control.Monad.Trans (lift)+import Control.Monad.State (MonadState(get,put))+import qualified Happstack.Server.HSP.HTML as HTML+import Happstack.Server.HSP.HTML (XML(..), Attribute(..), AttrValue(..))+import HSX.XMLGenerator (XMLGenerator(..), XMLGen(..), EmbedAsChild(..), EmbedAsAttr(..), IsName(..), Attr(..), Name)+import qualified HSP.Identity as HSP+import Language.Javascript.JMacro (JStat(..), JExpr(..), JVal(..), Ident(..), ToJExpr(..), toStat, jmacroE, jLam, jVarTy, jsToDoc, jsSaturate, renderPrefixJs)+import Text.PrettyPrint.HughesPJ (Style(..), Mode(..), renderStyle, style) -class IntegerSupply m where +-- | This class provides a monotonically increasing supply of non-duplicate 'Integer' values+class IntegerSupply m where nextInteger :: m Integer -- | This help function allows you to easily create an 'IntegerSupply'@@ -47,7 +100,7 @@ return i instance (XMLGenerator m, IntegerSupply m) => EmbedAsChild m JStat where- asChild jstat = + asChild jstat = do i <- lift nextInteger asChild $ genElement (Nothing, "script") [asAttr ("type" := "text/javascript")]@@ -56,8 +109,73 @@ lineStyle = style { mode= OneLineMode } instance (IntegerSupply m, IsName n, EmbedAsAttr m (Attr Name String)) => EmbedAsAttr m (Attr n JStat) where- asAttr (n := jstat) = + asAttr (n := jstat) = do i <- lift nextInteger asAttr $ (toName n := (renderStyle lineStyle $ renderPrefixJs (show i) jstat)) where lineStyle = style { mode= OneLineMode }++-- | Provided for convenience since @Ident@ is exported by both+-- @HSP.Identity@ and @JMacro@. Using this you can avoid the need for an+-- extra and qualified import.+type DOMNode = HSP.Ident HTML.XML++instance ToJExpr DOMNode where+ toJExpr = toJExpr . HSP.evalIdentity++-- | newtype which can be used with 'toJExpr' to specify that the XML+-- should be converted to a DOM in javascript by using 'innerHTML'+newtype XMLToInnerHTML = XMLToInnerHTML HTML.XML++instance ToJExpr XMLToInnerHTML where+ toJExpr (XMLToInnerHTML xml) =+ [jmacroE| (function { var node = document.createElement('div')+ ; node.innerHTML = `(HTML.renderAsHTML xml)`+ ; return node.childNodes[0]+ })() |]++-- | newtype which can be used with 'toJExpr' to specify that the XML+-- should be converted to a DOM in javascript by using+-- @createElement@, @appendChild@, and other DOM functions.+--+-- WARNING: @CDATA FALSE@ values are assumed to be pre-escaped HTML and will be converted to a DOM node by using @innerHTML@. Additionally, if the call to @innerHTML@ returns more than one node, only the first node is used.+newtype XMLToDOM = XMLToDOM HTML.XML++instance ToJExpr XMLToDOM where+ toJExpr (XMLToDOM (Element (dm, n) attrs children)) =+ [jmacroE| (function { var node = `(createElement dm n)`+ ; `(map (setAttribute node) attrs)`+ ; `(map (appendChild node . XMLToDOM) children)`+ ; return node+ })()+ |]+ where+ createElement Nothing n = [jmacroE| document.createElement(`(n)`) |]+ createElement (Just ns) n = [jmacroE| document.createElementNS(`(ns)`, `(n)`) |]+ appendChild node c' =+ [jmacroE| (function () {+ var c = `(c')`;+ if (Object.prototype.toString.call(c) === '[object Array]') {+ for (var i = 0; i < c.length; i++)+ `(node)`.appendChild(c[i]);+ } else {+ `(node)`.appendChild(`(c)`);+ }+ })()+ |]+ setAttribute node (MkAttr ((Nothing, nm), (Value True val))) =+ [jmacroE| `(node)`.setAttribute(`(nm)`, `(val)`) |]+ setAttribute node (MkAttr ((Just ns, nm), (Value True val))) =+ [jmacroE| `(node)`.setAttributeNS(`(ns)`, `(nm)`, `(val)`) |]++ toJExpr (XMLToDOM (CDATA True txt)) =+ [jmacroE| document.createTextNode(`(txt)`) |]++ toJExpr (XMLToDOM (CDATA False txt)) =+ [jmacroE| (function { var node = document.createElement('div')+ ; node.innerHTML = `(txt)`+ ; return node+ })() |]++instance ToJExpr HTML.XML where+ toJExpr = toJExpr . XMLToInnerHTML
+ HSX/JMacroT.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeFamilies, QuasiQuotes #-}+-- | This experimental module provides a monad transformer 'JMacroT'+-- and corresponding 'XMLGenerator' instance which can be used to+-- directly generate javascript which builds an XML/HTML DOM.+--+-- This is similar to the 'ToJExpr XMLToDOM' instance except that+-- there is no intermediate XML type. The 'XMLGenerator' instance+-- directly generates the javascript needed to build the DOM.+--+-- This is intellectually fun. But it is not clear how it is valuable.+-- That is why this module is marked as experimental.+module HSX.JMacroT+ ( JMacroT(..)+ , evalJMacroT+ , mapJMacroT+ , JMacroM+ , evalJMacroM+ ) where++import Control.Applicative (Applicative, Alternative)+import Control.Monad (MonadPlus)+import Control.Monad.Cont (MonadCont)+import Control.Monad.Identity (Identity(..))+import Control.Monad.Error (MonadError)+import Control.Monad.Reader (MonadReader)+import Control.Monad.State (MonadState)+import Control.Monad.Writer (MonadWriter)+import Control.Monad.RWS (MonadRWS)+import Control.Monad.Trans (MonadIO, MonadTrans(..))+import qualified Data.Text as Strict+import qualified Data.Text.Lazy as Lazy+import HSX.XMLGenerator (Attr(..), XMLGen(..), XMLGenT(..), XMLGenerator, AppendChild(..), EmbedAsAttr(..), EmbedAsChild(..), Name(..), SetAttr(..), unXMLGenT)+import qualified HSX.XMLGenerator as HSX+import Language.Javascript.JMacro (ToJExpr(..), JExpr(..), JStat(..), ToStat(..), jmacroE, jLam, jVarTy)++-- | isomorphic to IdentityT, but used for generating javascript that generates XML/HTML+newtype JMacroT m a = JMacroT { unJMacroT :: m a }+ deriving ( Functor, Applicative, Alternative, Monad, MonadIO, MonadPlus, MonadState s, MonadReader r, MonadWriter w, MonadRWS r w s, MonadCont, MonadError e)++instance MonadTrans JMacroT where+ lift = JMacroT++-- | map a function over the inner monad+mapJMacroT :: (m a -> n b) -> JMacroT m a -> JMacroT n b+mapJMacroT f (JMacroT ma) = JMacroT (f ma)++-- | unwrap the 'XMLGenT' and 'JMacroT' constructors+evalJMacroT :: XMLGenT (JMacroT m) JExpr -> m JExpr+evalJMacroT = unJMacroT . unXMLGenT++-- | an alias for 'JMacroT Identity'+type JMacroM = JMacroT Identity++-- | evaluate 'JMacroM'+evalJMacroM :: XMLGenT JMacroM a -> a+evalJMacroM = runIdentity . unJMacroT . unXMLGenT++instance (ToJExpr a) => ToJExpr (XMLGenT JMacroM a) where+ toJExpr = toJExpr . evalJMacroM++instance (Functor m, Monad m) => XMLGen (JMacroT m) where+ type XML (JMacroT m) = JExpr+ newtype Child (JMacroT m) = JMChild { unJMChild :: JExpr }+ newtype Attribute (JMacroT m) = JMAttr { unJMAttr :: JExpr }+ genElement = element+ xmlToChild = JMChild+ pcdataToChild str = JMChild $ [jmacroE| document.createTextNode(`(str)`) |]+++-- | generate an XML Element+element :: (Functor m, Monad m, EmbedAsAttr (JMacroT m) attr, EmbedAsChild (JMacroT m) child) =>+ Name -- ^ element name+ -> [attr] -- ^ attributes+ -> [child] -- ^ children+ -> XMLGenT (JMacroT m) JExpr+element (ns, nm) attrs childer =+ do ats <- fmap (map unJMAttr . concat) $ mapM asAttr attrs+ children <- fmap (map unJMChild . concat) $ mapM asChild childer+ return+ [jmacroE| (function { var node = `(createElement ns nm)`;+ `(map (setAttributeNode node) ats)`;+ `(map (appendChild node) children)`;+ return node;+ })()+ |]++-- | javascript to create an element+createElement Nothing n = [jmacroE| document.createElement(`(n)`) |]+createElement (Just ns) n = [jmacroE| document.createElementNS(`(ns)`, `(n)`) |]++-- | javascript to append a child to an element+appendChild :: JExpr -> JExpr -> JExpr+appendChild node c =+ [jmacroE| `(node)`.appendChild(`(c)`) |]++-- | javascript to set the attribute node of an element+setAttributeNode :: JExpr -> JExpr -> JExpr+setAttributeNode node attr =+ [jmacroE| `(node)`.setAttributeNode(`(attr)`) |]++instance (Functor m, Monad m) => EmbedAsAttr (JMacroT m) (Attr String String) where+ asAttr (n := v) =+ return [JMAttr [jmacroE| (function (){ var attrNode = document.createAttribute(`(n)`)+ ; attrNode.nodeValue = `(v)`+ ; return attrNode;+ })()+ |]]++instance (Functor m, Monad m) => EmbedAsChild (JMacroT m) Char where+ asChild c = return [pcdataToChild [c]]++instance (Functor m, Monad m) => EmbedAsChild (JMacroT m) String where+ asChild str = return [pcdataToChild str]++instance (Functor m, Monad m) => EmbedAsChild (JMacroT m) Strict.Text where+ asChild txt = return [JMChild $ [jmacroE| document.createTextNode(`(Strict.unpack txt)`) |]]++instance (Functor m, Monad m) => EmbedAsChild (JMacroT m) Lazy.Text where+ asChild txt = return [JMChild $ [jmacroE| document.createTextNode(`(Lazy.unpack txt)`) |]]++instance (Functor m, Monad m) => EmbedAsChild (JMacroT m) () where+ asChild () = return []++instance (Functor m, Monad m) => EmbedAsAttr (JMacroT m) (Attr String Bool) where+ asAttr (n := True) = asAttr (n := "true")+ asAttr (n := False) = asAttr (n := "false")++instance (Functor m, Monad m) => EmbedAsAttr (JMacroT m) (Attr String Int) where+ asAttr (n := v) = asAttr (n := show v)++instance (Functor m, Monad m) => AppendChild (JMacroT m) JExpr where+ appChild parent child =+ do c <- child+ return $ [jmacroE| appendChild parent (unJMChild c) |]+ appAll parent children =+ do chs <- children+ return $ [jmacroE| `(map (appendChild parent) (map unJMChild chs))` |]++instance (Functor m, Monad m) => SetAttr (JMacroT m) JExpr where+ setAttr elem attrNode =+ do a <- attrNode+ return $ [jmacroE| `(setAttributeNode elem (unJMAttr a))` |]+ setAll elem attrNodes =+ do as <- attrNodes+ return $ [jmacroE| `(map (setAttributeNode elem) (map unJMAttr as))` |]++instance (Functor m, Monad m) => XMLGenerator (JMacroT m)
+ example.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleInstances, QuasiQuotes #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Main where++import Language.Javascript.JMacro+import HSX.JMacro+import HSP+import HSP.Identity+import HSP.ServerPartT+import Happstack.Server+import Happstack.Server.HSP.HTML+import Happstack.Server.JMacro+import Data.Unique+import Control.Monad.Trans++instance IntegerSupply (ServerPartT IO) where+ nextInteger = fmap (fromIntegral . (`mod` 1024) . hashUnique) (liftIO newUnique)++main :: IO ()+main =+ do let html :: DOMNode+ html = <p>Generate javascript from <span class="foo" id="h">HTML & XML</span>. <% cdata "<em>foo</em><em>bar</em>" %></p>++ xml = evalIdentity html++ js :: JStat+ js = [jmacro| document.getElementById('main').appendChild(`(XMLToDOM xml)`);+ document.getElementById('main').appendChild(document.createTextNode("i like <em>em</em>"));+ |]++ handler :: ServerPart XML+ handler = defaultTemplate "js-example" ()+ <%>+ <div id="main" />+ <% js %>+ </%>++ simpleHTTP nullConf handler
+ example2.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleInstances, QuasiQuotes #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Main where++import Language.Javascript.JMacro+import HSX.JMacro+import HSX.JMacroT+import HSP+import HSP.ServerPartT+import Happstack.Server+import Happstack.Server.HSP.HTML+import Happstack.Server.JMacro+import Data.Unique+import Control.Monad.Trans++instance IntegerSupply (ServerPartT IO) where+ nextInteger = fmap (fromIntegral . (`mod` 1024) . hashUnique) (liftIO newUnique)++main :: IO ()+main =+ do let html :: XMLGenT JMacroM JExpr+ html = <p>Generate javascript from <span class="foo" id="h">HTML & XML</span></p>++ js :: JStat+ js = [jmacro| document.getElementById('main').appendChild(`(html)`);+ |]++ handler :: ServerPart XML+ handler = defaultTemplate "js-example" ()+ <%>+ <div id="main" />+ <% js %>+ </%>++ simpleHTTP nullConf handler+
hsx-jmacro.cabal view
@@ -1,5 +1,5 @@ Name: hsx-jmacro-Version: 7.0.0+Version: 7.0.1 Synopsis: hsx+jmacro support Description: HSX allows for the use of literal XML in Haskell program text. JMacro allows for the use of javascript-syntax for generating javascript in Haskell. This library makes it easy to embed JMacro generated javascript in HSX templates. Homepage: http://www.happstack.com/@@ -10,14 +10,19 @@ Stability: Provisional Category: Web Build-type: Simple-Cabal-version: >=1.2+Cabal-version: >=1.6+Extra-source-files: example.hs,+ example2.hs Library Exposed-modules: HSX.JMacro+ HSX.JMacroT - Build-depends: + Build-depends: base >4 && <5,+ happstack-hsp, hsx, jmacro >= 0.5 && < 0.6, mtl,- pretty+ pretty,+ text == 0.11.*