Ports for change notification and storage triggering

Store state when triggered through a new port and on focus change in Elm.
Add a port for notifying JS about every state change.
Debounce change notifications, trigger storing editor state to
localStorage once in 10 secs in the default deployment.

src/Editor.elm

@@ -37,16 +37,19 @@ type JsonImport
     | ImportErr String (List Json.Decode.Error)
 
 
+type alias State =
+    { tableau : Tableau
+    , jsonImport : JsonImport
+    , config : Config
+    }
+
+
 type alias Model =
-    UndoList
-        { tableau : Tableau
-        , jsonImport : JsonImport
-        , config : Config
-        }
+    UndoList State
 
 
-init : Maybe String -> ( Model, Cmd msg )
-init mts =
+init : Maybe Json.Decode.Value -> ( Model, Cmd msg )
+init mtv =
     let
         emptyT =
             { node =
@@ -60,12 +63,12 @@ init mts =
             }
 
         (initCfg, initT) =
-            case mts of
+            case mtv of
                 Nothing ->
                     (Config.default, emptyT)
 
-                Just ts ->
-                    Helpers.Exporting.Json.Decode.decode ts 
+                Just tv ->
+                    Helpers.Exporting.Json.Decode.decodeValue tv
                     |> (\(cfg, t) -> 
                         (cfg |> Result.withDefault Config.default, t |> Result.withDefault emptyT))
     in
@@ -80,7 +83,7 @@ init mts =
 
 subscriptions : Model -> Sub Msg
 subscriptions _ =
-    Sub.none
+    storeTrigger (\_ -> Store)
 
 
 type Msg
@@ -109,13 +112,19 @@ type Msg
     | JsonRead String
     | Export
     | Print
-    | Cache
+    | Store
+
+
+port onPrint : () -> Cmd msg
 
 
-port print : () -> Cmd msg
+port onStore : Json.Encode.Value -> Cmd msg
 
 
-port cache : String -> Cmd msg
+port onChange : () -> Cmd msg
+
+
+port storeTrigger : (() -> msg) -> Sub msg
 
 
 top : Zipper.Zipper -> Tableau
@@ -147,52 +156,71 @@ update msg ({ present } as model) =
             )
 
         JsonRead contents ->
-            case contents |> Helpers.Exporting.Json.Decode.decode of
-                ( Ok cfg, Ok t ) ->
-                    ( UndoList.new
-                        { present | jsonImport = None, config = cfg, tableau = t }
-                        model
-                    , cache contents
-                    )
-
-                ( Err cfgErr, Ok t ) ->
-                    ( UndoList.new
-                        { present
-                        | jsonImport =
-                            ImportErr
-                                ("Failed to import rule set configuration. "
-                                    ++ "Keeping the last one.")
-                                [ cfgErr ]
-                        , tableau = t
-                        }
-                        model
-                    , cache contents
-                    )
-
-                ( Ok _, Err tErr ) ->
-                    ( { model
-                        | present =
-                            { present
-                            | jsonImport =
-                                ImportErr
-                                    "Failed to import tableau"
-                                    [ tErr ]
+            case contents |> Json.Decode.decodeString Json.Decode.value of
+                Ok value ->
+                    case value |> Helpers.Exporting.Json.Decode.decodeValue of
+                        ( Ok cfg, Ok t ) ->
+                            ( UndoList.new
+                                { present
+                                | jsonImport = None
+                                , config = cfg
+                                , tableau = t }
+                                model
+                            , onChange ()
+                            )
+
+                        ( Err cfgErr, Ok t ) ->
+                            ( UndoList.new
+                                { present
+                                | jsonImport =
+                                    ImportErr
+                                        ("Failed to import rule set configuration. "
+                                            ++ "Keeping the last one.")
+                                        [ cfgErr ]
+                                , tableau = t
+                                }
+                                model
+                            , onChange ()
+                            )
+
+                        ( Ok _, Err tErr ) ->
+                            ( { model
+                                | present =
+                                    { present
+                                    | jsonImport =
+                                        ImportErr
+                                            "Failed to import tableau"
+                                            [ tErr ]
+                                    }
                             }
-                      }
-                    , Cmd.none
-                    )
+                            , Cmd.none
+                            )
+
+                        ( Err cfgErr, Err tErr ) ->
+                            ( { model
+                                | present =
+                                    { present
+                                    | jsonImport =
+                                        ImportErr
+                                            ("Failed to import tableau and " ++
+                                                "rule set configuration")
+                                            [ tErr, cfgErr ]
+                                    }
+                            }
+                            , Cmd.none
+                            )
 
-                ( Err cfgErr, Err tErr ) ->
+                Err err ->
                     ( { model
                         | present =
                             { present
                             | jsonImport =
                                 ImportErr
-                                    ("Failed to import tableau and " ++
-                                        "rule set configuration")
-                                    [ tErr, cfgErr ]
+                                    ("Failed to import file, " ++
+                                        "its content is not valid JSON")
+                                    [ err ]
                             }
-                      }
+                    }
                     , Cmd.none
                     )
 
@@ -202,38 +230,41 @@ update msg ({ present } as model) =
                 "tableau.json"
                 "application/json"
               <|
-                Helpers.Exporting.Json.Encode.encode 2 present.config present.tableau
+                Helpers.Exporting.Json.Encode.encodeString 2 present.config present.tableau
             )
 
         Undo ->
             ( UndoList.undo
                 { model | present = { present | jsonImport = None } }
-            , Cmd.none
+            , onChange ()
             )
 
         Redo ->
             ( UndoList.redo model, Cmd.none )
 
         Print ->
