Commit 5cac0234 authored by László Domoszlai's avatar László Domoszlai

- big refactoring related to client side execution

- new JS API
- JS caching (not completely ready yet)

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@2642 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 8d26a3d1
definition module iTasks.API.Core.Client.Editlet
import iTasks
//****************************************************************************//
// Wrapper types for defining custom editor components that can process events
// that are defined server-side but run client-side
//****************************************************************************//
:: Editlet a d =
{ value :: a
, html :: ComponentId -> HtmlTag
, handlers :: [ComponentEvent a]
// Functions for efficient bidirectional synchronisation of the editlet value
, genDiff :: a a -> Maybe d
, appDiff :: d a -> a
}
:: EditletEvent = EditletEvent
:: ComponentId :== String
:: ComponentEventName :== String
:: ComponentEvent a = ComponentEvent !ComponentId !ComponentEventName (ComponentEventHandlerFunc a)
:: ComponentEventHandlerFunc a :== ComponentId (JSVal EditletEvent) a *JSWorld -> *(!a,!*JSWorld)
derive JSONEncode Editlet
derive JSONDecode Editlet
derive gDefault Editlet
derive gEq Editlet
derive gVisualizeText Editlet
derive gEditor Editlet
derive gEditMeta Editlet
derive gUpdate Editlet
derive gVerify Editlet
implementation module iTasks.API.Core.Client.Editlet
import iTasks.Framework.Client.LinkerSupport
from Data.Map import :: Map, newMap, put
import StdMisc
//* Client-side types
JSONEncode{|Editlet|} _ _ tt = [dynamicJSONEncode tt]
JSONDecode{|Editlet|} _ _ [tt:c] = (dynamicJSONDecode tt,c)
JSONDecode{|Editlet|} _ _ c = (Nothing,c)
gDefault{|Editlet|} fa _
= {Editlet|value=fa,html = \_ -> RawText "", handlers=[], genDiff = \_ _ -> Nothing, appDiff = \_ x -> x}
gEq{|Editlet|} fa _ x y = fa x.Editlet.value y.Editlet.value //Only compare values
gVisualizeText{|Editlet|} fa _ mode {Editlet|value} = fa mode value
gEditor{|Editlet|} fa textA defaultA headersA jsonEncA jsonDecA _ _ _ _ jsonEncD jsonDecD dp ({Editlet|value,html,handlers,genDiff,appDiff},mask,ver) meta vst=:{VSt|taskId,iworld}
# (jsScript,jsEvents, jsIV, jsGD, jsAD, iworld) = editletLinker [(id, event, f) \\(ComponentEvent id event f) <- handlers] clientInit clientGenDiff clientAppDiff iworld
# iworld = addDiffer iworld
= (NormalEditor [(ui jsScript jsEvents jsIV jsGD jsAD, newMap)],{VSt|vst & iworld = iworld})
where
htmlId = "editlet-" +++ taskId +++ "-" +++ editorId dp
ui jsScript jsEvents jsIV jsGD jsAD
= UIEditlet defaultSizeOpts {UIEditletOpts|taskId=taskId,editorId=editorId dp,value=toJSONA value, html = toString (html htmlId)
,script = Just jsScript, events = Just jsEvents, initValue = Just jsIV, genDiff = Just jsGD, appDiff = Just jsAD}
toJSONA a = case jsonEncA a of
[json:_] = json
_ = JSONNull
toJSOND d = case jsonEncD d of
[json:_] = json
_ = JSONNull
clientInit json = case jsonDecA [json] of
(Just a,_) = a
_ = abort "Editlet cannot initialize its value"
serverGenDiff jsonOld jsonNew
= case (jsonDecA [jsonOld],jsonDecA [jsonNew]) of
((Just old,_),(Just new,_)) = case genDiff old new of
Just diff = Just (toJSOND diff)
Nothing = Nothing
_ = Nothing
clientAppDiff json old = case jsonDecD [json] of
(Just diff,_) = appDiff diff old
_ = old
clientGenDiff old new = case (genDiff old new) of
Just diff = toJSOND diff
_ = JSONNull
addDiffer iworld=:{IWorld|uiDiffers}
= {IWorld|iworld & uiDiffers = put (taskId,editorId dp) serverGenDiff uiDiffers}
gEditMeta{|Editlet|} fa _ {Editlet|value} = fa value
gUpdate{|Editlet|} fa _ jDeca _ _ jDecd [] json (ov=:{Editlet|value,appDiff},omask)
= case jDecd [json] of
(Just diff,_) = ({Editlet|ov & value = appDiff diff value},Touched)
_ = (ov,omask)
gUpdate{|Editlet|} fa _ _ _ _ _ _ _ mv = mv
gVerify{|Editlet|} fa _ _ mv = alwaysValid mv
definition module iTasks.API.Core.Client.Interface definition module iTasks.API.Core.Client.Interface
import StdString, Data.Void, Data.Maybe import StdString, Data.Void, Data.Maybe
:: DomElementId :== String
/** /**
* This module provides access to the javascript world of webbrowsers * This module provides access to the javascript world of webbrowsers
* where all the client side objects of which the iTask world live. * where all the client side objects of which the iTask world live.
*/ */
:: JSWorld :: JSWorld
:: JSPtr a //Pointer to a javascript object :: JSVal a //Pointer to a javascript object
:: JSArg
:: JSFunction a //A javascript function object :: JSFunction a //A javascript function object
:: JSWindow //Represents the global window object :: JSWindow //Represents the global window object
...@@ -16,56 +20,65 @@ import StdString, Data.Void, Data.Maybe ...@@ -16,56 +20,65 @@ import StdString, Data.Void, Data.Maybe
//CORE JAVASCRIPT ACCESS //CORE JAVASCRIPT ACCESS
//Constants //Constants
jsNull :: (JSPtr a) // Can be any type jsNull :: (JSVal a) // Can be any type
jsWindow :: (JSPtr JSWindow) // Singleton 'window' object that serves a global scope jsWindow :: (JSVal JSWindow) // Singleton 'window' object that serves a global scope
jsDocument :: (JSVal JSDocument) // Singleton? 'document'
//Manipulating objects //Manipulating objects
jsEmptyObject :: !*JSWorld -> *(!JSPtr a, !*JSWorld) // {} jsEmptyObject :: !*JSWorld -> *(!JSVal a, !*JSWorld) // {}
jsNewObject :: !(JSPtr (JSFunction f)) !*JSWorld -> *(!JSPtr a, !*JSWorld) //creates a new object using 'new' keyword jsNewObject :: !String ![JSArg] !*JSWorld -> *(!JSVal b, !*JSWorld)
jsGetObjectAttr :: !String !(JSPtr a) !*JSWorld -> *(!b, !*JSWorld) jsGetObjectAttr :: !String !(JSVal o) !*JSWorld -> *(!JSVal b, !*JSWorld)
jsGetObjectEl :: !Int !(JSPtr a) !*JSWorld -> *(!b, !*JSWorld) jsGetObjectEl :: !Int !(JSVal o) !*JSWorld -> *(!JSVal b, !*JSWorld)
jsSetObjectAttr :: !String !b !(JSPtr a) !*JSWorld -> *JSWorld jsSetObjectAttr :: !String !(JSVal v) !(JSVal o) !*JSWorld -> *(!JSVal o, !*JSWorld)
jsSetObjectEl :: !Int !b !(JSPtr a) !*JSWorld -> *JSWorld jsSetObjectEl :: !Int !(JSVal v) !(JSVal o) !*JSWorld -> *(!JSVal o, !*JSWorld)
//Calling js functions //Calling js functions
jsApply :: !(JSPtr (JSFunction f)) !(JSPtr a) !(JSPtr b) !*JSWorld -> *(!c, !*JSWorld) jsApply :: !(JSVal (JSFunction f)) !(JSVal scope) ![JSArg] !*JSWorld -> *(!JSVal a, !*JSWorld)
//Special keywords //Special keywords
jsThis :: !*JSWorld -> *(!JSPtr a, !*JSWorld) jsThis :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsTypeof :: !a !*JSWorld -> *(!String, !*JSWorld) jsTypeof :: !(JSVal a) -> String
//Creating js functions from clean functions toJSVal :: !a -> JSVal b
jsWrapFun :: !f !*JSWorld -> *(!JSPtr (JSFunction f), !*JSWorld) toJSArg :: !a -> JSArg
fromJSVal :: !(JSVal a) -> Dynamic
toJSPtr :: !a !*JSWorld -> *(!JSPtr b, !*JSWorld) newJSArray :: !*JSWorld -> *(!JSVal [a], !*JSWorld)
//USEFUL DERIVED UTIL FUNCTIONS //USEFUL DERIVED UTIL FUNCTIONS
jsDocument :: !*JSWorld -> *(!JSPtr JSDocument, !*JSWorld)
newJSArray :: !*JSWorld -> *(!JSPtr [a], !*JSWorld) jsArrayPush :: !(JSVal a) !(JSVal [a]) !*JSWorld -> *(!JSVal [a], !*JSWorld)
jsArrayReverse :: !(JSVal [a]) !*JSWorld -> *(!JSVal [a], !*JSWorld)
toJSArray :: ![a] !*JSWorld -> *(!JSVal [a], !*JSWorld)
jsArrayPush :: !a (!JSPtr [a]) !*JSWorld -> *(!JSPtr [a], !*JSWorld) jsIsUndefined :: !(JSVal a) -> Bool
jsArrayReverse :: (!JSPtr [a]) !*JSWorld -> *(!JSPtr [a], !*JSWorld) getDomElement :: !DomElementId !*JSWorld -> *(!JSVal a, !*JSWorld)
getDomAttr :: !DomElementId !String !*JSWorld -> *(!JSVal a, !*JSWorld)
setDomAttr :: !DomElementId !String !(JSVal a) !*JSWorld -> *JSWorld
toJSArray :: ![a] !*JSWorld -> *(!JSPtr [a], !*JSWorld) //Call a method on a javascript object. Object can be (JSVal null)
callObjectMethod :: !String ![JSArg] !(JSVal o) !*JSWorld -> *(!JSVal c, !JSVal o, !*JSWorld)
jsIsUndefined :: !a !*JSWorld -> *(!Bool, !*JSWorld)
:: DomElementId :== String
getDomElement :: !DomElementId !*JSWorld -> *(!JSPtr a, !*JSWorld)
getDomAttr :: !DomElementId !String !*JSWorld -> *(!a, !*JSWorld)
setDomAttr :: !DomElementId !String !a !*JSWorld -> *JSWorld
//Get a value from the global scope. //Get a value from the global scope.
//The argument may be in dotted notation (e.g. google.maps.MayTypeId.ROADMAP) for deep searching //The argument may be in dotted notation (e.g. google.maps.MayTypeId.ROADMAP) for deep searching
findObject :: !String !*JSWorld -> *(!JSPtr a, !*JSWorld) findObject :: !String !*JSWorld -> *(!JSVal a, !*JSWorld)
//Call a method on a javascript object
callObjectMethod :: !String ![b] !(JSPtr a) !*JSWorld -> *(!c, !*JSWorld)
//Load external JS by its URL. A continuation must be given, //Load external JS by its URL. A continuation must be given,
//which is called when script is actually loaded //which is called when script is actually loaded
addJSFromUrl :: !String !(Maybe (JSPtr (JSFunction f))) *JSWorld -> *JSWorld addJSFromUrl :: !String !(Maybe (JSVal (JSFunction f))) !*JSWorld -> *JSWorld
jsTrace :: a *JSWorld -> *JSWorld
jsValToString :: !(JSVal a) -> String
jsValToReal :: !(JSVal a) -> Real
jsValToInt :: !(JSVal a) -> Int
withDef :: !((JSVal a) -> b) !b !(JSVal a) -> b
...@@ -3,96 +3,97 @@ implementation module iTasks.API.Core.Client.Interface ...@@ -3,96 +3,97 @@ implementation module iTasks.API.Core.Client.Interface
import StdEnv, Data.Void, Data.Maybe, Text import StdEnv, Data.Void, Data.Maybe, Text
:: JSWorld = JSWorld :: JSWorld = JSWorld
:: JSPtr a = JSPtr :: JSVal a = JSVal !a
// It describes what is the goal, but the actual wrapping doesn't happen,
// don't try to unwrap it!
:: JSArg = E.a: JSArg (JSVal a)
:: JSWindow = JSWindow :: JSWindow = JSWindow
:: JSDocument = JSDocument :: JSDocument = JSDocument
:: JSFunction a = JSFunction :: JSFunction a = JSFunction
jsNull :: (JSPtr a) jsNull :: (JSVal a)
jsNull = undef jsNull = undef
jsWindow :: (JSPtr JSWindow) jsWindow :: (JSVal JSWindow)
jsWindow = undef jsWindow = undef
jsEmptyObject :: !*JSWorld -> *(!JSPtr a, !*JSWorld) jsDocument :: (JSVal JSDocument)
jsDocument = undef
jsEmptyObject :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsEmptyObject world = undef jsEmptyObject world = undef
jsNewObject :: !(JSPtr (JSFunction f)) !*JSWorld -> *(!JSPtr a, !*JSWorld) jsNewObject :: !String ![JSArg] !*JSWorld -> *(!JSVal b, !*JSWorld)
jsNewObject constructor world = undef jsNewObject cons_name args world = undef
jsGetObjectAttr :: !String !(JSPtr a) !*JSWorld -> *(!b, !*JSWorld) jsGetObjectAttr :: !String !(JSVal a) !*JSWorld -> *(!JSVal b, !*JSWorld)
jsGetObjectAttr attr obj world = undef jsGetObjectAttr attr obj world = undef
jsGetObjectEl :: !Int !(JSPtr a) !*JSWorld -> *(!b, !*JSWorld) jsGetObjectEl :: !Int !(JSVal o) !*JSWorld -> *(!JSVal b, !*JSWorld)
jsGetObjectEl index obj world = undef jsGetObjectEl index obj world = undef
jsSetObjectAttr :: !String !b !(JSPtr a) !*JSWorld -> *JSWorld jsSetObjectAttr :: !String !(JSVal v) !(JSVal o) !*JSWorld -> *(!JSVal o, !*JSWorld)
jsSetObjectAttr attr value obj world = undef jsSetObjectAttr attr value obj world = undef
jsSetObjectEl :: !Int !b !(JSPtr a) !*JSWorld -> *JSWorld jsSetObjectEl :: !Int !(JSVal v) !(JSVal o) !*JSWorld -> *(!JSVal o, !*JSWorld)
jsSetObjectEl index value obj world = undef jsSetObjectEl index value obj world = undef
jsApply :: !(JSPtr (JSFunction f)) !(JSPtr a) !(JSPtr b) !*JSWorld -> *(!c, !*JSWorld) jsApply :: !(JSVal (JSFunction f)) !(JSVal scope) ![JSArg] !*JSWorld -> *(!JSVal a, !*JSWorld)
jsApply fun scope args world = undef jsApply fun scope args world = undef
jsThis :: !*JSWorld -> *(!JSPtr a, !*JSWorld) jsThis :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsThis world = undef jsThis world = undef
jsTypeof :: !a !*JSWorld -> *(!String, !*JSWorld) jsTypeof :: !(JSVal a) -> String
jsTypeof obj world = undef jsTypeof obj = undef
jsWrapFun :: !f !*JSWorld -> *(!JSPtr (JSFunction f), !*JSWorld) newJSArray :: !*JSWorld -> *(!JSVal [a], !*JSWorld)
jsWrapFun fun world = undef newJSArray world = undef
toJSPtr :: !a !*JSWorld -> *(!JSPtr b, !*JSWorld) toJSVal :: !a -> JSVal b
toJSPtr val world = undef toJSVal val = undef
//UTIL toJSArg :: !a -> JSArg
toJSArg val = undef
jsDocument :: !*JSWorld -> *(!JSPtr JSDocument, !*JSWorld) fromJSVal :: !(JSVal a) -> Dynamic
jsDocument world fromJSVal ptr = undef
= jsGetObjectAttr "document" jsWindow world
newJSArray :: !*JSWorld -> *(!JSPtr [a], !*JSWorld) //UTIL
newJSArray world
# (constructor,world) = jsGetObjectAttr "Array" (jsWindow) world
= jsNewObject constructor world
jsArrayPush :: !a (!JSPtr [a]) !*JSWorld -> *(!JSPtr [a], !*JSWorld) jsArrayPush :: !(JSVal a) !(JSVal [a]) !*JSWorld -> *(!JSVal [a], !*JSWorld)
jsArrayPush x arr world = callObjectMethod "push" [x] arr world jsArrayPush x arr world = let (arr, _, w) = callObjectMethod "push" [toJSArg x] arr world in (arr, w)
jsArrayReverse :: (!JSPtr [a]) !*JSWorld -> *(!JSPtr [a], !*JSWorld) jsArrayReverse :: !(JSVal [a]) !*JSWorld -> *(!JSVal [a], !*JSWorld)
jsArrayReverse arr world = callObjectMethod "reverse" [] arr world jsArrayReverse arr world = let (arr, _, w) = callObjectMethod "reverse" [] arr world in (arr, w)
toJSArray :: ![a] !*JSWorld -> *(!JSPtr [a], !*JSWorld) toJSArray :: ![a] !*JSWorld -> *(!JSVal [a], !*JSWorld)
toJSArray xs world toJSArray xs world
# (arr, world) = newJSArray world # (arr, world) = newJSArray world
# world = foldl (op arr) world (zip2 [0..] xs) # world = foldl (op arr) world (zip2 [0..] xs)
= (arr, world) = (arr, world)
where op arr world (i, arg) = jsSetObjectEl i arg arr world where op arr world (i, arg) = snd (jsSetObjectEl i (toJSVal arg) arr world)
jsIsUndefined :: !a !*JSWorld -> *(!Bool, !*JSWorld) jsIsUndefined :: !(JSVal a) -> Bool
jsIsUndefined obj world jsIsUndefined obj = jsTypeof obj == "undefined"
# (type,world) = jsTypeof obj world
= (type == "undefined",world)
getDomElement :: !DomElementId !*JSWorld -> *(!JSPtr a, !*JSWorld) getDomElement :: !DomElementId !*JSWorld -> *(!JSVal a, !*JSWorld)
getDomElement elemId world getDomElement elemId world
# (document,world) = jsDocument world = let (val, _, w) = callObjectMethod "getElementById" [toJSArg elemId] jsDocument world in (val, w)
= callObjectMethod "getElementById" [elemId] document world
getDomAttr :: !DomElementId !String !*JSWorld -> *(!a, !*JSWorld) getDomAttr :: !DomElementId !String !*JSWorld -> *(!JSVal a, !*JSWorld)
getDomAttr elemId attr world getDomAttr elemId attr world
# (elem,world) = getDomElement elemId world # (elem,world) = getDomElement elemId world
= jsGetObjectAttr attr elem world = jsGetObjectAttr attr elem world
setDomAttr :: !DomElementId !String !b !*JSWorld -> *JSWorld setDomAttr :: !DomElementId !String !(JSVal a) !*JSWorld -> *JSWorld
setDomAttr elemId attr value world setDomAttr elemId attr value world
# (elem,world) = getDomElement elemId world # (elem, world) = getDomElement elemId world
= jsSetObjectAttr attr value elem world = snd (jsSetObjectAttr attr value elem world)
findObject :: !String !*JSWorld -> *(!JSPtr a, !*JSWorld) findObject :: !String !*JSWorld -> *(!JSVal a, !*JSWorld)
findObject query world findObject query world
# (obj,world) = jsGetObjectAttr attr jsWindow world //deref first attr separate to make the typechecker happy # (obj,world) = jsGetObjectAttr attr jsWindow world //deref first attr separate to make the typechecker happy
= case attrs of = case attrs of
...@@ -100,33 +101,58 @@ findObject query world ...@@ -100,33 +101,58 @@ findObject query world
= foldl op (obj,world) attrs = foldl op (obj,world) attrs
where where
[attr:attrs] = split "." query [attr:attrs] = split "." query
op (obj,world) attr = jsGetObjectAttr attr obj world op (obj,world) attr | jsIsUndefined obj
= (obj, world)
= jsGetObjectAttr attr obj world
callObjectMethod :: !String ![b] !(JSPtr a) !*JSWorld -> *(!c, !*JSWorld) callObjectMethod :: !String ![JSArg] !(JSVal o) !*JSWorld -> *(!JSVal c, !JSVal o, !*JSWorld)
callObjectMethod method args obj world callObjectMethod method args obj world
# (fun,world) = jsGetObjectAttr method obj world # (fun, world) = jsGetObjectAttr method obj world
# (arr,world) = toJSArray args world = let (r, w) = jsApply fun obj args world in (r, obj, w)
= jsApply fun obj arr world
addJSFromUrl :: !String !(Maybe (JSPtr (JSFunction a))) *JSWorld -> *JSWorld addJSFromUrl :: !String !(Maybe (JSVal (JSFunction a))) !*JSWorld -> *JSWorld
addJSFromUrl url mbCallback world addJSFromUrl url mbCallback world
# (document,world) = jsDocument world
//Create script tag //Create script tag
# (script,world) = callObjectMethod "createElement" ["script"] document world # (script,_,world) = callObjectMethod "createElement" [toJSArg "script"] jsDocument world
# world = jsSetObjectAttr "src" url script world # (script,world) = jsSetObjectAttr "src" (toJSVal url) script world
# world = jsSetObjectAttr "type" "text/javascript" script world # (script,world) = jsSetObjectAttr "type" (toJSVal "text/javascript") script world
# world = case mbCallback of # world = case mbCallback of
Nothing = world Nothing = world
Just callback = jsSetObjectAttr "onload" callback script world Just callback = snd (jsSetObjectAttr "onload" callback script world)
//Inject into the document head //Inject into the document head
# (head,world) = callObjectMethod "getElementsByTagName" ["head"] document world # (head,_,world) = callObjectMethod "getElementsByTagName" [toJSArg "head"] jsDocument world
# (head,world) = jsGetObjectEl 0 head world # (head,world) = jsGetObjectEl 0 head world
# (_,world) = callObjectMethod "appendChild" [script] head world # (_,head,world) = callObjectMethod "appendChild" [toJSArg script] head world
= world = world
jsTrace :: a *JSWorld -> *JSWorld jsTrace :: a *JSWorld -> *JSWorld
jsTrace val world jsTrace val world
# (console,world) = findObject "console" world # (console,world) = findObject "console" world
# (_,world) = callObjectMethod "log" [val] console world # (_,console,world) = callObjectMethod "log" [toJSArg val] console world
= world = world
jsValToString :: !(JSVal a) -> String
jsValToString ptr = case fromJSVal ptr of
(val :: String) = val
(val :: Real) = toString val
(val :: Int) = toString val
= abort "JSVal cannot be converted to String"
jsValToReal :: !(JSVal a) -> Real
jsValToReal ptr = case fromJSVal ptr of
(val :: Real) = val
= abort "Real was expected but something else came"
jsValToInt :: !(JSVal a) -> Int
jsValToInt ptr = case fromJSVal ptr of
(val :: Int) = val
= abort "Integer was expected but something else came"
withDef :: !((JSVal a) -> b) !b !(JSVal a) -> b
withDef f def ptr | jsIsUndefined ptr
= def
= f ptr
definition module iTasks.Framework.ClientSupport.ClientOverride definition module iTasks.API.Core.Client.Override
import StdDynamic, iTasks.API.Core.SystemTypes import StdDynamic, iTasks.API.Core.SystemTypes
......