Commit 26c93e20 authored by Bas Lijnse's avatar Bas Lijnse

Replaced all edit masks by a refactored version that contains information about validity

parent 7d697449
......@@ -42,12 +42,12 @@ enterInformation d _ = enterInformation d [EnterWith id]
updateInformation :: !d ![UpdateOption m m] m -> Task m | toPrompt d & iTask m
updateInformation d [UpdateWith tof fromf:_] m
= interact d null
(\r -> let v = tof m in (m,(v,Touched)))
(\r -> let v = tof m in (m,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk (let nl = fromf l v in (let nv = tof nl in (nl,(nv,m)))) (l,(v,m)))
Nothing
updateInformation d [UpdateUsing tof fromf editor:_] m
= interact d null
(\r -> let v = tof m in (m,(v,Touched)))
(\r -> let v = tof m in (m,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk (let nl = fromf l v in (let nv = tof nl in (nl,(nv,m)))) (l,(v,m)))
(Just editor)
//TODO: THIS OPTIMIZATION IS WRONG!
......@@ -69,10 +69,10 @@ viewInformation d _ m = viewInformation d [ViewWith id] m
updateSharedInformation :: !d ![UpdateOption r w] !(ReadWriteShared r w) -> Task w | toPrompt d & iTask r & iTask w
updateSharedInformation d [UpdateWith tof fromf:_] shared
= interact d (toReadOnly shared)
(\r -> let v = tof r in (fromf r v,(v,Touched)))
(\r -> let v = tof r in (fromf r v,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk
(if rCh //If the share changed, refresh the view
(let nv = tof r in (fromf r nv,(nv,Touched)))
(let nv = tof r in (fromf r nv,(nv,InitMask True)))
(fromf r v,(v,m))
)
(l,(v,m))
......@@ -81,10 +81,10 @@ updateSharedInformation d [UpdateWith tof fromf:_] shared
@> (mapval,shared)
updateSharedInformation d [UpdateUsing tof fromf editor:_] shared
= interact d (toReadOnly shared)
(\r -> let v = tof r in (fromf r v,(v,Touched)))
(\r -> let v = tof r in (fromf r v,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk
(if rCh //If the share changed, refresh the view
(let nv = tof r in (fromf r nv,(nv,Touched)))
(let nv = tof r in (fromf r nv,(nv,InitMask True)))
(fromf r v,(v,m))
)
(l,(v,m))
......@@ -93,14 +93,14 @@ updateSharedInformation d [UpdateUsing tof fromf editor:_] shared
@> (mapval,shared)
updateSharedInformation d [UpdateWithShared tof fromf conflictf:_] shared
= interact d (toReadOnly shared)
(\r -> let v = tof r in (fromf r v,(v,Touched)))
(\r -> let v = tof r in (fromf r v,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk
(if rCh
(if vCh
//Both the share changed and the view changed -> resolve conflict
(let nv = conflictf v (tof r) in (fromf r nv,(nv,Touched)))
(let nv = conflictf v (tof r) in (fromf r nv,(nv,InitMask True)))
//Only the share changed, refresh the view
(let nv = tof r in (fromf r nv,(nv,Touched)))
(let nv = tof r in (fromf r nv,(nv,InitMask True)))
)
(fromf r v,(v,m))
)
......@@ -114,14 +114,14 @@ updateSharedInformation d _ shared
= case dynamic id :: A.a: (a -> a) of
(rtow :: (r^ -> w^))
= interact d (toReadOnly shared)
(\r -> let v = rtow r in (rtow r,(v,Touched)))
(\l r (v,m) rCh vCh vOk -> if vOk (if (rtow r =!= l) (let nv = rtow r in (nv,(nv,Touched))) (v,(v,m))) (l,(v,m)))
(\r -> let v = rtow r in (rtow r,(v,InitMask True)))
(\l r (v,m) rCh vCh vOk -> if vOk (if (rtow r =!= l) (let nv = rtow r in (nv,(nv,InitMask True))) (v,(v,m))) (l,(v,m)))
Nothing
@> (mapval,shared)
_
= interact d (toReadOnly shared)
(\r -> let v = (Display r,defaultValue) in (defaultValue,(v,CompoundMask [Touched,Untouched])))
(\l r ((_,v),(CompoundMask [_,m])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [Touched,m]))))
(\r -> let v = (Display r,defaultValue) in (defaultValue,(v,CompoundMask [InitMask True,InitMask False])))
(\l r ((_,v),(CompoundMask [_,m])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [InitMask True,m]))))
Nothing
@> (mapval,shared)
......@@ -141,18 +141,18 @@ viewSharedInformation d _ shared = viewSharedInformation d [ViewWith id] shared
updateInformationWithShared :: !d ![UpdateOption (r,m) m] !(ReadWriteShared r w) m -> Task m | toPrompt d & iTask r & iTask m
updateInformationWithShared d [UpdateWith tof fromf:_] shared m
= interact d (toReadOnly shared)
(\r -> let v = tof (r,m) in (m,(v,Touched)))
(\l r (v,msk) rCh vCh vOk -> let nl = if vOk (fromf (r,l) v) l in (let v = tof (r,nl) in (nl,(v,Touched))))
(\r -> let v = tof (r,m) in (m,(v,InitMask True)))
(\l r (v,msk) rCh vCh vOk -> let nl = if vOk (fromf (r,l) v) l in (let v = tof (r,nl) in (nl,(v,InitMask True))))
Nothing
updateInformationWithShared d [UpdateUsing tof fromf editor:_] shared m
= interact d (toReadOnly shared)
(\r -> let v = tof (r,m) in (m,(v,Touched)))
(\l r (v,msk) rCh vCh vOk -> let nl = if vOk (fromf (r,l) v) l in (let v = tof (r,nl) in (nl,(v,Touched))))
(\r -> let v = tof (r,m) in (m,(v,InitMask True)))
(\l r (v,msk) rCh vCh vOk -> let nl = if vOk (fromf (r,l) v) l in (let v = tof (r,nl) in (nl,(v,InitMask True))))
(Just editor)
updateInformationWithShared d _ shared m
= interact d (toReadOnly shared)
(\r -> let v = (Display r,m) in (m,(v,CompoundMask [Touched,Untouched])))
(\l r ((_,v),(CompoundMask [_,msk])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [Touched,msk]))))
(\r -> let v = (Display r,m) in (m,(v,CompoundMask [InitMask True,InitMask False])))
(\l r ((_,v),(CompoundMask [_,msk])) rCh vCh vOk -> let nl = if vOk v l in (let nv = (Display r,nl) in (nl,(nv,CompoundMask [InitMask True,msk]))))
Nothing
//Core choice tasks
......@@ -268,7 +268,7 @@ where
initChoiceView :: (ChoiceType o v) [o] (o -> a) (Maybe a) -> (DynamicChoice v,EditMask) | iTask o & iTask v & iTask a
initChoiceView type container target mbSel
= updateChoiceSelection mbSel (map target container) (mkDynChoice type container,Untouched)
= updateChoiceSelection mbSel (map target container) (mkDynChoice type container,InitMask False)
where
mkDynChoice (AutoChoice view) container = mkDynChoice (autoChoiceType view container) container
mkDynChoice (ChooseFromComboBox view) container = DCCombo (ComboChoice [view o \\ o <- container] Nothing)
......@@ -288,7 +288,7 @@ headers _ a = case toJSON a of (JSONObject fields) = map fst fields ; _ = []
//When we don't have an (o -> a) transformation and no view transformation, we don't need to keep
//the choice options in the interact's state (which saves space and time)
initSimpleChoiceView :: [o] (Maybe o) -> (DynamicChoice o, EditMask) | iTask o
initSimpleChoiceView container mbSel = updateChoiceSelection mbSel container (mkDynChoice container,Untouched)
initSimpleChoiceView container mbSel = updateChoiceSelection mbSel container (mkDynChoice container,InitMask False)
where
mkDynChoice l = case headers l defaultValue of
[] = DCCombo (ComboChoice container Nothing)
......@@ -320,11 +320,11 @@ updateSimpleChoiceView container mbSel (view,mask)
= initSimpleChoiceView container mbSel
updateChoiceSelection :: (Maybe a) [a] (DynamicChoice v, EditMask) -> (DynamicChoice v, EditMask) | iTask v & iTask a
updateChoiceSelection Nothing targets (dynChoice,_) = (setSelectionIndex Nothing dynChoice, Untouched)
updateChoiceSelection (Just sel) targets (dynChoice,_) = (setSelectionIndex (findIndex ((===) sel) targets) dynChoice, Touched)
updateChoiceSelection Nothing targets (dynChoice,_) = (setSelectionIndex Nothing dynChoice, InitMask False)
updateChoiceSelection (Just sel) targets (dynChoice,_) = (setSelectionIndex (findIndex ((===) sel) targets) dynChoice, InitMask True)
updateSimpleChoiceSelection :: (Maybe o) (DynamicChoice o, EditMask) -> (DynamicChoice o, EditMask) | iTask o
updateSimpleChoiceSelection mbSel (dynChoice,_) = (setSelectionView mbSel dynChoice, if (isJust mbSel) Touched Untouched)
updateSimpleChoiceSelection mbSel (dynChoice,_) = (setSelectionView mbSel dynChoice, InitMask (isJust mbSel))
choiceRes :: (TaskValue ([a],DynamicChoice v)) -> TaskValue a
choiceRes (Value (targets,view) _) = case selectionFromChoiceView targets view of
......
......@@ -84,9 +84,9 @@ where
(Error e,iworld) = (Error e,iworld)
makeView [ViewWith viewFun] status taskId iworld
= makeEditor (Display (viewFun status),Touched) taskId iworld
= makeEditor (Display (viewFun status),InitMask True) taskId iworld
makeView _ status taskId iworld
= makeEditor (Display (defaultViewFun status),Touched) taskId iworld
= makeEditor (Display (defaultViewFun status),InitMask True) taskId iworld
makeEditor value=:(v,vmask) taskId iworld
# vst = {VSt| selectedConsIndex = -1, optional = False, disabled = False, taskId = toString taskId, iworld = iworld}
......
......@@ -150,7 +150,7 @@ where
Error e = (ExceptionResult e,iworld)
Ok r
# v = toView r
# (l,v,mask) = (r,v,Touched)
# (l,v,mask) = (r,v,InitMask True)
= eval event evalOpts (TCInteract2 taskId ts (toJSON l) (toJSON r) mask) iworld
eval event evalOpts (TCInteract2 taskId=:(TaskId instanceNo _) ts encl encr m) iworld=:{current={taskTime}}
......@@ -168,7 +168,7 @@ where
# rChanged = nr =!= r
# vChanged = nts =!= ts
# vValid = isValid (verifyMaskedValue (nv,nm))
# (nl,(nv,nm)) = if rChanged (nr,(toView nr,Touched)) (l,(nv,nm))
# (nl,(nv,nm)) = if rChanged (nr,(toView nr,InitMask True)) (l,(nv,nm))
//Update visualization v
= case visualizeView_ taskId evalOpts mbEditor event (v,m) (nv,nm) desc iworld of
(Ok change,valid,iworld)
......@@ -184,7 +184,7 @@ interactNullEnter desc initFun fromf mbEditor = Task eval
where
eval event evalOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# v = initFun
# mask = Untouched
# mask = InitMask False
= eval event evalOpts (TCInteract1 taskId ts (toJSON v) mask) iworld
eval event evalOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encv m) iworld=:{current={taskTime}}
......@@ -215,7 +215,7 @@ where
eval event evalOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# v = tof m
l = m
mask = Touched
mask = InitMask True
= eval event evalOpts (TCInteract1 taskId ts (toJSON l) mask) iworld
eval event evalOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encl m) iworld=:{current={taskTime}}
......@@ -242,7 +242,7 @@ where
| ok
# nl = fromf l v
# nv = tof nl
= (l,(nv,Touched))
= (l,(nv,InitMask True))
= (l,(v,m))
interactNullView :: !d (l->v) (Maybe (Editor v)) l -> Task l | toPrompt d & iTask l & iTask v
......@@ -251,7 +251,7 @@ where
eval event evalOpts (TCInit taskId=:(TaskId instanceNo _) ts) iworld
# l = m
v = Display (tof l)
mask = Touched
mask = InitMask True
= eval event evalOpts (TCInteract1 taskId ts (toJSON l) mask) iworld
eval event evalOpts (TCInteract1 taskId=:(TaskId instanceNo _) ts encl m) iworld=:{current={taskTime}}
......
......@@ -120,7 +120,7 @@ matchAndApplyEvent_ _ matchId evalOpts mbEditor taskTime (v,m) ts desc iworld
updateValueAndMask_ :: TaskId DataPath (Maybe (Editor v)) JSONNode (Masked v) *IWorld -> *(!Masked v,*IWorld) | iTask v
updateValueAndMask_ taskId path mbEditor diff (v,m) iworld
# editor = fromMaybe gEditor{|*|} mbEditor
# (nv,nm,ust=:{USt|iworld}) = editor.Editor.onEdit path diff v m {USt|taskId=toString taskId,iworld=iworld}
# (nv,nm,ust=:{USt|iworld}) = editor.Editor.onEdit path diff v m {USt|taskId=toString taskId,optional=False,iworld=iworld}
= ((nv,nm),iworld)
visualizeView_ :: TaskId TaskEvalOpts (Maybe (Editor v)) Event (Masked v) (Masked v) d *IWorld -> *(!MaybeErrorString UIChange,!Bool,!*IWorld) | iTask v & toPrompt d
......
......@@ -613,9 +613,11 @@ where
updUI dp old om new nm vst=:{VSt|optional}
= (Ok (if (old === new) NoChange (ChangeUI [SetAttribute "value" (encodeUI new):stdAttributeChanges typeDesc optional om nm] [])),vst)
onEdit dp e val mask ust = case fromJSON e of
Nothing = ({Document|documentId = "", contentUrl = "", name="", mime="", size = 0},Blanked,ust)// Reset
Just doc = (doc,Touched,ust) //Update
onEdit dp e val mask ust=:{USt|optional} = case fromJSON e of
Nothing = ({Document|documentId = "", contentUrl = "", name="", mime="", size = 0}
,FieldMask {touched=True,valid=optional,state=JSONNull}
,ust)// Reset
Just doc = (doc,FieldMask {touched=True,valid=True,state=e},ust) //Update
gVerify{|Document|} mv options = simpleVerify mv options
......@@ -959,12 +961,12 @@ gText{|TreeChoice|} fv _ _ = [""]
gEditor{|TreeChoice|} _ gx _ _ _ = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
where
genUI dp val mask vst=:{VSt|taskId,disabled}
# attr = choiceAttrs taskId (editorId dp) (value val) (options gx val mask)
# attr = choiceAttrs taskId (editorId dp) (value val) (options gx val)
= (Ok (uia UITree attr),vst)
value (TreeChoice _ mbSel) = maybe [] (\s->[s]) mbSel
options vizLabel (TreeChoice nodes _) msk = map toJSON (fst (mkTree vizLabel nodes 0))
options vizLabel (TreeChoice nodes _) = map toJSON (fst (mkTree vizLabel nodes 0))
where
mkTree vizLabel [] idx = ([],idx)
mkTree vizLabel [{ChoiceTree|label,icon,type}:r] idx
......@@ -980,10 +982,10 @@ where
= ([{UITreeNode|text=concat (vizLabel AsSingleLine (Just label)),iconCls=fmap (\i ->"icon-"+++i) icon,value=idx,leaf=isNothing children
,expanded = expanded, children=children}:rtree],idx`)
options _ _ _ = []
options _ _ = []
updUI dp old om new nm vst
| options gx old Untouched === options gx new Untouched && value old === value new
| options gx old === options gx new && value old === value new
= (Ok NoChange,vst)
# (nviz,vst) = genUI dp new nm vst
= (fmap ReplaceUI nviz,vst)
......@@ -1151,11 +1153,8 @@ where
getSelections (CheckMultiChoice options sels) = fmap snd (getListOptions options sels)
getSelectionViews (CheckMultiChoice options sels) = fmap fst (getListOptions options sels)
// Utility functions for Choice and MultiChoice instances
touch (TouchedUnparsed r) = TouchedUnparsed r
touch (TouchedWithState s) = TouchedWithState s
touch (CompoundMask c) = CompoundMask c
touch _ = Touched
touch (FieldMask fmask) = FieldMask {FieldMask|fmask & touched =True}
touch mask = mask
setTreeExpanded :: Int Bool [ChoiceTree a] -> [ChoiceTree a]
setTreeExpanded idx expanded tree = snd (expand idx tree)
......
......@@ -78,7 +78,7 @@ updUI _ (AnalogClock t1) _ (AnalogClock t2) _ vst = case ( (if (t1.Time.sec ==
onEdit :: DataPath JSONNode AnalogClock EditMask *USt -> *(!AnalogClock,!EditMask,!*USt)
onEdit [] diff t m ust = case fromJSON diff of
Just diffs = (app diffs t,Touched,ust)
Just diffs = (app diffs t,FieldMask {touched=True,valid=True,state=JSONNull},ust)
Nothing = (t,m,ust)
where
app [] t = t
......
......@@ -29,17 +29,13 @@ from Text.JSON import :: JSONNode
* During editing, values can be in an inconsistent, or even untypable state
*/
:: EditMask
= Untouched //The value has not been touched by the user
| Touched //The value has been touched by the user, now it makes sense to check the input
| TouchedUnparsed !JSONNode //The user has edited the value to something that cannot be parsed to a valid value
| TouchedWithState !JSONNode //Some components need to keep local state that can't be encoded in the value
| Blanked //The value was previously touched, but has been made blank again
| FieldMask !FieldMask
| CompoundMask ![EditMask] //The value is a compound structure of which some parts are, and some aren't touched
= InitMask !Bool
| FieldMask !FieldMask
| CompoundMask ![EditMask]
:: FieldMask =
{ touched :: !Bool
, version :: !Int
//, version :: !Int
, valid :: !Bool
, state :: !JSONNode
}
......@@ -48,11 +44,23 @@ from Text.JSON import :: JSONNode
derive JSONEncode EditMask, FieldMask
derive JSONDecode EditMask, FieldMask
derive gEq EditMask, FieldMask
subMasks :: !Int EditMask -> [EditMask]
toPairMask :: !Int !EditMask -> EditMask
isTouched :: !EditMask -> Bool
containsInvalidFields :: !EditMask -> Bool
//Utility functions making specializations of gEditor
checkMask :: !EditMask a -> Maybe a
checkMaskValue :: !EditMask a -> Maybe JSONNode | JSONEncode{|*|} a
stdAttributes :: String Bool EditMask -> UIAttributes
stdAttributeChanges :: String Bool EditMask EditMask -> [UIAttributeChange]
:: *VSt =
{ selectedConsIndex :: !Int // Index of the selected constructor in an Object
, optional :: !Bool // Create optional form fields
......@@ -62,7 +70,8 @@ isTouched :: !EditMask -> Bool
}
:: *USt =
{ taskId :: !String
{ optional :: !Bool
, taskId :: !String
, iworld :: !*IWorld
}
......
......@@ -8,6 +8,7 @@ import qualified Data.Map as DM
derive JSONEncode EditMask, FieldMask
derive JSONDecode EditMask, FieldMask
derive gEq EditMask, FieldMask
emptyEditor :: Editor a
emptyEditor = {Editor|genUI=genUI,updUI=updUI,onEdit=onEdit}
......@@ -21,17 +22,14 @@ subMasks n (CompoundMask ms) = ms
subMasks n m = repeatn n m
isTouched :: !EditMask -> Bool
isTouched Touched = True
isTouched (TouchedUnparsed _) = True
isTouched (TouchedWithState _) = True
isTouched Blanked = True
isTouched (CompoundMask ms) = isTouched` ms
where
isTouched` [] = False
isTouched` [m:ms]
| isTouched m = True
| otherwise = isTouched` ms
isTouched _ = False
isTouched (InitMask update) = update
isTouched (FieldMask {FieldMask|touched}) = touched
isTouched (CompoundMask ms) = or (map isTouched ms)
containsInvalidFields :: !EditMask -> Bool
containsInvalidFields (InitMask _) = False
containsInvalidFields (FieldMask {FieldMask|valid}) = not valid
containsInvalidFields (CompoundMask ms) = or (map containsInvalidFields ms)
toPairMask :: !Int !EditMask -> EditMask
toPairMask len mask = split len (subMasks len mask)
......@@ -43,6 +41,43 @@ where
middle = n / 2
(left,right) = splitAt middle masks
checkMask :: !EditMask a -> Maybe a
checkMask mask val
| isTouched mask = Just val
= Nothing
checkMaskValue :: !EditMask a -> Maybe JSONNode | JSONEncode{|*|} a
checkMaskValue (FieldMask {FieldMask|touched,state}) _ = if touched (Just state) Nothing
checkMaskValue _ _ = Nothing
/**
* Set basic hint and error information based on the verification
*/
stdAttributes :: String Bool EditMask -> UIAttributes
stdAttributes typename optional (CompoundMask _) = 'DM'.newMap
stdAttributes typename optional mask
# (touched,valid,state) = case mask of
(FieldMask {FieldMask|touched,valid,state}) = (touched,valid,state)
(InitMask update) = (update,update,JSONNull)
| not touched || (state =:JSONNull && optional)
= 'DM'.fromList [(HINT_TYPE_ATTRIBUTE,JSONString HINT_TYPE_INFO)
,(HINT_ATTRIBUTE,JSONString ("Please enter a " +++ typename +++ if optional "" " (this value is required)"))]
| valid
= 'DM'.fromList [(HINT_TYPE_ATTRIBUTE,JSONString HINT_TYPE_VALID)
,(HINT_ATTRIBUTE,JSONString ("You have correctly entered a " +++ typename))]
| state =: JSONNull
= 'DM'.fromList [(HINT_TYPE_ATTRIBUTE,JSONString HINT_TYPE_INVALID)
,(HINT_ATTRIBUTE,JSONString ("You need to enter a "+++ typename +++ " (this value is required)"))]
| otherwise
= 'DM'.fromList [(HINT_TYPE_ATTRIBUTE,JSONString HINT_TYPE_INVALID)
,(HINT_ATTRIBUTE,JSONString ("This value not in the required format of a " +++ typename))]
stdAttributeChanges :: String Bool EditMask EditMask -> [UIAttributeChange]
stdAttributeChanges typename optional om nm
| om === nm = [] //Nothing to change
| otherwise = [SetAttribute k v \\ (k,v) <- 'DM'.toList (stdAttributes typename optional nm)]
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}
where
......
......@@ -3,8 +3,6 @@ implementation module iTasks.UI.Editor.Builtin
import iTasks.UI.Definition, iTasks.UI.Editor
import qualified Data.Map as DM
import StdMisc
textField :: Editor String
textField = simpleComponent UIEditString
......@@ -30,9 +28,10 @@ where
| checkMaskValue om ov === checkMaskValue nm nv = (Ok NoChange,vst)
| otherwise = (Ok (ChangeUI [SetAttribute "value" (toJSON nv)] []),vst)
onEdit dp e val mask ust
onEdit dp e val mask ust=:{USt|optional}
= case e of
JSONNull = (val,Blanked,ust)
JSONNull = (val,FieldMask {touched=True,valid=optional,state=JSONNull},ust)
json = case fromJSON e of
Nothing = (val,TouchedUnparsed e,ust)
Just val = (val,Touched,ust)
Nothing = (val,FieldMask {touched=True,valid=False,state=e},ust)
Just val = (val,FieldMask {touched=True,valid=True,state=e},ust)
......@@ -59,7 +59,7 @@ where
"mdn" = if reorder (swap items (index+1),swap childMasks (index+1)) (items,childMasks)
"rem" = if remove (removeAt index items,removeAt index childMasks) (items,childMasks)
"add" = case add of
(Just f) = (insertAt (length items) (f items) items, insertAt (length items) Touched childMasks)
(Just f) = (insertAt (length items) (f items) items, insertAt (length items) (InitMask True) childMasks)
_ = (items,childMasks)
_
= (items,childMasks)
......
......@@ -11,7 +11,6 @@ import StdArray
generic gEditor a | gText a, gDefault a, JSONEncode a, JSONDecode a :: Editor a
derive bimap Editor,(,,),(,,,)
derive gEq EditMask, FieldMask
gEditor{|UNIT|} = emptyEditor
......@@ -37,8 +36,8 @@ where
onEdit [] e (RECORD record) mask ust //Enabling or disabling of a record
# mask = case e of
JSONBool False = Blanked
_ = Touched
JSONBool False = InitMask False
_ = mask
= (RECORD record,mask,ust)
onEdit [d:ds] e (RECORD record) mask ust
......@@ -73,8 +72,7 @@ where
= case ex.Editor.genUI dp x mask {VSt|vst & optional=False} of
(Ok items, vst=:{selectedConsIndex})
# choice = case mask of
Untouched = []
Blanked = []
(FieldMask {FieldMask|state=JSONNull}) = []
_ = [selectedConsIndex]
| allConsesArityZero gtd_conses //If all constructors have arity 0, we only need the constructor dropwdown
= (Ok (consDropdown choice), {vst & selectedConsIndex = curSelectedConsIndex})
......@@ -121,8 +119,8 @@ where
JSONInt i = i
_ = 0
# mask = case e of
JSONNull = Blanked //Reset
_ = CompoundMask (repeatn (gtd_conses !! consIdx).gcd_arity Untouched)
JSONNull = InitMask False //Reset
_ = CompoundMask (repeatn (gtd_conses !! consIdx).gcd_arity (InitMask False))
# (val,_,ust) = ex.Editor.onEdit (updConsPath (if (consIdx < gtd_num_conses) consIdx 0) gtd_num_conses) e val mask ust
= (OBJECT val, mask, ust)
onEdit dp e (OBJECT val) mask ust //Update is targeted somewhere in a substructure of this value
......@@ -154,14 +152,14 @@ where
onEdit [d:ds] e either mask ust
| d == -1 = case ds of
[] = (LEFT dx, Untouched, ust)
[] = (LEFT dx, InitMask False, ust)
_
# (x,mask,ust) = ex.Editor.onEdit ds e dx Untouched ust
# (x,mask,ust) = ex.Editor.onEdit ds e dx (InitMask False) ust
= (LEFT x, mask, ust)
| d == -2 = case ds of
[] = (RIGHT dy, Untouched, ust)
[] = (RIGHT dy, InitMask False, ust)
_
# (y,mask,ust) = ey.Editor.onEdit ds e dy Untouched ust
# (y,mask,ust) = ey.Editor.onEdit ds e dy (InitMask False) ust
= (RIGHT y, mask, ust)
| otherwise
= case either of
......@@ -198,7 +196,7 @@ where
genUI dp (PAIR x y) mask vst
# (xmask,ymask) = case mask of
CompoundMask [xmask,ymask] = (xmask,ymask)
_ = (Untouched,Untouched)
_ = (InitMask False,InitMask False)
# (dpx,dpy) = pairPathSplit dp
# (vizx, vst) = ex.Editor.genUI dpx x xmask vst
| vizx =: (Error _)
......@@ -215,10 +213,10 @@ where
# (dpx,dpy) = pairPathSplit dp
# (oxmask,oymask) = case om of
CompoundMask [xmask,ymask] = (xmask,ymask)
_ = (Untouched,Untouched)
_ = (InitMask False,InitMask False)
# (nxmask,nymask) = case nm of
CompoundMask [xmask,ymask] = (xmask,ymask)
_ = (Untouched,Untouched)
_ = (InitMask False,InitMask False)
# (diffx,vst) = ex.Editor.updUI dpx oldx oxmask newx nxmask vst
| diffx =: (Error _) = (diffx,vst)
# (diffy,vst) = ey.Editor.updUI dpy oldy oymask newy nymask vst
......@@ -240,28 +238,31 @@ where
genUI dp val mask vst=:{VSt|optional,disabled}
# (viz,vst) = case val of
(Just x) = ex.Editor.genUI dp x mask {VSt|vst & optional = True}
_ = ex.Editor.genUI dp dx Untouched {VSt|vst & optional = True}