DynamicEditor.icl 27.1 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
Steffen Michels's avatar
Steffen Michels committed
20 21 22 23 24 25 26 27 28 29 30
    }

(<<@@@) 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}
31 32
tunedDynamicConsEditor (ApplyCssClasses classes) cons
	= {cons & uiAttributes = 'Map'.union (classAttr classes) cons.uiAttributes}
Steffen Michels's avatar
Steffen Michels committed
33 34 35 36 37 38 39 40 41 42

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
43
                                    , uiAttributes     = 'Map'.newMap
Steffen Michels's avatar
Steffen Michels committed
44 45 46 47 48 49 50 51 52 53 54
                                    }

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
55
                                , uiAttributes     = 'Map'.newMap
Steffen Michels's avatar
Steffen Michels committed
56 57 58 59 60 61 62 63 64
                                }

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
65
                                       , uiAttributes     = 'Map'.newMap
Steffen Michels's avatar
Steffen Michels committed
66 67 68 69
                                       }

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

toValueDyn :: !(DynamicEditor a) !(DynamicEditorValue a) -> Dynamic | TC a
toValueDyn (DynamicEditor elements) (DynamicEditorValue cid val) = toValue` (cid, val)
Steffen Michels's avatar
Steffen Michels committed
76 77 78 79 80 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
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

150
:: E = E.a: E (Editor (DynamicEditorValue a)) & TC a
Steffen Michels's avatar
Steffen Michels committed
151 152 153 154 155 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
:: 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

189
// Bool element if state indicates whether the type is correct, i.e. the child types are matching
Steffen Michels's avatar
Steffen Michels committed
190
dynamicCompoundEditor
191
	:: !(DynamicEditor a) -> CompoundEditor (Maybe (!DynamicConsId, !ConsType, !Bool)) (DynamicEditorValue a) | TC a
Steffen Michels's avatar
Steffen Michels committed
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
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
209
          -> *(!MaybeErrorString (!UI, !Maybe (!DynamicConsId, !ConsType, !Bool), ![EditState]), !*VSt)
Steffen Michels's avatar
Steffen Michels committed
210 211 212 213
    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
214
                # mbUis = ( \(uis, childSts) -> (uiContainer attr uis, Just (onlyChoice.consId, type, True), [nullState: childSts])
Steffen Michels's avatar
Steffen Michels committed
215 216 217 218 219 220 221 222 223
                          ) <$>
                          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
224
                                = (Ok (uiContainer attr uis, Just (defaultChoice.consId, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
225 226
                            | otherwise
                                # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
227
                                = ( Ok ( uiContainer attr [consChooseUI: uis]
228
                                       , Just (defaultChoice.consId, type, True)
Steffen Michels's avatar
Steffen Michels committed
229 230 231 232 233 234 235
                                       , [chooseSt: childSts]
                                       )
                                  , vst
                                  )
                        Error e = (Error e, vst)
                _
                    # (consChooseUI, chooseSt) = genConsChooseUI taskId dp Nothing
236
                    = (Ok (uiContainer attr [consChooseUI], Nothing, [chooseSt]), vst)
Steffen Michels's avatar
Steffen Michels committed
237 238 239 240 241 242
		Update Undefined = genUI attr dp Enter vst
        Update (DynamicEditorValue cid val)
            # (mbUis, idx, type, label, vst) = genChildEditors dp cid (Update val) vst
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
243
                        = (Ok (uiContainer attr uis, Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
244 245
                    | otherwise
                        # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
246
                        = (Ok (uiContainer attr [consChooseUI: uis], Just (cid, type, True), [chooseSt: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
247 248 249 250 251 252 253
                Error e = (Error e, vst)

        View (DynamicEditorValue cid val)
            # (mbUis, _, type, label, vst) = genChildEditors dp cid (View val) vst
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
254
                        = (Ok (uiContainer attr uis, Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
255 256
                    | otherwise
                        # consChooseUI = uia UITextView $ valueAttr $ JSONString label
257
                        = (Ok (uiContainer attr [consChooseUI: uis], Just (cid, type, True), [nullState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273
                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)
274
              !(Maybe (!DynamicConsId, !ConsType, !Bool))
Steffen Michels's avatar
Steffen Michels committed
275 276
              ![EditState]
              !*VSt
277
           -> *( !MaybeErrorString (!UIChange, !Maybe (!DynamicConsId, !ConsType, !Bool), ![EditState])
Steffen Michels's avatar
Steffen Michels committed
278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
               , !*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
                # change = ChangeUI [] (removals ++ inserts)
                # builderChooseState = LeafState {touched = True, state = JSONInt $ length uis}
293
                = (Ok (change, Just (cons.consId, type, True), [builderChooseState: childSts]), vst)
Steffen Michels's avatar
Steffen Michels committed
294 295
            Error e = (Error e, vst)

296
    // other events targeted directly at this cons
Steffen Michels's avatar
Steffen Michels committed
297 298 299 300
    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
301
            = (Ok (change, Nothing, [nullState]), vst)
Steffen Michels's avatar
Steffen Michels committed
302 303 304 305
        | otherwise
            = (Error $ concat ["Unknown dynamic editor select event: '", toString e, "'"], vst)

    // update is targeted somewhere inside this value    
306
    onEdit dp ([argIdx: tp], e) (Just (cid, type, typeWasCorrect)) childSts vst
Steffen Michels's avatar
Steffen Michels committed
307 308 309 310 311 312 313 314 315
        # (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
316
                = (listBuilderEditor lbuilder cons.uiAttributes).Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
Steffen Michels's avatar
Steffen Michels committed
317 318 319 320
            CustomEditorCons editor
                = editor.Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
        = case res of
            Ok (change, childSt)
321
				# change = ChangeUI [] ([(argIdx + if hideCons 0 1, ChangeChild change)] ++ mbErrorIconChange)
322 323 324
				// replace state for this child
				= (Ok (change, Just (cid, type, isOk typeIsCorrect), childSts`), vst)
			where
