{-# LANGUAGE DeriveDataTypeable #-}
module Graphics.UI.Threepenny.Internal (
    -- * Synopsis
    -- | Internal core:
    -- 'UI' monad, integrating FRP and JavaScript FFI. garbage collection

    -- * Documentation
    Window, disconnect,
    startGUI, loadFile, loadDirectory,

    UI, runUI, MonadUI(..), liftIOLater, askWindow, liftJSWindow,

    FFI, FromJS, ToJS, JSFunction, JSObject, ffi,
    runFunction, callFunction,
    CallBufferMode(..), setCallBufferMode, flushCallBuffer,
    ffiExport, debug, timestamp,

    Element(toJSObject), fromJSObject, getWindow,
    mkElementNamespace, mkElement, delete, appendChild, clearChildren,

    EventData, domEvent, unsafeFromJSON,
    ) where

import           Control.Applicative                   (Applicative(..))
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import qualified Control.Monad.Trans.RWS.Lazy as Monad
import           Data.Dynamic                          (Typeable)

import qualified Data.Aeson              as JSON
import qualified Foreign.JavaScript      as JS
import qualified Foreign.RemotePtr       as Foreign

import qualified Reactive.Threepenny     as RB

import Foreign.JavaScript hiding
    (runFunction, callFunction, setCallBufferMode, flushCallBuffer
    ,debug, timestamp, Window, loadFile, loadDirectory)

{-----------------------------------------------------------------------------
    Custom Window type
------------------------------------------------------------------------------}
-- | The type 'Window' represents a browser window.
data Window = Window
    { Window -> Window
jsWindow    :: JS.Window  -- JavaScript window
    , Window -> Event ()
eDisconnect :: RB.Event () -- event that happens when client disconnects
    , Window -> Vendor Events
wEvents     :: Foreign.Vendor Events
                     -- events associated to 'Element's
    , Window -> Vendor ()
wChildren   :: Foreign.Vendor ()
                     -- children reachable from 'Element's
    }

-- | Start server for GUI sessions.
startGUI
    :: Config               -- ^ Server configuration.
    -> (Window -> UI ())    -- ^ Action to run whenever a client browser connects.
    -> IO ()
startGUI :: Config -> (Window -> UI ()) -> IO ()
startGUI Config
config Window -> UI ()
init = Config -> (Window -> IO ()) -> IO ()
JS.serve Config
config forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    -- set up disconnect event
    (Event ()
eDisconnect, Handler ()
handleDisconnect) <- forall a. IO (Event a, Handler a)
RB.newEvent
    Window -> IO () -> IO ()
JS.onDisconnect Window
w forall a b. (a -> b) -> a -> b
$ Handler ()
handleDisconnect ()

    -- make window
    Vendor Events
wEvents   <- forall a. IO (Vendor a)
Foreign.newVendor
    Vendor ()
wChildren <- forall a. IO (Vendor a)
Foreign.newVendor
    let window :: Window
window = Window
            { jsWindow :: Window
jsWindow    = Window
w
            , eDisconnect :: Event ()
eDisconnect = Event ()
eDisconnect
            , wEvents :: Vendor Events
wEvents     = Vendor Events
wEvents
            , wChildren :: Vendor ()
wChildren   = Vendor ()
wChildren
            }

    -- run initialization
    forall a. Window -> UI a -> IO a
runUI Window
window forall a b. (a -> b) -> a -> b
$ Window -> UI ()
init Window
window

-- | Event that occurs whenever the client has disconnected,
-- be it by closing the browser window or by exception.
--
-- Note: DOM Elements in a browser window that has been closed
-- can no longer be manipulated.
disconnect :: Window -> RB.Event ()
disconnect :: Window -> Event ()
disconnect = Window -> Event ()
eDisconnect

-- | Begin to serve a local file with a given 'MimeType' under a relative URI.
loadFile
    :: String    -- ^ MIME type
    -> FilePath  -- ^ Local path to the file
    -> UI String -- ^ Relative URI under which this file is now accessible
loadFile :: String -> String -> UI String
loadFile String
x String
y = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Server -> String -> String -> IO String
JS.loadFile (Window -> Server
JS.getServer Window
w) String
x String
y

-- | Make a local directory available under a relative URI.
loadDirectory :: FilePath -> UI String
loadDirectory :: String -> UI String
loadDirectory String
x = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Server -> String -> IO String
JS.loadDirectory (Window -> Server
JS.getServer Window
w) String
x

{-----------------------------------------------------------------------------
    Elements
------------------------------------------------------------------------------}
type Events = String -> RB.Event JSON.Value

-- Reachability information for children of an 'Element'.
-- The children of an element are always reachable from this RemotePtr.
type Children = Foreign.RemotePtr ()

data Element = Element
    { Element -> JSObject
toJSObject  :: JS.JSObject -- ^ Access to the primitive 'JS.JSObject' for roll-your-own foreign calls.
    , Element -> Events
elEvents    :: Events      -- ^ FRP event mapping
    , Element -> Children
elChildren  :: Children    -- ^ The children of this element
    , Element -> Window
elWindow    :: Window      -- ^ Window in which the element was created
    } deriving (Typeable)

instance ToJS Element where
    render :: Element -> IO JSCode
render = forall a. ToJS a => a -> IO JSCode
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> JSObject
toJSObject

getWindow :: Element -> IO Window
getWindow :: Element -> IO Window
getWindow = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Window
elWindow

-- | Lookup or create reachability information for the children of
-- an element that is represented by a JavaScript object.
getChildren :: JS.JSObject -> Window -> IO Children
getChildren :: JSObject -> Window -> IO Children
getChildren JSObject
el window :: Window
window@Window{ wChildren :: Window -> Vendor ()
wChildren = Vendor ()
wChildren } =
    forall a b. RemotePtr a -> (Coupon -> a -> IO b) -> IO b
Foreign.withRemotePtr JSObject
el forall a b. (a -> b) -> a -> b
$ \Coupon
coupon JSPtr
_ -> do
        Maybe Children
mptr <- forall a. Coupon -> Vendor a -> IO (Maybe (RemotePtr a))
Foreign.lookup Coupon
coupon Vendor ()
wChildren
        case Maybe Children
mptr of
            Maybe Children
Nothing -> do
                -- Create new pointer for reachability information.
                Children
ptr <- forall a. Coupon -> a -> Vendor a -> IO (RemotePtr a)
Foreign.newRemotePtr Coupon
coupon () Vendor ()
wChildren
                forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable JSObject
el Children
ptr
                forall (m :: * -> *) a. Monad m => a -> m a
return Children
ptr
            Just Children
p  ->
                -- Return existing information
                forall (m :: * -> *) a. Monad m => a -> m a
return Children
p

-- | Convert JavaScript object into an Element by attaching relevant information.
-- The JavaScript object may still be subject to garbage collection.
fromJSObject0 :: JS.JSObject -> Window -> IO Element
fromJSObject0 :: JSObject -> Window -> IO Element
fromJSObject0 JSObject
el Window
window = do
    Events
events   <- JSObject -> Window -> IO Events
getEvents   JSObject
el Window
window
    Children
children <- JSObject -> Window -> IO Children
getChildren JSObject
el Window
window
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ JSObject -> Events -> Children -> Window -> Element
Element JSObject
el Events
events Children
children Window
window

-- | Convert JavaScript object into an element.
--
-- FIXME: For the purpose of garbage collection, this element
-- will always be reachable from the root.
fromJSObject :: JS.JSObject -> UI Element
fromJSObject :: JSObject -> UI Element
fromJSObject JSObject
el = do
    Window
window <- UI Window
askWindow
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable (Window -> Children
JS.root forall a b. (a -> b) -> a -> b
$ Window -> Window
jsWindow Window
window) JSObject
el
        JSObject -> Window -> IO Element
fromJSObject0 JSObject
el Window
window

-- | Add lazy FRP events to a JavaScript object.
addEvents :: JS.JSObject -> Window -> IO Events
addEvents :: JSObject -> Window -> IO Events
addEvents JSObject
el Window{ jsWindow :: Window -> Window
jsWindow = Window
w, wEvents :: Window -> Vendor Events
wEvents = Vendor Events
wEvents } = do
    -- Lazily create FRP events whenever they are needed.
    let initializeEvent :: (t, b, a) -> IO ()
initializeEvent (t
name,b
_,a
handler) = do
            JSObject
handlerPtr <- forall a. IsHandler a => Window -> a -> IO JSObject
JS.exportHandler Window
w a
handler
            -- make handler reachable from element
            forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable JSObject
el JSObject
handlerPtr
            Window -> JSFunction () -> IO ()
JS.runFunction Window
w forall a b. (a -> b) -> a -> b
$
                forall a. FFI a => String -> a
ffi String
"Haskell.on(%1,%2,%3)" JSObject
el t
name JSObject
handlerPtr

    Events
events <- forall name a.
Ord name =>
Handler (name, Event a, Handler a) -> IO (name -> Event a)
RB.newEventsNamed forall {a} {t} {b}. (IsHandler a, ToJS t) => (t, b, a) -> IO ()
initializeEvent

    -- Create new pointer and add reachability.
    forall a b. RemotePtr a -> (Coupon -> a -> IO b) -> IO b
Foreign.withRemotePtr JSObject
el forall a b. (a -> b) -> a -> b
$ \Coupon
coupon JSPtr
_ -> do
        RemotePtr Events
ptr <- forall a. Coupon -> a -> Vendor a -> IO (RemotePtr a)
Foreign.newRemotePtr Coupon
coupon Events
events Vendor Events
wEvents
        forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable JSObject
el RemotePtr Events
ptr

    forall (m :: * -> *) a. Monad m => a -> m a
return Events
events

-- | Lookup or create lazy events for a JavaScript object.
getEvents :: JS.JSObject -> Window -> IO Events
getEvents :: JSObject -> Window -> IO Events
getEvents JSObject
el window :: Window
window@Window{ wEvents :: Window -> Vendor Events
wEvents = Vendor Events
wEvents } = do
    forall a b. RemotePtr a -> (Coupon -> a -> IO b) -> IO b
Foreign.withRemotePtr JSObject
el forall a b. (a -> b) -> a -> b
$ \Coupon
coupon JSPtr
_ -> do
        Maybe (RemotePtr Events)
mptr <- forall a. Coupon -> Vendor a -> IO (Maybe (RemotePtr a))
Foreign.lookup Coupon
coupon Vendor Events
wEvents
        case Maybe (RemotePtr Events)
mptr of
            Maybe (RemotePtr Events)
Nothing -> JSObject -> Window -> IO Events
addEvents JSObject
el Window
window
            Just RemotePtr Events
p  -> forall a b. RemotePtr a -> (Coupon -> a -> IO b) -> IO b
Foreign.withRemotePtr RemotePtr Events
p forall a b. (a -> b) -> a -> b
$ \Coupon
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Events may carry data. At the moment, they may return
-- a single JSON value, as defined in the "Data.Aeson" module.
type EventData = JSON.Value

-- | Convert event data to a Haskell value.
-- Throws an exception when the data cannot be converted.
unsafeFromJSON :: JSON.FromJSON a => EventData -> a
unsafeFromJSON :: forall a. FromJSON a => Value -> a
unsafeFromJSON Value
x = let JSON.Success a
y = forall a. FromJSON a => Value -> Result a
JSON.fromJSON Value
x in a
y

-- | Obtain DOM event for a given element.
domEvent
    :: String
        -- ^ Event name. A full list can be found at
        --   <http://www.w3schools.com/jsref/dom_obj_event.asp>.
        --   Note that the @on@-prefix is not included,
        --   the name is @click@ and so on.
    -> Element          -- ^ Element where the event is to occur.
    -> RB.Event EventData
domEvent :: String -> Element -> Event Value
domEvent String
name Element
el = Element -> Events
elEvents Element
el String
name

-- | Make a new DOM element with a given tag name.
mkElement :: String -> UI Element
mkElement :: String -> UI Element
mkElement = Maybe String -> String -> UI Element
mkElementNamespace forall a. Maybe a
Nothing

-- | Make a new DOM element with a namespace and a given tag name.
--
-- A namespace 'Nothing' corresponds to the default HTML namespace.
mkElementNamespace :: Maybe String -> String -> UI Element
mkElementNamespace :: Maybe String -> String -> UI Element
mkElementNamespace Maybe String
namespace String
tag = do
    Window
window <- UI Window
askWindow
    let w :: Window
w = Window -> Window
jsWindow Window
window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        JSObject
el <- Window -> JSFunction NewJSObject -> IO JSObject
JS.unsafeCreateJSObject Window
w forall a b. (a -> b) -> a -> b
$ case Maybe String
namespace of
            Maybe String
Nothing -> forall a. FFI a => String -> a
ffi String
"document.createElement(%1)" String
tag
            Just String
ns -> forall a. FFI a => String -> a
ffi String
"document.createElementNS(%1,%2)" String
ns String
tag
        JSObject -> Window -> IO Element
fromJSObject0 JSObject
el Window
window

-- | Delete the given element.
--
-- This operation removes the element from the browser window DOM
-- and marks it for garbage collection on the Haskell side.
-- The element is unusable afterwards.
--
-- NOTE: If you wish to temporarily remove an element from the DOM tree,
-- change the 'children' property of its parent element instead.
delete :: Element -> UI ()
delete :: Element -> UI ()
delete Element
el = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    Window -> JSFunction () -> IO ()
JS.runFunction Window
w forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).detach()" Element
el
    forall a. RemotePtr a -> IO ()
