Merge pull request finos#1092 from finos/typebuilder

Typebuilder

cli/elm.json

@@ -30,6 +30,7 @@
             "lattyware/elm-fontawesome": "6.0.0",
             "matthewsj/elm-ordering": "2.0.0",
             "mdgriffith/elm-ui": "1.1.8",
+            "perzanko/elm-loading": "2.0.5",
             "pzp1997/assoc-list": "1.0.0",
             "rundis/elm-bootstrap": "5.2.0",
             "stil4m/elm-syntax": "7.2.9"
@@ -44,6 +45,8 @@
             "elm-community/intdict": "3.0.0",
             "miniBill/elm-unicode": "1.0.3",
             "myrho/elm-round": "1.0.5",
+            "robinheghan/murmur3": "1.0.0",
+            "rtfeldman/elm-css": "17.1.1",
             "rtfeldman/elm-hex": "1.0.0",
             "stil4m/structured-writer": "1.0.3"
         }

cli/morphir-elm-develop.js

@@ -36,7 +36,7 @@ const webDir = path.join(__dirname, "web");
 
 
 app.use(express.static(webDir, { index: false }));
-app.use(express.json());
+app.use(express.json({limit: "100mb"}));
 
 app.get("/", wrap(async (req, res, next) => {
   res.setHeader('Content-type', 'text/html')
@@ -102,6 +102,21 @@ app.post(
   })
 );
 
+app.post(
+  "/server/morphir-ir.json",
+  wrap(async (req, res, next) => {
+    const morphirIRJsonPath = path.join(
+      program.opts().projectDir,
+      "morphir-ir.json"
+    );
+    var jsonContent = JSON.stringify(req.body, null, 4);
+    await writeFile(morphirIRJsonPath, jsonContent);
+    const morphirIRJsonContent = await readFile(morphirIRJsonPath);
+    const morphirIRJson = JSON.parse(morphirIRJsonContent.toString());
+    res.send(morphirIRJson);
+  })
+);
+
 app.get("*", wrap(async (req, res, next) => {
   res.setHeader('Content-type', 'text/html')
   res.send(await indexHtmlWithVersion());

cli/src/Morphir/Web/DevelopApp.elm

@@ -1,4 +1,4 @@
-module Morphir.Web.DevelopApp exposing (IRState(..), Model, Msg(..), ServerState(..), httpMakeModel, init, main, routeParser, subscriptions, update, view, viewBody, viewHeader)
+port module Morphir.Web.DevelopApp exposing (IRState(..), Model, Msg(..), ServerState(..), httpMakeModel, init, main, routeParser, subscriptions, update, view, viewBody, viewHeader)
 
 import Array exposing (Array)
 import Array.Extra
@@ -22,6 +22,7 @@ import Element
         , fillPortion
         , height
         , image
+        , inFront
         , layout
         , link
         , maximum
@@ -51,21 +52,22 @@ import Element.Keyed
 import FontAwesome.Styles as Icon
 import Http exposing (emptyBody, jsonBody)
 import List.Extra
+import Loading
 import Morphir.Correctness.Codec exposing (decodeTestSuite, encodeTestSuite)
 import Morphir.Correctness.Test exposing (TestCase, TestSuite)
 import Morphir.IR.Decoration exposing (AllDecorationConfigAndData, DecorationData, DecorationID)
 import Morphir.IR.Decoration.Codec exposing (decodeAllDecorationConfigAndData, decodeDecorationData, encodeDecorationData)
 import Morphir.IR.Distribution exposing (Distribution(..))
 import Morphir.IR.Distribution.Codec as DistributionCodec
-import Morphir.IR.FQName exposing (FQName)
+import Morphir.IR.FQName as FQName exposing (FQName)
 import Morphir.IR.Module as Module exposing (ModuleName)
 import Morphir.IR.Name as Name exposing (Name)
 import Morphir.IR.NodeId exposing (NodeID(..))
 import Morphir.IR.Package as Package exposing (PackageName)
 import Morphir.IR.Path as Path exposing (Path)
 import Morphir.IR.Repo as Repo exposing (Repo)
 import Morphir.IR.SDK as SDK exposing (packageName)
-import Morphir.IR.Type as Type exposing (Type)
+import Morphir.IR.Type as Type exposing (Type(..))
 import Morphir.IR.Value as Value exposing (RawValue, Value(..))
 import Morphir.SDK.Dict as SDKDict
 import Morphir.Type.Infer as Infer
@@ -80,6 +82,7 @@ import Morphir.Visual.Components.SectionComponent as SectionComponent
 import Morphir.Visual.Components.SelectableElement as SelectableElement
 import Morphir.Visual.Components.TabsComponent as TabsComponent
 import Morphir.Visual.Components.TreeViewComponent as TreeViewComponent
+import Morphir.Visual.Components.TypeBuilder as TypeBuilder
 import Morphir.Visual.Config exposing (DrillDownFunctions(..), ExpressionTreePath, PopupScreenRecord, addToDrillDown, removeFromDrillDown)
 import Morphir.Visual.EnrichedValue exposing (fromRawValue)
 import Morphir.Visual.Theme as Theme exposing (Theme, borderBottom, borderRounded, largePadding, largeSpacing, smallPadding)
@@ -111,6 +114,9 @@ main =
         }
 
 
+port unsavedChangesPort : Bool -> Cmd msg
+
+
 
 -- MODEL
 
@@ -127,6 +133,7 @@ type alias Model =
     , homeState : HomeState
     , repo : Repo
     , insightViewState : Morphir.Visual.Config.VisualState
+    , typeBuilderState : TypeBuilder.State
     , argStates : InsightArgumentState
     , expandedValues : Dict ( FQName, Name ) (Value.Definition () (Type ()))
     , allDecorationConfigAndData : AllDecorationConfigAndData
@@ -139,6 +146,7 @@ type alias Model =
     , modalContent : Element Msg
     , version : String
     , showSaveTestError : Bool
+    , unsavedChanges : Bool
     }
 
 
@@ -182,6 +190,7 @@ type Definition
 
 type IRState
     = IRLoading
+    | IRReloading Distribution
     | IRLoaded Distribution
 
 
@@ -216,6 +225,7 @@ init flags url key =
                 }
             , repo = Repo.empty []
             , insightViewState = emptyVisualState
+            , typeBuilderState = TypeBuilder.init Nothing False
             , argStates = Dict.empty
             , expandedValues = Dict.empty
             , allDecorationConfigAndData = Dict.empty
@@ -228,6 +238,7 @@ init flags url key =
             , modalContent = none
             , version = flags.version
             , showSaveTestError = False
+            , unsavedChanges = False
             }
     in
     ( toRoute url initModel
@@ -307,6 +318,9 @@ type UIMsg
     | OpenHttpErrorModal Http.Error String Bool
     | DismissHttpError
     | CloseModal
+    | TypeBuilderChanged TypeBuilder.State
+    | TypeAdded TypeBuilder.NewType
+    | SaveIR
 
 
 type FilterMsg
@@ -400,8 +414,8 @@ update msg model =
             in
             case Repo.fromDistribution distribution of
                 Ok r ->
-                    ( { model | irState = irLoaded, repo = r, argStates = initialArgumentStates, insightViewState = initInsightViewState initialArgumentStates }
-                    , httpTestModel distribution
+                    ( { model | irState = irLoaded, repo = r, argStates = initialArgumentStates, insightViewState = initInsightViewState initialArgumentStates, unsavedChanges = False }
+                    , Cmd.batch [ httpTestModel distribution, unsavedChangesPort False ]
                     )
 
                 Err _ ->
@@ -464,6 +478,22 @@ update msg model =
                 CloseModal ->
                     ( { model | isModalOpen = False }, Cmd.none )
 
+                TypeBuilderChanged newTypeBuilderState ->
+                    ( { model | typeBuilderState = newTypeBuilderState }, Cmd.none )
+
+                TypeAdded newType ->
+                    case model.repo |> Repo.insertType newType.moduleName newType.name newType.definition newType.access newType.documentation of
+                        Ok newRepo ->
+                            ( { model | typeBuilderState = TypeBuilder.init (model.homeState.selectedModule |> Maybe.map Tuple.second) True, unsavedChanges = True, irState = IRLoaded (Repo.toDistribution newRepo), repo = newRepo }
+                            , unsavedChangesPort True
+                            )
+
+                        _ ->
+                            ( model, Cmd.none )
+
+                SaveIR ->
+                    ( { model | irState = IRReloading (Repo.toDistribution model.repo) }, httpSaveDistribution (Repo.toDistribution model.repo) )
+
         ServerGetTestsResponse testSuite ->
             ( { model | testSuite = fromStoredTestSuite testSuite }, Cmd.none )
 
@@ -793,10 +823,18 @@ updateHomeState pack mod def filterState =
                 initialArgState =
                     initArgumentStates model.irState maybeSelectedDefinition
             in
-            { model | homeState = newState, insightViewState = initInsightViewState initialArgState, argStates = initialArgState, selectedTestcaseIndex = -1, testDescription = "", openSections = Set.fromList [ 1 ] }
+            { model
+                | homeState = newState
+                , insightViewState = initInsightViewState initialArgState
+                , argStates = initialArgState
+                , selectedTestcaseIndex = -1
+                , testDescription = ""
+                , openSections = Set.fromList [ 1 ]
+                , typeBuilderState = TypeBuilder.init (newState.selectedModule |> Maybe.map Tuple.second) model.unsavedChanges
+            }
 
         -- When selecting a definition, we should not change the selected module, once the user explicitly selected one
-        keepOrChangeSelectedModule : ( List Path, List Name )
+        keepOrChangeSelectedModule : ( List Path, ModuleName )
         keepOrChangeSelectedModule =
             if filterState.moduleClicked == pack then
                 ( urlFragmentToNodePath "", [] )
@@ -1070,6 +1108,13 @@ viewHeader model =
                             (text "Morphir Web")
                         ]
                 }
