Commit 561ac3ab authored by Bas Lijnse's avatar Bas Lijnse

Changed the event handlers of generic editors to get rid of editmasks in the...

Changed the event handlers of generic editors to get rid of editmasks in the task domain. This temporarily breaks event handling.
parent 4972bd5f
Pipeline #2998 skipped
......@@ -138,10 +138,10 @@ visualizeView_ taskId evalOpts mode mbEditor event old=:(v,m) new=:(nv,nm) promp
# change = ReplaceUI (uic UIInteract [promptUI,editUI])
= (Ok change,vst)
_ //compare old and new value to determine changes
= case editor.Editor.updUI [] v m nv nm vst of
(Ok editChange,vst)
= case editor.Editor.onRefresh [] nv v m vst of
(Ok (editChange,_),_,vst)
= (Ok (ChangeUI [] [(0,ChangeChild NoChange), (1,ChangeChild editChange)]) ,vst)
(Error e,vst) = (Error e,vst)
(Error e,_,vst) = (Error e,vst)
= (change,valid,iworld)
tcplisten :: !Int !Bool !(RWShared () r w) (ConnectionHandlers l r w) -> Task [l] | iTask l & iTask r & iTask w
......
This diff is collapsed.
......@@ -21,8 +21,8 @@ analogClockEditlet
= {Editlet
|genUI = genUI
,initUI = initUI
,updUI = updUI
,onEdit = onEdit
,onRefresh = onRefresh
}
where
genUI dp (AnalogClock {Time|hour,min,sec}) world
......@@ -71,10 +71,10 @@ where
degrees 1 v = 6 * v
degrees 2 v = 30 * v
updUI _ (AnalogClock t1) _ (AnalogClock t2) _ vst = case ( (if (t1.Time.sec == t2.Time.sec) [] [(0,t2.Time.sec)])
onRefresh _ new=:(AnalogClock t2) (AnalogClock t1) mask vst = case ( (if (t1.Time.sec == t2.Time.sec) [] [(0,t2.Time.sec)])
++ (if (t1.Time.min == t2.Time.min) [] [(1,t2.Time.min)])
++ (if (t1.Time.hour == t2.Time.hour) [] [(2,t2.Time.hour)])
) of [] = (Ok NoChange,vst) ; delta = (Ok (ChangeUI [SetAttribute "diff" (toJSON delta)] []),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
Just diffs = (Ok (NoChange,FieldMask {touched=True,valid=True,state=JSONNull}),app diffs t,ust)
......
......@@ -17,8 +17,8 @@ controlLightEditlet
= {Editlet
|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 (NoChange,m),a,ust)
,onRefresh = \_ b a m vst -> (Ok (if (a===b) NoChange (ChangeUI [SetAttribute "value" (JSONString (color b))] []),m),b,vst)
}
where
genUI dp val world
......
......@@ -61,8 +61,8 @@ googleMapEditlet
= { Editlet
| genUI = genUI
, initUI = initUI
, updUI = updUI
, onEdit = onEdit
, onRefresh = onRefresh
}
where
genUI dp val world
......@@ -401,10 +401,9 @@ where
# (_,world) = jsApply cb jsWindow [] world
= world
updUI :: DataPath GoogleMap EditMask GoogleMap EditMask *VSt -> *(!MaybeErrorString UIChange,!*VSt)
updUI _ g1 _ g2 _ vst = case settingsDiff ++ perspectiveDiff ++ remMarkersDiff ++ addMarkersDiff ++ updMarkersDiff of
[] = (Ok NoChange,vst)
diffs = (Ok (ChangeUI [SetAttribute "diff" (toJSON diffs)] []),vst)
onRefresh _ g2 g1 mask vst = case settingsDiff ++ perspectiveDiff ++ remMarkersDiff ++ addMarkersDiff ++ updMarkersDiff of
[] = (Ok (NoChange,mask),g2,vst)
diffs = (Ok (ChangeUI [SetAttribute "diff" (toJSON diffs)] [],mask),g2,vst)
where
settingsDiff = if (g1.GoogleMap.settings === g2.GoogleMap.settings) [] [SetSettings g2.GoogleMap.settings]
perspectiveDiff = if (g1.GoogleMap.perspective === g2.GoogleMap.perspective) [] [SetPerspective g2.GoogleMap.perspective]
......
......@@ -59,8 +59,7 @@ MAP_OPTIONS :== {attributionControl = False, zoomControl = True}
| LDUpdateObject !Int !Int !LeafletObject
| LDRemoveObjects !Int !Int
updUI :: DataPath LeafletMap EditMask LeafletMap EditMask *VSt -> *(!MaybeErrorString UIChange,!*VSt)
updUI _ m1 _ m2 _ vst = case diffs of [] = (Ok NoChange,vst) ; _ = (Ok (ChangeUI [SetAttribute "diff" (toJSON diffs)] []),vst)
onRefresh _ m2 m1 mask vst = case diffs of [] = (Ok (NoChange,mask),m2,vst) ; _ = (Ok (ChangeUI [SetAttribute "diff" (toJSON diffs)] [],mask),m2,vst)
where
diffs
= diffPerspectives m1.perspective m2.perspective
......@@ -129,8 +128,8 @@ leafletEditlet
= { Editlet
| genUI = genUI
, initUI = initUI
, updUI = updUI
, onEdit = onEdit
, onRefresh = onRefresh
}
where
genUI dp val world
......
......@@ -73,8 +73,8 @@ svgRenderer :: (SVGLet s v) -> Editlet s | iTask s
svgRenderer svglet=:{initView,renderImage,updView,updModel}
= { genUI = genUI
, initUI = initUI
, updUI = updUI
, onEdit = onEdit
, onRefresh = onRefresh
}
where
genUI dp val world
......@@ -111,7 +111,9 @@ svgRenderer svglet=:{initView,renderImage,updView,updModel}
| otherwise
= (jsNull,jsTrace "Unknown attribute change" world)
updUI _ ov om nv nm vst = (Ok (if (ov === nv) NoChange (ChangeUI [SetAttribute "stateChange" (toJSON nv)] [])),vst)
onRefresh _ new old mask vst
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "stateChange" (toJSON new)] []),mask),new,vst)
onEdit _ _ st m ust = (Ok (NoChange,m),st,ust)
onNewState :: !(JSVal a) !(SVGLet s v) !s !*JSWorld -> *JSWorld | JSONEncode{|*|} s
......
......@@ -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
, 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
{ 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
, 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
......@@ -87,10 +87,10 @@ 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
, updUI :: DataPath a EditMask a EditMask *VSt -> *(!MaybeErrorString UIChange, !*VSt)
{ 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
, 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
......@@ -99,7 +99,7 @@ basicEditSimple :: !DataPath !JSONNode !a !EditMask !*VSt -> *(!MaybeErrorString
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
fromEditlet editlet=:{Editlet|genUI,initUI,updUI,onEdit} = {Editor|genUI=genUI`,updUI=updUI,onEdit=onEdit}
fromEditlet editlet=:{Editlet|genUI,initUI,onEdit,onRefresh} = {Editor|genUI=genUI`,onEdit=onEdit,onRefresh=onRefresh}
where
genUI` dp val vst=:{VSt|taskId}
= case genUI dp val vst of
......
......@@ -42,7 +42,7 @@ icon :: Editor String
icon = simpleComponent toJSON UIIcon
//Simple components for which simply knowing the UI type is sufficient
simpleComponent toValue type = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
simpleComponent toValue type = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst=:{VSt|taskId,mode,optional}
# mask = newFieldMask
......@@ -50,10 +50,6 @@ where
# attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr val]
= (Ok (uia type attr,mask),vst)
updUI dp ov om nv nm vst=:{VSt|mode,optional}
| checkMaskValue om ov === checkMaskValue nm nv = (Ok NoChange,vst)
| otherwise = (Ok (ChangeUI [SetAttribute "value" (toValue nv)] []),vst)
onEdit dp e val mask vst=:{VSt|optional}
= case e of
JSONNull = (Ok (ChangeUI [SetAttribute "value" JSONNull] [],FieldMask {touched=True,valid=optional,state=JSONNull}),val,vst)
......@@ -61,3 +57,7 @@ where
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)
onRefresh dp new old mask vst=:{VSt|mode,optional}
| old === new = (Ok (NoChange,mask),new,vst)
| otherwise = (Ok (ChangeUI [SetAttribute "value" (toValue new)] [],mask),new,vst)
......@@ -5,7 +5,7 @@ import Data.Error, Text.JSON
import qualified Data.Map as DM
withHintAttributes :: String (Editor a) -> Editor a
withHintAttributes typeDesc editor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
withHintAttributes typeDesc editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst=:{VSt|taskId,optional}
= case editor.Editor.genUI dp val vst of
......@@ -14,55 +14,63 @@ where
# attr = 'DM'.union (stdAttributes typeDesc optional mask) attr
= (Ok (UI type attr items,mask),vst)
(e,vst) = (e,vst)
updUI dp ov om nv nm vst=:{VSt|optional}
= case stdAttributeChanges typeDesc optional om nm of
[] = editor.Editor.updUI dp ov om nv nm vst //Nothing to add
hintChanges = case editor.Editor.updUI dp ov om nv nm vst of
(Ok NoChange,vst) = (Ok (ChangeUI hintChanges []),vst)
(Ok (ChangeUI attrChanges itemChanges),vst) = (Ok (ChangeUI (attrChanges ++ hintChanges) itemChanges),vst)
(e,vst) = (e,vst)
onEdit dp e val mask ust = editor.Editor.onEdit dp e val mask ust
onRefresh dp new old mask vst=:{VSt|optional}
= case stdAttributeChanges typeDesc optional mask mask of
[] = editor.Editor.onRefresh dp new old mask vst //Nothing to add
hintChanges = case editor.Editor.onRefresh dp new old mask vst of
(Ok (NoChange,mask),new,vst) = (Ok (ChangeUI hintChanges [],mask),new,vst)
(Ok (ChangeUI attrChanges itemChanges,mask),new,vst) = (Ok (ChangeUI (attrChanges ++ hintChanges) itemChanges,mask),new,vst)
(e,val,vst) = (e,val,vst)
whenDisabled :: (Editor a) (Editor a) -> Editor a
whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
whenDisabled disabledEditor enabledEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst=:{VSt|mode}
| mode =: View = disabledEditor.Editor.genUI dp val vst
= enabledEditor.Editor.genUI dp val vst
updUI dp ov om nv nm vst=:{VSt|mode}
| mode =: View = disabledEditor.Editor.updUI dp ov om nv nm vst
= enabledEditor.Editor.updUI dp ov om nv nm vst
onEdit dp e val mask ust
= enabledEditor.Editor.onEdit dp e val mask ust
onRefresh dp new old mask vst=:{VSt|mode}
| mode =: View = disabledEditor.Editor.onRefresh dp new old mask vst
= enabledEditor.Editor.onRefresh dp new old mask vst
liftEditor :: (b -> a) (a -> b) (Editor a) -> Editor b
liftEditor tof fromf editor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
liftEditor tof fromf editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst = editor.Editor.genUI dp (tof val) vst
updUI dp ov om nv nm vst = editor.Editor.updUI dp (tof ov) om (tof nv) nm vst
onEdit dp e val mask ust
# (mask,val,ust) = editor.Editor.onEdit dp e (tof val) mask ust
= (mask,fromf val,ust)
onRefresh dp new old mask vst
# (change,val,vst) = editor.Editor.onRefresh dp (tof new) (tof old) mask vst
= (change,fromf val,vst)
liftEditorAsymmetric :: (b -> a) (a -> MaybeErrorString b) (Editor a) -> Editor b
liftEditorAsymmetric tof fromf editor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
liftEditorAsymmetric tof fromf editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst = editor.Editor.genUI dp (tof val) vst
updUI dp ov om nv nm vst = editor.Editor.updUI dp (tof ov) om (tof nv) nm vst
onEdit dp e old mask ust
# (mask,val,ust) = editor.Editor.onEdit dp e (tof old) mask ust
onEdit dp e old mask vst
# (mask,val,vst) = editor.Editor.onEdit dp e (tof old) mask vst
= case fromf val of
(Ok new) = (mask,new,ust)
(Error e) = (mask,old,ust)
(Ok new) = (mask,new,vst)
(Error e) = (mask,old,vst)
onRefresh dp new old mask vst
# (change,val,vst) = editor.Editor.onRefresh dp (tof new) (tof old) mask vst
= case fromf val of
(Ok new) = (change,new,vst)
(Error e) = (change,old,vst)
constEditor :: a (Editor a) -> (Editor a)
constEditor val editor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
constEditor val editor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp _ vst = editor.Editor.genUI dp val vst
updUI dp _ _ _ _ vst = (Ok NoChange,vst)
onEdit dp _ val mask ust = (Ok (NoChange,mask),val,ust)
onEdit dp _ val mask vst = (Ok (NoChange,mask),val,vst)
onRefresh dp _ val mask vst = (Ok (NoChange,mask),val,vst)
......@@ -6,14 +6,14 @@ import Data.Tuple, Data.Error, Text, Text.JSON
import qualified Data.Map as DM
emptyEditor :: Editor a
emptyEditor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
emptyEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI _ _ vst = (Ok (ui UIEmpty,newFieldMask),vst)
updUI _ _ _ _ _ vst = (Ok NoChange,vst)
onEdit _ _ val mask ust = (Ok (NoChange,mask),val,ust)
onEdit _ _ val mask vst = (Ok (NoChange,mask),val,vst)
onRefresh _ _ val mask vst = (Ok (NoChange,mask),val,vst)
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}
listEditor add remove reorder count itemEditor = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp val vst=:{VSt|taskId} = case genChildUIs dp 0 val [] vst of
(Ok (items,masks),vst)
......@@ -46,10 +46,6 @@ where
# attr = 'DM'.unions [halignAttr AlignRight,heightAttr WrapSize,directionAttr Horizontal]
= uiac UIContainer attr (if (reorder || remove) ([item] ++ buttons) [item])
updUI dp ov om nv nm vst = case genUI dp nv vst of
(Ok (ui,mask),vst) = (Ok (ReplaceUI ui),vst)
(Error e,vst) = (Error e,vst)
onEdit dp e items listMask ust
# childMasks = subMasks (length items) listMask
# (items,childMasks,ust) = updateItems dp e items childMasks ust
......@@ -88,3 +84,8 @@ where
# l = list !! (index)
= updateAt (index-1) l (updateAt index f list)
onRefresh dp new old mask vst = case genUI dp new vst of
(Ok (ui,mask),vst) = (Ok (ReplaceUI ui,mask),new,vst)
(Error e,vst) = (Error e,old,vst)
......@@ -17,7 +17,7 @@ derive bimap Editor,(,),(,,),(,,,), MaybeError
gEditor{|UNIT|} = emptyEditor
gEditor{|RECORD of {grd_arity}|} ex _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
gEditor{|RECORD of {grd_arity}|} ex _ _ _ _ = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (RECORD x) vst=:{VSt|taskId,mode,optional}
= case mode of
......@@ -45,10 +45,6 @@ where
where
checkbox checked = uia UICheckbox (editAttrs taskId (editorId dp) (Just (JSONBool checked)))
updUI dp (RECORD old) om (RECORD new) nm vst
# (diff,vst) = ex.Editor.updUI (pairPath grd_arity dp) old (toPairMask grd_arity om) new (toPairMask grd_arity nm) vst
= (fmap (flattenPairDiff 0 grd_arity) diff,vst)
onEdit [] e (RECORD record) mask ust //Enabling or disabling of a record
# mask = case e of
JSONBool False = CompoundMask []
......@@ -63,19 +59,25 @@ where
= (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}
onRefresh dp (RECORD new) (RECORD old) mask vst
# (change,val,vst) = ex.Editor.onRefresh (pairPath grd_arity dp) new old (toPairMask grd_arity mask) vst
= (fmap (flattenPairDiff 0 grd_arity) change,RECORD val,vst)
gEditor{|FIELD of {gfd_name}|} ex _ _ _ _ = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (FIELD x) vst = case ex.Editor.genUI dp x vst of //Just add the field name as a label
(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)
updUI dp (FIELD old) om (FIELD new) nm vst = ex.Editor.updUI dp old om new nm vst
onEdit dp e (FIELD field) mask vst
# (mbmask,field,vst) = ex.Editor.onEdit dp e field mask vst
= (mbmask,FIELD field,vst)
gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} ex _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
onRefresh dp (FIELD new) (FIELD old) mask vst
# (change,val,vst) = ex.Editor.onRefresh dp new old mask vst
= (change,FIELD val,vst)
gEditor{|OBJECT of {gtd_num_conses,gtd_conses}|} ex _ _ _ _ = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (OBJECT x) vst=:{VSt|taskId,mode,selectedConsIndex}
= case mode of
......@@ -109,23 +111,6 @@ where
= (Ok (UI UIVarCons attr [consNameUI:items],CompoundMask [newFieldMask:masks]),{vst & selectedConsIndex = selectedConsIndex})
(Error e,vst) = (Error e,vst)
updUI dp (OBJECT old) om (OBJECT new) nm vst=:{VSt|mode,selectedConsIndex=curSelectedConsIndex}
| gtd_num_conses > 1 && (mode =:Enter || mode =: Update)
= case ex.Editor.updUI dp old om new nm {vst & selectedConsIndex = 0} of
(Ok diff,vst=:{VSt|selectedConsIndex})
| selectedConsIndex < 0 //A cons was changed
# selectedCons = ~selectedConsIndex - 1
# consChange = ChangeUI [SetAttribute "value" (JSONArray [toJSON selectedCons,JSONBool True])] []
| allConsesArityZero gtd_conses
= (Ok consChange,{vst & selectedConsIndex = curSelectedConsIndex})
| otherwise
= (Ok (ChangeUI [] [(0,ChangeChild consChange),(1,ChangeChild diff)]),{vst & selectedConsIndex = curSelectedConsIndex})
| otherwise
= (Ok diff,{vst & selectedConsIndex = curSelectedConsIndex})
(Error e,vst) = (Error e,vst)
| otherwise
= ex.Editor.updUI dp old om new nm vst
onEdit [] e (OBJECT val) mask ust //Update is a constructor switch
# consIdx = case e of
JSONInt i = i
......@@ -139,31 +124,34 @@ where
# (Ok (change,mask),val,ust) = ex.Editor.onEdit dp e val mask ust
= (Ok (change,mask),OBJECT val,ust)
onRefresh dp (OBJECT new) (OBJECT old) mask vst=:{VSt|mode,selectedConsIndex=curSelectedConsIndex}
| gtd_num_conses > 1 && (mode =:Enter || mode =: Update)
= case ex.Editor.onRefresh dp new old mask {vst & selectedConsIndex = 0} of
(Ok (change,mask),val,vst=:{VSt|selectedConsIndex})
| selectedConsIndex < 0 //A cons was changed
# selectedCons = ~selectedConsIndex - 1
# consChange = ChangeUI [SetAttribute "value" (JSONArray [toJSON selectedCons,JSONBool True])] []
| allConsesArityZero gtd_conses
= (Ok (consChange,mask),OBJECT val,{vst & selectedConsIndex = curSelectedConsIndex})
| otherwise
= (Ok (ChangeUI [] [(0,ChangeChild consChange),(1,ChangeChild change)],mask),OBJECT val,{vst & selectedConsIndex = curSelectedConsIndex})
| otherwise
= (Ok (change,mask),OBJECT val,{vst & selectedConsIndex = curSelectedConsIndex})
(Error e,val,vst) = (Error e,OBJECT val,vst)
| otherwise
# (change,val,vst) = ex.Editor.onRefresh dp new old mask vst
= (change,OBJECT val,vst)
allConsesArityZero [] = True
allConsesArityZero [{gcd_arity}:cs]
| gcd_arity > 0 = False
= allConsesArityZero cs
gEditor{|EITHER|} ex _ dx _ _ ey _ dy _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
gEditor{|EITHER|} ex _ dx _ _ ey _ dy _ _ = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (LEFT x) vst = ex.Editor.genUI dp x vst
genUI dp (RIGHT y) vst = ey.Editor.genUI dp y vst
updUI dp (LEFT old) om (LEFT new) nm vst = ex.Editor.updUI dp old om new nm vst
updUI dp (RIGHT old) om (RIGHT new) nm vst = ey.Editor.updUI dp old om new nm vst
//A different constructor is selected -> generate a new UI
//We use a negative selConsIndex to encode that the constructor was changed
updUI dp (LEFT old) om (RIGHT new) nm vst
= case ey.Editor.genUI dp new vst of
(Ok (ui,mask),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui), {vst & selectedConsIndex = -1 - selectedConsIndex})
(Error e,vst=:{selectedConsIndex}) = (Error e,{vst & selectedConsIndex = -1 - selectedConsIndex})
updUI dp (RIGHT old) om (LEFT new) nm vst
= case ex.Editor.genUI dp new vst of
(Ok (ui,mask),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui), {vst & selectedConsIndex = -1 - selectedConsIndex})
(Error e,vst=:{selectedConsIndex}) = (Error e,{vst & selectedConsIndex = -1 - selectedConsIndex})
onEdit [d:ds] e either mask ust
| d == -1 = case ds of
[] = (Ok (NoChange,newFieldMask),LEFT dx,ust)
......@@ -184,19 +172,32 @@ where
# (mask,y,ust) = ey.Editor.onEdit [d:ds] e y mask ust
= (mask,RIGHT y,ust)
gEditor{|CONS of {gcd_index,gcd_arity}|} ex _ _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
onRefresh dp (LEFT new) (LEFT old) mask vst
# (change,val,vst) = ex.Editor.onRefresh dp new old mask vst
= (change,LEFT val,vst)
onRefresh dp (RIGHT new) (RIGHT old) mask vst
# (change,val,vst) = ey.Editor.onRefresh dp new old mask vst
= (change,RIGHT val,vst)
//A different constructor is selected -> generate a new UI
//We use a negative selConsIndex to encode that the constructor was changed
onRefresh dp (RIGHT new) (LEFT old) mask vst
= case ey.Editor.genUI dp new vst of
(Ok (ui,mask),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui,mask),RIGHT new,{vst & selectedConsIndex = -1 - selectedConsIndex})
(Error e,vst=:{selectedConsIndex}) = (Error e,LEFT old,{vst & selectedConsIndex = -1 - selectedConsIndex})
onRefresh dp (LEFT new) (RIGHT old) mask vst
= case ex.Editor.genUI dp new vst of
(Ok (ui,mask),vst=:{selectedConsIndex}) = (Ok (ReplaceUI ui,mask),LEFT new,{vst & selectedConsIndex = -1 - selectedConsIndex})
(Error e,vst=:{selectedConsIndex}) = (Error e,RIGHT old,{vst & selectedConsIndex = -1 - selectedConsIndex})
gEditor{|CONS of {gcd_index,gcd_arity}|} ex _ _ _ _ = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
where
genUI dp (CONS x) vst = case ex.Editor.genUI (pairPath gcd_arity dp) x vst of
(Ok viz,vst) = (Ok (flattenUIPairs UICons gcd_arity viz), {VSt| vst & selectedConsIndex = gcd_index})
(Error e,vst) = (Error e,{VSt| vst & selectedConsIndex = gcd_index})
updUI dp (CONS old) om (CONS new) nm vst
//Diff all fields of the constructor
# (diff,vst) = ex.Editor.updUI (pairPath gcd_arity dp) old (toPairMask gcd_arity om) new (toPairMask gcd_arity nm) vst
//Flatten the binary tree of ChangeUI constructors created from
//the PAIR's into a single ChangeUI constructor
= (fmap (flattenPairDiff 0 gcd_arity) diff,vst)
onEdit [d:ds] e (CONS val) mask ust
| d >= gcd_arity
= (Ok (NoChange,mask),CONS val,ust)
......@@ -205,7 +206,14 @@ where
= (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}
onRefresh dp (CONS new) (CONS old) mask vst
//Diff all fields of the constructor
# (change,val,vst) = ex.Editor.onRefresh (pairPath gcd_arity dp) new old (toPairMask gcd_arity mask) vst
//Flatten the binary tree of ChangeUI constructors created from
//the PAIR's into a single ChangeUI constructor
= (fmap (flattenPairDiff 0 gcd_arity) change,CONS val,vst)
gEditor{|PAIR|} ex _ _ _ _ ey _ _ _ _ = {Editor|genUI=genUI,onRefresh=onRefresh,onEdit=onEdit}
where
genUI dp (PAIR x y) vst
# (dpx,dpy) = pairPathSplit dp
......@@ -216,21 +224,6 @@ where
# ((vizx,maskx),(vizy,masky)) = (fromOk vizx,fromOk vizy)
= (Ok (uic UIPair [vizx,vizy],CompoundMask [maskx,masky]),vst)
updUI dp (PAIR oldx oldy) om (PAIR newx newy) nm vst
# (dpx,dpy) = pairPathSplit dp
# (oxmask,oymask) = case om of
CompoundMask [xmask,ymask] = (xmask,ymask)
_ = (newFieldMask,newFieldMask)
# (nxmask,nymask) = case nm of
CompoundMask [xmask,ymask] = (xmask,ymask)
_ = (newFieldMask,newFieldMask)
# (diffx,vst) = ex.Editor.updUI dpx oldx oxmask newx nxmask vst