Commit 353e64db authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'master' into 259-editors-need-refinement

parents 47e4f146 bbe0706e
......@@ -71,7 +71,7 @@ toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
fromLeafletMap :: ContactMap LeafletMap -> ContactMap
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
selectionFromLeafletMap :: LeafletMap -> [String]
selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
//Standard layers available to use in all map views
standardPerspective :: Shared ContactMapPerspective
......
......@@ -215,8 +215,9 @@ where
fromLeafletLayer cl ll = cl
*/
selectionFromLeafletMap :: LeafletMap -> [String]
selectionFromLeafletMap {LeafletMap|objects} = [markerId \\ Marker {LeafletMarker|markerId,selected} <- objects | selected]
selectionFromLeafletMap :: LeafletMap -> [LeafletObjectID]
selectionFromLeafletMap {LeafletMap|objects} =
[markerId \\ Marker {LeafletMarker|markerId,selected} <- objects | selected]
fromLeafletLatLng :: !LeafletLatLng -> (!Real,!Real)
fromLeafletLatLng {LeafletLatLng|lat,lng} = (lat,lng)
......
......@@ -605,7 +605,7 @@ where
isSelected _ _ = False
updateSelection [] = Nothing
updateSelection [markerId:ms]
updateSelection [LeafletObjectID markerId:ms]
| startsWith "c" markerId = Just (Left (toInt (subString 1 (textSize markerId) markerId)))
| startsWith "a" markerId = Just (Right (toInt (subString 1 (textSize markerId) markerId)))
= updateSelection ms
......
......@@ -117,9 +117,9 @@ toLeafletMap {ContactMap|perspective,markers}
where
convMarkers markers = [conv m \\ m=:{ContactMapMarker|position} <- markers]
conv {ContactMapMarker|markerId,title,position,heading,type,selected}
= Marker {LeafletMarker|markerId = markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> iconIndex heading t selected) type, selected = selected, popup = Nothing}
= Marker {LeafletMarker|markerId = LeafletObjectID markerId, title = title, position = toLeafletLatLng position, icon = fmap (\t -> LeafletIconID (iconIndex heading t selected)) type, selected = selected, popup = Nothing}
icon i = {LeafletIcon|iconId=toString i,iconUrl ="/ship-icons/"+++toString i+++".png",iconSize=(24,24)}
icon i = {LeafletIcon|iconId=LeafletIconID (toString i),iconUrl ="/ship-icons/"+++toString i+++".png",iconSize=(24,24)}
iconIndex heading type selected = toString (cat type + ( (maybe 24 (\d -> toInt d / 15) heading) + (if selected 25 0)) * 5)
toLeafletPerspective :: ContactMapPerspective -> LeafletPerspective
......@@ -139,7 +139,7 @@ fromLeafletMap {LeafletMap|perspective,objects}
where
toMarkers objects
= [{ContactMapMarker|markerId=markerId,title=Nothing,position = fromLeafletLatLng position, type=Nothing,heading=Nothing,selected=selected}
\\ Marker {LeafletMarker|markerId,position,selected} <- objects]
\\ Marker {LeafletMarker|markerId = LeafletObjectID markerId,position,selected} <- objects]
fromLeafletPerspective :: LeafletPerspective -> ContactMapPerspective
fromLeafletPerspective {LeafletPerspective|center,cursor,zoom}
......
......@@ -43,7 +43,7 @@ where
>>- \marker -> upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [marker]}) m
toRandomMarker (rLat,rLng)
= Marker {markerId = markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, selected = False, popup = Nothing}
= Marker {markerId = LeafletObjectID markerId, position= {LeafletLatLng|lat = lat, lng = lng}, title = Just markerId, icon = Just icon, selected = False, popup = Nothing}
where
lat = 52.0 + (toReal (500 + (rLat rem 1000)) / 1000.0)
lng = 6.0 + (toReal (500 + (rLng rem 1000)) / 1000.0)
......@@ -53,7 +53,7 @@ where
addMarkerConnectingLine m
= upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [line objects]}) m
where
line objects = Polyline { polylineId = "markerConnection"
line objects = Polyline { polylineId = LeafletObjectID "markerConnection"
, style = [Style (LineStrokeColor "#f0f"), Style (LineStrokeWidth 4)]
, points = points objects
}
......@@ -62,7 +62,7 @@ where
addMarkerConnectingPolygon m
= upd (\l=:{LeafletMap|objects} -> {LeafletMap|l & objects = objects ++ [polygon objects]}) m
where
polygon objects = Polygon { polygonId = "markerConnection"
polygon objects = Polygon { polygonId = LeafletObjectID "markerConnection"
, style = [ Style (PolygonLineStrokeColor "#000")
, Style (PolygonLineStrokeWidth 2)
, Style (PolygonFillColor "#0f0")
......@@ -75,6 +75,6 @@ where
= upd (\l=:{LeafletMap|perspective={LeafletPerspective|cursor},objects} -> {LeafletMap|l & objects = withMarkerFromCursor cursor objects}) m
where
withMarkerFromCursor Nothing objects = objects
withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = "CURSOR", position= position, title = Nothing, icon = Nothing, selected = False, popup = Nothing}]
withMarkerFromCursor (Just position) objects = objects ++ [Marker {markerId = LeafletObjectID "CURSOR", position= position, title = Nothing, icon = Nothing, selected = False, popup = Nothing}]
Start world = doTasks playWithMaps world
......@@ -5,24 +5,24 @@ import iTasks
leafletEditor :: Editor LeafletMap
:: LeafletMap =
{ perspective :: LeafletPerspective
, tilesUrls :: [String]
, objects :: [LeafletObject] //Markers, lines and polygon
, icons :: [LeafletIcon] //Custom icons used by markers. They are indexed by 'iconId' string and cannot be changed once the map is loaded
{ perspective :: !LeafletPerspective
, tilesUrls :: ![String]
, objects :: ![LeafletObject] //Markers, lines and polygon
, icons :: ![LeafletIcon] //Custom icons used by markers. They are indexed by 'iconId' string and cannot be changed once the map is loaded
}
:: LeafletPerspective =
{ center :: LeafletLatLng
, zoom :: Int
, cursor :: Maybe LeafletLatLng
, bounds :: Maybe LeafletBounds
{ center :: !LeafletLatLng
, zoom :: !Int
, cursor :: !Maybe LeafletLatLng
, bounds :: !Maybe LeafletBounds
}
:: LeafletIconID :== String
:: LeafletIconID =: LeafletIconID String
:: LeafletIcon =
{ iconId :: LeafletIconID
, iconUrl :: String
, iconSize :: (!Int,!Int)
{ iconId :: !LeafletIconID
, iconUrl :: !String
, iconSize :: !(!Int,!Int)
}
:: LeafletLatLng =
......@@ -41,7 +41,7 @@ leafletEditor :: Editor LeafletMap
| Polygon !LeafletPolygon
| Window !LeafletWindow
:: LeafletObjectID :== String
:: LeafletObjectID =: LeafletObjectID String
:: LeafletMarker =
{ markerId :: !LeafletObjectID
, position :: !LeafletLatLng
......@@ -68,7 +68,7 @@ leafletEditor :: Editor LeafletMap
, initPosition :: !LeafletWindowPos
, title :: !String
, content :: !HtmlTag
, relatedMarkers :: ![(LeafletObjectID, [LeafletStyleDef LeafletLineStyle])] // connecting lines are drawn between the window and the markers
, relatedMarkers :: ![(!LeafletObjectID, ![LeafletStyleDef LeafletLineStyle])] // connecting lines are drawn between the window and the markers
// to visualise the relation
}
......@@ -85,7 +85,7 @@ leafletEditor :: Editor LeafletMap
| PolygonFillColor !String // html/css color definition
| PolygonFillOpacity !Real
:: CSSClass :== String
:: CSSClass =: CSSClass String
:: LeafletStyleDef style = Style style
| Class CSSClass
......@@ -102,4 +102,3 @@ derive gEq LeafletMap, LeafletPerspective
derive gText LeafletMap, LeafletPerspective, LeafletLatLng
derive gEditor LeafletMap, LeafletPerspective, LeafletLatLng
derive class iTask LeafletIcon, LeafletBounds, LeafletObject, LeafletMarker, LeafletPolyline, LeafletPolygon, LeafletWindow, LeafletWindowPos, LeafletLineStyle, LeafletStyleDef, LeafletPolygonStyle
This diff is collapsed.
......@@ -4,9 +4,9 @@ implementation module iTasks.Extensions.GIS.LeafletNavalIcons
*/
from iTasks.Extensions.GIS.Leaflet import :: LeafletIcon(..), :: LeafletIconID(..)
from StdFunc import o
import StdString, StdInt, StdList, Data.Maybe
import StdString, StdInt, StdList, Data.Maybe, Text
URL iconId :== "/leaflet-naval-icons/" +++ iconId +++ ".png"
URL (LeafletIconID iconId) :== concat ["/leaflet-naval-icons/", iconId, ".png"]
SIZE :== (24,24)
instance toString ShipIconColor
......@@ -29,6 +29,7 @@ where
* Find the right icon based on a heading and color
*/
shipIconId :: (Maybe ShipIconHeading) ShipIconColor Bool -> LeafletIconID
shipIconId mbHeading color selected = toString color +++ if selected "-sel" "" +++ maybe "" toRoundedHeading mbHeading
shipIconId mbHeading color selected =
LeafletIconID (concat [toString color, if selected "-sel" "", maybe "" toRoundedHeading mbHeading])
where
toRoundedHeading h = "-" +++ toString (((h rem 360) / 15) * 15)
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -45,8 +45,10 @@
.leaflet-container .leaflet-marker-pane img,
.leaflet-container .leaflet-shadow-pane img,
.leaflet-container .leaflet-tile-pane img,
.leaflet-container img.leaflet-image-layer {
.leaflet-container img.leaflet-image-layer,
.leaflet-container .leaflet-tile {
max-width: none !important;
max-height: none !important;
}
.leaflet-container.leaflet-touch-zoom {
......@@ -55,7 +57,10 @@
}
.leaflet-container.leaflet-touch-drag {
-ms-touch-action: pinch-zoom;
}
/* Fallback for FF which doesn't support pinch-zoom */
touch-action: none;
touch-action: pinch-zoom;
}
.leaflet-container.leaflet-touch-drag.leaflet-touch-zoom {
-ms-touch-action: none;
touch-action: none;
......@@ -164,7 +169,6 @@
opacity: 0;
-webkit-transition: opacity 0.2s linear;
-moz-transition: opacity 0.2s linear;
-o-transition: opacity 0.2s linear;
transition: opacity 0.2s linear;
}
.leaflet-fade-anim .leaflet-map-pane .leaflet-popup {
......@@ -181,14 +185,12 @@
.leaflet-zoom-anim .leaflet-zoom-animated {
-webkit-transition: -webkit-transform 0.25s cubic-bezier(0,0,0.25,1);
-moz-transition: -moz-transform 0.25s cubic-bezier(0,0,0.25,1);
-o-transition: -o-transform 0.25s cubic-bezier(0,0,0.25,1);
transition: transform 0.25s cubic-bezier(0,0,0.25,1);
}
.leaflet-zoom-anim .leaflet-tile,
.leaflet-pan-anim .leaflet-tile {
-webkit-transition: none;
-moz-transition: none;
-o-transition: none;
transition: none;
}
......@@ -205,6 +207,7 @@
.leaflet-grab {
cursor: -webkit-grab;
cursor: -moz-grab;
cursor: grab;
}
.leaflet-crosshair,
.leaflet-crosshair .leaflet-interactive {
......@@ -220,6 +223,7 @@
cursor: move;
cursor: -webkit-grabbing;
cursor: -moz-grabbing;
cursor: grabbing;
}
/* marker & overlays interactivity */
......@@ -366,6 +370,7 @@
}
.leaflet-control-layers-scrollbar {
overflow-y: scroll;
overflow-x: hidden;
padding-right: 5px;
}
.leaflet-control-layers-selector {
......@@ -489,7 +494,6 @@
-webkit-transform: rotate(45deg);
-moz-transform: rotate(45deg);
-ms-transform: rotate(45deg);
-o-transform: rotate(45deg);
transform: rotate(45deg);
}
.leaflet-popup-content-wrapper,
......
This source diff could not be displayed because it is too large. You can view the blob instead.
This source diff could not be displayed because it is too large. You can view the blob instead.
L.Window = L.Control.extend({
initialize: function (baseLayers, overlays, options) {
this._relatedMarkers = {};
},
options: {
position: 'topleft'
},
......@@ -6,13 +9,71 @@ L.Window = L.Control.extend({
this._initPos = pos;
},
setTitle: function(title) {
this._title = title;
if (this._titleEl) {
this._titleEl.innerHTML = title;
} else {
this._initTitle = title;
}
},
setContent: function(content) {
this._content = content;
if (this._contentNode) {
this._contentNode.innerHTML = content;
} else {
this._initContent = content;
}
},
addRelatedMarker: function(markerId, options) {
if (!this._relatedMarkers) this._relatedMarkers = {};
setRelatedMarkers: function(markers) {
// remove all markers
for (markerId in this._relatedMarkers) {
if (markerId in this._relatedMarkerConnectors) {
this._relatedMarkerConnectors[markerId].polyline.remove();
}
};
this._relatedMarkers = {};
this._relatedMarkerConnectors = {};
markers.forEach((marker) => this.addRelatedMarker(marker));
// this actually creates the connectors
this._map.eachLayer((l) => this._onLayerAdd({layer: l}));
},
addRelatedMarker: function(marker) {
const markerId = marker[0];
const lineStyles = marker[1];
var options = {};
lineStyles.forEach((lineStyle) => {
const lineStyleConstr = lineStyle[0];
const lineStyleConstrArg = lineStyle[1];
switch (lineStyleConstr) {
case "Style":
const lineStyleAttr = lineStyleConstrArg[0];
const lineStyleAttrVal = lineStyleConstrArg[1];
switch (lineStyleAttr) {
case "LineStrokeColor":
options.color = lineStyleAttrVal;
break;
case "LineStrokeWidth":
options.weight = lineStyleAttrVal;
break;
case "LineOpacity":
options.opacity = lineStyleAttrVal;
break;
case "LineDashArray":
options.dashArray = lineStyleAttrVal;
break;
default:
throw new Error("Unknown line style attribute: " + lineStyleAttr);
}
break;
case "Class":
options.className = lineStyleConstrArg;
break;
default:
throw new Error("Unknown line style constructor: " + lineStyleConstr);
}
});
this._relatedMarkers[markerId] = options;
},
......@@ -29,11 +90,14 @@ L.Window = L.Control.extend({
L.DomEvent.on(closeButton, 'mouseup', this._onCloseButtonClick, this);
const titleSpan = L.DomUtil.create('span', '', titleBar);
titleSpan.innerHTML = this._title;
titleSpan.innerHTML = this._initTitle;
delete this._initTitle;
this._titleEl = titleSpan;
// add content container
this._contentNode = L.DomUtil.create('div', '', container);
this._contentNode.innerHTML = this._content;
this._contentNode.innerHTML = this._initContent;
delete this._initContent;
// absolute -> otherwise windows influence each other if multiple are present
container.style = "margin: 0px; position: absolute;";
......@@ -44,14 +108,21 @@ L.Window = L.Control.extend({
L.DomEvent.on(container, 'contextmenu', L.DomEvent.stopPropagation);
this.dragging = false;
L.DomEvent.on(titleBar, 'mousedown', function(e) {
// store current size of map container & title bar
// required to prevent title var from being dragged out of view
const mapContainerSize = this._map.getSize();
this._mapContainerWidth = mapContainerSize.x;
this._mapContainerHeight = mapContainerSize.y;
this._titleBarWidth = titleBar.offsetWidth;
this._titleBarHeight = titleBar.offsetHeight;
// store delta between left upper corner of window and mouse position
const containerRect = this._container.getBoundingClientRect();
this.dragging = [e.clientX - containerRect.left, e.clientY - containerRect.top];
L.DomUtil.disableTextSelection();
this._container.style.opacity = 0.6;
L.DomUtil.toFront(container);
},
this);
}, this);
L.DomEvent.on(document, 'mouseup', this._mouseUp, this);
L.DomEvent.on(document, 'mousemove', this._mouseMove, this);
......@@ -73,7 +144,6 @@ L.Window = L.Control.extend({
// this is done after adding the window,
// as we need the content's size
// to position the connectors properly
if (this._relatedMarkers)
map.eachLayer((l) => this._onLayerAdd({layer: l}));
},
_onLayerAdd: function(e) {
......@@ -109,11 +179,14 @@ L.Window = L.Control.extend({
this._container.style.opacity = 1.0;
},
_mouseMove: function(e) {
var dragging = this.dragging;
const dragging = this.dragging;
if (dragging) {
const mapPos = this._map.mouseEventToContainerPoint(e);
// delta (stored in 'dragging') to compensate for where inside title bar drag was started
this._setPos({x: mapPos.x - dragging[0], y: mapPos.y - dragging[1]});
// restrict position such that title bar is never dragged outside of map container
const x = Math.min(this._mapContainerWidth - this._titleBarWidth, Math.max(0, mapPos.x - dragging[0]));
const y = Math.min(this._mapContainerHeight - this._titleBarHeight, Math.max(0, mapPos.y - dragging[1]));
this._setPos({x: x, y: y});
this._updateRelatedMarkerConnectorPositions();
}
},
......
......@@ -2,12 +2,13 @@ implementation module iTasks.Extensions.SVG.SVGEditor
import Graphics.Scalable.Internal.Image`
import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.JS.Encoding
import StdArray, StdBool, StdEnum, StdInt, StdMisc, StdReal, StdTuple
from StdFunc import o
import StdEnv
import Data.List, Data.GenEq, Data.Func
import Data.Error
import Data.MapCollection
from Data.Foldable import class Foldable (foldr`)
import qualified Data.Foldable as DF
from Data.Map import :: Map, instance Functor (Map k)
from Data.Set import :: Set, instance == (Set a), instance < (Set a), instance Foldable Set
import qualified Data.Map as DM
......@@ -267,7 +268,7 @@ where
, ("y", "-10000")
]
#! world = foldl (\world args -> snd ((elem `setAttribute` args) world)) world fontAttrs
#! (ws, world) = foldr` (calcTextLength elem) ('DM'.newMap, world) strs
#! (ws, world) = 'DF'.foldr` (calcTextLength elem) ('DM'.newMap, world) strs
= ('DM'.alter (merge ws) fontdef text_spans, world)
where
merge :: !(Map String TextSpan) !(Maybe (Map String TextSpan)) -> Maybe (Map String TextSpan)
......
......@@ -15,9 +15,6 @@ import Data.Error, Data.Either
derive JSONEncode TIMeta, TIValue, TIReduct, TaskTree, ParallelTaskState, ParallelTaskChange, TaskResult, TaskEvalInfo, TonicOpts, CircularStack
derive JSONDecode TIMeta, TIValue, TIReduct, TaskTree, ParallelTaskState, ParallelTaskChange, TaskResult, TaskEvalInfo, TonicOpts, CircularStack
derive JSONEncode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
derive JSONDecode LUI, LUIChanges, LUIEffects, LUIEffectStage, LUINo, Set
instance toString DeferredJSON where
toString (DeferredJSON x) = toString $ toJSON x
toString (DeferredJSONNode json) = toString json
......
implementation module iTasks.Internal.TaskStore
import StdOverloaded, StdBool, StdArray, StdTuple, StdString
from StdFunc import const, id, o
import Data.Maybe, Data.Either, Text, System.Time, Math.Random, Text.GenJSON, Data.Func, Data.Tuple, Data.List, Data.Error, System.FilePath, Data.Functor
import StdEnv
import Data.Maybe, Data.Either, Text, System.Time, Math.Random, Text.GenJSON, Data.Func, Data.Tuple, Data.List, Data.Error, System.FilePath, Data.Functor, Data.Set.GenJSON
import iTasks.Engine
import iTasks.Internal.IWorld, iTasks.Internal.TaskState, iTasks.Internal.Task, iTasks.Internal.Store
......@@ -32,10 +31,10 @@ import Data.GenEq
//Derives required for storage of UI definitions
derive JSONEncode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange, TIUIState
derive JSONEncode Queue, Event, Set
derive JSONEncode Queue, Event
derive JSONDecode TaskOutputMessage, TaskResult, TaskEvalInfo, TIValue, ParallelTaskState, ParallelTaskChange, TIUIState
derive JSONDecode Queue, Event, Set
derive JSONDecode Queue, Event
derive gDefault TIMeta
derive gEq ParallelTaskChange, TaskOutputMessage
......
......@@ -239,8 +239,6 @@ derive class iTask StaticDisplaySettings, DynamicDisplaySettings,
derive gEditor Set
derive gText Set
derive gDefault Set
derive JSONEncode Set
derive JSONDecode Set
//-----------------------------------------------------------------------------
// REST
......
implementation module iTasks.Internal.Tonic.Pretty
import StdArray
import StdBool
import StdClass
import StdOverloaded
import StdString
import StdEnv
import Data.List
import iTasks.Internal.Tonic.AbsSyn
......
......@@ -3,7 +3,7 @@ definition module iTasks.UI.Editor.Common
* This module provides some convenient editors
*/
from iTasks.UI.Editor import :: Editor
from iTasks.UI.Definition import :: UI, :: UIChildChange
from iTasks.UI.Definition import :: UI, :: UIChildChange, :: UIChange
from Data.Maybe import :: Maybe
from Text.GenJSON import generic JSONEncode, :: JSONNode, generic JSONDecode
import iTasks.Internal.Generic.Defaults
......@@ -41,6 +41,13 @@ emptyEditorWithErrorInEnterMode :: !String -> Editor a | JSONEncode{|*|}, JSONDe
emptyEditorWithErrorInEnterMode_ :: !(Bool a -> [JSONNode]) !(Bool [JSONNode] -> (!Maybe a, ![JSONNode])) !String
-> Editor a
/**
* Indicates if and how a UI child can be updated to another one.
*/
:: ChildUpdate = ChildUpdateImpossible //* the child a cannot be update
| NoChildUpdateRequired //* no update is required, i.e. the child already equals the existing one
| ChildUpdate !UIChange //* the child has to be changed
/**
* Determines the diff between an old and a new list of children,
* consisting of insert, remove and move change instructions.
......@@ -51,10 +58,11 @@ emptyEditorWithErrorInEnterMode_ :: !(Bool a -> [JSONNode]) !(Bool [JSONNode] ->
*
* @param: Old: The previous child list.
* @param: New: The new child list.
* @param UpdateFromOldToNew: If and how an old value can be updated to a new one.
* @param: To UI: A function to map children to UIs.
* @return A list of index/change pairs as expected by 'iTasks.UI.Definition.ChangeUI'.
*/
diffChildren :: ![a] ![a] !(a -> UI) -> [(!Int, !UIChildChange)] | gEq{|*|} a
diffChildren :: ![a] ![a] !(a a -> ChildUpdate) !(a -> UI) -> [(!Int, !UIChildChange)]
/**
* Simple dropdown that edits an index by choosing from a list of labels
......
......@@ -46,32 +46,40 @@ where
onRefresh _ val _ vst = (Ok (NoChange, val),vst) // just use new value
valueFromState val = Just val
diffChildren :: ![a] ![a] !(a -> UI) -> [(!Int, !UIChildChange)] | gEq{|*|} a
diffChildren old new toUI = diffChildren` 0 old new
diffChildren :: ![a] ![a] !(a a -> ChildUpdate) !(a -> UI) -> [(!Int, !UIChildChange)]
diffChildren old new updateFromOldToNew toUI = diffChildren` (length old - 1) (reverse old) (reverse new)
where
// only children from old list are left -> remove them all
diffChildren` idx old [] = removeRemaining idx old
diffChildren` _ old [] = removeRemaining old
// only new children are left -> insert them all
diffChildren` idx [] new = addNew idx new
diffChildren` idx [nextOld : old] [nextNew : new]
// children are equal -> no change required
| nextOld === nextNew = diffChildren` (inc idx) old new
// old item cannot be reused, as it does not occur in remaining new children -> remove it
| not (isMemberGen nextOld new) = [(idx, RemoveChild) : diffChildren` idx old [nextNew : new]]
diffChildren` _ [] new = addNew new
diffChildren` idx [nextOld : old] [nextNew : new] = case updateFromOldToNew nextOld nextNew of
ChildUpdateImpossible
| isEmpty $ filter (\n -> not $ (updateFromOldToNew nextOld n) =: ChildUpdateImpossible) new
// old item cannot be reused, as no remaining new item can be updated to it -> remove it
= [(idx, RemoveChild) : diffChildren` (dec idx) old [nextNew : new]]
| otherwise
# (change, old`) = moveFromOldOrInsert (inc idx) old
= [change : diffChildren` (inc idx) [nextOld : old`] new]
# (change, idx, old`) = moveFromOldOrInsert (dec idx) old
= change ++ diffChildren` idx [nextOld : old`] new
where
// next new child not found in old children list -> insert it
moveFromOldOrInsert _ [] = ((idx, InsertChild (toUI nextNew)), [])
moveFromOldOrInsert idxOld [nextOld : oldRest]
// next new child found in old children list -> reuse it, i.e. move it to new index
| nextNew === nextOld = ((idxOld, MoveChild idx), oldRest)
// no item found which can be updated to next new child -> insert it
moveFromOldOrInsert _ [] = ([(inc idx, InsertChild $ toUI nextNew)], idx, [])
moveFromOldOrInsert idxOld [nextOld : oldRest] = case updateFromOldToNew nextOld nextNew of
// look for child to reuse in remaining old children elements
| otherwise = appSnd (\old` -> [nextOld : old`]) (moveFromOldOrInsert (inc idxOld) oldRest)
removeRemaining idx rem = [(idx, RemoveChild) \\ _ <- rem]
addNew idx new = [(i, InsertChild (toUI x)) \\ i <- [idx..] & x <- new]
ChildUpdateImpossible = appThd3 (\old` -> [nextOld : old`])
(moveFromOldOrInsert (dec idxOld) oldRest)
// move item without change
NoChildUpdateRequired = ([(idxOld, MoveChild idx)], dec idx, oldRest)
// old item which can be updated to next new child found -> reuse it,