+            , el
+                [ alignRight
+                , Font.color model.theme.colors.lightest
+                , Font.size (Theme.scaled 5 model.theme)
+                ]
+              <|
+                ifThenElse model.unsavedChanges (text " You have unsaved changes! ") Element.none
             , el
                 [ alignRight
                 , pointer
@@ -1216,6 +1261,19 @@ viewBody model =
                     (text "Loading the IR ...")
                 )
 
+        IRReloading (Library packageName _ packageDef) ->
+            el
+                [ width fill
+                , height fill
+                , centerX
+                , centerY
+                , inFront <|
+                    el [ Background.color model.theme.colors.lightGray, onClick DoNothing, width fill, height fill ] <|
+                        el [ centerX, centerY ] <|
+                            Element.html (Loading.render Loading.Circle Loading.defaultConfig Loading.On)
+                ]
+                (viewHome model packageName packageDef)
+
         IRLoaded (Library packageName _ packageDef) ->
             viewHome model packageName packageDef
 
@@ -1415,27 +1473,35 @@ viewHome model packageName packageDef =
                 , activeTab = model.activeTabIndex
                 , tabs =
                     Array.fromList
-                        [ { name = "Summary"
-                          , content = col [ summary ]
-                          }
-                        , { name = "Dependency Graph"
-                          , content = col [ dependencyGraph model.homeState.selectedModule model.repo ]
-                          }
-                        , { name = "Decorations"
-                          , content =
-                                let
-                                    decorationTabContent =
-                                        case maybeModuleName of
-                                            Just moduleName ->
-                                                [ viewDecorationValues model (ModuleID ( packageName, moduleName )) ]
-
-                                            Nothing ->
-                                                -- Since we don't annotate package for now, we don't show the Value Editors
-                                                []
-                                in
-                                col decorationTabContent
-                          }
-                        ]
+                        ([ { name = "Summary"
+                           , content = col [ summary ]
+                           }
+                         , { name = "Dependency Graph"
+                           , content = col [ dependencyGraph model.homeState.selectedModule model.repo ]
+                           }
+                         ]
+                            ++ (case maybeModuleName of
+                                    Just moduleName ->
+                                        [ { name = "Decorations"
+                                          , content =
+                                                col [ viewDecorationValues model (ModuleID ( packageName, moduleName )) ]
+                                          }
+                                        , { name = "Add new term"
+                                          , content =
+                                                col <|
+                                                    [ TypeBuilder.view model.theme
+                                                        { state = model.typeBuilderState, onStateChange = UI << TypeBuilderChanged, onTypeAdd = UI << TypeAdded, onIRSave = UI SaveIR }
+                                                        packageName
+                                                        packageDef
+                                                        moduleName
+                                                    ]
+                                          }
+                                        ]
+
+                                    Nothing ->
+                                        []
+                               )
+                        )
                 }
     in
     row [ width fill, height fill, Background.color model.theme.colors.gray, spacing (Theme.smallSpacing model.theme) ]