Foreign.destroy forall a b. (a -> b) -> a -> b
$ Element -> JSObject
toJSObject Element
el

-- | Remove all child elements.
clearChildren :: Element -> UI ()
clearChildren :: Element -> UI ()
clearChildren Element
element = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    let el :: JSObject
el = Element -> JSObject
toJSObject Element
element
    forall a b. RemotePtr a -> (Coupon -> a -> IO b) -> IO b
Foreign.withRemotePtr JSObject
el forall a b. (a -> b) -> a -> b
$ \Coupon
_ JSPtr
_ -> do
        -- Previous children are no longer reachable from this element
        Window -> JSFunction () -> IO ()
JS.runFunction Window
w forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).contents().detach()" JSObject
el
        forall a. RemotePtr a -> IO ()
Foreign.clearReachable (Element -> Children
elChildren Element
element)

-- | Append a child element.
appendChild :: Element -> Element -> UI ()
appendChild :: Element -> Element -> UI ()
appendChild Element
parent Element
child = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    -- FIXME: We have to stop the child being reachable from its
    -- /previous/ parent.
    forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable (Element -> Children
elChildren Element
parent) (Element -> JSObject
toJSObject Element
child)
    Window -> JSFunction () -> IO ()
JS.runFunction Window
w forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).append($(%2))" (Element -> JSObject
toJSObject Element
parent) (Element -> JSObject
toJSObject Element
child)


