JMacro.hs

{-# LANGUAGE QuasiQuotes #-}

-- |This modules provides support for using JMacro with Happstack.
--
-- It provides the instance,
--
-- > instance ToMessage JStat
--
-- Which will serve a 'JStat' value as @text/javascript; charset=UTF-8@.
-- The rendered JavaScript will be wrapped in an anonymous function that is
-- then called, so as to ensure the statements execute in a local scope.
-- An implication of this is that top-level unhygienic variables in JMacro
-- will /not/ be globally available; instead, you should set properties on
-- the global @window@ object.
module Happstack.Server.JMacro (jmResponse) where

import qualified Data.ByteString           as B
import qualified Data.ByteString.Char8     as S

import Data.ByteString.Base64.URL   (encode)
import Data.Digest.Adler32          (adler32)
import Data.Serialize               (runPut, putWord32le)
import qualified Data.Text.Lazy.Encoding as T
import Happstack.Server             (ToMessage(..), ServerMonad, Request(Request, rqUri), Response, askRq)
import Language.Javascript.JMacro   (JStat(..), renderJs, renderPrefixJs, jmacro, jLam, toStat)
import Text.PrettyPrint.Leijen.Text (Doc, displayT, renderOneLine)
-- import Text.PrettyPrint           (Style(mode), Mode(OneLineMode), style, renderStyle)

mkId :: String -> String
mkId = S.unpack
     . S.map dollar
     . S.takeWhile (/= '=')
     . encode
     . B.dropWhile (== 0)
     . runPut
     . putWord32le
     . adler32
     . S.pack
  where
    dollar '-' = '$'
    dollar c   = c

data PrefixedJStat = PrefixedJStat String JStat

instance ToMessage JStat where
    toContentType _ = S.pack "text/javascript; charset=UTF-8"
    toMessage    js =
        T.encodeUtf8 . displayT . renderOneLine . renderJs $ scoped
      where
        scoped = [jmacro| (function { `(js)`; })(); |]

instance ToMessage PrefixedJStat where
    toContentType _ = S.pack "text/javascript; charset=UTF-8"
    toMessage (PrefixedJStat prefix js) =
        T.encodeUtf8 . displayT . renderOneLine . renderPrefixJs (mkId prefix) $ js

-- | Render a 'JStat' into a 'Response', saturating the variable names with
-- a hash computed from the 'rqUri'.  Unlike the 'ToMessage' instance for
-- @JStat@, this doesn't wrap the statements in a function and so the
-- workaround for global unhygienic names isn't necessary.  On the other
-- hand, generated variable names are a bit longer.
jmResponse :: ServerMonad m => JStat -> m Response
jmResponse jstat =
    do Request{rqUri = uri} <- askRq
       return . toResponse $ PrefixedJStat uri jstat