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 ...@@ -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 matchAndApplyEvent_ (EditEvent eTaskId name edit) taskId mode mbEditor taskTime v mask ts prompt iworld
| eTaskId == taskId | eTaskId == taskId
# editor = fromMaybe gEditor{|*|} mbEditor # 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) (Ok (change,mask),v,{VSt|iworld}) = (Ok (v,ChangeUI [] [(1,ChangeChild change)],mask,taskTime),iworld)
(Error e,_,{VSt|iworld}) = (Error e,iworld) (Error e,_,{VSt|iworld}) = (Error e,iworld)
| otherwise = (Ok (v,NoChange,mask,ts),iworld) | otherwise = (Ok (v,NoChange,mask,ts),iworld)
......
...@@ -481,10 +481,10 @@ where ...@@ -481,10 +481,10 @@ where
# attr = 'DM'.unions [editAttrs taskId (editorId dp) value,stdAttributes typeDesc optional mask] # attr = 'DM'.unions [editAttrs taskId (editorId dp) value,stdAttributes typeDesc optional mask]
= (Ok (uia UIEditDocument attr,mask),vst) = (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} Nothing = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),{Document|documentId = "", contentUrl = "", name="", mime="", size = 0}
,ust)// Reset ,vst)// Reset
Just doc = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),doc,ust) //Update Just doc = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),doc,vst) //Update
onRefresh dp new old mask vst=:{VSt|optional} 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) = (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI new):stdAttributeChanges typeDesc optional mask mask] []),mask),new,vst)
...@@ -840,7 +840,7 @@ where ...@@ -840,7 +840,7 @@ where
options _ _ = [] 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 ("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) Just ("exp",idx,val) = (Ok (NoChange, touch mask),TreeChoice (setTreeExpanded idx val tree) sel, ust)
_ = (Ok (NoChange,mask),TreeChoice 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 ...@@ -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)]) ++ (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) ) 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) Just diffs = (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONNull}),app diffs t,ust)
Nothing = (Ok (NoChange,m),t,ust) Nothing = (Ok (NoChange,m),t,ust)
where where
......
...@@ -422,7 +422,7 @@ where ...@@ -422,7 +422,7 @@ where
oldMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g1.GoogleMap.markers] oldMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g1.GoogleMap.markers]
newMarkerIds = [markerId \\ {GoogleMapMarker|markerId} <- g2.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) Just diffs = (Ok (NoChange,msk),foldl app g diffs,ust)
Nothing = (Ok (NoChange,msk),g,ust) Nothing = (Ok (NoChange,msk),g,ust)
where where
......
...@@ -97,7 +97,7 @@ where ...@@ -97,7 +97,7 @@ where
| o1 === o2 = diffObjects l (inc i) os1 os2 | o1 === o2 = diffObjects l (inc i) os1 os2
= [LDUpdateObject l i 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) Just diffs = (Ok (NoChange,msk),app diffs m,vst)
Nothing = (Ok (NoChange,msk),m,vst) Nothing = (Ok (NoChange,msk),m,vst)
where where
......
...@@ -20,9 +20,9 @@ from GenEq import generic gEq ...@@ -20,9 +20,9 @@ from GenEq import generic gEq
* Definition of an editor editor * Definition of an editor editor
*/ */
:: Editor a = :: Editor a =
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt) //Generating the initial UI { 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 , onRefresh :: DataPath a a EditMask *VSt -> *(!MaybeErrorString (!UIChange, !EditMask), !a, !*VSt) //React to a new model value
} }
//* Datapaths identify sub structures in a composite structure //* Datapaths identify sub structures in a composite structure
...@@ -78,8 +78,8 @@ checkMaskValue :: !EditMask a -> Maybe JSONNode | JSONEncode{|*|} a ...@@ -78,8 +78,8 @@ checkMaskValue :: !EditMask a -> Maybe JSONNode | JSONEncode{|*|} a
stdAttributes :: String Bool EditMask -> UIAttributes stdAttributes :: String Bool EditMask -> UIAttributes
stdAttributeChanges :: String Bool EditMask EditMask -> [UIAttributeChange] stdAttributeChanges :: String Bool EditMask EditMask -> [UIAttributeChange]
basicEdit :: !(upd a -> Maybe a) !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd basicEdit :: !(upd a -> Maybe a) !DataPath !(!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 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 // Alternative wrapper type for defining custom editor components that can process events
...@@ -87,10 +87,9 @@ basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString ...@@ -87,10 +87,9 @@ basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString
//****************************************************************************// //****************************************************************************//
:: Editlet a :: Editlet a
= =
{ genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI,!EditMask), !*VSt) { genUI :: DataPath a *VSt -> *(!MaybeErrorString (!UI, !EditMask), !*VSt) //Generating the initial UI
, initUI :: (JSObj ()) *JSWorld -> *JSWorld , initUI :: (JSObj ()) *JSWorld -> *JSWorld //Initialize client-side
, 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 , 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 fromEditlet :: (Editlet a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
...@@ -84,19 +84,19 @@ stdAttributeChanges typename optional om nm ...@@ -84,19 +84,19 @@ stdAttributeChanges typename optional om nm
| om === nm = [] //Nothing to change | om === nm = [] //Nothing to change
| otherwise = [SetAttribute k v \\ (k,v) <- 'DM'.toList (stdAttributes typename optional nm)] | 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 :: !(upd a -> Maybe a) !DataPath !(!DataPath,!JSONNode) !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask), !a, !*VSt) | JSONDecode{|*|} upd
basicEdit toV [] upd v vmask ust=:{VSt|optional} basicEdit toV dp ([],e) v vmask vst=:{VSt|optional}
= case upd of = case e of
JSONNull = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),v,ust) JSONNull = (Ok (NoChange,FieldMask {touched=True,valid=optional,state=JSONNull}),v,vst)
json = case fromJSON upd of json = case fromJSON json of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=upd}),v,ust) Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),v,vst)
(Just e) = case toV e v of (Just event) = case toV event v of
Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=upd}),v,ust) Nothing = (Ok (NoChange,FieldMask {touched=True,valid=False,state=e}),v,vst)
Just val = (Ok (NoChange,FieldMask {touched=True,valid=True,state=upd}),val,ust) Just val = (Ok (NoChange,FieldMask {touched=True,valid=True,state=e}),val,vst)
basicEdit toV _ upd v vmask ust = (Ok (NoChange,vmask),v,ust) basicEdit toV _ upd v vmask vst = (Ok (NoChange,vmask),v,vst)
basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString (!UIChange,!EditMask),!a,!*VSt) | JSONDecode{|*|} a basicEditSimple :: !DataPath !(!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 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 a) -> (Editor a) | JSONEncode{|*|} a & JSONDecode{|*|} a & gDefault{|*|} a
fromEditlet editlet=:{Editlet|genUI,initUI,onEdit,onRefresh} = {Editor|genUI=genUI`,onEdit=onEdit,onRefresh=onRefresh} fromEditlet editlet=:{Editlet|genUI,initUI,onEdit,onRefresh} = {Editor|genUI=genUI`,onEdit=onEdit,onRefresh=onRefresh}
......
...@@ -51,7 +51,7 @@ where ...@@ -51,7 +51,7 @@ where
# attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val] # attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val]
= (Ok (uia type attr,mask),vst) = (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 = case e of
JSONNull = (Ok (ChangeUI [SetAttribute "value" JSONNull] [],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 json = case fromJSON e of
......
...@@ -46,10 +46,10 @@ where ...@@ -46,10 +46,10 @@ where
# attr = 'DM'.unions [halignAttr AlignRight,heightAttr WrapSize,directionAttr Horizontal] # attr = 'DM'.unions [halignAttr AlignRight,heightAttr WrapSize,directionAttr Horizontal]
= uiac UIContainer attr (if (reorder || remove) ([item] ++ buttons) [item]) = 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 # childMasks = subMasks (length items) listMask
# (items,childMasks,ust) = updateItems dp e items childMasks ust # (items,childMasks,ust) = updateItems dp e items childMasks ust
| isEmpty dp | isEmpty tp
//Process the reordering commands //Process the reordering commands
# split = split "_" (fromMaybe "" (fromJSON e)) # split = split "_" (fromMaybe "" (fromJSON e))
# index = toInt (last split) # index = toInt (last split)
...@@ -66,13 +66,13 @@ where ...@@ -66,13 +66,13 @@ where
| otherwise | otherwise
= (Ok (NoChange,CompoundMask childMasks),items,ust) = (Ok (NoChange,CompoundMask childMasks),items,ust)
where where
updateItems [i:dp] e items masks ust updateItems [i:tp] e items masks ust
| i >= (length items) = (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 = 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) _ = (items,masks,ust)
updateItems dp e items masks ust updateItems tp e items masks ust
= (items,masks,ust) = (items,masks,ust)
swap [] _ = [] swap [] _ = []
......
...@@ -45,18 +45,20 @@ where ...@@ -45,18 +45,20 @@ where
where where
checkbox checked = uia UICheckbox (editAttrs taskId (editorId dp) (Just (JSONBool checked))) 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 # mask = case e of
JSONBool False = CompoundMask [] JSONBool False = CompoundMask []
_ = mask _ = mask
= (Ok (NoChange,mask),RECORD record,ust) = (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 | d >= grd_arity
= (Ok (NoChange,mask),RECORD record,ust) = (Ok (NoChange,mask),RECORD record,ust)
# childMasks = subMasks grd_arity mask # 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,(CompoundMask (updateAt d targetMask childMasks))),RECORD record,ust) (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) onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
onRefresh dp (RECORD new) (RECORD old) mask vst onRefresh dp (RECORD new) (RECORD old) mask vst
...@@ -69,8 +71,8 @@ where ...@@ -69,8 +71,8 @@ where
(Ok (UI type attr items, mask),vst) = (Ok (UI type ('DM'.union attr (labelAttr gfd_name)) items, mask),vst) (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) (Error e,vst) = (Error e,vst)
onEdit dp e (FIELD field) mask vst onEdit dp (tp,e) (FIELD field) mask vst
# (mbmask,field,vst) = ex.Editor.onEdit dp e field mask vst # (mbmask,field,vst) = ex.Editor.onEdit dp (tp,e) field mask vst
= (mbmask,FIELD field,vst) = (mbmask,FIELD field,vst)
onRefresh dp (FIELD new) (FIELD old) mask vst onRefresh dp (FIELD new) (FIELD old) mask vst
...@@ -113,7 +115,7 @@ where ...@@ -113,7 +115,7 @@ where
= (Ok (UI UIVarCons attr [consNameUI:items],CompoundMask [newFieldMask:masks]),{vst & selectedConsIndex = selectedConsIndex}) = (Ok (UI UIVarCons attr [consNameUI:items],CompoundMask [newFieldMask:masks]),{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e,vst) (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 //If necessary remove the fields of the previously selected constructor
# change = case state of # change = case state of
(JSONInt prevConsIdx) = ChangeUI [] (repeatn (gtd_conses !! prevConsIdx).gcd_arity (1,RemoveChild)) (JSONInt prevConsIdx) = ChangeUI [] (repeatn (gtd_conses !! prevConsIdx).gcd_arity (1,RemoveChild))
...@@ -121,13 +123,13 @@ where ...@@ -121,13 +123,13 @@ where
# consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull} # consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
= (Ok (change,CompoundMask [consChooseMask:masks]),OBJECT val, vst) = (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 | consIdx < 0 || consIdx >= gtd_num_conses
= (Error "Constructor selection out of bounds",OBJECT val,vst) = (Error "Constructor selection out of bounds",OBJECT val,vst)
//Create a default value for the selected constructor //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 //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) (Ok (UI UICons attr items, CompoundMask masks),vst)
//Construct a UI change that does the following: //Construct a UI change that does the following:
//1: If necessary remove the fields of the previously selected constructor //1: If necessary remove the fields of the previously selected constructor
...@@ -142,19 +144,19 @@ where ...@@ -142,19 +144,19 @@ where
= (Ok (change,CompoundMask [consChooseMask:masks]), OBJECT val, {vst & mode = mode}) = (Ok (change,CompoundMask [consChooseMask:masks]), OBJECT val, {vst & mode = mode})
(Error e,vst) = (Error e, 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) = (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 | gtd_num_conses == 1
//Just call onEdit for the inner value //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) (Ok (change,mask),val,vst) = (Ok (change,mask),OBJECT val,vst)
(Error e,val,vst) = (Error e, OBJECT val, vst) (Error e,val,vst) = (Error e, OBJECT val, vst)
| otherwise | otherwise
//Adjust for the added constructor switch UI //Adjust for the added constructor switch UI
# (CompoundMask [consChooseMask:masks]) = mask # (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) (Ok (change,CompoundMask masks),val,vst)
# change = case change of # change = case change of
(ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges] (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
...@@ -233,11 +235,11 @@ where ...@@ -233,11 +235,11 @@ where
(Ok viz,vst) = (Ok (flattenUIPairs UICons gcd_arity viz), {VSt| vst & selectedConsIndex = gcd_index}) (Ok viz,vst) = (Ok (flattenUIPairs UICons gcd_arity viz), {VSt| vst & selectedConsIndex = gcd_index})
(Error e,vst) = (Error e,{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 | d >= gcd_arity
= (Error "Edit aimed at non-existent constructor field",CONS val,vst) = (Error "Edit aimed at non-existent constructor field",CONS val,vst)
//Update the targeted field in the constructor //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) (Ok (change,mask),val,vst)
//Extend the change //Extend the change
# change = case change of # change = case change of
...@@ -266,11 +268,11 @@ where ...@@ -266,11 +268,11 @@ where
# ((vizx,maskx),(vizy,masky)) = (fromOk vizx,fromOk vizy) # ((vizx,maskx),(vizy,masky)) = (fromOk vizx,fromOk vizy)
= (Ok (uic UIPair [vizx,vizy],CompoundMask [maskx,masky]),vst) = (Ok (uic UIPair [vizx,vizy],CompoundMask [maskx,masky]),vst)
onEdit [0:ds] e (PAIR x y) xmask ust onEdit dp ([0:ds],e) (PAIR x y) xmask ust
# (xmask,x,ust) = ex.Editor.onEdit ds e x xmask ust # (xmask,x,ust) = ex.Editor.onEdit dp (ds,e) x xmask ust
= (xmask,PAIR x y,ust) = (xmask,PAIR x y,ust)
onEdit [1:ds] e (PAIR x y) ymask ust onEdit dp ([1:ds],e) (PAIR x y) ymask ust
# (ymask,y,ust) = ey.Editor.onEdit ds e y ymask ust # (ymask,y,ust) = ey.Editor.onEdit dp (ds,e) y ymask ust
= (ymask,PAIR x y,ust) = (ymask,PAIR x y,ust)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust) onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
...@@ -296,15 +298,15 @@ where ...@@ -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}) (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}) (Error e,vst) = (Error e, {VSt|vst & optional = optional})
onEdit dp e val mask vst=:{VSt|optional} onEdit dp (tp,e) val mask vst=:{VSt|optional}
| isEmpty dp && (e === JSONNull || e === JSONBool False) | isEmpty tp && (e === JSONNull || e === JSONBool False)
# mask = case mask of # mask = case mask of
(FieldMask fmask) = FieldMask {FieldMask|fmask & state = JSONNull} (FieldMask fmask) = FieldMask {FieldMask|fmask & state = JSONNull}
(CompoundMask m) = CompoundMask [] (CompoundMask m) = CompoundMask []
= (Ok (NoChange,mask),Nothing,vst) //Reset = (Ok (NoChange,mask),Nothing,vst) //Reset
| otherwise | otherwise
# (x,xmask) = maybe (dx,CompoundMask []) (\x -> (x,mask)) val # (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}) = (xmask,Just x,{VSt|vst & optional = optional})
onRefresh dp Nothing Nothing mask vst = (Ok (NoChange,mask),Nothing,vst) 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