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
jmResponse :: ServerMonad m => JStat -> m Response
jmResponse jstat =
do Request{rqUri = uri} <- askRq
return . toResponse $ PrefixedJStat uri jstat