Commit 4972bd5f authored by Bas Lijnse's avatar Bas Lijnse

Changed onEdit function in Editor to directly return UI changes in response to the event

parent 89baf020
......@@ -122,8 +122,8 @@ updateValueAndMask_ taskId mode path mbEditor diff (v,m) iworld
# editor = fromMaybe gEditor{|*|} mbEditor
# (nm,nv,vst=:{VSt|iworld}) = editor.Editor.onEdit path diff v m {VSt|mode = mode, taskId=toString taskId, optional=False, selectedConsIndex= -1, iworld=iworld}
= case nm of
Ok m = ((nv,m),iworld)
_ = ((v,m),iworld)
Ok (_,m) = ((nv,m),iworld)
_ = ((v,m),iworld)
visualizeView_ :: TaskId TaskEvalOpts EditMode (Maybe (Editor v)) Event (Masked v) (Masked v) d *IWorld -> *(!MaybeErrorString UIChange,!Bool,!*IWorld) | iTask v & toPrompt d
visualizeView_ taskId evalOpts mode mbEditor event old=:(v,m) new=:(nv,nm) prompt iworld
......
......@@ -484,9 +484,9 @@ where
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI new):stdAttributeChanges typeDesc optional om nm] [])),vst)
onEdit dp e val mask ust=:{VSt|optional} = case fromJSON e of
Nothing = (Ok (FieldMask {touched=True,valid=optional,state=JSONNull}),{Document|documentId = "", contentUrl = "", name="", mime="", size = 0}
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),{Document|documentId = "", contentUrl = "", name="", mime="", size = 0}
,ust)// Reset
Just doc = (Ok (FieldMask {touched=True,valid=True,state=e}),doc,ust) //Update
Just doc = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),doc,ust) //Update
derive JSONEncode Document
derive JSONDecode Document
......@@ -585,7 +585,7 @@ where
updUI dp old om new nm vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI (value new))] [])),vst)
onEdit dp e val mask ust = (Ok mask,val,ust)
onEdit dp e val mask ust = (Ok (NoChange,mask),val,ust)
derive gDefault Progress
......@@ -610,7 +610,7 @@ where
updUI dp (HtmlInclude old) om (HtmlInclude new) nm vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI new)] [])),vst)
onEdit dp e val mask ust = (Ok mask,val,ust)
onEdit dp e val mask ust = (Ok (NoChange,mask),val,ust)
derive gDefault HtmlInclude
......@@ -849,9 +849,9 @@ where
(Error e,vst) = (Error e,vst)
onEdit dp e (TreeChoice tree sel) mask ust = case fromJSON e of
Just ("sel",idx,val) = (Ok (touch mask),TreeChoice tree (if val (Just idx) Nothing), ust)
Just ("exp",idx,val) = (Ok (touch mask),TreeChoice (setTreeExpanded idx val tree) sel, ust)
_ = (Ok mask,TreeChoice tree sel, ust)
Just ("sel",idx,val) = (Ok (NoChange, touch mask),TreeChoice tree (if val (Just idx) Nothing), ust)
Just ("exp",idx,val) = (Ok (NoChange, touch mask),TreeChoice (setTreeExpanded idx val tree) sel, ust)
_ = (Ok (NoChange,mask),TreeChoice tree sel, ust)
instance Choice TreeChoice
where
......@@ -1351,8 +1351,7 @@ where
instance toPrompt [d] | toPrompt d
where
toPrompt list = ui UIEmpty //foldl mergeAttributes 'DM'.newMap (map toPrompt list)
toPrompt list = ui UIEmpty
derive JSONEncode Icon
derive JSONDecode Icon
......@@ -1363,11 +1362,10 @@ derive gText Icon
gEditor{|Icon|} = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI _ (Icon icon) vst = (Ok (uia UIIcon (iconClsAttr ("icon-"+++icon)),newFieldMask), vst)
onEdit dp e val mask ust = (Ok (NoChange,mask),val,ust)
updUI _ (Icon old) om (Icon new) nm vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "iconCls" (encodeUI ("icon-"+++new))] [])),vst)
onEdit dp e val mask ust = (Ok mask,val,ust)
// Generic instances for common library types
derive JSONEncode Either, MaybeError, HtmlTag, HtmlAttr
derive JSONDecode Either, MaybeError, HtmlTag, HtmlAttr
......@@ -1387,12 +1385,7 @@ gEq{|(->)|} _ _ fa fb = copy_to_string fa == copy_to_string fb // HACK: Compare
gEq{|Dynamic|} _ _ = False // dynamics are never equal
gDefault{|{}|} _ = undef
gEditor{|{}|} _ _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI _ _ vst = (Ok (ui UIEmpty,newCompoundMask),vst)
updUI _ _ _ _ _ vst = (Ok NoChange,vst)
onEdit _ _ val mask ust = (Ok mask,val,ust)
gEditor{|{}|} _ _ _ _ _ = emptyEditor
gText{|{}|} _ _ _ = undef
derive JSONEncode SVGElt, SVGAttr, SVGAlign, SVGColor, SVGDefer, SVGFillOpacity, SVGFuncIRI, SVGLengthAdjust, SVGLengthUnit, SVGLineCap, SVGFillRule, SVGLineJoin, SVGMeetOrSlice, SVGStrokeMiterLimit, SVGPaint, SVGStrokeDashArray, SVGStrokeDashOffset, SVGStrokeWidth, SVGTransform, SVGZoomAndPan
......
......@@ -77,11 +77,11 @@ updUI _ (AnalogClock t1) _ (AnalogClock t2) _ vst = case ( (if (t1.Time.sec ==
) of [] = (Ok NoChange,vst) ; delta = (Ok (ChangeUI [SetAttribute "diff" (toJSON delta)] []),vst)
onEdit [] diff t m ust = case fromJSON diff of
Just diffs = (Ok (FieldMask {touched=True,valid=True,state=JSONNull}),app diffs t,ust)
Nothing = (Ok m,t,ust)
Just diffs = (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONNull}),app diffs t,ust)
Nothing = (Ok (NoChange,m),t,ust)
where
app [] t = t
app [(0,s):d] (AnalogClock t) = app d (AnalogClock {Time|t & sec = s})
app [(1,m):d] (AnalogClock t) = app d (AnalogClock {Time|t & min = m})
app [(2,h):d] (AnalogClock t) = app d (AnalogClock {Time|t & hour = h})
onEdit _ _ t m ust = (Ok m,t,ust)
onEdit _ _ t m ust = (Ok (NoChange,m),t,ust)
......@@ -18,7 +18,7 @@ controlLightEditlet
|genUI = genUI
,initUI = initUI
,updUI = \_ a _ b _ vst -> (Ok (if (a===b) NoChange (ChangeUI [SetAttribute "value" (JSONString (color b))] [])),vst)
,onEdit = \_ _ a m ust -> (Ok m,a,ust)
,onEdit = \_ _ a m ust -> (Ok (NoChange,m),a,ust)
}
where
genUI dp val world
......
......@@ -424,8 +424,8 @@ where
newMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g2.GoogleMap.markers]
onEdit [] d g msk ust = case fromJSON d of
Just diffs = (Ok msk,foldl app g diffs,ust)
Nothing = (Ok msk,g,ust)
Just diffs = (Ok (NoChange,msk),foldl app g diffs,ust)
Nothing = (Ok (NoChange,msk),g,ust)
where
app g (SetSettings settings) = {GoogleMap|g & settings = settings}
app g (SetPerspective perspective) = {GoogleMap|g & perspective = perspective}
......@@ -435,7 +435,7 @@ where
upd markers updated = [if (m.GoogleMapMarker.markerId == updated.GoogleMapMarker.markerId) updated m \\ m <- markers]
app g (RemoveMarkers m) = {GoogleMap|g & markers = [marker \\ marker <- g.GoogleMap.markers | not (isMember marker.GoogleMapMarker.markerId m)]}
app g _ = g
onEdit _ d g msk ust = (Ok msk,g,ust)
onEdit _ d g msk ust = (Ok (NoChange,msk),g,ust)
//--------------------------------------------------------------------------------------------------
instance toString GoogleMapType
......
......@@ -99,8 +99,8 @@ where
= [LDUpdateObject l i o2:diffObjects l (inc i) os1 os2]
onEdit [] diff m msk vst = case fromJSON diff of
Just diffs = (Ok msk,app diffs m,vst)
Nothing = (Ok msk,m,vst)
Just diffs = (Ok (NoChange,msk),app diffs m,vst)
Nothing = (Ok (NoChange,msk),m,vst)
where
app [] m = m
app [LDSetZoom zoom:ds] m = app ds {m & perspective = {m.perspective & zoom = zoom}}
......@@ -119,7 +119,7 @@ where
app ds {m & layers = updateAt l (ObjectLayer (take n o)) m.layers}
app [LDUpdateObject l i object:ds] m = let (ObjectLayer o) = m.layers !! l in
app ds {m & layers = updateAt l (ObjectLayer (updateAt i object o)) m.layers}
onEdit _ _ m msk ust = (Ok msk,m,ust)
onEdit _ _ m msk ust = (Ok (NoChange,msk),m,ust)
openStreetMapTiles :: LeafletLayer
openStreetMapTiles = TileLayer "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png"
......
......@@ -112,7 +112,7 @@ svgRenderer svglet=:{initView,renderImage,updView,updModel}
= (jsNull,jsTrace "Unknown attribute change" world)
updUI _ ov om nv nm vst = (Ok (if (ov === nv) NoChange (ChangeUI [SetAttribute "stateChange" (toJSON nv)] [])),vst)
onEdit _ _ st m ust = (Ok m,st,ust)
onEdit _ _ st m ust = (Ok (NoChange,m),st,ust)
onNewState :: !(JSVal a) !(SVGLet s v) !s !*JSWorld -> *JSWorld | JSONEncode{|*|} s
onNewState me svglet=:{initView,renderImage} s world
......
......@@ -20,9 +20,9 @@ from GenEq import generic gEq
* Definition of an editor editor
*/
:: Editor a =
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt) //Generating the initial UI
, updUI :: DataPath a EditMask a EditMask *VSt -> *(!MaybeErrorString UIChange, !*VSt)
, onEdit :: DataPath JSONNode a EditMask *VSt -> *(!MaybeErrorString EditMask, !a, !*VSt) //React to edit events
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt) //Generating the initial UI
, onEdit :: DataPath JSONNode a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to edit events
, updUI :: DataPath a EditMask a EditMask *VSt -> *(!MaybeErrorString UIChange, !*VSt) //React to a new model value
}
//* Datapaths identify sub structures in a composite structure
......@@ -78,8 +78,8 @@ checkMaskValue :: !EditMask a -> Maybe JSONNode | JSONEncode{|*|} a
stdAttributes :: String Bool EditMask -> UIAttributes
stdAttributeChanges :: String Bool EditMask EditMask -> [UIAttributeChange]
basicEdit :: !(upd a -> Maybe a) !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString EditMask, !a, !*VSt) | JSONDecode{|*|} upd
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString EditMask,!a,!*VSt) | JSONDecode{|*|} a
basicEdit :: !(upd a -> Maybe a) !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
//****************************************************************************//
// Alternative wrapper type for defining custom editor components that can process events
......@@ -89,8 +89,8 @@ basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString
=
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI,!EditMask), !*VSt)
, initUI :: (JSObj ()) *JSWorld -> *JSWorld
, onEdit :: DataPath JSONNode a EditMask *VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) //React to edit events
, updUI :: DataPath a EditMask a EditMask *VSt -> *(!MaybeErrorString UIChange, !*VSt)
, onEdit :: DataPath JSONNode a EditMask *VSt -> *(!MaybeErrorString EditMask, !a, !*VSt) //React to edit events
}
fromEditlet :: (Editlet a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
......@@ -84,18 +84,18 @@ stdAttributeChanges typename optional om nm
| om === nm = [] //Nothing to change
| otherwise = [SetAttribute k v \\ (k,v) <- 'DM'.toList (stdAttributes typename optional nm)]
basicEdit :: !(upd a -> Maybe a) !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString EditMask, !a, !*VSt) | JSONDecode{|*|} upd
basicEdit :: !(upd a -> Maybe a) !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEdit toV [] upd v vmask ust=:{VSt|optional}
= case upd of
JSONNull = (Ok (FieldMask {touched=True,valid=optional,state=JSONNull}),v,ust)
JSONNull = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),v,ust)
json = case fromJSON upd of
Nothing = (Ok (FieldMask {touched=True,valid=False,state=upd}),v,ust)
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=upd}),v,ust)
(Just e) = case toV e v of
Nothing = (Ok (FieldMask {touched=True,valid=False,state=upd}),v,ust)
Just val = (Ok (FieldMask {touched=True,valid=True,state=upd}),val,ust)
basicEdit toV _ upd v vmask ust = (Ok vmask,v,ust)
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=upd}),v,ust)
Just val = (Ok (NoChange,FieldMask {touched=True,valid=True,state=upd}),val,ust)
basicEdit toV _ upd v vmask ust = (Ok (NoChange,vmask),v,ust)
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString EditMask,!a,!*VSt) | JSONDecode{|*|} a
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
basicEditSimple target upd val mask iworld = basicEdit (\json _ -> fromJSON json) target upd val mask iworld
fromEditlet :: (Editlet a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
......
......@@ -56,8 +56,8 @@ where
onEdit dp e val mask vst=:{VSt|optional}
= case e of
JSONNull = (Ok (FieldMask {touched=True,valid=optional,state=JSONNull}),val,vst)
JSONNull = (Ok (ChangeUI [SetAttribute "value" JSONNull] [],FieldMask {touched=True,valid=optional,state=JSONNull}),val,vst)
json = case fromJSON e of
Nothing = (Ok (FieldMask {touched=True,valid=False,state=e}),val,vst)
Just val = (Ok (FieldMask {touched=True,valid=True,state=e}),val,vst)
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),val,vst)
Just val = (Ok (ChangeUI [SetAttribute "value" (toValue val)] [],FieldMask {touched=True,valid=True,state=e}),val,vst)
......@@ -64,5 +64,5 @@ constEditor val editor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI dp _ vst = editor.Editor.genUI dp val vst
updUI dp _ _ _ _ vst = (Ok NoChange,vst)
onEdit dp _ val mask ust = (Ok mask,val,ust)
onEdit dp _ val mask ust = (Ok (NoChange,mask),val,ust)
......@@ -10,7 +10,7 @@ emptyEditor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI _ _ vst = (Ok (ui UIEmpty,newFieldMask),vst)
updUI _ _ _ _ _ vst = (Ok NoChange,vst)
onEdit _ _ val mask ust = (Ok mask,val,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
listEditor :: (Maybe ([a] -> a)) Bool Bool (Maybe ([a] -> String)) (Editor a) -> Editor [a]
listEditor add remove reorder count itemEditor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
......@@ -66,15 +66,15 @@ where
_ = (items,childMasks)
_
= (items,childMasks)
= (Ok (CompoundMask childMasks),items,ust)
= (Ok (NoChange,CompoundMask childMasks),items,ust)
| otherwise
= (Ok (CompoundMask childMasks),items,ust)
= (Ok (NoChange,CompoundMask childMasks),items,ust)
where
updateItems [i:dp] e items masks ust
| i >= (length items) = (items,masks,ust)
# (nm,nx,ust) = itemEditor.Editor.onEdit dp e (items !! i) (masks !! i) ust
= case nm of
Ok m = (updateAt i nx items, updateAt i m masks,ust)
Ok (_,m) = (updateAt i nx items, updateAt i m masks,ust)
_ = (items,masks,ust)
updateItems dp e items masks ust
= (items,masks,ust)
......
......@@ -53,15 +53,15 @@ where
# mask = case e of
JSONBool False = CompoundMask []
_ = mask
= (Ok mask,RECORD record,ust)
= (Ok (NoChange,mask),RECORD record,ust)
onEdit [d:ds] e (RECORD record) mask ust
| d >= grd_arity
= (Ok mask,RECORD record,ust)
= (Ok (NoChange,mask),RECORD record,ust)
# childMasks = subMasks grd_arity mask
# (Ok targetMask,record,ust) = ex.Editor.onEdit (updPairPath d grd_arity ++ ds) e record (childMasks !! d) ust
= (Ok (CompoundMask (updateAt d targetMask childMasks)),RECORD record,ust)
onEdit _ _ val mask ust = (Ok mask,val,ust)
# (Ok (targetChange,targetMask),record,ust) = ex.Editor.onEdit (updPairPath d grd_arity ++ ds) e record (childMasks !! d) ust
= (Ok (targetChange,(CompoundMask (updateAt d targetMask childMasks))),RECORD record,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
gEditor{|FIELD of {gfd_name}|} ex _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
......@@ -134,10 +134,10 @@ where
JSONNull = newCompoundMask //Reset
_ = CompoundMask (repeatn (gtd_conses !! consIdx).gcd_arity newFieldMask)
# (_,val,ust) = ex.Editor.onEdit (updConsPath (if (consIdx < gtd_num_conses) consIdx 0) gtd_num_conses) e val mask ust
= (Ok mask,OBJECT val, ust)
= (Ok (NoChange,mask),OBJECT val, ust)
onEdit dp e (OBJECT val) mask ust //Update is targeted somewhere in a substructure of this value
# (Ok mask,val,ust) = ex.Editor.onEdit dp e val mask ust
= (Ok mask,OBJECT val,ust)
# (Ok (change,mask),val,ust) = ex.Editor.onEdit dp e val mask ust
= (Ok (change,mask),OBJECT val,ust)
allConsesArityZero [] = True
allConsesArityZero [{gcd_arity}:cs]
......@@ -166,12 +166,12 @@ where
onEdit [d:ds] e either mask ust
| d == -1 = case ds of
[] = (Ok newFieldMask,LEFT dx,ust)
[] = (Ok (NoChange,newFieldMask),LEFT dx,ust)
_
# (mask,x,ust) = ex.Editor.onEdit ds e dx newFieldMask ust
= (mask,LEFT x,ust)
| d == -2 = case ds of
[] = (Ok newFieldMask,RIGHT dy,ust)
[] = (Ok (NoChange,newFieldMask),RIGHT dy,ust)
_
# (mask,y,ust) = ey.Editor.onEdit ds e dy newFieldMask ust
= (mask,RIGHT y,ust)
......@@ -199,11 +199,11 @@ where
onEdit [d:ds] e (CONS val) mask ust
| d >= gcd_arity
= (Ok mask,CONS val,ust)
= (Ok (NoChange,mask),CONS val,ust)
# childMasks = subMasks gcd_arity mask
# (Ok targetMask,val,ust) = ex.Editor.onEdit (updPairPath d gcd_arity ++ ds) e val (childMasks !! d) ust
= (Ok (CompoundMask (updateAt d targetMask childMasks)),CONS val,ust)
onEdit _ _ val mask ust = (Ok mask,val,ust)
# (Ok (targetChange,targetMask),val,ust) = ex.Editor.onEdit (updPairPath d gcd_arity ++ ds) e val (childMasks !! d) ust
= (Ok (targetChange,CompoundMask (updateAt d targetMask childMasks)),CONS val,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
gEditor{|PAIR|} ex _ _ _ _ ey _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
......@@ -237,7 +237,7 @@ where
onEdit [1:ds] e (PAIR x y) ymask ust
# (ymask,y,ust) = ey.Editor.onEdit ds e y ymask ust
= (ymask,PAIR x y,ust)
onEdit _ _ val mask ust = (Ok mask,val,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
//The maybe editor makes it content optional
gEditor{|Maybe|} ex _ dx _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
......@@ -265,7 +265,7 @@ where
# mask = case mask of
(FieldMask fmask) = FieldMask {FieldMask|fmask & state = JSONNull}
(CompoundMask m) = CompoundMask []
= (Ok mask,Nothing,vst) //Reset
= (Ok (NoChange,mask),Nothing,vst) //Reset
| otherwise
# (x,xmask) = maybe (dx,CompoundMask []) (\x -> (x,mask)) val
# (xmask,x,vst) = ex.Editor.onEdit dp e x xmask {VSt|vst & optional = True}
......
......@@ -14,7 +14,7 @@ where
editlet = { genUI = genUI
, initUI = \m w -> w
, updUI = \_ o _ n _ vst -> (Ok (if (o == n) NoChange (ChangeUI [SetAttribute "value" (toJSON n)] [])),vst)
, onEdit = \_ _ n msk ust -> (Ok msk,n,ust)
, onEdit = \_ _ n msk ust -> (Ok (NoChange,msk),n,ust)
}
genUI dp val world
......
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