DynamicEditor.icl 28.3 KB
Newer Older
1
implementation module iTasks.Extensions.Editors.DynamicEditor
Steffen Michels's avatar
Steffen Michels committed
2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18

import StdEnv => qualified foldl
import StdMisc, Data.Tuple, Text, Data.Maybe, Text.GenPrint
from StdFunc import seq, flip
from Data.Tuple import appFst
import iTasks, iTasks.UI.Definition, iTasks.UI.Editor.Common, iTasks.UI.Editor.Modifiers
import qualified Data.Map as Map
from Data.Func import $
from Data.List import zip3, intersperse
import Data.Functor

:: DynamicCons =
    { consId           :: !DynamicConsId
    , label            :: !String
    , builder          :: !DynamicConsBuilder
    , showIfOnlyChoice :: !Bool
    , useAsDefault     :: !Bool
19
    , uiAttributes     :: !UIAttributes
20
    , labels           :: ![Maybe String]
Steffen Michels's avatar
Steffen Michels committed
21 22 23 24 25 26 27 28 29 30 31
    }

(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
(<<@@@) cons opt = tunedDynamicConsEditor opt cons

(@@@>>) infixr 2 :: !DynamicConsOption !DynamicCons -> DynamicCons
(@@@>>) opt cons = cons <<@@@ opt

tunedDynamicConsEditor :: !DynamicConsOption !DynamicCons -> DynamicCons
tunedDynamicConsEditor HideIfOnlyChoice cons = {cons & showIfOnlyChoice = False}
tunedDynamicConsEditor UseAsDefault     cons = {cons & useAsDefault = True}
32 33 34
tunedDynamicConsEditor (ApplyCssClasses classes) cons =
	{cons & uiAttributes = 'Map'.union (classAttr classes) cons.uiAttributes}
tunedDynamicConsEditor (AddLabels labels) cons = {cons & labels = labels}
Steffen Michels's avatar
Steffen Michels committed
35 36 37 38 39 40 41 42 43 44

functionCons :: !String !String !a -> DynamicCons | TC a
functionCons consId label func = functionConsDyn consId label (dynamic func)

functionConsDyn :: !String !String !Dynamic -> DynamicCons
functionConsDyn consId label func = { consId           = consId
                                    , label            = label
                                    , builder          = FunctionCons func
                                    , showIfOnlyChoice = True
                                    , useAsDefault     = False
45
                                    , uiAttributes     = 'Map'.newMap
46
                                    , labels           = []
Steffen Michels's avatar
Steffen Michels committed
47 48 49 50 51 52 53 54 55 56 57
                                    }

listCons :: !String !String !([a] -> b) -> DynamicCons | TC a & TC b
listCons consId label func = listConsDyn consId label (dynamic func)

listConsDyn :: !String !String !Dynamic -> DynamicCons
listConsDyn consId label func = { consId           = consId
                                , label            = label
                                , builder          = ListCons func
                                , showIfOnlyChoice = True
                                , useAsDefault     = False
58
                                , uiAttributes     = 'Map'.newMap
59
                                , labels           = []
Steffen Michels's avatar
Steffen Michels committed
60 61 62 63 64 65 66 67 68
                                }

customEditorCons :: !String !String !(Editor a) -> DynamicCons
                  | TC, JSONEncode{|*|}, JSONDecode{|*|}, gText{|*|} a
customEditorCons consId label editor = { consId           = consId
                                       , label            = label
                                       , builder          = CustomEditorCons editor
                                       , showIfOnlyChoice = True
                                       , useAsDefault     = False
69
                                       , uiAttributes     = 'Map'.newMap
70
                                       , labels           = []
Steffen Michels's avatar
Steffen Michels committed
71 72 73 74
                                       }

// TODO: don't use aborts here
toValue :: !(DynamicEditor a) !(DynamicEditorValue a) -> a | TC a
75
toValue  dynEditor dynEditorValue = case toValueDyn dynEditor dynEditorValue of
Steffen Michels's avatar
Steffen Michels committed
76 77
    (v :: a^) = v
    _         = abort "corrupt dynamic editor value"
78 79 80

toValueDyn :: !(DynamicEditor a) !(DynamicEditorValue a) -> Dynamic | TC a
toValueDyn (DynamicEditor elements) (DynamicEditorValue cid val) = toValue` (cid, val)
Steffen Michels's avatar
Steffen Michels committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154
where
    toValue` :: !(!DynamicConsId, !DEVal) -> Dynamic
    toValue` (cid, val) = case val of
        DEApplication args = case cons.builder of
            FunctionCons fbuilder = toValueFunc fbuilder args
            ListCons     lbuilder = toValueList lbuilder args
            _                     = abort "corrupt dynamic editor value"
        DEJSONValue json = case cons.builder of
            CustomEditorCons editor = toValueGen editor json
            _                       = abort "corrupt dynamic editor value"
    where
        (cons, _) = consWithId cid $ consesOf elements

    toValueFunc :: !Dynamic ![(!DynamicConsId, !DEVal)] -> Dynamic
    toValueFunc v [] = v
    toValueFunc f [x : xs] = case (f, toValue` x) of
        (f :: a -> b, x :: a) = toValueFunc (dynamic (f x)) xs
        _                     = abort "corrupt dynamic editor value"

    toValueGen :: (Editor a) !JSONNode -> Dynamic | JSONDecode{|*|}, TC a
    toValueGen editor json = dynamic (fromJSON` editor json)
    where
        fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
        fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json

    toValueList :: !Dynamic ![(!DynamicConsId, !DEVal)] -> Dynamic
    toValueList (f :: [a] -> b) [] = dynamic (f [])
    toValueList f args=:[fst : _] = case (f, toValue` fst) of
        (g :: [a] -> b, _ :: a) -> dynamic (g $ fromDynList [toValue` val \\ val <- args])
        _                       -> abort "corrupt dynamic editor value"
    toValueList _ _ = abort "corrupt dynamic editor value"

    fromDynList :: ![Dynamic] -> [a] | TC a
    fromDynList dyns = fromDynList` dyns []
    where
        fromDynList` [] acc = reverse acc
        fromDynList` [(a :: a^) : dyns] acc = fromDynList` dyns [a:acc]
        fromDynList` _ _ = abort "corrupt dynamic editor value"

dynEditorValToString :: !(DynamicEditor a) !(DynamicEditorValue a) -> String
dynEditorValToString (DynamicEditor elements) (DynamicEditorValue cid val) =
	concat $ withCapitalisedFirstLetter $
		dropWhile (\s -> textSize (trim s) == 0) $ reverse [".": dynEditorValToString` (cid, val) []]
where
	withCapitalisedFirstLetter [firstString: rest] = [upperCaseFirst firstString: rest]

    dynEditorValToString` :: !(!DynamicConsId, !DEVal) ![String] -> [String]
    dynEditorValToString` (cid, val) accum = case val of
        DEApplication args = case cons.builder of
            FunctionCons fbuilder = 'StdEnv'.foldl (flip dynEditorValToString`)
                                                   [" ", cons.DynamicCons.label : accum]
                                                   args
            ListCons lbuilder
                # listElStrs = flatten $ intersperse [" ", cons.DynamicCons.label] $
                                                     (\arg -> dynEditorValToString` arg []) <$> reverse args
                = listElStrs ++ [" "] ++ accum
            _ = abort "corrupt dynamic editor value"
        DEJSONValue json = case cons.builder of
            CustomEditorCons editor = [ " ", toStringGen editor json
                                      , " ", cons.DynamicCons.label
                                      : accum
                                      ]
            _ = abort "corrupt dynamic editor value"
    where
        (cons, _) = consWithId cid $ consesOf elements

    toStringGen :: (Editor a) !JSONNode -> String | gText{|*|}, JSONDecode{|*|}  a
    toStringGen editor json = toSingleLineText $ fromJSON` editor json
    where
        fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
        fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json

derive class iTask DynamicEditorValue, DEVal

155
:: E = E.a: E (Editor (DynamicEditorValue a)) & TC a
Steffen Michels's avatar
Steffen Michels committed
156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
:: ConsType = Function | List | CustomEditor

derive JSONEncode ConsType
derive JSONDecode ConsType

parametrisedDynamicEditor
	:: !(p -> DynamicEditor a) -> Editor (!p, !DynamicEditorValue a)
	| TC a & gEq{|*|}, JSONEncode{|*|}, JSONDecode{|*|} p
parametrisedDynamicEditor editor
	= compoundEditorToEditor
		{CompoundEditor| genUI = genUI, onEdit = onEdit, onRefresh = onRefresh, valueFromState = valueFromState}
where
	genUI attr dp mode vst
		= case editModeValue mode of
			Nothing
				= abort "Enter mode not supported by parametrisedDynamicEditor.\n"
			Just (p, _)
				= appFst
					(fmap $ appSnd3 \st -> (p, st))
					((dynamicCompoundEditor $ editor p).CompoundEditor.genUI attr dp (mapEditMode snd mode) vst)

	onEdit dp event (p, mbSt) childSts vst
		= appFst
			(fmap $ appSnd3 \st -> (p, st))
			((dynamicCompoundEditor $ editor p).CompoundEditor.onEdit dp event mbSt childSts vst)

	onRefresh dp (p, new) st=:(p`, mbSt) childSts vst
		= appFst
			(fmap $ appSnd3 \st -> (p, st))
			((dynamicCompoundEditor $ editor p).CompoundEditor.onRefresh dp new mbSt childSts vst)

	valueFromState (p, st) childSts
		= (\val -> (p, val)) <$> (dynamicCompoundEditor $ editor p).CompoundEditor.valueFromState st childSts


dynamicEditor :: !(DynamicEditor a) -> Editor (DynamicEditorValue a) | TC a
dynamicEditor dynEditor = compoundEditorToEditor $ dynamicCompoundEditor dynEditor

194
// Bool element if state indicates whether the type is correct, i.e. the child types are matching
Steffen Michels's avatar
Steffen Michels committed
195
dynamicCompoundEditor
196
	:: !(DynamicEditor a) -> CompoundEditor (Maybe (!DynamicConsId, !ConsType, !Bool)) (DynamicEditorValue a) | TC a
Steffen Michels's avatar
Steffen Michels committed
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213
dynamicCompoundEditor dynEditor=:(DynamicEditor elements)
	| not $ isEmpty duplicateIds
		= abort $ concat ["duplicate cons IDs in dynamic editor: ", printToString duplicateIds, "\n"]
	= {CompoundEditor| genUI = genUI, onEdit = onEdit, onRefresh = onRefresh, valueFromState = valueFromState}
where
    // conses with optional group labels
    conses :: [(!DynamicCons, !Maybe String)]
    conses = consesOf elements

    duplicateIds = duplicateIds` $ (\(b, _) -> b.consId) <$> conses
    where
		duplicateIds` [] = []
		duplicateIds` [x: xs]
			| isMember x xs = [x: duplicateIds` xs]
			| otherwise     = duplicateIds` xs

    genUI :: !UIAttributes !DataPath !(EditMode (DynamicEditorValue a)) !*VSt
214
          -> *(!MaybeErrorString (!UI, !Maybe (!DynamicConsId, !ConsType, !Bool), ![EditState]), !*VSt)
Steffen Michels's avatar
Steffen Michels committed
215 216 217 218
    genUI attr dp mode vst=:{VSt|taskId} = case mode of
        Enter = case matchingConses of
            [(onlyChoice, _)] | hideCons
                # (mbUis, _, type, _, vst) = genChildEditors dp onlyChoice.consId Enter vst
219
                # mbUis = ( \(uis, childSts) -> (uiContainer attr onlyChoice.labels uis, Just (onlyChoice.consId, type, True), [nullState: childSts])
Steffen Michels's avatar
Steffen Michels committed
220 221 222 223 224 225 226 227 228
                          ) <$>
                          mbUis
                = (mbUis, vst)
            _ = case filter (\(cons, _) -> cons.useAsDefault) matchingConses of
                [(defaultChoice, _): _]
                    # (mbUis, idx, type, label, vst) = genChildEditors dp defaultChoice.consId Enter vst
                    = case mbUis of
                        Ok (uis, childSts)
                            | hideCons
229
                                = (Ok (uiContainer attr defaultChoice.labels uis, Just (defaultChoice.consId, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
230 231
                            | otherwise
                                # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
232
                                = ( Ok ( uiContainer attr [Nothing: defaultChoice.labels] [consChooseUI: uis]
233
                                       , Just (defaultChoice.consId, type, True)
Steffen Michels's avatar
Steffen Michels committed
234 235 236 237 238 239 240
                                       , [chooseSt: childSts]
                                       )
                                  , vst
                                  )
                        Error e = (Error e, vst)
                _
                    # (consChooseUI, chooseSt) = genConsChooseUI taskId dp Nothing
241
                    = (Ok (uiContainer attr [] [consChooseUI], Nothing, [chooseSt]), vst)
Steffen Michels's avatar
Steffen Michels committed
242 243 244
		Update Undefined = genUI attr dp Enter vst
        Update (DynamicEditorValue cid val)
            # (mbUis, idx, type, label, vst) = genChildEditors dp cid (Update val) vst
245
			# (cons, _) = consWithId cid matchingConses
Steffen Michels's avatar
Steffen Michels committed
246 247 248
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
249
                        = (Ok (uiContainer attr cons.labels uis, Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
250 251
                    | otherwise
                        # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
252
                        = (Ok (uiContainer attr [Nothing: cons.labels] [consChooseUI: uis], Just (cid, type, True), [chooseSt: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
253 254 255 256
                Error e = (Error e, vst)

        View (DynamicEditorValue cid val)
            # (mbUis, _, type, label, vst) = genChildEditors dp cid (View val) vst
257
			# (cons, _) = consWithId cid matchingConses
Steffen Michels's avatar
Steffen Michels committed
258 259 260
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
261
                        = (Ok (uiContainer attr cons.labels uis, Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
262 263
                    | otherwise
                        # consChooseUI = uia UITextView $ valueAttr $ JSONString label
264
                        = (Ok (uiContainer attr [Nothing: cons.labels] [consChooseUI: uis], Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
                Error e = (Error e, vst)

    genConsChooseUI taskId dp mbSelectedCons = (consChooseUI, consChooseSt)
    where
        consOptions = [ JSONObject $ [("id",JSONInt i),("text",JSONString cons.DynamicCons.label)] ++
                                     maybe [] (\label -> [("grouplabel", JSONString label)]) mbGroupLabel
                      \\ (cons, mbGroupLabel) <- matchingConses & i <- [0..]
                      ]
        consChooseUI = uia UIDropdown
                           ( 'Map'.put "width" JSONNull $
                             choiceAttrs taskId (editorId dp) (maybe [] (\x -> [x]) mbSelectedCons) consOptions
                           )
        consChooseSt = LeafState {touched=False,state=maybe JSONNull (\x -> JSONInt x) mbSelectedCons}

    onEdit :: !DataPath
              !(!DataPath, !JSONNode)
281
              !(Maybe (!DynamicConsId, !ConsType, !Bool))
Steffen Michels's avatar
Steffen Michels committed
282 283
              ![EditState]
              !*VSt
284
           -> *( !MaybeErrorString (!UIChange, !Maybe (!DynamicConsId, !ConsType, !Bool), ![EditState])
Steffen Michels's avatar
Steffen Michels committed
285 286 287 288 289 290 291 292 293 294 295 296 297
               , !*VSt
               )
    // new builder is selected: create a UI for the new builder
    onEdit dp ([], JSONArray [JSONInt builderIdx]) _ [_: childrenSts] vst
        | builderIdx < 0 || builderIdx >= length matchingConses
            = (Error "Dynamic editor selection out of bounds", vst)
        # (cons, _) = matchingConses !! builderIdx
        # (mbRes, _, type, _, vst) = genChildEditors dp cons.consId Enter vst
        = case mbRes of
            Ok (uis, childSts)
                // insert new UIs for arguments
                # inserts = [(i, InsertChild ui) \\ ui <- uis & i <- [1..]]
                # removals = removeNChildren $ length childrenSts
298 299 300
                // add "itasks-container" classes as this class always has to be present for containers
                # uiAttrs = 'Map'.alter (Just o addContainerClass) "class" cons.uiAttributes
                # change = ChangeUI (uncurry SetAttribute <$> 'Map'.toList uiAttrs) (removals ++ inserts)
Steffen Michels's avatar
Steffen Michels committed
301
                # builderChooseState = LeafState {touched = True, state = JSONInt $ length uis}
302
                = (Ok (change, Just (cons.consId, type, True), [builderChooseState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
303
            Error e = (Error e, vst)
304 305 306 307 308
	where
		addContainerClass :: !(Maybe JSONNode) -> JSONNode
		addContainerClass mbJSONClasses = JSONArray [JSONString "itasks-container": otherClasses]
		where
			otherClasses = maybe [] (\(JSONArray classes) -> classes) mbJSONClasses
Steffen Michels's avatar
Steffen Michels committed
309

310
    // other events targeted directly at this cons
Steffen Michels's avatar
Steffen Michels committed
311 312 313 314
    onEdit dp ([],e) _ [_: childSts] vst
        | 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 cons
            # change = ChangeUI [] $ removeNChildren $ length childSts
315
            = (Ok (change, Nothing, [nullState]), vst)
Steffen Michels's avatar
Steffen Michels committed
316 317 318 319
        | otherwise
            = (Error $ concat ["Unknown dynamic editor select event: '", toString e, "'"], vst)

    // update is targeted somewhere inside this value    
320
    onEdit dp ([argIdx: tp], e) (Just (cid, type, typeWasCorrect)) childSts vst
Steffen Michels's avatar
Steffen Michels committed
321 322 323 324 325 326 327 328 329
        # (cons, _) = consWithId cid matchingConses
        # (res, vst) = case cons.builder of
            FunctionCons fbuilder
                # children = childrenEditors fbuilder
                | argIdx < 0 || argIdx >= length children
                    = (Error "Edit event for dynamic editor has invalid path", vst)
                # (E editor) = children !! argIdx
                = editor.Editor.onEdit (dp ++ [argIdx]) (tp, e) (childSts !! (argIdx + 1)) vst
            ListCons lbuilder
330
                = (listBuilderEditor lbuilder).Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
Steffen Michels's avatar
Steffen Michels committed
331 332 333 334
            CustomEditorCons editor
                = editor.Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
        = case res of
            Ok (change, childSt)
335
				# change = ChangeUI [] ([(argIdx + if hideCons 0 1, ChangeChild change)] ++ mbErrorIconChange)
336 337 338
				// replace state for this child
				= (Ok (change, Just (cid, type, isOk typeIsCorrect), childSts`), vst)
			where
339 340 341 342 343 344 345 346 347 348 349 350
				mbErrorIconChange
					| typeWasCorrect && isError typeIsCorrect =
						[(length childSts, InsertChild errorIcon)]
					with
						errorIcon =
							UI
								UIIcon
								('Map'.union (iconClsAttr "icon-invalid") (tooltipAttr $ fromError typeIsCorrect))
								[]
					| not typeWasCorrect && isOk typeIsCorrect =
						[(length childSts, RemoveChild)]
					| otherwise = []
351 352
				typeIsCorrect = childTypesAreMatching cons.builder (drop 1 childSts`)
				childSts` = updateAt (argIdx + 1) childSt childSts
Steffen Michels's avatar
Steffen Michels committed
353 354 355 356 357 358 359 360 361
            Error e = (Error e, vst)

    onEdit _ _ _ _ vst = (Error "Invalid edit event for dynamic editor.", vst)

    removeNChildren :: !Int -> [(!Int, !UIChildChange)]
    removeNChildren nrArgs = repeatn nrArgs (1, RemoveChild)

    onRefresh :: !DataPath
                 !(DynamicEditorValue a)
362
                 !(Maybe (!DynamicConsId, !ConsType, !Bool))
Steffen Michels's avatar
Steffen Michels committed
363 364 365
                 ![EditState]
                 !*VSt
              -> *( !MaybeErrorString ( !UIChange
366
                                      , !Maybe (!DynamicConsId, !ConsType, !Bool)
Steffen Michels's avatar
Steffen Michels committed
367 368 369 370 371 372
                                      , ![EditState]
                                      )
                  , !*VSt
                  )
	// TODO: how to get UI attributes?
	// TODO: fine-grained replacement
373 374 375 376 377 378 379
    onRefresh dp new st childSts vst
		| isNotChanged (valueFromState st childSts) new = (Ok (NoChange, st, childSts), vst)
		= appFst (fmap $ appFst3 ReplaceUI) $ genUI 'Map'.newMap dp (Update new) vst
	where
		isNotChanged (Just (DynamicEditorValue consId val)) (DynamicEditorValue consId` val`) =
			consId == consId` && val === val`
		isNotChanged _ _ = False
Steffen Michels's avatar
Steffen Michels committed
380 381 382 383 384 385 386 387 388 389 390

    // TODO: accept ID or index
    genChildEditors :: !DataPath !DynamicConsId !(EditMode DEVal) !*VSt
                    -> *(!MaybeErrorString (![UI], ![EditState]), Int, ConsType, String, !*VSt)
    genChildEditors dp cid mode vst= case cons.builder of
        FunctionCons fbuilder
            # (mbUis, vst) = genChildEditors` (reverse $ zip3 vals (childrenEditors fbuilder) [0..]) [] [] vst
            = (mbUis, idx, type, cons.DynamicCons.label, vst)
        where
            genChildEditors` [] accUi accSt vst = (Ok (accUi, accSt), vst)
            genChildEditors` [(mbVal, E editor, i): children] accUi accSt vst =
391
                case editor.Editor.genUI 'Map'.newMap (dp ++ [i]) (maybe Enter (if viewMode View Update) mbVal) vst of
Steffen Michels's avatar
Steffen Michels committed
392 393 394 395 396 397 398 399 400 401 402
                    (Ok (ui, st), vst) = genChildEditors` children [ui: accUi] [st: accSt] vst
                    (Error e,     vst) = (Error e, vst)

            vals :: [Maybe (DynamicEditorValue a)]
            vals = case editModeValue mode of
                // update or view mode
                Just (DEApplication children) = [Just $ DynamicEditorValue cid val \\ (cid, val) <- children]
                // enter mode
                _                             = repeat Nothing
        ListCons lbuilder
            # listEditorMode = mapEditMode (\(DEApplication listElems) -> listElems) mode
403
            # (mbUi, vst) = (listBuilderEditor lbuilder).Editor.genUI 'Map'.newMap (dp ++ [0]) listEditorMode vst
Steffen Michels's avatar
Steffen Michels committed
404 405 406 407 408
            = ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
        CustomEditorCons editor
            # editorMode = mapEditMode
                (\(DEJSONValue json) -> fromMaybe (abort "Invalid dynamic editor state") $ fromJSON json)
                mode
409
            # (mbUi, vst) = editor.Editor.genUI 'Map'.newMap (dp ++ [0]) editorMode vst
Steffen Michels's avatar
Steffen Michels committed
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462
            = ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
    where
        (cons, idx) = consWithId cid matchingConses
        type = case cons.builder of
            FunctionCons     _ = Function
            ListCons         _ = List
            CustomEditorCons _ = CustomEditor
        viewMode = mode =: View _
 
    hideCons = case matchingConses of
        [(onlyChoice, _)] | not onlyChoice.showIfOnlyChoice = True
        _                                                   = False

    matchingConses :: [(!DynamicCons, !Maybe String)]
    matchingConses = catMaybes $
        (\(cons, mbGroupLabel) -> (\cons` -> (cons`, mbGroupLabel)) <$> matchingCons dynEditor cons) <$> conses

    // first arg only used for type
    // packs matching conses, with possibly updated (= more specific) type
    matchingCons :: !(DynamicEditor a) !DynamicCons -> Maybe DynamicCons | TC a
    matchingCons dynEd cons=:{builder} = (\b -> {cons & builder = b}) <$> mbBuilder`
    where
        mbBuilder` = case builder of
            FunctionCons     fbuilder = matchf fbuilder
            CustomEditorCons editor   = matchc editor
            ListCons         lbuilder = matchl lbuilder

        // works for functions with upto 10 args
        // the type of the dynamic is updated by unifying the function result with the type produced by the editor
        matchf :: !Dynamic -> Maybe DynamicConsBuilder
        matchf b = case (b, dynamic dynEd) of
            (b :: a b c d e f g h i j -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g h i   -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g h     -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g       -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f         -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e           -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d             -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c               -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b                 -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a                   -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b ::                        z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            _                                                     = Nothing

        // custom editors do not allow for quantified variables, so no type update is required
        matchc e = case (dynamic e, dynamic dynEd) of
            (_ :: Editor a, _ :: DynamicEditor a) = Just $ CustomEditorCons e
            _                                     = Nothing

        matchl f = case (f, dynamic dynEd) of
            (f :: [a] -> b, _ :: DynamicEditor b) = Just $ ListCons (dynamic f)
            _                                     = Nothing

463 464
    listBuilderEditor :: !Dynamic -> Editor [(!DynamicConsId, !DEVal)]
    listBuilderEditor (lbuilder :: [a] -> b) = listEditor (Just $ const Nothing) True True Nothing childrenEd`
Steffen Michels's avatar
Steffen Michels committed
465 466 467 468 469 470 471 472
    where
        childrenEd  = childrenEditorList lbuilder
        childrenEd` = bijectEditorValue (\(cid, val)                   -> DynamicEditorValue cid val)
                                        (\(DynamicEditorValue cid val) -> (cid, val))
                                        childrenEd

        // first argument only used for type
        childrenEditorList :: ([a] -> b) -> Editor (DynamicEditorValue a) | TC a
473 474
        childrenEditorList _ = dynamicEditor (DynamicEditor elements)
    listBuilderEditor _ = abort "dynamic editors: invalid list builder value"
Steffen Michels's avatar
Steffen Michels committed
475

476 477 478 479 480 481 482
    uiContainer :: !UIAttributes ![Maybe String] ![UI] -> UI
    uiContainer attr labels uis =
		UI UIRecord attr (withLabels <$> zip2 uis (labels ++ repeat Nothing))
	where
		withLabels :: !(!UI, !Maybe String) -> UI
		withLabels (UI type attrs item, Just label) = UI type ('Map'.union attrs $ labelAttr label) item
		withLabels (ui,                 Nothing)    = ui
Steffen Michels's avatar
Steffen Michels committed
483

484 485
    valueFromState :: !(Maybe (!DynamicConsId, !ConsType, !Bool)) ![EditState] -> *Maybe (DynamicEditorValue a)
    valueFromState (Just (cid, CustomEditor, True)) [_: [editorSt]] =
Steffen Michels's avatar
Steffen Michels committed
486 487 488 489 490 491 492 493 494
        mapMaybe (DynamicEditorValue cid o DEJSONValue o toJSON`) $ editor.Editor.valueFromState editorSt
    where
        ({builder}, _) = consWithId cid conses

        // toJSON` is used to solve overloading, JSONEncode{|*|} is attached to CustomEditorCons
        (editor, toJSON`) = case builder of
            CustomEditorCons editor = (editor, toJSON)
            _                       = abort "corrupt dynamic editor state"

495
    valueFromState (Just (cid, type, True)) [_: childSts] =
Steffen Michels's avatar
Steffen Michels committed
496 497 498 499 500 501 502 503 504 505 506 507 508 509
        mapMaybe (\childVals -> DynamicEditorValue cid $ DEApplication childVals) $ childValuesFor childSts` []
    where
        childSts` = case (type, childSts) of
            (List, [CompoundState _ childSts]) = childSts
            (_,    childSts)                   = childSts

        childValuesFor :: ![EditState] ![(!DynamicConsId, !DEVal)]
                       -> Maybe [(!DynamicConsId, !DEVal)]
        childValuesFor [] acc = Just $ reverse acc
        childValuesFor [childSt: childSts] acc = case (dynamicEditor dynEditor).Editor.valueFromState childSt of
            Just (DynamicEditorValue childCid childVal) = childValuesFor childSts [(childCid, childVal): acc]
            _                                           = Nothing
    valueFromState _ _ = Nothing

510 511 512 513 514 515 516 517 518 519 520 521 522 523
	childrenEditors :: !Dynamic -> [E]
	childrenEditors (f :: a -> b) = [E $ dynamicEditorFstArg f : childrenEditors (dynamic (f undef))]
	where
		// first argument only used for type
		dynamicEditorFstArg :: (a -> b) -> Editor (DynamicEditorValue a) | TC a
		dynamicEditorFstArg _ = dynamicEditor $ DynamicEditor elements
	childrenEditors _         = []

	childTypesAreMatching :: !DynamicConsBuilder [EditState] -> MaybeErrorString ()
	childTypesAreMatching (FunctionCons cons) childStates =
		childTypesAreMatching` cons (childValueOf <$> zip2 childStates (childrenEditors cons))
	where
		childTypesAreMatching` :: !Dynamic ![Maybe Dynamic] -> MaybeErrorString ()
		childTypesAreMatching` _ [] = Ok ()
524 525 526
		childTypesAreMatching` cons [Nothing: otherArgs] =
			case cons of
				(cons` :: a -> z) = childTypesAreMatching` (dynamic cons` undef) otherArgs
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542
		childTypesAreMatching` cons [Just nextArg: otherArgs] =
			case (cons, nextArg) of
				// `cons` undef` has type z`, which is z updated by unifying the type of the next arg
				(cons` :: a -> z, _ :: a) = childTypesAreMatching` (dynamic cons` undef) otherArgs
				_                         =
					Error $
						concat
							[ "\"", toString (argOf $ typeCodeOfDynamic cons), "\" and \""
							, toString (typeCodeOfDynamic nextArg), "\" cannot be unified."
							]

		childValueOf :: !(!EditState, !E) -> Maybe Dynamic
		childValueOf (state, E editor) = toValueDyn (DynamicEditor elements) <$> editor.Editor.valueFromState state

		argOf :: !TypeCode -> TypeCode
		argOf (TypeApp (TypeApp _ arg) _) = arg
543
		argOf (TypeScheme _ type)         = argOf type
544 545 546
	// only function conses can have not matching child types
	childTypesAreMatching _ _ = Ok ()

Steffen Michels's avatar
Steffen Michels committed
547 548 549 550 551 552 553 554 555 556 557 558 559 560 561
consWithId :: !DynamicConsId ![(!DynamicCons, !Maybe String)] -> (!DynamicCons, !Int)
consWithId cid conses = case filter (\(({consId}, _), _) -> consId == cid) $ zip2 conses [0..] of
    [((cons, _), idx)] = (cons, idx)
    []                 = abort $ concat ["dynamic editor: cons not found: '",   cid, "'\n"]
    _                  = abort $ concat ["dynamic editor: duplicate conses: '", cid, "'\n"]

nullState :: EditState
nullState = LeafState {touched = True, state = JSONNull}

consesOf :: ![DynamicEditorElement] -> [(!DynamicCons, !Maybe String)]
consesOf elements = flatten $ consesOf <$> elements
where
    consesOf :: !DynamicEditorElement -> [(!DynamicCons, !Maybe String)]
    consesOf (DynamicCons cons)              = [(cons, Nothing)]
    consesOf (DynamicConsGroup label conses) = (\cons -> (cons, Just label)) <$> conses