{-----------------------------------------------------------------------------
    UI monad
------------------------------------------------------------------------------}
{- |

User interface elements are created and manipulated in the 'UI' monad.

This monad is essentially just a thin wrapper around the familiar 'IO' monad.
Use the 'liftIO' function to access 'IO' operations like reading
and writing from files.

There are several subtle reasons why Threepenny
uses a custom 'UI' monad instead of the standard 'IO' monad:

* More convenience when calling JavaScript.
The monad keeps track of a browser 'Window' context
in which JavaScript function calls are executed.

* Recursion for functional reactive programming.

-}
newtype UI a = UI { forall a. UI a -> RWST Window [IO ()] () IO a
unUI :: Monad.RWST Window [IO ()] () IO a }
    deriving (Typeable)

class (Monad m) => MonadUI m where
    -- | Lift a computation from the 'UI' monad.
    liftUI :: UI a -> m a

instance MonadUI UI where
    liftUI :: forall a. UI a -> UI a
liftUI = forall a. a -> a
id

-- | Access to the primitive 'JS.Window' object,
--   for roll-your-own JS foreign calls.
liftJSWindow :: (JS.Window -> IO a) -> UI a
liftJSWindow :: forall a. (Window -> IO a) -> UI a
liftJSWindow Window -> IO a
f = UI Window
askWindow forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> IO a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window
jsWindow

