Commit 0fd3e650 authored by Camil Staps's avatar Camil Staps 🍃

Add iTasks.UI.JavaScript.Monad

parent 0004215f
Pipeline #31367 passed with stage
in 6 minutes and 40 seconds
......@@ -20,7 +20,14 @@ from StdMaybe import :: Maybe
from StdOverloaded import class toString
from Text.GenJSON import :: JSONNode
:: *JSWorld
/**
* All impure interfacing with JavaScript is handled through the `*JSWorld`, as
* native impure functionality is threaded through `*World`. `JSWorld` is not
* unique to be able to instantiate Monad (in `iTasks.UI.JavaScript.Monad`).
* Because all functions using `JSWorld` use it in a unique way, sharing is
* still prohibited.
*/
:: JSWorld
:: JSVal
:: JSFun :== JSVal
......
......@@ -10,7 +10,7 @@ import Data.Maybe
import Text.Encodings.Base64
import Text.GenJSON
:: *JSWorld = JSWorld
:: JSWorld = JSWorld
:: JSVal
= JSInt !Int
......
definition module iTasks.UI.JavaScript.Monad
/**
* This module provides an abstraction layer over `iTasks.UI.JavaScript`. In
* that module, low-level functions to interface with JavaScript through the
* WebAssembly ABC interpreter are defined. These functions work on a unique
* `*JSWorld` type. This module provides a state monad `JS` which can chain
* such functions.
*
* Typically, you will use `js` to lift functionality on the `*JSWorld` level
* to the `JS` monad, and `runJS` to run a `JS` monad on a `*JSWorld`.
*
* The benefit becomes particularly visible when using JavaScript promises,
* which themselves are very similar to monads. `` `then` `` allows chaining of
* promises and takes care of creating the callback function under the hood.
*
* However, you need to be very careful about which things return promises and
* which things return plain values. For example, when `f` returns a promise
* and `g` uses the value it resolves to you need to write ``f `then` g`` and
* not `f >>= g`, even though the latter is allowed by the type system.
* Typically the result of `` `then` `` is unused.
*/
from StdOverloaded import class toString
from Control.Applicative import class pure, class <*>, class Applicative
from Control.Monad import class Monad
from Data.Functor import class Functor
import iTasks.UI.JavaScript
:: JSState st =
{ jsworld :: !JSWorld
, component :: !JSVal //* The current component (to link shared objects to, for garbage collection)
, state :: !st
}
/**
* This type uses a non-unique JSWorld in order to implement {{`Monad`}}.
* The {{`js`}} and {{`runJS`}} functions can be used for casting.
*/
:: JS st a =: JS (.(JSState st) -> (a, .JSState st))
// These two functions use casts to enforce uniqueness of the JSWorld:
//* Lift a `*World` function to the `JS` monad.
js :: !(*JSWorld -> (a, *JSWorld)) -> JS st a
//* Execute a `JS` monad on a `*World`.
runJS :: !st !JSVal !(JS st a) !*JSWorld -> (a, *JSWorld)
//* Get a value from the `JS` monad state.
gets :: !((JSState st) -> a) -> JS st a
//* Modify the `JS` monad state.
modState :: !((JSState st) -> JSState st) -> JS st (JSState st)
instance Functor (JS st)
instance pure (JS st)
instance <*> (JS st)
instance Monad (JS st)
//* Type synonym used to indicate that a JavaScript value refers to a Promise.
:: JSPromise :== JSVal
/**
* Chain JavaScript promises in a monadic style.
* @param The promise.
* @param The continuation (possibly resolving to a promise).
* @result The resulting promise (which can be continued in a monadic style).
*/
(`then`) infixl 1 :: !(JS st JSPromise) !(JSVal -> JS st JSVal) -> JS st JSPromise
//* The Clean equivalent of `Promise.resolve()`, used to start a promise chain.
resolvePromise :: JS st JSPromise
implementation module iTasks.UI.JavaScript.Monad
import StdEnv
import Control.Applicative
import Control.Monad
import Data.Functor
import System._Unsafe
import iTasks.UI.JavaScript
js :: !(*JSWorld -> (a, *JSWorld)) -> JS st a
js f = JS \st
# (x,w) = (unsafeCoerce f) st.jsworld
# st & jsworld = w
-> (x,st)
runJS :: !st !JSVal !(JS st a) !*JSWorld -> (a, *JSWorld)
runJS state component (JS f) w = (unsafeCoerce \w
# st =
{ jsworld = w
, component = component
, state = state
}
# (x,st) = f st
-> (x,st.jsworld)) w
gets :: !((JSState st) -> a) -> JS st a
gets f = JS \st -> (f st,st)
modState :: !((JSState st) -> JSState st) -> JS st (JSState st)
modState f = JS \st -> let st` = f st in (st`,st`)
instance Functor (JS st)
where
fmap f (JS g) = JS \w -> let (r,w`) = g w in (f r,w`)
instance pure (JS st)
where
pure x = JS \w -> (x,w)
instance <*> (JS st)
where
<*> (JS f) (JS g) = JS
\w
# (f,w) = f w
# (x,w) = g w
-> (f x,w)
instance Monad (JS st)
where
bind (JS f) g = JS
\w
# (x,w) = f w
# (JS f) = g x
-> f w
(`then`) infixl 1 :: !(JS st JSPromise) !(JSVal -> JS st JSVal) -> JS st JSPromise
(`then`) first then =
gets id >>= \st ->
js (jsWrapFunWithResult (\args w -> runJS st.state st.component (then args.[0]) w) st.component) >>= \then ->
first >>= \promise ->
js (promise .# "then" .$ (then, jsGlobal "(e) => console.warn ('Promise failed (%s): %s',e.name,e.message)"))
resolvePromise :: JS st JSPromise
resolvePromise = js (jsGlobal "Promise" .# "resolve" .$ ())
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment