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 qualified Data.ByteString.Lazy.UTF8 as LB

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

lineStyle :: Style
lineStyle = style { mode = OneLineMode }

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 =
        LB.fromString . renderStyle lineStyle . renderJs $ scoped
      where
        scoped = [jmacro| (function { `(js)`; })(); |]

instance ToMessage PrefixedJStat where
    toContentType _ = S.pack "text/javascript; charset=UTF-8"
    toMessage (PrefixedJStat prefix js) =
        LB.fromString . renderStyle lineStyle . 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