-            ( model, print () )
+            ( model, onPrint () )
 
-        Cache ->
+        Store ->
             ( model
-            , cache (Helpers.Exporting.Json.Encode.encode 0 model.present.config model.present.tableau)
+            , onStore <| Helpers.Exporting.Json.Encode.encodeValue
+                model.present.config
+                model.present.tableau
             )
 
         _ ->
             let
-                presentSansImport =
+                presentWithoutImport =
                     { present | jsonImport = None }
             in
             ( UndoList.new
-                (simpleUpdate msg presentSansImport)
-                { model | present = presentSansImport }
-            , Cmd.none
+                (simpleUpdate msg presentWithoutImport)
+                { model | present = presentWithoutImport }
+            , onChange ()
             )
 
 
+simpleUpdate : Msg -> State -> State
 simpleUpdate msg model =
         (case msg of
             ChangeText z new ->
@@ -319,13 +350,13 @@ simpleUpdate msg model =
             Print ->
                 model
 
-            Cache ->
+            Store ->
                 model
         )
 
 
 view : Model -> Browser.Document Msg
-view ({ present } as model) =
+view ({ present }) =
     { title = "Tableau Editor"
     , body =
         [ div [ class "tableau" ]
@@ -496,7 +527,7 @@ autoSizeInput val attrs =
             :: value val
             -- :: size (String.length val + 1)
             :: size ((String.length val * 5 + 9) // 6)
-            :: onBlur Cache
+            :: onBlur Store
             :: attrs
         )
         []

src/Helpers/Exporting/Json/Decode.elm

@@ -1,10 +1,23 @@
-module Helpers.Exporting.Json.Decode exposing (decode, tableau)
+module Helpers.Exporting.Json.Decode exposing (decodeString, decodeValue)
 
 import Config exposing (Config)
-import Dict
-import Formula
 import Formula.Parser
-import Json.Decode exposing (..)
+import Json.Decode as D exposing
+    ( Decoder
+    , Error
+    , Value
+    , andThen
+    , fail
+    , field
+    , index
+    , int
+    , lazy
+    , list
+    , map
+    , map2
+    , map5
+    , string
+    , succeed)
 import Tableau exposing (Tableau)
 import Zipper
 
@@ -76,7 +89,7 @@ unaryRule extType =
     map2
         Tableau.Tableau
         (field "node" node)
-        (map (Tableau.Unary extType) (field "child" (Json.Decode.lazy (\_ -> tableau))))
+        (map (Tableau.Unary extType) (field "child" (lazy (\_ -> tableau))))
 
 
 unaryRuleWithSubst : Tableau.UnaryWithSubstExtType -> Decoder Tableau.Tableau
@@ -184,18 +197,34 @@ tableau =
         )
 
 
-decode : String -> ( Result Error Config, Result Error Tableau )
-decode s =
+{- Elm's type system is too weak to allow a functional that would take
+   D.decodeString or D.decodeValue as argument (Haskell's forall is missing).
+-}
+decodeString : (String -> ( Result Error Config, Result Error Tableau ))
+decodeString s =
     let
         decodeTableau =
-            decodeString tableau >> Result.map reRefTableau
+            D.decodeString tableau >> Result.map reRefTableau
 
         decodeConfig =
-            decodeString config
+            D.decodeString config
     in
     ( decodeConfig s, decodeTableau s )
 
 
+
+decodeValue : (Value -> ( Result Error Config, Result Error Tableau ))
+decodeValue v =
+    let
+        decodeTableau =
+            D.decodeValue tableau >> Result.map reRefTableau
+
+        decodeConfig =
+            D.decodeValue config
+    in
+    ( decodeConfig v, decodeTableau v )
+
+
 reRefTableau : Tableau.Tableau -> Tableau.Tableau
 reRefTableau t =
     t

src/Helpers/Exporting/Json/Encode.elm

@@ -1,4 +1,4 @@
-module Helpers.Exporting.Json.Encode exposing (encode, jsonTableau)
+module Helpers.Exporting.Json.Encode exposing (encodeString, encodeValue, jsonTableau)
 
 import Config exposing (Config)
 import Json.Encode exposing (..)
@@ -97,10 +97,15 @@ jsonTableauAndConfig config t =
     object <| jsonTblList t ++ jsonConfig config
 
 
-encode : Int -> Config -> Tableau -> String
-encode ind config t =
+encodeString : Int -> Config -> Tableau -> String
+encodeString ind config t =
     Json.Encode.encode ind (jsonTableauAndConfig config t) ++ "\n"
 
 
+encodeValue : Config -> Tableau -> Value
+encodeValue config t =
+    jsonTableauAndConfig config t
+
+
 
 {- vim: set sw=2 ts=2 sts=2 et : -}

src/Main.elm

@@ -1,9 +1,10 @@
 module Main exposing (main)
 
 import Browser
+import Json.Decode
 import Editor exposing (init, update, view, subscriptions, Msg, Model)
 
-main : Program (Maybe String) Model Msg
+main : Program (Maybe Json.Decode.Value) Model Msg
 main =
     Browser.document
         { init = init

src/MainEmbeddable.elm

@@ -1,9 +1,10 @@
 module MainEmbeddable exposing (main)
 
 import Browser
+import Json.Decode
 import Editor exposing (init, update, viewEmbeddable, subscriptions, Msg, Model)
 
-main : Program (Maybe String) Model Msg
+main : Program (Maybe Json.Decode.Value) Model Msg
 main =
     Browser.element
         { init = init