performance tuning with Html.Lazy

src/elm/Component/FileLoader.elm

@@ -2,6 +2,7 @@ module Component.FileLoader exposing (..)
 
 import Task
 import Html exposing (Html)
+import Html.Lazy as Lazy
 
 import Util.File as File exposing (..)
 import Util.HtmlUtil as HtmlUtil
@@ -36,4 +37,4 @@ update config message =
 
 view : Language -> Html Msg
 view lang =
-  HtmlUtil.fileLoadButton LoadFile S.imageLoadButton (I18n.loadImage lang)
+  Lazy.lazy3 HtmlUtil.fileLoadButton LoadFile S.imageLoadButton (I18n.loadImage lang)

src/elm/Component/FloorProperty.elm

@@ -3,6 +3,7 @@ module Component.FloorProperty exposing(..)
 import Maybe
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Lazy as Lazy
 
 import Util.HtmlUtil exposing (..)
 
@@ -228,9 +229,9 @@ heightValueView user useReal value =
 view : (Msg -> msg) -> Language -> User -> Floor -> FloorProperty -> Html msg -> Html msg -> Html msg -> Html msg -> List (Html msg)
 view transform lang user floor model floorLoadButton publishButton deleteButton deleteDialog =
   [ floorLoadButton
-  , floorNameInputView lang user model |> Html.map transform
-  , floorOrdInputView lang user model |> Html.map transform
-  , floorRealSizeInputView lang user model |> Html.map transform
+  , Lazy.lazy3 floorNameInputView lang user model |> Html.map transform
+  , Lazy.lazy3 floorOrdInputView lang user model |> Html.map transform
+  , Lazy.lazy3 floorRealSizeInputView lang user model |> Html.map transform
   , publishButton
   , deleteButton
   , deleteDialog

src/elm/Component/Header.elm

@@ -4,6 +4,7 @@ module Component.Header exposing (..)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
+import Html.Lazy as Lazy
 
 import Model.Person exposing (..)
 import Model.User as User exposing (..)
@@ -65,7 +66,7 @@ view context state =
       context.printMode
       context.title
       Nothing
-      (menu [ printButtonView context.onTogglePrintView context.lang True ])
+      (menu [ Lazy.lazy3 printButtonView context.onTogglePrintView context.lang True ])
   else
     HeaderView.view
       context.printMode
@@ -84,11 +85,11 @@ normalMenu context menuOpened =
       case context.user of
         Just user ->
           editingToggle context.onToggleEditing context.lang user context.editing ::
-          printButton context.onTogglePrintView context.lang user ::
+          Lazy.lazy3 printButton context.onTogglePrintView context.lang user ::
           ( if user == Guest then
-              [ signIn context.onSignInClicked context.lang ]
+              [ Lazy.lazy2 signIn context.onSignInClicked context.lang ]
             else
-              [ userMenuToggle context.onUpdate user menuOpened
+              [ Lazy.lazy3 userMenuToggle context.onUpdate user menuOpened
               , if menuOpened then
                   userMenuView context
                 else
@@ -106,17 +107,17 @@ userMenuToggle : (Msg -> msg) -> User -> Bool -> Html msg
 userMenuToggle onUpdate user menuOpened =
   div
     [ onClick (onUpdate ToggleUserMenu) ]
-    [ greeting user menuOpened
+    [ Lazy.lazy2 greeting user menuOpened
     ]
 
 
 userMenuView : Context msg -> Html msg
 userMenuView context =
   div
     [ style S.userMenuView ]
-    [ langSelectView context.onSelectLang context.lang
-    , linkToMaster context
-    , signOut context.onSignOutClicked context.lang
+    [ Lazy.lazy2 langSelectView context.onSelectLang context.lang
+    , Lazy.lazy2 linkToMaster context.lang context.user
+    , Lazy.lazy2 signOut context.onSignOutClicked context.lang
     ]
 
 
@@ -129,13 +130,13 @@ langSelectView onSelectLang lang =
     ]
 
 
-linkToMaster : Context msg -> Html msg
-linkToMaster context =
-  case context.user of
+linkToMaster : Language -> Maybe User -> Html msg
+linkToMaster lang user =
+  case user of
     Just (Admin _) ->
       div
         [ style S.userMenuItem ]
-        [ a [ href "/master" ] [ text ( I18n.goToMaster context.lang ) ] ]
+        [ a [ href "/master" ] [ text ( I18n.goToMaster lang ) ] ]
 
     _ ->
       text ""
@@ -164,7 +165,7 @@ printButton onTogglePrintView lang user =
   if User.isGuest user then
     text ""
   else
-    printButtonView onTogglePrintView lang False
+    Lazy.lazy3 printButtonView onTogglePrintView lang False
 
 
 signIn : msg -> Language -> Html msg
@@ -175,7 +176,7 @@ signIn onSignInClicked lang =
 printButtonView : msg -> Language -> Bool -> Html msg
 printButtonView onTogglePrintView lang printMode =
   -- iconView ToggleEditing (Icons.editingToggle False) "Print"
-  hover S.hoverHeaderIconHover
+  -- hover S.hoverHeaderIconHover
   div
     [ onClick onTogglePrintView
     , style (S.editingToggleContainer False)
@@ -189,8 +190,8 @@ printButtonView onTogglePrintView lang printMode =
 editingToggleView : msg -> Language -> Bool -> Html msg
 editingToggleView onToggleEditing lang editing =
   -- iconView ToggleEditing (Icons.editingToggle editing) "Edit"
-  hover
-    S.hoverHeaderIconHover
+  -- hover
+  --   S.hoverHeaderIconHover
     div
     [ onClick onToggleEditing
     , style (S.editingToggleContainer editing)

src/elm/Component/ObjectNameInput.elm

@@ -3,6 +3,7 @@ module Component.ObjectNameInput exposing (..)
 import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
+import Html.Lazy as Lazy
 import Html.Keyed as Keyed
 
 import Json.Decode as Decode
@@ -26,6 +27,7 @@ type alias ObjectNameInput =
 type alias ObjectId = String
 type alias PersonId = String
 
+
 init : ObjectNameInput
 init =
   { editingObject = Nothing
@@ -184,7 +186,7 @@ view_ objectId name maybePerson screenRectOfDesk transitionDisabled candidates m
     (relatedPersonExists, reletedpersonView_) =
       case maybePerson of
         Just person ->
-          (True, reletedpersonView objectId person)
+          (True, Lazy.lazy2 reletedpersonView objectId person)
 
         Nothing ->
           (False, text "")
@@ -226,7 +228,7 @@ reletedpersonView : ObjectId -> Person -> Html Msg
 reletedpersonView objectId person =
   div
     [ style (Styles.candidatesViewRelatedPerson) ]
-    ( unsetButton objectId :: ProfilePopup.innerView Nothing person )
+    ( Lazy.lazy unsetButton objectId :: ProfilePopup.innerView Nothing person )
 
 
 unsetButton : ObjectId -> Html Msg

src/elm/Page/Map/CanvasView.elm

@@ -9,7 +9,7 @@ import Html exposing (..)
 import Html.Attributes as Attributes exposing (..)
 import Html.Events exposing (..)
 import Html.Keyed as Keyed
-import Html.Lazy exposing (..)
+import Html.Lazy as Lazy exposing (..)
 import ContextMenu
 
 import Component.ObjectNameInput as ObjectNameInput
@@ -214,7 +214,7 @@ canvasView model floor =
       Mode.isEditMode model.mode
 
     children1 =
-      Just ("canvas-image", canvasImage floor) ::
+      Just ("canvas-image", Lazy.lazy canvasImage floor) ::
       (if isEditMode then Just ("grid-layer", gridLayer) else Nothing) ::
       (if isEditMode then Just ("canvas-name-input", nameInput) else Nothing) ::
       (if isEditMode then Just ("canvas-selector-rect", selectorRectView model) else Nothing) :: []

src/elm/Page/Map/FloorUpdateInfoView.elm

@@ -3,6 +3,7 @@ module Page.Map.FloorUpdateInfoView exposing (view)
 import Date exposing (Date)
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Lazy as Lazy
 
 import Util.DateUtil exposing (..)
 
@@ -30,6 +31,11 @@ view model =
 
 viewHelp : Language -> Date -> String -> Date -> Bool -> Html msg
 viewHelp lang visitDate by at printMode =
+  Lazy.lazy2 viewHelpHelp printMode (I18n.lastUpdateByAt lang by (formatDateOrTime visitDate at))
+
+
+viewHelpHelp : Bool -> String -> Html msg
+viewHelpHelp printMode string  =
   div
     [ style
       ( if printMode then
@@ -38,4 +44,4 @@ viewHelp lang visitDate by at printMode =
           S.floorPropertyLastUpdate
       )
     ]
-    [ text (I18n.lastUpdateByAt lang by (formatDateOrTime visitDate at)) ]
+    [ text string ]

src/elm/Page/Map/GridLayer.elm

@@ -2,8 +2,9 @@ module Page.Map.GridLayer exposing (view)
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Lazy as Lazy
 
-import Model.Scale as Scale
+import Model.Scale as Scale exposing (Scale)
 import Model.Floor as Floor exposing (Floor)
 import View.Styles as Styles
 
@@ -12,14 +13,19 @@ import Page.Map.Model as Model exposing (Model)
 
 view : Model -> Floor -> Html msg
 view model floor =
+  Lazy.lazy3 viewHelp model.scale model.gridSize floor
+
+
+viewHelp : Scale -> Int -> Floor -> Html msg
+viewHelp scale gridSize floor =
   let
     -- 10m = 100 unit = 100 * 8px(gridSize) = 800px (on image)
     intervalPxOnScreen =
-      Scale.imageToScreen model.scale (50 * model.gridSize)
+      Scale.imageToScreen scale (50 * gridSize)
 
     wh =
       Scale.imageToScreenForPosition
-        model.scale
+        scale
         { x = Floor.width floor
         , y = Floor.height floor
         }
@@ -32,13 +38,12 @@ view model floor =
 
     tops = List.map ((*) intervalPxOnScreen) (List.range 1 (height // intervalPxOnScreen))
 
-    vertical = List.map verticalLine lefts
+    vertical = List.map (Lazy.lazy verticalLine) lefts
 
-    horizontal = List.map horizontalLine tops
+    horizontal = List.map (Lazy.lazy horizontalLine) tops
   in
     div [ style Styles.gridLayer ] ( vertical ++ horizontal )
 
-
 verticalLine : Int -> Html msg
 verticalLine left =
   div [ style (Styles.gridLayerVirticalLine left) ] []

src/elm/Page/Map/PropertyView.elm

@@ -2,18 +2,21 @@ module Page.Map.PropertyView exposing (view)
 
 import Html exposing (..)
 import Html.Attributes exposing (..)
+import Html.Lazy as Lazy
 
 import View.Styles as S
 import View.Icons as Icons
 import View.Common exposing (..)
 
 import Util.HtmlUtil exposing (..)
-import Model.Object as Object
+import Model.Object as Object exposing (Object)
 import Model.ObjectsOperation as ObjectsOperation
+import Model.ColorPalette exposing (ColorPalette)
 
 import Page.Map.Msg exposing (..)
 import Page.Map.Model as Model exposing (Model, DraggingContext(..))
 
+
 view : Model -> List (Html Msg)
 view model =
   let
@@ -23,19 +26,19 @@ view model =
       []
     else
       [ if List.all Object.backgroundColorEditable selectedObjects then
-          formControl [ label Icons.backgroundColorPropLabel, backgroundColorView model ]
+          formControl [ Lazy.lazy label Icons.backgroundColorPropLabel, Lazy.lazy2 backgroundColorView model.colorPalette selectedObjects ]
         else
           text ""
       , if List.all Object.colorEditable selectedObjects then
-          formControl [ label Icons.colorPropLabel, colorView model ]
+          formControl [ Lazy.lazy label Icons.colorPropLabel, Lazy.lazy2 colorView model.colorPalette selectedObjects ]
         else
           text ""
       , if List.all Object.shapeEditable selectedObjects then
-          formControl [ label Icons.shapePropLabel, shapeView model ]
+          formControl [ Lazy.lazy label Icons.shapePropLabel, Lazy.lazy shapeView selectedObjects ]
         else
           text ""
       , if List.all Object.fontSizeEditable selectedObjects then
-          formControl [ label Icons.fontSizePropLabel, fontSizeView model ]
+          formControl [ Lazy.lazy label Icons.fontSizePropLabel, Lazy.lazy fontSizeView selectedObjects ]
         else
           text ""
       ] -- TODO name, icon?
@@ -46,20 +49,22 @@ label icon =
   div [ style S.propertyViewPropertyIcon ] [ icon ]
 
 
-backgroundColorView : Model -> Html Msg
-backgroundColorView model =
-  paletteView
+backgroundColorView : ColorPalette -> List Object -> Html Msg
+backgroundColorView colorPalette selectedObjects =
+  Lazy.lazy3
+    paletteView
     SelectBackgroundColor
-    (ObjectsOperation.backgroundColorProperty (Model.selectedObjects model))
-    model.colorPalette.backgroundColors
+    (ObjectsOperation.backgroundColorProperty selectedObjects)
+    colorPalette.backgroundColors
 
 
-colorView : Model -> Html Msg
-colorView model =
-  paletteView
+colorView : ColorPalette -> List Object -> Html Msg
+colorView colorPalette selectedObjects =
+  Lazy.lazy3
+    paletteView
     SelectColor
-    (ObjectsOperation.colorProperty (Model.selectedObjects model))
-    model.colorPalette.textColors
+    (ObjectsOperation.colorProperty selectedObjects)
+    colorPalette.textColors
 
 
 paletteView : (String -> Msg) -> Maybe String -> List String -> Html Msg
@@ -84,11 +89,11 @@ paletteViewEach toMsg match color =
     []
 
 
-shapeView : Model -> Html Msg
-shapeView model =
+shapeView : List Object -> Html Msg
+shapeView selectedObjects =
   let
     selectedShape =
-      ObjectsOperation.shapeProperty (Model.selectedObjects model)
+      ObjectsOperation.shapeProperty selectedObjects
 
     shapes =
       [ Object.Rectangle, Object.Ellipse ]
@@ -117,11 +122,12 @@ shapeViewEach toMsg match toIcon shape =
     [ toIcon shape ]
 
 
-fontSizeView : Model -> Html Msg
-fontSizeView model =
-  fontSizeViewHelp
+fontSizeView : List Object -> Html Msg
+fontSizeView selectedObjects =
+  Lazy.lazy3
+    fontSizeViewHelp
     SelectFontSize
-    (ObjectsOperation.fontSizeProperty (Model.selectedObjects model))
+    (ObjectsOperation.fontSizeProperty selectedObjects)
     [10, 12, 16, 20, 40, 80, 120, 160, 200, 300]