{-# 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 <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 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' :: m Integer
nextInteger' =
    do Integer
i <- m Integer
forall s (m :: * -> *). MonadState s m => m s
get
       Integer -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
i)
       Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i

instance (XMLGenerator m, IntegerSupply m, EmbedAsChild m Text, StringType m ~ Text) => EmbedAsChild m JStat where
  asChild :: JStat -> GenChildList m
asChild JStat
jstat =
      do Integer
i <- m Integer -> XMLGenT m Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Integer
forall (m :: * -> *). IntegerSupply m => m Integer
nextInteger
         XMLGenT m (XMLType m) -> GenChildList m
forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild (XMLGenT m (XMLType m) -> GenChildList m)
-> XMLGenT m (XMLType m) -> GenChildList m
forall a b. (a -> b) -> a -> b
$ Name (StringType m)
-> [XMLGenT m [AttributeType m]]
-> [GenChildList m]
-> XMLGenT m (XMLType m)
forall (m :: * -> *).
XMLGen m =>
Name (StringType m)
-> [XMLGenT m [AttributeType m]]
-> [XMLGenT m [ChildType m]]
-> XMLGenT m (XMLType m)
genElement (Maybe (StringType m)
forall a. Maybe a
Nothing, String -> Text
fromStringLit String
"script")
                    [Attr Text Text -> XMLGenT m [AttributeType m]
forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr ((String -> Text
fromStringLit String
"type" Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= String -> Text
fromStringLit String
"text/javascript") :: Attr Text Text)]
                    [Text -> GenChildList m
forall (m :: * -> *) c. EmbedAsChild m c => c -> GenChildList m
asChild (SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> SimpleDoc -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> SimpleDoc
renderOneLine (Doc -> SimpleDoc) -> Doc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ String -> JStat -> Doc
forall a. (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs (Integer -> String
forall a. Show a => a -> String
show Integer
i) JStat
jstat)]

instance (XMLGen m, IntegerSupply m, EmbedAsAttr m (Attr n Text)) => EmbedAsAttr m (Attr n JStat) where
  asAttr :: Attr n JStat -> GenAttributeList m
asAttr (n
n := JStat
jstat) =
      do Integer
i <- m Integer -> XMLGenT m Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Integer
forall (m :: * -> *). IntegerSupply m => m Integer
nextInteger
         Attr n Text -> GenAttributeList m
forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr (Attr n Text -> GenAttributeList m)
-> Attr n Text -> GenAttributeList m
forall a b. (a -> b) -> a -> b
$ (n
n n -> Text -> Attr n Text
forall n a. n -> a -> Attr n a
:= (SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> SimpleDoc -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> SimpleDoc
renderOneLine (Doc -> SimpleDoc) -> Doc -> SimpleDoc
forall a b. (a -> b) -> a -> b
$ String -> JStat -> Doc
forall a. (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs (Integer -> String
forall a. Show a => a -> String
show Integer
i) JStat
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 :: DOMNode -> JExpr
toJExpr = XML -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (XML -> JExpr) -> (DOMNode -> XML) -> DOMNode -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity XML -> XML
forall a. Identity a -> a
runIdentity (Identity XML -> XML)
-> (DOMNode -> Identity XML) -> DOMNode -> XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DOMNode -> Identity XML
forall xml (m :: * -> *) a. HSPT xml m a -> m a
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 -> JExpr
toJExpr (XMLToInnerHTML XML
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 -> JExpr
toJExpr (XMLToDOM (Element (Namespace
dm', Text
n') Attributes
attrs Children
children)) =
      let dm :: Maybe String
dm = (Text -> String) -> Namespace -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack Namespace
dm'
          n :: String
n = Text -> String
unpack Text
n'
      in
      [jmacroE| (function { var node = `(createElement (dm) (n))`
                          ;  `(map (setAttribute node) attrs)`
                          ;  `(map (appendChild node . XMLToDOM) children)`
                          ;  return node
                          })()
       |]
      where
        createElement :: Maybe a -> a -> JExpr
createElement Maybe a
Nothing a
n = [jmacroE| document.createElement(`(n)`) |]
        createElement (Just a
ns) a
n = [jmacroE| document.createElementNS(`(ns)`, `(n)`) |]
        appendChild :: a -> a -> JExpr
appendChild a
node a
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 :: a -> Attribute -> JExpr
setAttribute a
node (MkAttr ((Namespace
Nothing, Text
nm'), (Value Bool
True Text
val'))) =
            let nm :: String
nm = Text -> String
unpack Text
nm'
                val :: String
val = Text -> String
unpack Text
val'
            in
            [jmacroE| `(node)`.setAttribute(`(nm)`, `(val)`) |]
        setAttribute a
node (MkAttr ((Just Text
ns', Text
nm'), (Value Bool
True Text
val'))) =
            let ns :: String
ns = Text -> String
unpack Text
ns'
                nm :: String
nm = Text -> String
unpack Text
nm'
                val :: String
val = Text -> String
unpack Text
val'
            in
            [jmacroE| `(node)`.setAttributeNS(`(ns)`, `(nm)`, `(val)`) |]

  toJExpr (XMLToDOM (CDATA Bool
True Text
txt')) =
      let txt :: String
txt = Text -> String
unpack Text
txt' in
      [jmacroE| document.createTextNode(`(txt)`) |]

  toJExpr (XMLToDOM (CDATA Bool
False Text
txt')) =
      let txt :: String
txt = Text -> String
unpack Text
txt' in
      [jmacroE| (function { var node = document.createElement('div')
                          ; node.innerHTML = `(txt)`
                          ; return node
                          })() |]

instance ToJExpr XML where
    toJExpr :: XML -> JExpr
toJExpr = XMLToInnerHTML -> JExpr
forall a. ToJExpr a => a -> JExpr
toJExpr (XMLToInnerHTML -> JExpr)
-> (XML -> XMLToInnerHTML) -> XML -> JExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XML -> XMLToInnerHTML
XMLToInnerHTML