instance Functor UI where
    fmap :: forall a b. (a -> b) -> UI a -> UI b
fmap a -> b
f = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UI a -> RWST Window [IO ()] () IO a
unUI

instance Applicative UI where
    pure :: forall a. a -> UI a
pure  = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    <*> :: forall a b. UI (a -> b) -> UI a -> UI b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad UI where
    return :: forall a. a -> UI a
return  = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    UI a
m >>= :: forall a b. UI a -> (a -> UI b) -> UI b
>>= a -> UI b
k = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall a b. (a -> b) -> a -> b
$ forall a. UI a -> RWST Window [IO ()] () IO a
unUI UI a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. UI a -> RWST Window [IO ()] () IO a
unUI forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UI b
k

instance MonadIO UI where
    liftIO :: forall a. IO a -> UI a
liftIO = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance MonadFix UI where
    mfix :: forall a. (a -> UI a) -> UI a
mfix a -> UI a
f = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (forall a. UI a -> RWST Window [IO ()] () IO a
unUI forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UI a
f)

instance MonadThrow UI where
    throwM :: forall e a. Exception e => e -> UI a
throwM = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM

instance MonadCatch UI where
    catch :: forall e a. Exception e => UI a -> (e -> UI a) -> UI a
catch UI a
m e -> UI a
f = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall a. UI a -> RWST Window [IO ()] () IO a
unUI UI a
m) (forall a. UI a -> RWST Window [IO ()] () IO a
unUI forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> UI a
f)

