{-# 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
     (ByteString -> String)
-> (String -> ByteString) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ByteString -> ByteString
S.map Char -> Char
dollar
     (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
S.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'=')
     (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
encode
     (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
B.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
     (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut
     (Put -> ByteString) -> (String -> Put) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter Word32
putWord32le
     Putter Word32 -> (String -> Word32) -> String -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Word32
forall a. Adler32 a => a -> Word32
adler32
     (ByteString -> Word32)
-> (String -> ByteString) -> String -> Word32
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 (Text -> ByteString) -> (JStat -> Text) -> JStat -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> (JStat -> SimpleDoc) -> JStat -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderOneLine (Doc -> SimpleDoc) -> (JStat -> Doc) -> JStat -> SimpleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JStat -> Doc
forall a. (JsToDoc a, JMacro a) => a -> Doc
renderJs (JStat -> ByteString) -> JStat -> ByteString
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 (Text -> ByteString) -> (JStat -> Text) -> JStat -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDoc -> Text
displayT (SimpleDoc -> Text) -> (JStat -> SimpleDoc) -> JStat -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> SimpleDoc
renderOneLine (Doc -> SimpleDoc) -> (JStat -> Doc) -> JStat -> SimpleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JStat -> Doc
forall a. (JsToDoc a, JMacro a) => String -> a -> Doc
renderPrefixJs (String -> String
mkId String
prefix) (JStat -> ByteString) -> JStat -> ByteString
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 :: JStat -> m Response
jmResponse JStat
jstat =
    do Request{rqUri :: Request -> String
rqUri = String
uri} <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       Response -> m Response
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> m Response)
-> (PrefixedJStat -> Response) -> PrefixedJStat -> m Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrefixedJStat -> Response
forall a. ToMessage a => a -> Response
toResponse (PrefixedJStat -> m Response) -> PrefixedJStat -> m Response
forall a b. (a -> b) -> a -> b
$ String -> JStat -> PrefixedJStat
PrefixedJStat String
uri JStat
jstat