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