hsx-jmacro-7.3.8/0000755000000000000000000000000012725536622012004 5ustar0000000000000000hsx-jmacro-7.3.8/example.hs0000644000000000000000000000175512725536622014003 0ustar0000000000000000{-# 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 =

Generate javascript from HTML & XML.

js :: JStat js = [jmacro| document.getElementById('main').appendChild(`(html)`); |] handler :: ServerPart XML handler = defaultTemplate "js-example" () <%>
<% js %> simpleHTTP nullConf handler hsx-jmacro-7.3.8/example2.hs0000644000000000000000000000177212725536622014064 0ustar0000000000000000{-# 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 =

Generate javascript from HTML & XML

js :: JStat js = [jmacro| document.getElementById('main').appendChild(`(html)`); |] handler :: ServerPart XML handler = defaultTemplate "js-example" () <%>
<% js %> simpleHTTP nullConf handler hsx-jmacro-7.3.8/hsx-jmacro.cabal0000644000000000000000000000245012725536622015044 0ustar0000000000000000Name: hsx-jmacro Version: 7.3.8 Synopsis: hsp+jmacro support Description: HSP 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/ License: BSD3 License-file: LICENSE Author: Jeremy Shaw Maintainer: jeremy@n-heptane.com Stability: Provisional Category: Web Build-type: Simple Cabal-version: >=1.6 tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 Extra-source-files: example.hs, example2.hs, README.md source-repository head type: git location: https://github.com/Happstack/hsx-jmacro.git Library Exposed-modules: HSP.JMacro HSP.JMacroT Build-depends: base > 4 && <5, hsp >= 0.9 && < 0.11, jmacro >= 0.6 && < 0.7, mtl >= 2.0 && < 2.3, wl-pprint-text == 1.1.*, text >= 0.11 && < 1.3 hsx-jmacro-7.3.8/LICENSE0000644000000000000000000000275312725536622013020 0ustar0000000000000000Copyright Jeremy Shaw 2011 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jeremy Shaw nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hsx-jmacro-7.3.8/README.md0000644000000000000000000000051112725536622013260 0ustar0000000000000000hsx-jmacro [![Hackage](https://img.shields.io/hackage/v/hsx-jmacro.svg)](https://hackage.haskell.org/package/hsx-jmacro) [![Build Status](https://api.travis-ci.org/Happstack/hsx-jmacro.svg?branch=master)](https://travis-ci.org/Happstack/hsx-jmacro) ========= Support embedding of `jmacro` JavaScript quasi-quoter inside `hsx`. hsx-jmacro-7.3.8/Setup.hs0000644000000000000000000000011012725536622013430 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain hsx-jmacro-7.3.8/HSP/0000755000000000000000000000000012725536622012436 5ustar0000000000000000hsx-jmacro-7.3.8/HSP/JMacro.hs0000644000000000000000000002026512725536622014152 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, QuasiQuotes, TypeSynonymInstances, OverloadedStrings, TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | 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, we can use 'StateT' to provide an 'IntegerSupply' instance for 'ServerPartT': -- -- > instance IntegerSupply (ServerPartT (StateT Integer IO)) where -- > nextInteger = nextInteger' -- -- 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

I'm in a Monad!

-- > 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 =

I'm using JavaScript!

-- > 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 HSP.JMacro where import Control.Monad.Identity import Control.Monad.Trans (lift) import Control.Monad.State (MonadState(get,put)) import Data.Text.Lazy (Text, unpack) import HSP.XML import HSP.HTML4 (renderAsHTML) import HSP.XMLGenerator import HSP.Monad (HSPT(..)) import Language.Javascript.JMacro (JStat(..), JExpr(..), JVal(..), Ident(..), ToJExpr(..), toStat, jmacroE, jLam, jVarTy, jsToDoc, jsSaturate, renderPrefixJs) import Text.PrettyPrint.Leijen.Text (Doc, displayT, renderOneLine) -- | 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' -- instance for monads that have a 'MonadState' 'Integer' instance. -- -- For example: -- -- > instance IntegerSupply (ServerPartT (StateT Integer IO)) where -- > nextInteger = nextInteger' nextInteger' :: (MonadState Integer m) => m Integer nextInteger' = do i <- get put (succ i) return i instance (XMLGenerator m, IntegerSupply m, EmbedAsChild m Text, StringType m ~ Text) => EmbedAsChild m JStat where asChild jstat = do i <- lift nextInteger asChild $ genElement (Nothing, fromStringLit "script") [asAttr ((fromStringLit "type" := fromStringLit "text/javascript") :: Attr Text Text)] [asChild (displayT $ renderOneLine $ renderPrefixJs (show i) jstat)] instance (XMLGen m, IntegerSupply m, EmbedAsAttr m (Attr n Text)) => EmbedAsAttr m (Attr n JStat) where asAttr (n := jstat) = do i <- lift nextInteger asAttr $ (n := (displayT $ renderOneLine $ renderPrefixJs (show i) jstat)) -- | 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 = HSPT XML Identity XML instance ToJExpr DOMNode where toJExpr = toJExpr . runIdentity . unHSPT -- | 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 XML instance ToJExpr XMLToInnerHTML where toJExpr (XMLToInnerHTML xml) = [jmacroE| (function { var node = document.createElement('div') ; node.innerHTML = `(unpack $ 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 XML instance ToJExpr XMLToDOM where toJExpr (XMLToDOM (Element (dm', n') attrs children)) = let dm = fmap unpack dm' n = unpack n' in [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'))) = let nm = unpack nm' val = unpack val' in [jmacroE| `(node)`.setAttribute(`(nm)`, `(val)`) |] setAttribute node (MkAttr ((Just ns', nm'), (Value True val'))) = let ns = unpack ns' nm = unpack nm' val = unpack val' in [jmacroE| `(node)`.setAttributeNS(`(ns)`, `(nm)`, `(val)`) |] toJExpr (XMLToDOM (CDATA True txt')) = let txt = unpack txt' in [jmacroE| document.createTextNode(`(txt)`) |] toJExpr (XMLToDOM (CDATA False txt')) = let txt = unpack txt' in [jmacroE| (function { var node = document.createElement('div') ; node.innerHTML = `(txt)` ; return node })() |] instance ToJExpr XML where toJExpr = toJExpr . XMLToInnerHTML hsx-jmacro-7.3.8/HSP/JMacroT.hs0000644000000000000000000001504112725536622014272 0ustar0000000000000000{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeFamilies, TypeSynonymInstances, QuasiQuotes, OverloadedStrings #-} -- | 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 HSP.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 HSP.XMLGenerator (Attr(..), XMLGen(..), XMLGenT(..), XMLGenerator, AppendChild(..), EmbedAsAttr(..), EmbedAsChild(..), Name(..), SetAttr(..), unXMLGenT) import Language.Javascript.JMacro (ToJExpr(..), JExpr(..), JStat(..), JVal(JVar), Ident(StrI), 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 XMLType (JMacroT m) = JExpr type StringType (JMacroT m) = Lazy.Text newtype ChildType (JMacroT m) = JMChild { unJMChild :: JExpr } newtype AttributeType (JMacroT m) = JMAttr { unJMAttr :: JExpr } genElement = element xmlToChild = JMChild pcdataToChild str = JMChild $ [jmacroE| document.createTextNode(`(Lazy.unpack str)`) |] -- | generate an XML Element element :: (Functor m, Monad m, EmbedAsAttr (JMacroT m) attr, EmbedAsChild (JMacroT m) child) => Name Lazy.Text -- ^ 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 (fmap Lazy.unpack ns) (Lazy.unpack 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 Lazy.Text Lazy.Text) where asAttr (n := v) = return [JMAttr [jmacroE| (function (){ var attrNode = document.createAttribute(`(Lazy.unpack n)`) ; attrNode.nodeValue = `(Lazy.unpack v)` ; return attrNode; })() |]] instance (Functor m, Monad m, StringType (JMacroT m) ~ Lazy.Text) => EmbedAsChild (JMacroT m) Char where asChild c = return [pcdataToChild $ Lazy.singleton c] instance (Functor m, Monad m, StringType (JMacroT m) ~ Lazy.Text) => EmbedAsChild (JMacroT m) String where asChild str = return [pcdataToChild $ Lazy.pack 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 Lazy.Text Bool) where asAttr (n := True) = asAttr (n := ("true" :: Lazy.Text)) asAttr (n := False) = asAttr (n := ("false" :: Lazy.Text)) instance (Functor m, Monad m) => EmbedAsAttr (JMacroT m) (Attr Lazy.Text Int) where asAttr (n := v) = asAttr (n := (Lazy.pack $ 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, StringType (JMacroT m) ~ Lazy.Text) => XMLGenerator (JMacroT m)