old/metaeditor/EditorExt.icl

   1 implementation module EditorExt
   2
   3 from Data.Func import $
   4 import Data.Tuple
   5 import qualified Data.Map as DM
   6 import StdTuple
   7 import Data.Maybe
   8
   9 import iTasks
  10 import iTasks.UI.Editor.Common
  11
  12 row :: String (Editor a) -> Editor a
  13 row l e = bijectEditorValue (tuple l) snd $
  14         container2 label e <<@ directionAttr Horizontal
  15
  16 import StdDebug, StdMisc
  17
  18 // Choose combinators (Used for selecting constructors in ADTs)
  19 choose :: [(String, Editor a)] -> Editor (Int, a)
  20 choose [] = emptyEditor
  21 choose [(k,v)] = bijectEditorValue snd (tuple 0) $ row k v
  22 choose cs = {Editor|genUI=genUI,onEdit=onEdit,onRefresh=onRefresh}
  23 where
  24         numConses = length cs
  25         conses = map fst cs
  26
  27         genUI dp (consindex, value) vst=:{VSt|taskId,mode,optional,selectedConsIndex}
  28                 # cured = snd (cs !! consindex)
  29                 = case mode of
  30                         Enter
  31                                 # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses Nothing
  32                                 = (Ok (UI UIVarCons 'DM'.newMap [consChooseUI],CompoundMask {fields=[consChooseMask],state=JSONNull}),{vst & selectedConsIndex = selectedConsIndex})
  33                         Update
  34                                 = case cured.Editor.genUI dp value vst of
  35                                         (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
  36                                                 # (consChooseUI,consChooseMask) = genConsChooseUI taskId dp optional conses (Just vst.selectedConsIndex)
  37                                                 = (Ok (UI UIVarCons attr [consChooseUI:items],CompoundMask {fields=[consChooseMask:fields],state=JSONNull})
  38                                                         ,{vst & selectedConsIndex = selectedConsIndex})
  39                                         (Error e,vst) = (Error e,vst)
  40                         View
  41                                 = case cured.Editor.genUI dp value vst of
  42                                         (Ok (consUI=:(UI _ attr items), consMask=:(CompoundMask {fields})),vst)
  43                                                 # (consViewUI,consViewMask) = genConsViewUI conses vst.selectedConsIndex
  44                                                 = (Ok (UI UIVarCons attr [consViewUI:items],CompoundMask {fields=[consViewMask:fields],state=JSONNull})
  45                                                         ,{vst & selectedConsIndex = selectedConsIndex})
  46                                         (Error e,vst) = (Error e,vst)
  47
  48         genConsChooseUI taskId dp optional gtd_conses mbSelectedCons = (consChooseUI,consChooseMask)
  49         where
  50                 consOptions = [JSONObject [("id",JSONInt i),("text",JSONString gdc)] \\ gdc <- gtd_conses & i <- [0..]]
  51                 consChooseUI = uia UIDropdown (choiceAttrs taskId (editorId dp) (maybeToList mbSelectedCons) consOptions)
  52                 consChooseMask = FieldMask {touched=False,valid=optional || isJust mbSelectedCons,state=maybe JSONNull JSONInt mbSelectedCons}
  53
  54         genConsViewUI gtd_conses selectedCons
  55                 = (uia UITextView (valueAttr (JSONString (gtd_conses !! selectedCons))), newFieldMask)
  56
  57         //Update is a constructor switch
  58         onEdit dp ([],JSONArray [JSONInt consIdx]) (i, val) (CompoundMask {fields=[FieldMask {FieldMask|touched,valid,state}:masks]}) vst//=:{VSt|mode}
  59                 | not (trace_tn ("cons switch from " +++ toString i +++ " to " +++ toString consIdx)) = undef
  60                 # cured = snd (cs !! consIdx)
  61                 | consIdx < 0 || consIdx >= numConses
  62                         = (Error "Constructor selection out of bounds", (i, val),vst)
  63                 //Create a default value for the selected constructor
  64                 //This is a rather ugly trick: We create a special target path that consists only of negative values that is
  65                 //decoded by the the onEdit instance of EITHER to create a value that consists of the correct nesting of LEFT's and RIGHT's
  66                 //                                                                              //TODO hier zit de bug
  67         # (_,val,vst)   = cured.Editor.onEdit dp (consCreatePath consIdx numConses,JSONNull) val newCompoundMask vst
  68                 //Create a UI for the new constructor
  69                 = case cured.Editor.genUI dp val {vst & mode = Enter} of
  70                         (Ok (UI _ attr items, CompoundMask {fields=masks}),vst)
  71                                 //Construct a UI change that does the following:
  72                                 //1: If necessary remove the fields of the previously selected constructor
  73                                 # removals = case state of
  74 //                                      (JSONInt prevConsIdx) = repeatn (length (snd (cs !! prevConsIdx))) (1,RemoveChild)
  75 //                                      (JSONInt prevConsIdx) = repeatn (length items) (1,RemoveChild)
  76                                         _                 = []
  77                                 //2: Inserts the fields of the newly created ui
  78                                 # inserts = [(i,InsertChild ui) \\ ui <- items & i <- [1..]]
  79                                 # change = ChangeUI [] (removals ++ inserts)
  80                                 //Create a new mask for the constructor selection
  81                                 # consChooseMask = FieldMask {touched=True,valid=True,state=JSONInt consIdx}
  82                                 = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}), (consIdx, val), vst)
  83                         (Error e,vst) = (Error e, (i, val), vst)
  84
  85         //Other events targeted directly at the ADT
  86         onEdit dp ([],e) (i, val) (CompoundMask {fields=[consChooseMask=:(FieldMask {FieldMask|touched,valid,state}):masks]}) vst=:{VSt|optional}
  87                 | e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
  88                         //If necessary remove the fields of the previously selected constructor
  89                         # change = case state of
  90 //                              (JSONInt prevConsIdx) = ChangeUI [] (repeatn 32 /*(gtd_conses !! prevConsIdx).gcd_arity */(1,RemoveChild))
  91                                 _                     = NoChange
  92                         # consChooseMask = FieldMask {touched=True,valid=optional,state=JSONNull}
  93                         = (Ok (change,CompoundMask {fields=[consChooseMask:masks],state=JSONNull}),(i, val), vst)
  94                 = (Error "Unknown constructor select event ",(i, val),vst)
  95
  96         //Update is targeted somewhere inside this value
  97         onEdit dp (tp,e) (i, val) mask=:(CompoundMask {fields,state}) vst
  98                 # cured = snd (cs !! i)
  99                 //Adjust for the added constructor switch UI
 100                 # consChooseMask = hd fields
 101                 = case cured.Editor.onEdit dp (tp,e) val (CompoundMask {fields=tl fields,state=JSONNull}) vst of
 102                         (Ok (change,CompoundMask {fields}),val,vst)
 103                                 # change = case change of
 104                                         (ChangeUI attrChanges itemChanges) = ChangeUI attrChanges [(i + 1,c) \\ (i,c) <- itemChanges]
 105                                         _                                  = NoChange
 106                                 = (Ok (change,CompoundMask {fields=[consChooseMask:fields],state=JSONNull}),(i, val),vst)
 107                         (Error e,val,vst) = (Error e, (i, val), vst)
 108
 109         consCreatePath i n
 110         | i >= n     = []
 111         | n == 1     = []
 112         | i < (n /2) = [ -1: consCreatePath i (n/2) ]
 113         | otherwise  = [ -2: consCreatePath (i - (n/2)) (n - (n/2)) ]
 114
 115         onRefresh dp (i, new) (j, old) mask=:(CompoundMask {fields}) vst=:{VSt|mode,taskId,optional,selectedConsIndex=curSelectedConsIndex}
 116                 # cured = snd (cs !! i)
 117                 | numConses == 1
 118                         # (change,val,vst) = cured.Editor.onRefresh dp new old mask vst
 119                         = (change,(j, val),vst)
 120                 | otherwise
 121                         //Adjust for the added constructor view/choose UI
 122                         # consChooseMask = hd fields
 123                         //Don't recursively refresh if no constructor has been chosen
 124                         | (not mode =: View) && consChooseMask =: (FieldMask {FieldMask|state=JSONNull})
 125                                 = (Ok (NoChange,mask),(i, old),vst)
 126                         = case cured.Editor.onRefresh dp new old (CompoundMask {fields=tl fields,state=JSONNull}) {vst & selectedConsIndex = 0} of
 127                                 (Ok (change,CompoundMask {fields}),val,vst=:{VSt|selectedConsIndex})
 128                                         //If the cons was changed we need to update the selector
 129                                         # consIndex = ~selectedConsIndex - 1
 130                                         # consChange = if (selectedConsIndex < 0)
 131                                                 [(0, ChangeChild (ChangeUI [SetAttribute "value" (JSONArray [JSONInt consIndex,JSONBool True])] []))]
 132                                                 []
 133                                         //Adjust the changes
 134                                         # change = case change of
 135                                                 NoChange                                                     = if (consChange =: []) NoChange (ChangeUI [] consChange)
 136                                                 (ChangeUI attrChanges itemChanges)   = ChangeUI attrChanges (consChange ++ [(i + 1,c) \\ (i,c) <- itemChanges])
 137                                                 (ReplaceUI ui=:(UI type attr items))
 138                                                         //Add the constructor selection/view ui
 139                                                         # (consUI,_) = if (mode =: View)
 140                                                                                                 (genConsViewUI conses consIndex)
 141                                                                                                 (genConsChooseUI taskId dp optional conses (Just consIndex))
 142                                                         = ReplaceUI (UI type attr [consUI:items])
 143                                         | otherwise
 144                                                 = (Ok (change, CompoundMask {fields=[consChooseMask:fields],state=JSONNull}), (j, val),{vst & selectedConsIndex = curSelectedConsIndex})
 145
 146                                 (Ok (change,mask),val,vst=:{VSt|selectedConsIndex})
 147                                         = (Error "Corrupt mask in generic choose editor",(i, old), vst)
 148                                 (Error e,val,vst) = (Error e,(i, val),vst)
 149         onRefresh dp (i, new) (j, old) mask vst
 150                 = (Error "Corrupt mask in generic choose editor",(j, old), vst)