Fix concretization of generic type instances in Elm compiler

+ Expand the example app to demo backend state serialization to cover more cases of instantiation of generic types: Add tuples, records, and instances of 'Maybe' with generic type arguments. + Automate test to assert that the demo app program code compiles. + Fix the concretization of generic type instances in compilation to generate JSON coding functions: Add coverage for 'instance', 'record', and 'tuple' cases.
pine-vm · Feb 1, 2023 · 29a913b · 29a913b
1 parent 565757e
commit 29a913b
Show file tree

Hide file tree

Showing 6 changed files with 128 additions and 7 deletions.
diff --git a/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm b/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm
@@ -2618,6 +2618,68 @@ tryConcretizeRecordInstance typeArguments recordType =
                         Just typeArgument ->
                             Ok typeArgument
 
+                InstanceElmType instanceElmType ->
+                    instanceElmType.instantiated
+                        |> tryConcretizeFieldType
+                        |> Result.mapError ((++) "Failed to concretize instantiated: ")
+                        |> Result.andThen
+                            (\concreteInstantiated ->
+                                instanceElmType.arguments
+                                    |> List.indexedMap
+                                        (\argIndex ->
+                                            tryConcretizeFieldType
+                                                >> Result.mapError
+                                                    ((++)
+                                                        ("Failed to concretize instance argument "
+                                                            ++ String.fromInt argIndex
+                                                            ++ ": "
+                                                        )
+                                                    )
+                                        )
+                                    |> Result.Extra.combine
+                                    |> Result.map
+                                        (\concreteArguments ->
+                                            InstanceElmType
+                                                { instantiated = concreteInstantiated
+                                                , arguments = concreteArguments
+                                                }
+                                        )
+                            )
+
+                TupleElmType tupleElmType ->
+                    tupleElmType
+                        |> List.indexedMap
+                            (\argIndex ->
+                                tryConcretizeFieldType
+                                    >> Result.mapError
+                                        ((++)
+                                            ("Failed to concretize tuple element "
+                                                ++ String.fromInt argIndex
+                                                ++ ": "
+                                            )
+                                        )
+                            )
+                        |> Result.Extra.combine
+                        |> Result.map TupleElmType
+
+                RecordElmType recordElmType ->
+                    recordElmType.fields
+                        |> List.map
+                            (\( fieldName, innerFieldType ) ->
+                                innerFieldType
+                                    |> tryConcretizeFieldType
+                                    |> Result.mapError
+                                        ((++)
+                                            ("Failed to concretize field "
+                                                ++ fieldName
+                                                ++ ": "
+                                            )
+                                        )
+                                    |> Result.map (Tuple.pair fieldName)
+                            )
+                        |> Result.Extra.combine
+                        |> Result.map (\fields -> RecordElmType { fields = fields })
+
                 _ ->
                     Ok fieldType
     in