@@ -1924,6 +1990,25 @@ httpSaveTestSuite ir newTestSuite oldTestSuite =
         }
 
 
+httpSaveDistribution : Distribution -> Cmd Msg
+httpSaveDistribution distribution =
+    Http.post
+        { url = "/server/morphir-ir.json"
+        , body = jsonBody <| DistributionCodec.encodeVersionedDistribution distribution
+        , expect =
+            Http.expectJson
+                (\response ->
+                    case response of
+                        Err httpError ->
+                            HttpError "We encountered an issue while saving the IR" httpError
+
+                        Ok result ->
+                            ServerGetIRResponse result
+                )
+                DistributionCodec.decodeVersionedDistribution
+        }
+
+
 {-| Display a Tree View of clickable module names in the given package, with urls pointing to the give module
 -}
 viewModuleNames : Model -> PackageName -> ModuleName -> List ModuleName -> TreeViewComponent.Node ModuleName Msg
@@ -2413,7 +2498,7 @@ viewDefinitionDetails model =
                 Nothing ->
                     none
 
-        IRLoading ->
+        _ ->
             none
 
 
@@ -2455,7 +2540,7 @@ initArgumentStates irState maybeSelectedDefinition =
                 Nothing ->
                     Dict.empty
 
-        IRLoading ->
+        _ ->
             Dict.empty
 
 

