{-# LANGUAGE RecordWildCards #-}
module Foreign.JavaScript (
    -- * Synopsis
    -- | A JavaScript foreign function interface (FFI).
    --
    -- This module implements a web server that communicates with
    -- a web browser and allows you to execute arbitrary JavaScript code on it.
    --
    -- NOTE: This module is used internally by the "Graphics.UI.Threepenny"
    -- library, but the types are /not/ compatible directly
    -- (although some escape hatches are provided).
    -- Use "Foreign.JavaScript" only if you want to roll your own
    -- interface to the web browser.

    -- * Server
    serve, defaultConfig, Config(
          jsPort, jsAddr
        , jsCustomHTML, jsStatic, jsLog
        , jsWindowReloadOnDisconnect, jsCallBufferMode
        , jsUseSSL),
    ConfigSSL (jsSSLBind, jsSSLCert, jsSSLChainCert, jsSSLKey, jsSSLPort),
    Server, MimeType, URI, loadFile, loadDirectory,
    Window, getServer, getCookies, root,

    -- * JavaScript FFI
    ToJS(..), FromJS, JSFunction, JSObject, JavaScriptException,
    FFI, ffi, runFunction, callFunction,
    NewJSObject, unsafeCreateJSObject,
    CallBufferMode(..), setCallBufferMode, getCallBufferMode, flushCallBuffer,
    IsHandler, exportHandler, onDisconnect,
    debug, timestamp,
    ) where

import           Control.Concurrent.STM       as STM
import           Control.Monad                           (unless)
import qualified Data.Aeson                   as JSON
import           Foreign.JavaScript.CallBuffer
import           Foreign.JavaScript.EventLoop
import           Foreign.JavaScript.Marshal
import           Foreign.JavaScript.Server
import           Foreign.JavaScript.Types
import           Foreign.RemotePtr            as Foreign

{-----------------------------------------------------------------------------
    Server
------------------------------------------------------------------------------}
-- | Run a "Foreign.JavaScript" server.
serve
    :: Config               -- ^ Configuration options.
    -> (Window -> IO ())    -- ^ Initialization whenever a client connects.
    -> IO ()
serve :: Config -> (Window -> IO ()) -> IO ()
serve Config
config Window -> IO ()
init = Config -> EventLoop -> IO ()
httpComm Config
config forall a b. (a -> b) -> a -> b
$ forall void. (Window -> IO void) -> EventLoop
eventLoop forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    Window -> CallBufferMode -> IO ()
setCallBufferMode Window
w (Config -> CallBufferMode
jsCallBufferMode Config
config)
    Window -> JSFunction () -> IO ()
runFunction Window
w forall a b. (a -> b) -> a -> b
$
        forall a. FFI a => String -> a
ffi String
"connection.setReloadOnDisconnect(%1)" forall a b. (a -> b) -> a -> b
$ Config -> Bool
jsWindowReloadOnDisconnect Config
config
    Window -> IO ()
flushCallBuffer Window
w   -- make sure that all `runEval` commands are executed
    Window -> IO ()
init Window
w
    Window -> IO ()
flushCallBuffer Window
w   -- make sure that all `runEval` commands are executed

{-----------------------------------------------------------------------------
    JavaScript
------------------------------------------------------------------------------}
-- | Run a JavaScript function, but do not wait for a result.
--
-- NOTE: The JavaScript function need not be executed immediately,
-- it can be buffered and sent to the browser window at a later time.
-- See 'setCallBufferMode' and 'flushCallBuffer' for more.
runFunction :: Window -> JSFunction () -> IO ()
runFunction :: Window -> JSFunction () -> IO ()
runFunction Window
w JSFunction ()
f = Window -> String -> IO ()
bufferRunEval Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> IO String
toCode JSFunction ()
f

-- | Run a JavaScript function that creates a new object.
-- Return a corresponding 'JSObject' without waiting for the browser
-- to send a result.
--
-- WARNING: This function assumes that the supplied JavaScript code does,
-- in fact, create an object that is new.
unsafeCreateJSObject :: Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject :: Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject Window
w JSFunction NewJSObject
f = do
    JSFunction JSObject
g <- Window -> JSFunction NewJSObject -> IO (JSFunction JSObject)
wrapImposeStablePtr Window
w JSFunction NewJSObject
f
    Window -> String -> IO ()
bufferRunEval Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> IO String
toCode JSFunction JSObject
g
    forall a. JSFunction a -> Window -> Value -> IO a
marshalResult JSFunction JSObject
g Window
w forall {a}. a
err
    where
    err :: a
err = forall a. HasCallStack => String -> a
error String
"unsafeCreateJSObject: marshal does not take arguments"

-- | Call a JavaScript function and wait for the result.
callFunction :: Window -> JSFunction a -> IO a
callFunction :: forall a. Window -> JSFunction a -> IO a
callFunction Window
w JSFunction a
f = do
    -- FIXME: Add the code of f to the buffer as well!
    -- However, we have to pay attention to the semantics of exceptions in this case.
    Window -> IO ()
flushCallBuffer Window
w

    Value
resultJS <- Window -> String -> IO Value
callEval Window
w forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> IO String
toCode JSFunction a
f
    forall a. JSFunction a -> Window -> Value -> IO a
marshalResult JSFunction a
f Window
w Value
resultJS

-- | Export a Haskell function as an event handler.
--
-- The result is a JavaScript @Function@ object that can be called
-- from JavaScript like a regular function. However,
-- the corresponding Haskell function will /not/ be run immediately,
-- rather it will be added to the event queue and processed
-- like an event. In other words, this the Haskell code is only called
-- asynchronously.
--
-- WARNING: The event handler will be garbage collected unless you
-- keep a reference to it /on the Haskell side/!
-- Registering it with a JavaScript function will generally /not/
-- keep it alive.
exportHandler :: IsHandler a => Window -> a -> IO JSObject
exportHandler :: forall a. IsHandler a => Window -> a -> IO JSObject
exportHandler Window
w a
f = do
    HsEvent
g <- Window -> ([Value] -> IO ()) -> IO HsEvent
newHandler Window
w (\[Value]
args -> forall a. IsHandler a => a -> Window -> [Value] -> IO ()
handle a
f Window
w [Value]
args forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> IO ()
flushCallBuffer Window
w)
    JSObject
h <- Window -> JSFunction NewJSObject -> IO JSObject
unsafeCreateJSObject Window
w forall a b. (a -> b) -> a -> b
$
        forall a. FFI a => String -> a
ffi String
"Haskell.newEvent(%1,%2)" HsEvent
g (forall a. IsHandler a => a -> String
convertArguments a
f)
    forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable JSObject
h HsEvent
g
    forall (m :: * -> *) a. Monad m => a -> m a
return JSObject
h