325 326 327 328 329 330 331 332 333 334 335 336
				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 = []
337 338
				typeIsCorrect = childTypesAreMatching cons.builder (drop 1 childSts`)
				childSts` = updateAt (argIdx + 1) childSt childSts
Steffen Michels's avatar
Steffen Michels committed
339 340 341 342 343 344 345 346 347
            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)
348
                 !(Maybe (!DynamicConsId, !ConsType, !Bool))
Steffen Michels's avatar
Steffen Michels committed
349 350 351
                 ![EditState]
                 !*VSt
              -> *( !MaybeErrorString ( !UIChange
352
                                      , !Maybe (!DynamicConsId, !ConsType, !Bool)
Steffen Michels's avatar
Steffen Michels committed
353 354 355 356 357 358
                                      , ![EditState]
                                      )
                  , !*VSt
                  )
	// TODO: how to get UI attributes?
	// TODO: fine-grained replacement
359 360 361 362 363 364 365
    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
366 367 368 369 370 371 372 373 374 375 376

    // 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 =
377
                case editor.Editor.genUI cons.uiAttributes (dp ++ [i]) (maybe Enter (if viewMode View Update) mbVal) vst of
Steffen Michels's avatar
Steffen Michels committed
378 379 380 381 382 383 384 385 386 387 388
                    (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
389
            # (mbUi, vst) = (listBuilderEditor lbuilder cons.uiAttributes).Editor.genUI 'Map'.newMap (dp ++ [0]) listEditorMode vst
Steffen Michels's avatar
Steffen Michels committed
390 391 392 393 394
            = ((\(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
395
            # (mbUi, vst) = editor.Editor.genUI cons.uiAttributes (dp ++ [0]) editorMode vst
Steffen Michels's avatar
Steffen Michels committed
396 397 398 399 400 401 402 403 404 405 406 407 408 409 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
            = ((\(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

449 450
    listBuilderEditor :: !Dynamic !UIAttributes -> Editor [(!DynamicConsId, !DEVal)]
    listBuilderEditor (lbuilder :: [a] -> b) attrs = listEditor (Just $ const Nothing) True True Nothing childrenEd`
Steffen Michels's avatar
Steffen Michels committed
451 452 453 454 455 456 457 458
    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
459 460
        childrenEditorList _ = dynamicEditor (DynamicEditor elements) <<@ attrs
    listBuilderEditor _ _ = abort "dynamic editors: invalid list builder value"
Steffen Michels's avatar
Steffen Michels committed
461

462 463
    uiContainer :: !UIAttributes ![UI] -> UI
    uiContainer attr uis = UI UIContainer attr uis
Steffen Michels's avatar
Steffen Michels committed
464

465 466
    valueFromState :: !(Maybe (!DynamicConsId, !ConsType, !Bool)) ![EditState] -> *Maybe (DynamicEditorValue a)
    valueFromState (Just (cid, CustomEditor, True)) [_: [editorSt]] =
Steffen Michels's avatar
Steffen Michels committed
467 468 469 470 471 472 473 474 475
        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"

476
    valueFromState (Just (cid, type, True)) [_: childSts] =
Steffen Michels's avatar
Steffen Michels committed
477 478 479 480 481 482 483 484 485 486 487 488 489 490
        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

491 492 493 494 495 496 497 498 499 500 501 502 503 504
	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 ()
505 506 507
		childTypesAreMatching` cons [Nothing: otherArgs] =
			case cons of
				(cons` :: a -> z) = childTypesAreMatching` (dynamic cons` undef) otherArgs
508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526
		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
	// only function conses can have not matching child types
	childTypesAreMatching _ _ = Ok ()

Steffen Michels's avatar
Steffen Michels committed
527 528 529 530 531 532 533 534 535 536 537 538 539 540 541
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