{-# 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 :: String -> String
mkId = ByteString -> String
S.unpack
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
S.map Char -> Char
dollar
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
S.takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'=')
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile (forall a. Eq a => a -> a -> Bool
== Word8
0)
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter Word32
putWord32le
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Adler32 a => a -> Word32
adler32
     forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
S.pack
  where
    dollar :: Char -> Char
dollar Char
'-' = Char
'$'
    dollar Char
c   = Char
c

data PrefixedJStat = PrefixedJStat String JStat

instance ToMessage JStat where
    toContentType :: JStat -> ByteString
toContentType JStat
_ = String -> ByteString
S.pack String
"text/javascript; charset=UTF-8"
    toMessage :: JStat -> ByteString
toMessage    JStat
js =
        Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderOneLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs forall a b. (a -> b) -> a -> b
$ JStat
scoped
      where
        scoped :: JStat
scoped = [jmacro| (function { `(js)`; })(); |]

instance ToMessage PrefixedJStat where
    toContentType :: PrefixedJStat -> ByteString
toContentType PrefixedJStat
_ = String -> ByteString
S.pack String
"text/javascript; charset=UTF-8"
    toMessage :: PrefixedJStat -> ByteString
toMessage (PrefixedJStat String
prefix JStat
js) =
        Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderOneLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs (String -> String
mkId String
prefix) forall a b. (a -> b) -> a -> b
$ JStat
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 :: forall (m :: * -> *). ServerMonad m => JStat -> m Response
jmResponse JStat
jstat =
    do Request{rqUri :: Request -> String
rqUri = String
uri} <- forall (m :: * -> *). ServerMonad m => m Request
askRq
       forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ String -> JStat -> PrefixedJStat
PrefixedJStat String
uri JStat
jstat