cli/web/index.html

@@ -24,6 +24,18 @@
           node: document.getElementById("elm"),
           flags: {version : "__VERSION_NUMBER__"}
         });
+        var unsaved = false;
+
+        app.ports.unsavedChangesPort.subscribe(message => {
+          unsaved = message;
+        });
+
+        window.addEventListener("beforeunload", event => {
+          if (unsaved) {
+            event.returnValue = "unsaved changes";
+            return event.returnValue;
+          }
+        });
       } catch (e) {
         // display initialization errors (e.g. bad flags, infinite recursion)
         var header = document.createElement("h1");

elm.json

@@ -78,6 +78,7 @@
         "fabhof/elm-ui-datepicker": "5.0.0 <= v < 6.0.0",
         "justinmimbs/date": "3.2.1 <= v < 4.0.0",
         "lattyware/elm-fontawesome": "6.0.0 <= v < 7.0.0",
+        "matthewsj/elm-ordering": "2.0.0 <= v < 3.0.0",
         "mdgriffith/elm-ui": "1.1.8 <= v < 2.0.0",
         "pzp1997/assoc-list": "1.0.0 <= v < 2.0.0",
         "rtfeldman/elm-iso8601-date-strings": "1.1.4 <= v < 2.0.0",

src/Morphir/Visual/Components/DecisionTable.elm

@@ -180,7 +180,7 @@ getCaseFromIndex config head viewValue highlightState rule =
                     let
                         parsedMatches : List (Element msg)
                         parsedMatches =
-                            List.map (getCaseFromIndex config head viewValue highlightState << Just << toTypedPattern) (matches)
+                            List.map (getCaseFromIndex config head viewValue highlightState << Just << toTypedPattern) matches
 
                         --enclose in parentheses for nested constructors
                     in