{-# LANGUAGE QuasiQuotes #-} module Network.Socketed.Template (socketedScript, evalHtml) where import Data.List (intercalate) import Network.Socketed.Internal (SocketedOptions(..), showWSHost, stringQuote) socketedScript :: String -> Int -> String -> String -> String socketedScript h ldrop hf ef = [stringQuote| |] wrapHtml :: String -> String wrapHtml inner = [stringQuote| |] ++ inner ++ [stringQuote| |] evalHtml :: Int -> SocketedOptions -> String evalHtml r (SocketedOptions h p) = wrapHtml $ socketedScript (showWSHost h p) r [stringQuote| function(event) { eval(event.data); } |] [stringQuote| function(event, error) { var c = document.createElement('div'); c.textContent = 'failed to eval: '+ event.data; window.document.body.appendChild(c); } |]