-- | Execute an 'UI' action in a particular browser window.
-- Also runs all scheduled 'IO' actions.
runUI :: Window -> UI a -> IO a
runUI :: forall a. Window -> UI a -> IO a
runUI Window
window UI a
m = do
    (a
a, ()
_, [IO ()]
actions) <- forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Monad.runRWST (forall a. UI a -> RWST Window [IO ()] () IO a
unUI UI a
m) Window
window ()
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [IO ()]
actions
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Retrieve current 'Window' context in the 'UI' monad.
askWindow :: UI Window
askWindow :: UI Window
askWindow = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
Monad.ask

-- | Schedule an 'IO' action to be run later.
liftIOLater :: IO () -> UI ()
liftIOLater :: IO () -> UI ()
liftIOLater IO ()
x = forall a. RWST Window [IO ()] () IO a -> UI a
UI forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
Monad.tell [IO ()
x]

{-----------------------------------------------------------------------------
    FFI
------------------------------------------------------------------------------}
-- | Run a JavaScript function, but do not wait for a result.
--
-- The client window uses JavaScript's @eval()@ function to run the code.
--
-- 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 :: JSFunction () -> UI ()
runFunction :: JSFunction () -> UI ()
runFunction JSFunction ()
fun = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Window -> JSFunction () -> IO ()
JS.runFunction Window
w JSFunction ()
fun

-- | Call a JavaScript function and wait for the result.
--
-- The client window uses JavaScript's @eval()@ function to run the code.
callFunction :: JSFunction a -> UI a
callFunction :: forall a. JSFunction a -> UI a
callFunction JSFunction a
fun = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> forall a. Window -> JSFunction a -> IO a
JS.callFunction Window
w JSFunction a
fun

-- | Set the call buffering mode for the browser window.
setCallBufferMode :: CallBufferMode -> UI ()
setCallBufferMode :: CallBufferMode -> UI ()
setCallBufferMode CallBufferMode
x = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Window -> CallBufferMode -> IO ()
JS.setCallBufferMode Window
w CallBufferMode
x

-- | Flush the call buffer,
-- i.e. send all outstanding JavaScript to the client in one single message.
flushCallBuffer :: UI ()
flushCallBuffer :: UI ()
flushCallBuffer = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Window -> IO ()
JS.flushCallBuffer Window
w

-- | Export the given Haskell function so that it can be called
-- from JavaScript code.
--
-- NOTE: At the moment, the 'JSObject' representing the exported function
-- will be referenced by the browser 'Window' in which it was created,
-- preventing garbage collection until this browser 'Window' is disconnected.
--
-- This makes it possible to use it as an event handler on the JavaScript side,
-- but it also means that the Haskell runtime has no way to detect
-- early when it is no longer needed.
--
-- In contrast, if you use the function 'domEvent' to register an
-- event handler to an 'Element',
-- then the handler will be garbage collected
-- as soon as the associated 'Element' is garbage collected.
ffiExport :: JS.IsHandler a => a -> UI JSObject
ffiExport :: forall a. IsHandler a => a -> UI JSObject
ffiExport a
fun = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> do
    JSObject
handlerPtr <- forall a. IsHandler a => Window -> a -> IO JSObject
JS.exportHandler Window
w a
fun
    forall a b. RemotePtr a -> RemotePtr b -> IO ()
Foreign.addReachable (Window -> Children
JS.root Window
w) JSObject
handlerPtr
    forall (m :: * -> *) a. Monad m => a -> m a
return JSObject
handlerPtr

-- | Print a message on the client console if the client has debugging enabled.
debug :: String -> UI ()
debug :: String -> UI ()
debug String
s = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> Window -> String -> IO ()
JS.debug Window
w String
s

-- | Print a timestamp and the difference to the previous timestamp
-- on the client console if the client has debugging enabled.
timestamp :: UI ()
timestamp :: UI ()
timestamp = forall a. (Window -> IO a) -> UI a
liftJSWindow Window -> IO ()
JS.timestamp