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

Examples/Applications/Incidone/Incidone/ContactPosition.dcl

@@ -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

Examples/Applications/Incidone/Incidone/ContactPosition.icl

@@ -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)

Examples/Applications/Incidone/Incidone/OP/ContactManagementTasks.icl

@@ -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

Examples/Applications/ShipAdventure/C2/Framework/ContactPosition.icl

@@ -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}

Examples/GIS/LeafletMapExample.icl

@@ -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

Libraries/iTasks/Extensions/GIS/Leaflet.dcl

@@ -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
-

Libraries/iTasks/Extensions/GIS/LeafletNavalIcons.icl

@@ -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)

Libraries/iTasks/Extensions/GIS/WebPublic/leaflet-1.1.0/leaflet.css → Libraries/iTasks/Extensions/GIS/WebPublic/leaflet-1.3.4/leaflet.css

@@ -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,

Libraries/iTasks/Extensions/GIS/WebPublic/leaflet-window.js

 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 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);
+            // 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);
         L.DomEvent.on(document, 'mouseup', this._mouseUp, this);
         L.DomEvent.on(document, 'mousemove', this._mouseMove, this);
 
@@ -73,8 +144,7 @@ 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}));
+        map.eachLayer((l) => this._onLayerAdd({layer: l}));
     },
     _onLayerAdd: function(e) {
         const marker = e.layer;
@@ -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();
         }
     },

Libraries/iTasks/Extensions/SVG/SVGEditor.icl

@@ -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)

Libraries/iTasks/Internal/TaskState.icl

@@ -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

Libraries/iTasks/Internal/TaskStore.icl

 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

Libraries/iTasks/Internal/Tonic.icl

@@ -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

Libraries/iTasks/Internal/Tonic/Pretty.icl

 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
 

Libraries/iTasks/UI/Editor/Common.dcl

@@ -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.
@@ -49,12 +56,13 @@ emptyEditorWithErrorInEnterMode_ :: !(Bool a -> [JSONNode]) !(Bool [JSONNode] ->
 * and m the length of the new children list). The complexity however decreases with
 * more similar old and new lists and is O(n) for equal lists.
 *
-* @param: Old:   The previous child list.
-* @param: New:   The new child list.
-* @param: To UI: A function to map children to UIs.
-* @return        A list of index/change pairs as expected by 'iTasks.UI.Definition.ChangeUI'.
+* @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

Libraries/iTasks/UI/Editor/Common.icl

@@ -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]]
-        | otherwise
-            # (change, old`) = moveFromOldOrInsert (inc idx) old
-            = [change : diffChildren` (inc 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)
-            // 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]
+    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