Commit 841d2b65 authored by Bas Lijnse's avatar Bas Lijnse
Browse files

Added additional datapath parameter to onEdit event handler in Editor type....

Added additional datapath parameter to onEdit event handler in Editor type. This is needed to correctly generate fresh UI's after switching constructors in the generic implementation.
parent c7e49fdc
......@@ -119,7 +119,7 @@ matchAndApplyEvent_ ResetEvent taskId mode mbEditor taskTime v mask ts prompt iw
matchAndApplyEvent_ (EditEvent eTaskId name edit) taskId mode mbEditor taskTime v mask ts prompt iworld
| eTaskId == taskId
# editor = fromMaybe gEditor{|*|} mbEditor
= case editor.Editor.onEdit (s2dp name) edit v mask {VSt|mode = mode, taskId=toString taskId, optional=False, selectedConsIndex= -1, iworld=iworld} of
= case editor.Editor.onEdit [] (s2dp name,edit) v mask {VSt|mode = mode, taskId=toString taskId, optional=False, selectedConsIndex= -1, iworld=iworld} of
(Ok (change,mask),v,{VSt|iworld}) = (Ok (v,ChangeUI [] [(1,ChangeChild change)],mask,taskTime),iworld)
(Error e,_,{VSt|iworld}) = (Error e,iworld)
| otherwise = (Ok (v,NoChange,mask,ts),iworld)
......
......@@ -481,10 +481,10 @@ where
# attr = 'DM'.unions [editAttrs taskId (editorId dp) value,stdAttributes typeDesc optional mask]
= (Ok (uia UIEditDocument attr,mask),vst)
onEdit dp e val mask ust=:{VSt|optional} = case fromJSON e of
onEdit dp (tp,e) val mask vst=:{VSt|optional} = case fromJSON e of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),{Document|documentId = "", contentUrl = "", name="", mime="", size = 0}
,ust)// Reset
Just doc = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),doc,ust) //Update
,vst)// Reset
Just doc = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),doc,vst) //Update
onRefresh dp new old mask vst=:{VSt|optional}
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI new):stdAttributeChanges typeDesc optional mask mask] []),mask),new,vst)
......@@ -840,7 +840,7 @@ where
options _ _ = []
onEdit dp e (TreeChoice tree sel) mask ust = case fromJSON e of
onEdit dp (tp,e) (TreeChoice tree sel) mask ust = case fromJSON e of
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)
......
......@@ -76,7 +76,7 @@ onRefresh _ new=:(AnalogClock t2) (AnalogClock t1) mask vst = case ( (if (t1.Ti
++ (if (t1.Time.hour == t2.Time.hour) [] [(2,t2.Time.hour)])
) of [] = (Ok (NoChange,mask),new,vst) ; delta = (Ok (ChangeUI [SetAttribute "diff" (toJSON delta)] [],mask),new,vst)
onEdit [] diff t m ust = case fromJSON diff of
onEdit dp ([],diff) t m ust = case fromJSON diff of
Just diffs = (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONNull}),app diffs t,ust)
Nothing = (Ok (NoChange,m),t,ust)
where
......
......@@ -422,7 +422,7 @@ where
oldMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g1.GoogleMap.markers]
newMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g2.GoogleMap.markers]
onEdit [] d g msk ust = case fromJSON d of
onEdit dp ([],d) g msk ust = case fromJSON d of
Just diffs = (Ok (NoChange,msk),foldl app g diffs,ust)
Nothing = (Ok (NoChange,msk),g,ust)
where
......
......@@ -97,7 +97,7 @@ where
| o1 === o2 = diffObjects l (inc i) os1 os2
= [LDUpdateObject l i o2:diffObjects l (inc i) os1 os2]
onEdit [] diff m msk vst = case fromJSON diff of
onEdit dp ([],diff) m msk vst = case fromJSON diff of
Just diffs = (Ok (NoChange,msk),app diffs m,vst)
Nothing = (Ok (NoChange,msk),m,vst)
where
......
......@@ -21,7 +21,7 @@ from GenEq import generic gEq
*/
:: Editor a =
{ 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
, onEdit :: DataPath (DataPath,JSONNode) a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to edit events
, onRefresh :: DataPath a a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to a new model value
}
......@@ -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 (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
basicEdit :: !(upd a -> Maybe a) !DataPath !(!DataPath,!JSONNode) !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEditSimple :: !DataPath !(!DataPath,!JSONNode) !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
//****************************************************************************//
// Alternative wrapper type for defining custom editor components that can process events
......@@ -87,10 +87,9 @@ basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString
//****************************************************************************//
:: Editlet a
=
{ 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
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt) //Generating the initial UI
, initUI :: (JSObj ()) *JSWorld -> *JSWorld //Initialize client-side
, onEdit :: DataPath (DataPath,JSONNode) a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to edit events
, onRefresh :: DataPath a a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to a new model value
}
fromEditlet :: (Editlet a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
......@@ -84,19 +84,19 @@ 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 (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEdit toV [] upd v vmask ust=:{VSt|optional}
= case upd of
JSONNull = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),v,ust)
json = case fromJSON upd of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=upd}),v,ust)
(Just e) = case toV e v of
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 (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
basicEditSimple target upd val mask iworld = basicEdit (\json _ -> fromJSON json) target upd val mask iworld
basicEdit :: !(upd a -> Maybe a) !DataPath !(!DataPath,!JSONNode) !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEdit toV dp ([],e) v vmask vst=:{VSt|optional}
= case e of
JSONNull = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),v,vst)
json = case fromJSON json of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),v,vst)
(Just event) = case toV event v of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),v,vst)
Just val = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),val,vst)
basicEdit toV _ upd v vmask vst = (Ok (NoChange,vmask),v,vst)
basicEditSimple :: !DataPath !(!DataPath,!JSONNode) !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a
basicEditSimple dp (tp,e) val mask iworld = basicEdit (\json _ -> fromJSON json) dp (tp,e) val mask iworld
fromEditlet :: (Editlet a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
fromEditlet editlet=:{Editlet|genUI,initUI,onEdit,onRefresh} = {Editor|genUI=genUI`,onEdit=onEdit,onRefresh=onRefresh}
......
......@@ -51,7 +51,7 @@ where
# attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val]
= (Ok (uia type attr,mask),vst)
onEdit dp e val mask vst=:{VSt|optional}
onEdit dp (tp,e) val mask vst=:{VSt|optional}
= case e of
JSONNull = (Ok (ChangeUI [SetAttribute "value" JSONNull] [],FieldMask {touched=True,valid=optional,state=JSONNull}),val,vst)
json = case fromJSON e of
......
......@@ -46,10 +46,10 @@ where
# attr = 'DM'.unions [halignAttr AlignRight,heightAttr WrapSize,directionAttr Horizontal]
= uiac UIContainer attr (if (reorder || remove) ([item] ++ buttons) [item])
onEdit dp e items listMask ust
onEdit dp (tp,e) items listMask ust
# childMasks = subMasks (length items) listMask
# (items,childMasks,ust) = updateItems dp e items childMasks ust
| isEmpty dp
| isEmpty tp
//Process the reordering commands
# split = split "_" (fromMaybe "" (fromJSON e))
# index = toInt (last split)
......@@ -66,13 +66,13 @@ where
| otherwise
= (Ok (NoChange,CompoundMask childMasks),items,ust)
where
updateItems [i:dp] e items masks ust
updateItems [i:tp] e items masks ust
| i >= (length items) = (items,masks,ust)
# (nm,nx,ust) = itemEditor.Editor.onEdit dp e (items !! i) (masks !! i) ust
# (nm,nx,ust) = itemEditor.Editor.onEdit dp (tp,e) (items !! i) (masks !! i) ust
= case nm of
Ok (_,m) = (updateAt i nx items, updateAt i m masks,ust)
_ = (items,masks,ust)
updateItems dp e items masks ust
updateItems tp e items masks ust
= (items,masks,ust)
swap [] _ = []
......
......@@ -45,18 +45,20 @@ where
where
checkbox checked = uia UICheckbox (editAttrs taskId (editorId dp) (Just (JSONBool checked)))
onEdit [] e (RECORD record) mask ust //Enabling or disabling of a record
onEdit dp ([],e) (RECORD record) mask ust //Enabling or disabling of a record
# mask = case e of
JSONBool False = CompoundMask []
_ = mask
= (Ok (NoChange,mask),RECORD record,ust)
onEdit [d:ds] e (RECORD record) mask ust
onEdit dp ([d:ds],e) (RECORD record) mask ust
| d >= grd_arity
= (Ok (NoChange,mask),RECORD record,ust)
# childMasks = subMasks grd_arity mask
# (Ok (targetChange,targetMask),record,ust) = ex.Editor.onEdit (pairSelectPath d grd_arity ++ ds) e record (childMasks !! d) ust
= case ex.Editor.onEdit dp (pairSelectPath d grd_arity ++ ds,e) record (childMasks !! d) ust of
(Ok (targetChange,targetMask),record,ust)
= (Ok (targetChange,(CompoundMask (updateAt d targetMask childMasks))),RECORD record,ust)
(Error e,record,ust) = (Error e,RECORD record, ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
onRefresh dp (RECORD new) (RECORD old) mask vst
......@@ -69,8 +71,8 @@ where
(Ok (UI type attr items, mask),vst) = (Ok (UI type ('DM'.union attr (labelAttr gfd_name)) items, mask),vst)
(Error e,vst) = (Error e,vst)
onEdit dp e (FIELD field) mask vst
# (mbmask,field,vst) = ex.Editor.onEdit dp e field mask vst
onEdit dp (tp,e) (FIELD field) mask vst
# (mbmask,field,vst) = ex.Editor.onEdit dp (tp,e) field mask vst
= (mbmask,FIELD field,vst)
onRefresh dp (FIELD new) (FIELD old) mask vst
......@@ -113,7 +115,7 @@ where
= (Ok (UI UIVarCons attr [consNameUI:items],CompoundMask [newFieldMask:masks]),{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e,vst)
onEdit [] JSONNull (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|optional} //Update is a constructor reset
onEdit dp ([],JSONNull) (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|optional} //Update is a constructor reset
//If necessary remove the fields of the previously selected constructor
# change = case state of
(JSONInt prevConsIdx) = ChangeUI [] (repeatn (gtd_conses !! prevConsIdx).gcd_arity (1,RemoveChild))
......@@ -121,13 +123,13 @@ where
# consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
= (Ok (change,CompoundMask [consChooseMask:masks]),OBJECT val, vst)
onEdit [] (JSONInt consIdx) (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|mode} //Update is a constructor switch
onEdit dp ([],JSONInt consIdx) (OBJECT val) (CompoundMask [FieldMask {FieldMask|touched,valid,state}:masks]) vst=:{VSt|mode} //Update is a constructor switch
| consIdx < 0 || consIdx >= gtd_num_conses
= (Error "Constructor selection out of bounds",OBJECT val,vst)
//Create a default value for the selected constructor
# (_,val,vst) = ex.Editor.onEdit (consCreatePath consIdx gtd_num_conses) JSONNull val (CompoundMask []) vst //UGLY TRICK
# (_,val,vst) = ex.Editor.onEdit dp (consCreatePath consIdx gtd_num_conses,JSONNull) val (CompoundMask []) vst //UGLY TRICK
//Create an UI for the new constructor
= case ex.Editor.genUI [] val {vst & mode = Enter} of //HOW WILL I KNOW THE CORRECT DATAPATH?!
= case ex.Editor.genUI dp val {vst & mode = Enter} of
(Ok (UI UICons attr items, CompoundMask masks),vst)
//Construct a UI change that does the following:
//1: If necessary remove the fields of the previously selected constructor
......@@ -142,19 +144,19 @@ where
= (Ok (change,CompoundMask [consChooseMask:masks]), OBJECT val, {vst & mode = mode})
(Error e,vst) = (Error e, OBJECT val, {vst & mode = mode})
onEdit [] _ (OBJECT val) mask vst
onEdit dp ([],_) (OBJECT val) mask vst
= (Error "Unknown constructor select event",OBJECT val,vst)
onEdit dp e (OBJECT val) mask vst //Update is targeted somewhere in a substructure of this value
onEdit dp (tp,e) (OBJECT val) mask vst //Update is targeted somewhere in a substructure of this value
| gtd_num_conses == 1
//Just call onEdit for the inner value
= case ex.Editor.onEdit dp e val mask vst of
= case ex.Editor.onEdit dp (tp,e) val mask vst of
(Ok (change,mask),val,vst) = (Ok (change,mask),OBJECT val,vst)
(Error e,val,vst) = (Error e, OBJECT val, vst)
| otherwise
//Adjust for the added constructor switch UI
# (CompoundMask [consChooseMask:masks]) = mask
= case ex.Editor.onEdit dp e val (CompoundMask masks) vst of
= case ex.Editor.onEdit dp (tp,e) val (CompoundMask masks) vst of
(Ok (change,CompoundMask masks),val,vst)
# change = case change of
(ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
......@@ -233,11 +235,11 @@ where
(Ok viz,vst) = (Ok (flattenUIPairs UICons gcd_arity viz), {VSt| vst & selectedConsIndex = gcd_index})
(Error e,vst) = (Error e,{VSt| vst & selectedConsIndex = gcd_index})
onEdit [d:ds] e (CONS val) (CompoundMask masks) vst
onEdit dp ([d:ds],e) (CONS val) (CompoundMask masks) vst
| d >= gcd_arity
= (Error "Edit aimed at non-existent constructor field",CONS val,vst)
//Update the targeted field in the constructor
= case ex.Editor.onEdit (pairSelectPath d gcd_arity ++ ds) e val (masks !! d) vst of
= case ex.Editor.onEdit dp (pairSelectPath d gcd_arity ++ ds,e) val (masks !! d) vst of
(Ok (change,mask),val,vst)
//Extend the change
# change = case change of
......@@ -266,11 +268,11 @@ where
# ((vizx,maskx),(vizy,masky)) = (fromOk vizx,fromOk vizy)
= (Ok (uic UIPair [vizx,vizy],CompoundMask [maskx,masky]),vst)
onEdit [0:ds] e (PAIR x y) xmask ust
# (xmask,x,ust) = ex.Editor.onEdit ds e x xmask ust
onEdit dp ([0:ds],e) (PAIR x y) xmask ust
# (xmask,x,ust) = ex.Editor.onEdit dp (ds,e) x xmask ust
= (xmask,PAIR x y,ust)
onEdit [1:ds] e (PAIR x y) ymask ust
# (ymask,y,ust) = ey.Editor.onEdit ds e y ymask ust
onEdit dp ([1:ds],e) (PAIR x y) ymask ust
# (ymask,y,ust) = ey.Editor.onEdit dp (ds,e) y ymask ust
= (ymask,PAIR x y,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
......@@ -296,15 +298,15 @@ where
(Ok (UI type attr items, mask),vst) = (Ok (UI type ('DM'.union (optionalAttr True) attr) items,mask), {VSt|vst & optional = optional})
(Error e,vst) = (Error e, {VSt|vst & optional = optional})
onEdit dp e val mask vst=:{VSt|optional}
| isEmpty dp && (e === JSONNull || e === JSONBool False)
onEdit dp (tp,e) val mask vst=:{VSt|optional}
| isEmpty tp && (e === JSONNull || e === JSONBool False)
# mask = case mask of
(FieldMask fmask) = FieldMask {FieldMask|fmask & state = JSONNull}
(CompoundMask m) = CompoundMask []
= (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}
# (xmask,x,vst) = ex.Editor.onEdit dp (tp,e) x xmask {VSt|vst & optional = True}
= (xmask,Just x,{VSt|vst & optional = optional})
onRefresh dp Nothing Nothing mask vst = (Ok (NoChange,mask),Nothing,vst)
......
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