{-# LANGUAGE QuasiQuotes #-}
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)
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
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