diff --git a/implement/elm-fullstack/Program.cs b/implement/elm-fullstack/Program.cs
@@ -16,7 +16,7 @@ namespace ElmFullstack;
 
 public class Program
 {
-    static public string AppVersionId => "2023-01-31";
+    static public string AppVersionId => "2023-02-01";
 
     static int AdminInterfaceDefaultPort => 4000;
 

diff --git a/implement/elm-fullstack/elm-fullstack.csproj b/implement/elm-fullstack/elm-fullstack.csproj
@@ -5,8 +5,8 @@
     <TargetFramework>net7.0</TargetFramework>
     <RootNamespace>ElmFullstack</RootNamespace>
     <AssemblyName>elm-fs</AssemblyName>
-    <AssemblyVersion>2023.0131.0.0</AssemblyVersion>
-    <FileVersion>2023.0131.0.0</FileVersion>
+    <AssemblyVersion>2023.0201.0.0</AssemblyVersion>
+    <FileVersion>2023.0201.0.0</FileVersion>
     <Nullable>enable</Nullable>
     <GenerateEmbeddedFilesManifest>true</GenerateEmbeddedFilesManifest>
   </PropertyGroup>

diff --git a/implement/example-apps/demo-backend-state/src/Backend/Main.elm b/implement/example-apps/demo-backend-state/src/Backend/Main.elm
@@ -110,7 +110,20 @@ initState =
     , empty_record = {}
     , empty_tuple = ()
     , choiceTypeInstance = ChoiceTypeWithTypeParameter 4
-    , record_instance = { field_a = 123, field_parameterized = "test arg" }
+    , record_instance_string =
+        { field_a = 123
+        , field_parameterized = "test arg"
+        , field_parameterized_maybe = Nothing
+        , field_parameterized_tuple = ( "alfa", "beta" )
+        , field_parameterized_record = { field_int = 0, field_parameterized = "test" }
+        }
+    , record_instance_int =
+        { field_a = 234
+        , field_parameterized = 456
+        , field_parameterized_maybe = Just 567
+        , field_parameterized_tuple = ( 3, 4 )
+        , field_parameterized_record = { field_int = 0, field_parameterized = 78 }
+        }
     , listDict =
         [ ( { orig = 1, dest = 3 }, "Edge A" )
         , ( { orig = 3, dest = 4 }, "Edge B" )

diff --git a/implement/example-apps/demo-backend-state/src/Backend/State.elm b/implement/example-apps/demo-backend-state/src/Backend/State.elm
@@ -31,7 +31,8 @@ type alias State =
     , empty_record : {}
     , empty_tuple : ()
     , choiceTypeInstance : ChoiceTypeWithTypeParameter Int
-    , record_instance : RecordAliasWithTypeParameter String
+    , record_instance_string : RecordAliasWithTypeParameter_Alfa String
+    , record_instance_int : RecordAliasWithTypeParameter_Alfa Int
     , listDict :
         ListDict.Dict
             { orig : Int
@@ -77,7 +78,16 @@ type ChoiceTypeWithTypeParameter a
     = ChoiceTypeWithTypeParameter a
 
 
-type alias RecordAliasWithTypeParameter typeParamInRecord =
+type alias RecordAliasWithTypeParameter_Alfa typeParamInRecord_alfa =
     { field_a : Int
-    , field_parameterized : typeParamInRecord
+    , field_parameterized : typeParamInRecord_alfa
+    , field_parameterized_maybe : Maybe typeParamInRecord_alfa
+    , field_parameterized_tuple : ( typeParamInRecord_alfa, typeParamInRecord_alfa )
+    , field_parameterized_record : RecordAliasWithTypeParameter_Beta typeParamInRecord_alfa
+    }
+
+
+type alias RecordAliasWithTypeParameter_Beta typeParamInRecord_beta =
+    { field_int : Int
+    , field_parameterized : typeParamInRecord_beta
     }
diff --git a/implement/test-elm-fullstack/TestDemoBackendState.cs b/implement/test-elm-fullstack/TestDemoBackendState.cs
@@ -0,0 +1,36 @@
+using System.Collections.Immutable;
+using ElmFullstack;
+using Microsoft.VisualStudio.TestTools.UnitTesting;
+using System.Linq;
+using Pine;
+
+namespace TestElmFullstack
+{
+    [TestClass]
+    public class TestDemoBackendState
+    {
+        [TestMethod]
+        public void Test_demo_backend_state()
+        {
+            var sourceFiles =
+                TestSetup.GetElmAppFromDirectoryPath(
+                    ImmutableList.Create(".", "..", "..", "..", "..", "example-apps", "demo-backend-state"));
+
+            var webAppSource =
+                TestSetup.AppConfigComponentFromFiles(sourceFiles);
+
+            var compilationResult = ElmAppCompilation.AsCompletelyLoweredElmApp(
+                sourceFiles: sourceFiles,
+                interfaceConfig: ElmAppInterfaceConfig.Default);
+
+            var compilationSuccess =
+                compilationResult.Extract(err => throw new System.Exception(
+                    "Failed compilation:\n" +
+                    string.Join("\n", err.Select(singleErr => ElmAppCompilation.DescribeCompilationError(singleErr)))));
+
+            using var testSetup = WebHostAdminInterfaceTestSetup.Setup(deployAppConfigAndInitElmState: webAppSource);
+            using var server = testSetup.StartWebHost();
+            using var publicAppClient = testSetup.BuildPublicAppHttpClient();
+        }
+    }
+}