--- /dev/null
+implementation module EditorExt
+
+from Data.Func import $
+import Data.Tuple
+import qualified Data.Map as DM
+import StdTuple
+import Data.Maybe
+
+import iTasks
+import iTasks.UI.Editor.Common
+
+row :: String (Editor a) -> Editor a
+row l e = bijectEditorValue (tuple l) snd $
+ container2 label e <<@ directionAttr Horizontal
+
+import StdDebug, StdMisc
+
+// Choose combinators (Used for selecting constructors in ADTs)
+choose :: [(String, Editor a)] -> Editor (Int, a)
+choose [] = emptyEditor
+choose [(k,v)] = bijectEditorValue snd (tuple 0) $ row k v
+choose cs = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
+where
+ numConses = length cs
+ conses = map fst cs
+
+ genUI dp (consindex, value) vst=:{VSt|taskId,mode,optional,selectedConsIndex}
+ # cured = snd (cs !! consindex)
+ = case mode of
+ Enter
+ # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses Nothing
+ = (Ok (UI UIVarCons 'DM'.newMap [consChooseUI],CompoundMask {fields=[consChooseMask],state=JSONNull}),{vst & selectedConsIndex = selectedConsIndex})
+ Update
+ = case cured.Editor.genUI dp value vst of
+ (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+ # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses (Just vst.selectedConsIndex)
+ = (Ok (UI UIVarCons attr [consChooseUI:items],CompoundMask {fields=[consChooseMask:fields],state=JSONNull})
+ ,{vst & selectedConsIndex = selectedConsIndex})
+ (Error e,vst) = (Error e,vst)
+ View
+ = case cured.Editor.genUI dp value vst of
+ (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
+ # (consViewUI,consViewMask) = genConsViewUI conses vst.selectedConsIndex
+ = (Ok (UI UIVarCons attr [consViewUI:items],CompoundMask {fields=[consViewMask:fields],state=JSONNull})
+ ,{vst & selectedConsIndex = selectedConsIndex})
+ (Error e,vst) = (Error e,vst)
+
+ genConsChooseUI taskId dp optional gtd_conses mbSelectedCons = (consChooseUI,consChooseMask)
+ where
+ consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc)] \\ gdc <- gtd_conses & i <- [0..]]
+ consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) (maybeToList mbSelectedCons) consOptions)
+ consChooseMask = FieldMask {touched=False,valid=optional || isJust mbSelectedCons,state=maybe JSONNull JSONInt mbSelectedCons}
+
+ genConsViewUI gtd_conses selectedCons
+ = (uia UITextView (valueAttr (JSONString (gtd_conses !! selectedCons))), newFieldMask)
+
+ //Update is a constructor switch
+ onEdit dp ([],JSONArray [JSONInt consIdx]) (i, val) (CompoundMask {fields=[FieldMask {FieldMask|touched,valid,state}:masks]}) vst//=:{VSt|mode}
+ | not (trace_tn ("cons switch from " +++ toString i +++ " to " +++ toString consIdx)) = undef
+ # cured = snd (cs !! consIdx)
+ | consIdx < 0 || consIdx >= numConses
+ = (Error "Constructor selection out of bounds", (i, val),vst)
+ //Create a default value for the selected constructor
+ //This is a rather ugly trick: We create a special target path that consists only of negative values that is
+ //decoded by the the onEdit instance of EITHER to create a value that consists of the correct nesting of LEFT's and RIGHT's
+ // //TODO hier zit de bug
+ # (_,val,vst) = cured.Editor.onEdit dp (consCreatePath consIdx numConses,JSONNull) val newCompoundMask vst
+ //Create a UI for the new constructor
+ = case cured.Editor.genUI dp val {vst & mode = Enter} of
+ (Ok (UI _ attr items, CompoundMask {fields=masks}),vst)
+ //Construct a UI change that does the following:
+ //1: If necessary remove the fields of the previously selected constructor
+ # removals = case state of
+// (JSONInt prevConsIdx) = repeatn (length (snd (cs !! prevConsIdx))) (1,RemoveChild)
+// (JSONInt prevConsIdx) = repeatn (length items) (1,RemoveChild)
+ _ = []
+ //2: Inserts the fields of the newly created ui
+ # inserts = [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
+ # change = ChangeUI [] (removals ++ inserts)
+ //Create a new mask for the constructor selection
+ # consChooseMask = FieldMask {touched=True,valid=True,state=JSONInt consIdx}
+ = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}), (consIdx, val), vst)
+ (Error e,vst) = (Error e, (i, val), vst)
+
+ //Other events targeted directly at the ADT
+ onEdit dp ([],e) (i, val) (CompoundMask {fields=[consChooseMask=:(FieldMask {FieldMask|touched,valid,state}):masks]}) vst=:{VSt|optional}
+ | e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
+ //If necessary remove the fields of the previously selected constructor
+ # change = case state of
+// (JSONInt prevConsIdx) = ChangeUI [] (repeatn 32 /*(gtd_conses !! prevConsIdx).gcd_arity */(1,RemoveChild))
+ _ = NoChange
+ # consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
+ = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}),(i, val), vst)
+ = (Error "Unknown constructor select event ",(i, val),vst)
+
+ //Update is targeted somewhere inside this value
+ onEdit dp (tp,e) (i, val) mask=:(CompoundMask {fields,state}) vst
+ # cured = snd (cs !! i)
+ //Adjust for the added constructor switch UI
+ # consChooseMask = hd fields
+ = case cured.Editor.onEdit dp (tp,e) val (CompoundMask {fields=tl fields,state=JSONNull}) vst of
+ (Ok (change,CompoundMask {fields}),val,vst)
+ # change = case change of
+ (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
+ _ = NoChange
+ = (Ok (change,CompoundMask {fields=[consChooseMask:fields],state=JSONNull}),(i, val),vst)
+ (Error e,val,vst) = (Error e, (i, val), vst)
+
+ consCreatePath i n
+ | i >= n = []
+ | n == 1 = []
+ | i < (n /2) = [ -1: consCreatePath i (n/2) ]
+ | otherwise = [ -2: consCreatePath (i - (n/2)) (n - (n/2)) ]
+
+ onRefresh dp (i, new) (j, old) mask=:(CompoundMask {fields}) vst=:{VSt|mode,taskId,optional,selectedConsIndex=curSelectedConsIndex}
+ # cured = snd (cs !! i)
+ | numConses == 1
+ # (change,val,vst) = cured.Editor.onRefresh dp new old mask vst
+ = (change,(j, val),vst)
+ | otherwise
+ //Adjust for the added constructor view/choose UI
+ # consChooseMask = hd fields
+ //Don't recursively refresh if no constructor has been chosen
+ | (not mode =: View) && consChooseMask =: (FieldMask {FieldMask|state=JSONNull})
+ = (Ok (NoChange,mask),(i, old),vst)
+ = case cured.Editor.onRefresh dp new old (CompoundMask {fields=tl fields,state=JSONNull}) {vst & selectedConsIndex = 0} of
+ (Ok (change,CompoundMask {fields}),val,vst=:{VSt|selectedConsIndex})
+ //If the cons was changed we need to update the selector
+ # consIndex = ~selectedConsIndex - 1
+ # consChange = if (selectedConsIndex < 0)
+ [(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt consIndex,JSONBool True])] []))]
+ []
+ //Adjust the changes
+ # change = case change of
+ NoChange = if (consChange =: []) NoChange (ChangeUI [] consChange)
+ (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges (consChange ++ [(i + 1,c) \\ (i,c) <- itemChanges])
+ (ReplaceUI ui=:(UI type attr items))
+ //Add the constructor selection/view ui
+ # (consUI,_) = if (mode =: View)
+ (genConsViewUI conses consIndex)
+ (genConsChooseUI taskId dp optional conses (Just consIndex))
+ = ReplaceUI (UI type attr [consUI:items])
+ | otherwise
+ = (Ok (change, CompoundMask {fields=[consChooseMask:fields],state=JSONNull}), (j, val),{vst & selectedConsIndex = curSelectedConsIndex})
+
+ (Ok (change,mask),val,vst=:{VSt|selectedConsIndex})
+ = (Error "Corrupt mask in generic choose editor",(i, old), vst)
+ (Error e,val,vst) = (Error e,(i, val),vst)
+ onRefresh dp (i, new) (j, old) mask vst
+ = (Error "Corrupt mask in generic choose editor",(j, old), vst)
repositories / clean-tests.git / blobdiff