From da02778622717516ba999c8a770d0f523cf41fe1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Michael=20R=C3=A4tzel?= Date: Tue, 18 May 2021 16:00:29 +0000 Subject: [PATCH] Migrate compilation for migrations to new compilation pipeline Simplify the implementation of migrations by reusing the same compilation pipeline as the compilation interface for app code. To implement the emitting for migrations, reuse earlier implemented `mapAppFilesAndModuleTextToSupportJsonCoding`. With this new application/integration, I noticed we can simplify the implementation in and around this function, leading to refactoring to `mapAppFilesToSupportJsonCoding`: Instead of returning a function to update the module text, we now what is necessary to build (or update) that module: The names of the modules we depend on for types and the name of the generated module. Besides what is necessary for migrations, also simplify the compilation in some places. --- .../ElmFullstack/CompileElmValueSerializer.cs | 1206 ----------------- .../elm-fullstack/ElmFullstack/ElmApp.cs | 306 +---- .../src/CompileFullstackApp.elm | 606 ++++++--- .../compile-elm-program/tests/Tests.elm | 37 +- implement/elm-fullstack/Program.cs | 6 +- ...PersistentProcessVolatileRepresentation.cs | 138 +- .../test-elm-fullstack/TestModeledInElm.cs | 3 +- implement/test-elm-fullstack/TestSetup.cs | 3 +- 8 files changed, 431 insertions(+), 1874 deletions(-) delete mode 100644 implement/elm-fullstack/ElmFullstack/CompileElmValueSerializer.cs diff --git a/implement/elm-fullstack/ElmFullstack/CompileElmValueSerializer.cs b/implement/elm-fullstack/ElmFullstack/CompileElmValueSerializer.cs deleted file mode 100644 index fa19ec0a..00000000 --- a/implement/elm-fullstack/ElmFullstack/CompileElmValueSerializer.cs +++ /dev/null @@ -1,1206 +0,0 @@ -using System; -using System.Collections.Generic; -using System.Collections.Immutable; -using System.Linq; -using System.Text; -using System.Text.RegularExpressions; -using Pine; - -namespace ElmFullstack -{ - public class CompileElmValueSerializer - { - static string encodeParamName => "valueToEncode"; - - static string jsonEncodeFunctionNamePrefix => "jsonEncode_"; - - static string jsonDecodeFunctionNamePrefix => "jsonDecode_"; - - static string jsonCodeMaybeFunctionNameCommonPart => "_generic_Maybe"; - - static string jsonCodeListFunctionNameCommonPart => "_generic_List"; - - static string jsonCodeSetFunctionNameCommonPart => "_generic_Set"; - - static string jsonCodeDictFunctionNameCommonPart => "_generic_Dict"; - - static string jsonCodeResultFunctionNameCommonPart => "_generic_Result"; - - static string jsonCodeTupleFunctionNameCommonPart => "_tuple_"; - - static IImmutableDictionary LeafExpressions => - ImmutableDictionary.Empty - .Add("String", ("Json.Encode.string " + encodeParamName, "Json.Decode.string")) - .Add("Int", ("Json.Encode.int " + encodeParamName, "Json.Decode.int")) - .Add("Bool", ("Json.Encode.bool " + encodeParamName, "Json.Decode.bool")) - .Add("Float", ("Json.Encode.float " + encodeParamName, "Json.Decode.float")) - .Add("()", ("Json.Encode.list (always (Json.Encode.object [])) []", "Json.Decode.succeed ()")) - .Add("{}", ("Json.Encode.object []", "Json.Decode.succeed {}")) - .Add("Bytes.Bytes", ("json_encode_Bytes " + encodeParamName, "json_decode_Bytes")); - - static IImmutableDictionary InstantiationSpecialCases => - ImmutableDictionary.Empty - .Add("List", jsonCodeListFunctionNameCommonPart) - .Add("Set.Set", jsonCodeSetFunctionNameCommonPart) - .Add("Maybe", jsonCodeMaybeFunctionNameCommonPart) - .Add("Result", jsonCodeResultFunctionNameCommonPart) - .Add("Dict.Dict", jsonCodeDictFunctionNameCommonPart); - - public struct ResolveTypeResult - { - public string canonicalTypeText; - - public string canonicalTypeTextWithParameters; - - public Func<(string encodeExpression, string decodeExpression, IImmutableSet dependencies)> compileExpressions; - - public IImmutableSet referencedModules; - } - - static bool StartsWithLowercaseLetter(string text) => - text.Length < 1 ? false : Char.IsLower(text[0]); - - static public ((string encodeFunctionName, string decodeFunctionName, string commonPart) functionNames, - IImmutableList typeParameterNames) - GetFunctionNamesAndTypeParametersFromTypeText(string typeText) - { - var (typeTextMinusTypeParameters, typeParametersNames) = parseForTypeParameters(typeText); - - var rootTypeTextHash = CommonConversion.HashSHA256(Encoding.UTF8.GetBytes(typeTextMinusTypeParameters)); - - var functionNameCommonPart = - StartsWithLowercaseLetter(typeTextMinusTypeParameters.Trim()) - ? - "type_parameter_" + typeTextMinusTypeParameters - : - (Regex.IsMatch(typeTextMinusTypeParameters, @"^[\w\d_\.]+$") ? - "named_" + typeTextMinusTypeParameters.Replace(".", "_dot_") - : - "anonymous_" + CommonConversion.StringBase16FromByteArray(rootTypeTextHash).Substring(0, 10)); - - return - ((jsonEncodeFunctionNamePrefix + functionNameCommonPart, - jsonDecodeFunctionNamePrefix + functionNameCommonPart, - functionNameCommonPart), typeParametersNames); - } - - static public (string encodeFunction, string decodeFunction) BuildJsonCodingFunctionTexts( - string typeText, - string encodeExpression, - string decodeExpression) - { - var (functionNames, typeParametersNames) = GetFunctionNamesAndTypeParametersFromTypeText(typeText); - - var typeParameters = - typeParametersNames - .Select(typeParameterName => - { - var parameterNameCommonPart = "type_parameter_" + typeParameterName; - - return - new - { - encodeAnnotation = typeParameterName + " -> Json.Encode.Value", - encodeParameter = jsonEncodeFunctionNamePrefix + parameterNameCommonPart, - - decodeAnnotation = "Json.Decode.Decoder " + typeParameterName, - decodeParameter = jsonDecodeFunctionNamePrefix + parameterNameCommonPart, - }; - }) - .ToImmutableList(); - - string annotationsFromTypeList(IEnumerable types) => - string.Join(" -> ", types.Select(@type => "(" + @type + ")")); - - var encodeFunction = - functionNames.encodeFunctionName + " : " + - annotationsFromTypeList( - typeParameters.Select(typeParam => typeParam.encodeAnnotation).Concat( - new[] { typeText, "Json.Encode.Value" })) + "\n" + - functionNames.encodeFunctionName + " " + - string.Join(" ", typeParameters.Select(typeParam => typeParam.encodeParameter)) + - " " + encodeParamName + " =\n" + - IndentElmCodeLines(1, encodeExpression); - - var decodeFunction = - functionNames.decodeFunctionName + " : " + - annotationsFromTypeList( - typeParameters.Select(typeParam => typeParam.decodeAnnotation).Concat( - new[] { "Json.Decode.Decoder (" + typeText + ")" })) + "\n" + - functionNames.decodeFunctionName + " " + - string.Join(" ", typeParameters.Select(typeParam => typeParam.decodeParameter)) + - " =\n" + - IndentElmCodeLines(1, decodeExpression); - - return (encodeFunction, decodeFunction); - } - - static (string typeTextMinusTypeParameters, ImmutableList typeParametersNames) parseForTypeParameters(string typeText) - { - var instanceTypeTextWithParametersMatch = Regex.Match(typeText.Trim(), @"^\((.+?)((\s+[a-z][^\s]*){1,})\)$"); - - if (instanceTypeTextWithParametersMatch.Success) - return - (instanceTypeTextWithParametersMatch.Groups[1].Value, - Regex.Split(instanceTypeTextWithParametersMatch.Groups[2].Value.Trim(), @"\s+").ToImmutableList()); - - var parseTypeResult = ParseElmTypeText(typeText, canBeInstance: true); - - var parsedType = parseTypeResult.parsedType; - - if (parsedType.Instance != null) - { - var typeParametersNames = - parsedType.Instance.Value.parameters - .SelectMany(EnumerateAllTypeNamesFromTypeText) - .Where(typeName => Char.IsLower(typeName[0])).ToImmutableList(); - - return (typeText, typeParametersNames); - } - - { - var typeParametersNames = - EnumerateAllTypeNamesFromTypeText(typeText).Where(typeName => Char.IsLower(typeName[0])).ToImmutableList(); - - return (typeText, typeParametersNames); - } - } - - static IEnumerable EnumerateAllTypeNamesFromTypeText(string typeText) - { - var parseTypeResult = ParseElmTypeText(typeText, canBeInstance: true); - - if (0 < parseTypeResult.remainingString?.Trim()?.Length) - throw new NotSupportedException("Unexpected remaining string after parsing type: '" + parseTypeResult.remainingString + "'."); - - var parsedType = parseTypeResult.parsedType; - - if (parsedType.Instance != null) - { - var instancedTypes = new[] { parsedType.Instance.Value.typeName }; - - if (parsedType.Instance.Value.parameters.Count < 1) - return instancedTypes; - - return instancedTypes.Concat(parsedType.Instance.Value.parameters.SelectMany(EnumerateAllTypeNamesFromTypeText)); - } - - if (parsedType.Tuple != null) - return parsedType.Tuple.SelectMany(EnumerateAllTypeNamesFromTypeText); - - if (parsedType.Record != null) - return parsedType.Record.Value.fields.SelectMany(field => EnumerateAllTypeNamesFromTypeText(field.typeText)); - - throw new NotImplementedException(); - } - - static public ResolveTypeResult ResolveType( - string rootTypeText, - string sourceModuleName, - IImmutableDictionary sourceModules, - Action logWriteLine) - { - rootTypeText = rootTypeText.Trim(); - - logWriteLine?.Invoke("Begin ResolveType for '" + rootTypeText + "' in module '" + sourceModuleName + "'."); - - sourceModules.TryGetValue(sourceModuleName, out var sourceModuleText); - - if (LeafExpressions.TryGetValue(rootTypeText, out var leafExpressions)) - { - logWriteLine?.Invoke("Found a leaf for type '" + rootTypeText + "'."); - - return new ResolveTypeResult - { - canonicalTypeText = rootTypeText, - - compileExpressions = () => (leafExpressions.encodeExpression, leafExpressions.decodeExpression, ImmutableHashSet.Empty), - - referencedModules = ImmutableHashSet.Empty, - }; - } - - (string referencedModuleName, string typeNameInReferencedModule) - GetCanonicalModuleNameAndLocalTypeNameFromNameInSourceModule(string nameInThisModule) - { - var importedName = GetCanonicalNameFromImportedNameInModule(nameInThisModule, sourceModuleText); - - if (importedName != null) - return importedName.Value; - - if (nameInThisModule.Contains('.')) - throw new Exception("Failed to look up name '" + nameInThisModule + "'."); - - return (sourceModuleName, nameInThisModule); - } - - (string canonicalTypeText, IImmutableSet dependencies) ResolveLocalTypeText(string typeText) - { - if (StartsWithLowercaseLetter(typeText)) - return (typeText, ImmutableHashSet.Empty); - - var canonicalTypeText = ResolveType(typeText, sourceModuleName, sourceModules, logWriteLine).canonicalTypeText; - - return (canonicalTypeText, ImmutableHashSet.Create(canonicalTypeText)); - } - - var rootType = ParseElmTypeText(rootTypeText, canBeInstance: true).parsedType; - - if (rootType.Alias != null) - { - logWriteLine?.Invoke("Type '" + rootTypeText + "' is alias for '" + rootType.Alias.Value.aliasedText + "'."); - - return ResolveType( - rootType.Alias.Value.aliasedText, - sourceModuleName, - sourceModules, - logWriteLine); - } - - if (rootType.Instance != null) - { - if (rootType.Instance.Value.parameters.Count == 0) - { - var (referencedModuleName, typeNameInReferencedModule) = - GetCanonicalModuleNameAndLocalTypeNameFromNameInSourceModule(rootTypeText); - - if (referencedModuleName != sourceModuleName) - { - logWriteLine?.Invoke("Type '" + rootTypeText + "' in '" + sourceModuleName + "' refers to '" + referencedModuleName + "." + typeNameInReferencedModule + "'."); - - return ResolveType( - typeNameInReferencedModule, - referencedModuleName, - sourceModules, - logWriteLine); - } - - logWriteLine?.Invoke("Resolve type text for '" + rootTypeText + "' in '" + sourceModuleName + "'."); - - var referencedTypeText = GetTypeDefinitionTextFromModuleText(rootTypeText, sourceModuleText); - - if (!(0 < referencedTypeText?.Length)) - throw new Exception("Did not find the definition of type '" + rootTypeText + "'."); - - return ResolveType(referencedTypeText, sourceModuleName, sourceModules, logWriteLine); - } - - logWriteLine?.Invoke("Type '" + rootTypeText + "' is instance of '" + - rootType.Instance.Value.typeName + "' with " + - rootType.Instance.Value.parameters.Count + " parameters."); - - var parameters = - rootType.Instance.Value.parameters - .Select(parameter => - { - var dependencies = ResolveType(parameter, sourceModuleName, sourceModules, logWriteLine); - - var (functionNames, typeParametersNames) = GetFunctionNamesAndTypeParametersFromTypeText(dependencies.canonicalTypeText); - - var encodeFunction = expressionTextForFunctionWithOptionalTypeParameters( - functionNames.encodeFunctionName, jsonEncodeFunctionNamePrefix, typeParametersNames); - - var decodeFunction = expressionTextForFunctionWithOptionalTypeParameters( - functionNames.decodeFunctionName, jsonDecodeFunctionNamePrefix, typeParametersNames); - - return new { encodeFunction, decodeFunction, dependencies }; - }) - .ToImmutableList(); - - string instantiatedTypeCanonicalName = null; - string instantiatedTypeFunctionNameCommonPart = null; - IImmutableSet dependenciesFromInstantiatedType = ImmutableHashSet.Empty; - - if (InstantiationSpecialCases.TryGetValue(rootType.Instance.Value.typeName, out var specialCaseFunctionNameCommonPart)) - { - instantiatedTypeCanonicalName = rootType.Instance.Value.typeName; - instantiatedTypeFunctionNameCommonPart = specialCaseFunctionNameCommonPart; - } - else - { - var instantiatedTypeResolution = ResolveType(rootType.Instance.Value.typeName, sourceModuleName, sourceModules, logWriteLine); - instantiatedTypeCanonicalName = instantiatedTypeResolution.canonicalTypeText; - instantiatedTypeFunctionNameCommonPart = GetFunctionNamesAndTypeParametersFromTypeText(instantiatedTypeCanonicalName).functionNames.commonPart; - dependenciesFromInstantiatedType = ImmutableHashSet.Create(instantiatedTypeResolution.canonicalTypeText); - } - - var parametersTypeTextsForComposition = - parameters.Select(param => - { - var needsParentheses = - param.dependencies.canonicalTypeText.Contains(" ") && - !param.dependencies.canonicalTypeText.StartsWith("(") && - !param.dependencies.canonicalTypeText.StartsWith("{"); - - var beforeParentheses = - param.dependencies.canonicalTypeText; - - if (needsParentheses) - return "(" + beforeParentheses + ")"; - - return beforeParentheses; - }); - - return new ResolveTypeResult - { - canonicalTypeText = instantiatedTypeCanonicalName + " " + String.Join(" ", parametersTypeTextsForComposition), - - compileExpressions = () => - (jsonEncodeFunctionNamePrefix + instantiatedTypeFunctionNameCommonPart + " " + String.Join(" ", parameters.Select(param => param.encodeFunction)) + " " + encodeParamName, - jsonDecodeFunctionNamePrefix + instantiatedTypeFunctionNameCommonPart + " " + String.Join(" ", parameters.Select(param => param.decodeFunction)), - dependenciesFromInstantiatedType.Union(parameters.Select(parameter => parameter.dependencies.canonicalTypeText))), - - referencedModules = ImmutableHashSet.Empty, - }; - } - - if (rootType.Record != null) - { - logWriteLine?.Invoke("'" + rootTypeText + "' is a record type."); - - var fields = rootType.Record.Value.fields.Select(recordField => - { - var fieldTypeResolution = ResolveLocalTypeText(recordField.typeText); - - var (fieldFunctionNames, fieldTypeParametersNames) = - GetFunctionNamesAndTypeParametersFromTypeText(fieldTypeResolution.canonicalTypeText); - - var encodeFunction = expressionTextForFunctionWithOptionalTypeParameters( - fieldFunctionNames.encodeFunctionName, jsonEncodeFunctionNamePrefix, fieldTypeParametersNames); - - var decodeFunction = expressionTextForFunctionWithOptionalTypeParameters( - fieldFunctionNames.decodeFunctionName, jsonDecodeFunctionNamePrefix, fieldTypeParametersNames); - - var encodeFieldValueExpression = - encodeParamName + "." + recordField.name + " |> " + encodeFunction; - - return new - { - fieldName = recordField.name, - fieldCanonicalType = fieldTypeResolution.canonicalTypeText, - encodeExpression = "( \"" + recordField.name + "\", " + encodeFieldValueExpression + " )", - decodeExpression = "|> jsonDecode_andMap ( Json.Decode.field \"" + recordField.name + "\" " + decodeFunction + " )", - dependencies = fieldTypeResolution.dependencies, - }; - }).ToImmutableList(); - - var encodeListExpression = - "[ " + - String.Join( - "\n, ", - fields.Select(field => field.encodeExpression)) - + "\n]"; - - var dencodeListExpression = - String.Join("\n", fields.Select(field => field.decodeExpression)); - - var allFieldsDependencies = - fields - .Select(field => field.dependencies) - .Aggregate(ImmutableHashSet.Empty, (a, b) => a.Union(b)); - - var encodeExpression = - "Json.Encode.object\n" + - IndentElmCodeLines(1, encodeListExpression); - - var recordFieldsNames = rootType.Record.Value.fields.Select(field => field.name); - - var decodeMapFunction = - "(\\" + String.Join(" ", recordFieldsNames) + " -> { " + - String.Join(", ", recordFieldsNames.Select(fieldName => fieldName + " = " + fieldName)) - + " })"; - - var decodeExpression = - "Json.Decode.succeed " + decodeMapFunction + "\n" + - IndentElmCodeLines(1, dencodeListExpression); - - var canonicalTypeText = - "{" + - string.Join(",", fields.Select(field => field.fieldName + ":" + field.fieldCanonicalType)) + - "}"; - - return new ResolveTypeResult - { - canonicalTypeText = canonicalTypeText, - - compileExpressions = () => (encodeExpression, decodeExpression, allFieldsDependencies), - - referencedModules = ImmutableHashSet.Empty.Add(sourceModuleName), - }; - } - - if (rootType.Custom != null) - { - logWriteLine?.Invoke("'" + rootTypeText + "' is a custom type."); - - (string encodeExpression, string decodeExpression, IImmutableSet dependencies) compileExpressions() - { - var tags = rootType.Custom.Value.tags.Select(typeTag => - { - var typeTagCanonicalName = sourceModuleName + "." + typeTag.Key; - - string encodeCaseSyntaxFromArgumentSyntaxAndObjectContentSyntax(string argumentSyntax, string objectContentSyntax) - { - var tagEncodeCase = - typeTagCanonicalName + " " + argumentSyntax + " ->"; - - var tagEncodeExpression = - @"Json.Encode.object [ ( """ + typeTag.Key + @""", " + objectContentSyntax + " ) ]"; - - return tagEncodeCase + "\n" + IndentElmCodeLines(1, tagEncodeExpression); - } - - var decodeSyntaxCommonPart = @"Json.Decode.field """ + typeTag.Key + @""""; - - if (typeTag.Value.Count == 0) - { - return new - { - encodeCase = encodeCaseSyntaxFromArgumentSyntaxAndObjectContentSyntax("", "Json.Encode.list identity []"), - decodeExpression = decodeSyntaxCommonPart + " (Json.Decode.succeed " + typeTagCanonicalName + ")", - dependencies = ImmutableHashSet.Empty, - }; - } - - var tagParametersExpressions = - typeTag.Value.Select(tagParameterType => - { - var tagParameterCanonicalTypeTextAndDependencies = ResolveLocalTypeText(tagParameterType); - - var (tagParameterTypeFunctionNames, tagParameterTypeParametersNames) = - GetFunctionNamesAndTypeParametersFromTypeText(tagParameterCanonicalTypeTextAndDependencies.canonicalTypeText); - - var tagParameterEncodeFunction = - expressionTextForFunctionWithOptionalTypeParameters( - tagParameterTypeFunctionNames.encodeFunctionName, jsonEncodeFunctionNamePrefix, tagParameterTypeParametersNames); - - var tagParameterDecodeFunction = - expressionTextForFunctionWithOptionalTypeParameters( - tagParameterTypeFunctionNames.decodeFunctionName, jsonDecodeFunctionNamePrefix, tagParameterTypeParametersNames); - - return new - { - encodeFunction = tagParameterEncodeFunction, - decodeFunction = tagParameterDecodeFunction, - canonicalTypeTextAndDependencies = tagParameterCanonicalTypeTextAndDependencies, - }; - }).ToImmutableList(); - - var tagDecodeExpressionBeforeLazy = - tagParametersExpressions.Count == 1 - /* - 2020-03-07: To support easy migration of existing applications, support decoding from the older JSON representation for tags with one parameter. - This branch can be removed when all apps have been migrated. - */ - ? - "Json.Decode.map " + typeTagCanonicalName + - " (Json.Decode.oneOf [ " + tagParametersExpressions.Single().decodeFunction + ", " + - "(Json.Decode.index 0 " + tagParametersExpressions.Single().decodeFunction + ")" + - " ])" - : - "Json.Decode.map" + tagParametersExpressions.Count.ToString() + " " + typeTagCanonicalName + " " + - string.Join(" ", tagParametersExpressions.Select((tagParamExpr, tagParamIndex) => - "(Json.Decode.index " + tagParamIndex.ToString() + " " + tagParamExpr.decodeFunction + ")")); - - var tagDecodeExpression = - decodeSyntaxCommonPart + @" (Json.Decode.lazy (\_ -> " + - tagDecodeExpressionBeforeLazy + - " ) )"; - - var encodeArgumentsAndExpressions = - tagParametersExpressions - .Select((tagArgumentExpressions, tagParameterIndex) => - { - var argumentName = "tagArgument" + tagParameterIndex.ToString(); - - return (argumentName, encodeExpression: argumentName + " |> " + tagArgumentExpressions.encodeFunction); - }).ToImmutableList(); - - var encodeArgumentSyntax = - string.Join(" ", encodeArgumentsAndExpressions.Select(argumentAndExpr => argumentAndExpr.argumentName)); - - var encodeObjectContentSyntax = - "[ " + - string.Join(", ", encodeArgumentsAndExpressions.Select(argumentAndExpr => argumentAndExpr.encodeExpression)) - + " ] |> Json.Encode.list identity"; - - var tagParametersDependencies = - tagParametersExpressions - .Select(tagParamResult => tagParamResult.canonicalTypeTextAndDependencies.dependencies) - .Aggregate(ImmutableHashSet.Empty, (a, b) => a.Union(b)); - - return new - { - encodeCase = encodeCaseSyntaxFromArgumentSyntaxAndObjectContentSyntax( - encodeArgumentSyntax, - encodeObjectContentSyntax), - decodeExpression = tagDecodeExpression, - dependencies = tagParametersDependencies, - }; - }) - .ToImmutableList(); - - var encodeCases = - String.Join("\n\n", tags.Select(tag => tag.encodeCase)); - - var encodeExpression = - "case " + encodeParamName + " of\n" + - IndentElmCodeLines(1, encodeCases); - - var decodeArrayExpression = "[ " + String.Join("\n, ", tags.Select(tag => tag.decodeExpression)) + "\n]"; - - var decodeExpression = - "Json.Decode.oneOf\n" + - IndentElmCodeLines(1, decodeArrayExpression); - - var allTagsDependencies = - tags.SelectMany(field => field.dependencies) - .ToImmutableHashSet(); - - return (encodeExpression, decodeExpression, allTagsDependencies); - } - - var canonicalTypeText = sourceModuleName + "." + rootType.Custom.Value.typeLocalName; - - var canonicalTypeTextWithParameters = - rootType.Custom.Value.parameters.Count < 1 - ? - canonicalTypeText - : - "(" + canonicalTypeText + " " + string.Join(" ", rootType.Custom.Value.parameters) + ")"; - - return new ResolveTypeResult - { - canonicalTypeText = canonicalTypeText, - canonicalTypeTextWithParameters = canonicalTypeTextWithParameters, - - compileExpressions = compileExpressions, - - referencedModules = ImmutableHashSet.Empty.Add(sourceModuleName), - }; - } - - if (rootType.Tuple != null) - { - logWriteLine?.Invoke("'" + rootTypeText + "' is a " + rootType.Tuple.Count + "-tuple."); - - var tupleElementsResults = - rootType.Tuple - .Select(tupleElementType => ResolveLocalTypeText(tupleElementType)) - .ToImmutableList(); - - var tupleElementsCanonicalTypeName = - tupleElementsResults - .Select(elementResult => elementResult.canonicalTypeText) - .ToImmutableList(); - - var allElementsDependencies = - tupleElementsResults.SelectMany(elementResult => elementResult.dependencies) - .ToImmutableHashSet(); - - var tupleElementsFunctionNames = - tupleElementsCanonicalTypeName - .Select(tupleElement => GetFunctionNamesAndTypeParametersFromTypeText(tupleElement).functionNames) - .ToImmutableList(); - - var functionNameCommonPart = jsonCodeTupleFunctionNameCommonPart + rootType.Tuple.Count.ToString(); - - var encodeExpression = - jsonEncodeFunctionNamePrefix + functionNameCommonPart + " " + - String.Join(" ", tupleElementsFunctionNames.Select(functionNamesAndTypeParams => - functionNamesAndTypeParams.encodeFunctionName)) + " " + - encodeParamName; - - var decodeExpression = - jsonDecodeFunctionNamePrefix + functionNameCommonPart + " " + - String.Join(" ", tupleElementsFunctionNames.Select(functionNamesAndTypeParams => - functionNamesAndTypeParams.decodeFunctionName)); - - var canonicalTypeText = "(" + string.Join(",", tupleElementsCanonicalTypeName) + ")"; - - return new ResolveTypeResult - { - canonicalTypeText = canonicalTypeText, - - compileExpressions = () => (encodeExpression, decodeExpression, allElementsDependencies), - - referencedModules = ImmutableHashSet.Empty.Add(sourceModuleName), - }; - } - - throw new Exception("Parsed invalid case for type '" + rootTypeText + "'"); - } - - static string expressionTextForFunctionWithOptionalTypeParameters( - string functionName, string typeParametersFunctionsCommonPrefix, IImmutableList typeParametersNames) - { - var needsParentheses = 0 < typeParametersNames.Count; - - var beforeParentheses = - functionName + - String.Join("", typeParametersNames.Select(typeParameterName => " " + typeParametersFunctionsCommonPrefix + "type_parameter_" + typeParameterName)); - - if (needsParentheses) - return "(" + beforeParentheses + ")"; - - return beforeParentheses; - } - - - static string ElmCodeIndentString(int level) => - level <= 0 ? "" : " " + ElmCodeIndentString(level - 1); - - static public string IndentElmCodeLines(int level, string textBeforeIndent) - { - var indentString = ElmCodeIndentString(level); - - return indentString + textBeforeIndent.Replace("\n", "\n" + indentString); - } - - static public (ElmType parsedType, string remainingString) ParseElmTypeText( - string elmTypeText, - bool canBeInstance) - { - // Assume: Custom type tags are all on their own line. - - try - { - var typeDefinitionTextLines = elmTypeText.Split(new char[] { '\n' }); - - var aliasMatch = Regex.Match(typeDefinitionTextLines[0], @"^type\s+alias\s+([A-Z][^\s]*(\s+[a-z][^\s]*){0,})\s*="); - - if (aliasMatch.Success) - { - var aliasNameAndParameters = Regex.Split(aliasMatch.Groups[1].Value.Trim(), @"\s+"); - - var aliasLocalName = aliasNameAndParameters.First(); - var parameters = aliasNameAndParameters.Skip(1).ToImmutableList(); - - return (parsedType: new ElmType - { - Alias = new ElmType.AliasStructure - { - aliasLocalName = aliasLocalName, - parameters = parameters, - aliasedText = string.Join("\n", typeDefinitionTextLines.Skip(1).ToArray()), - }, - }, ""); - } - - var customTypeMatch = Regex.Match(string.Join("", typeDefinitionTextLines), @"^type\s+([A-Z][^\s]*(\s+[a-z][^\s]*){0,})\s*="); - - if (customTypeMatch.Success) - { - var typeNameAndParameters = Regex.Split(customTypeMatch.Groups[1].Value, @"\s+"); - - var typeLocalName = typeNameAndParameters.First(); - var parameters = typeNameAndParameters.Skip(1).ToImmutableList(); - - var tags = - typeDefinitionTextLines.Skip(1) - .Select(tagLine => - { - var overallMatch = Regex.Match(tagLine, @"^\s+(=|\|)\s*([\w\d_]+)(.*)$"); - - if (!overallMatch.Success) - throw new Exception("Failed to parse Custom Type tag name from '" + tagLine + "'"); - - var parametersText = overallMatch.Groups[3].Value.Trim(); - - var tagParametersTexts = new List(); - - var tagParametersTextRemaining = parametersText; - - while (0 < tagParametersTextRemaining?.Length) - { - var (parameter, remainingAfterParameter) = ParseElmTypeText(tagParametersTextRemaining, canBeInstance: false); - - var tagParameterText = - tagParametersTextRemaining - .Substring(0, tagParametersTextRemaining.Length - remainingAfterParameter.Length) - .Trim(); - - tagParametersTexts.Add(tagParameterText); - - tagParametersTextRemaining = remainingAfterParameter.TrimStart(); - } - - return (tagName: overallMatch.Groups[2].Value, tagParameters: (IImmutableList)tagParametersTexts.ToImmutableList()); - }) - .ToImmutableDictionary(tag => tag.tagName, tag => tag.tagParameters); - - return (parsedType: new ElmType - { - Custom = new ElmType.CustomStructure - { - typeLocalName = typeLocalName, - parameters = parameters, - tags = tags - }, - }, ""); - } - - var withoutLeadingWhitespace = elmTypeText.TrimStart(); - - switch (withoutLeadingWhitespace[0]) - { - case '(': - var parenthesesRest = withoutLeadingWhitespace.Substring(1); - - var elements = new List(); - - while (true) - { - var (_, restWithoutLeadingWhitespace) = parseRegexPattern(parenthesesRest, @"\s*"); - - if (restWithoutLeadingWhitespace.Length < 1) - throw new Exception("Missing terminating parenthesis."); - - var (termination, restAfterTermination) = parseRegexPattern(restWithoutLeadingWhitespace, @"\)"); - - if (0 < termination.Length) - { - var parsedType = - 1 == elements.Count ? - ParseElmTypeText(elements.Single(), canBeInstance: true).parsedType - : - new ElmType - { - Tuple = elements.ToImmutableList() - }; - - return (parsedType, restAfterTermination); - } - - if (0 < elements.Count) - { - var (separator, restAfterSeparator) = parseRegexPattern(restWithoutLeadingWhitespace, @",\s*"); - - if (!(0 < separator.Length)) - throw new Exception("Missing separator."); - - restWithoutLeadingWhitespace = restAfterSeparator.TrimStart(); - } - - var parsedElement = ParseElmTypeText(restWithoutLeadingWhitespace, canBeInstance: true); - - var parsedElementText = restWithoutLeadingWhitespace.Substring(0, restWithoutLeadingWhitespace.Length - parsedElement.remainingString.Length); - - elements.Add(parsedElementText); - parenthesesRest = parsedElement.remainingString; - } - - case '{': - var recordRest = withoutLeadingWhitespace.Substring(1); - - var fields = new List<(string fieldName, string fieldTypeText, ElmType fieldType)>(); - - while (true) - { - var recordRestWithoutLeadingWhitespace = recordRest.TrimStart(); - - if (recordRestWithoutLeadingWhitespace[0] == '}') - { - return (parsedType: new ElmType - { - Record = new ElmType.RecordStructure - { - fields = fields.ToImmutableList(), - } - }, remainingString: recordRestWithoutLeadingWhitespace.Substring(1)); - } - - var (_, restAfterFieldSeparator) = parseRegexPattern(recordRestWithoutLeadingWhitespace, @"\s*,\s*"); - - var (fieldName, restAfterFieldName) = parseFieldName(restAfterFieldSeparator); - - var (_, restAfterFieldColon) = parseRegexPattern(restAfterFieldName, @"\s*:\s*"); - - var (fieldType, restAfterFieldType) = ParseElmTypeText(restAfterFieldColon, canBeInstance: true); - - recordRest = restAfterFieldType; - - var fieldTypeTextLength = restAfterFieldColon.Length - recordRest.Length; - - if (fieldName.Length < 1) - throw new Exception("Missing termination token."); - - fields.Add((fieldName, fieldTypeText: restAfterFieldColon.Substring(0, fieldTypeTextLength), fieldType)); - } - - case char firstCharacter when Char.IsLetter(firstCharacter) || firstCharacter == '_': - - var nameInInstanceRegexPattern = @"[\w\d_\.]+"; - - var (firstName, restAfterFirstName) = parseRegexPattern(withoutLeadingWhitespace, nameInInstanceRegexPattern); - - if (!canBeInstance) - { - return (parsedType: new ElmType - { - Instance = (typeName: firstName, parameters: ImmutableList.Empty), - }, - remainingString: restAfterFirstName); - } - - var parametersTexts = new List(); - - var instanceRest = restAfterFirstName; - - while (true) - { - var (_, instanceRestWithoutWhitespace) = parseRegexPattern(instanceRest, @"\s*"); - - var (parameterName, restAfterParameterName) = parseRegexPattern( - instanceRestWithoutWhitespace, nameInInstanceRegexPattern); - - if (0 < parameterName.Length) - { - parametersTexts.Add(parameterName); - instanceRest = restAfterParameterName; - continue; - } - - var (parameterTypeBegin, _) = parseRegexPattern(instanceRestWithoutWhitespace, @"[\(\{]"); - - if (0 < parameterTypeBegin.Length) - { - var parameterParsed = ParseElmTypeText(instanceRestWithoutWhitespace, canBeInstance: false); - - var parameterTypeText = instanceRestWithoutWhitespace.Substring(0, instanceRestWithoutWhitespace.Length - parameterParsed.remainingString.Length); - - parametersTexts.Add(parameterTypeText); - instanceRest = parameterParsed.remainingString; - continue; - } - - return (parsedType: new ElmType - { - Instance = (typeName: firstName, parametersTexts.ToImmutableList()), - }, - remainingString: instanceRest); - } - - case char other: - throw new NotSupportedException("Unexpected first character in type text: '" + other.ToString() + "'."); - } - - throw new NotImplementedException("Type text did not match any supported pattern."); - } - catch (Exception e) - { - throw new Exception("Failed to parse type '" + elmTypeText + "'.", e); - } - } - - static (string fieldName, string remainingString) parseFieldName(string originalString) - { - return parseRegexPattern(originalString, @"[\w\d_]+"); - } - - static (string matchValue, string remainingString) parseRegexPattern(string originalString, string regexPattern) - { - var match = Regex.Match(originalString, "^" + regexPattern); - - return (matchValue: match.Value, remainingString: originalString.Substring(match.Length)); - } - - /* - Resolve the 'exposing' and optional 'as' parts 'import' statements. - Return null in case this name is not imported. - */ - static public (string moduleName, string localTypeName)? GetCanonicalNameFromImportedNameInModule( - string importedNameInModule, string moduleText) - { - // Assume: Each import is expressed on a single line. - - var qualifiedMatch = Regex.Match(importedNameInModule, @"(.+)\.(.+)"); - - var imports = - GetElmModuleTextLines(moduleText) - .Select(line => Regex.Match(line, @"^import\s+([\w\d\._]+)(.*)")) - .Where(match => match.Success) - .ToImmutableDictionary(match => match.Groups[1].Value, match => match.Groups[2].Value); - - if (qualifiedMatch.Success) - { - // In this case, we are looking for 'as' or the unmapped name. - - var moduleName = qualifiedMatch.Groups[1].Value; - var typeName = qualifiedMatch.Groups[2].Value; - - { - imports.TryGetValue(moduleName, out var literalMatch); - - if (literalMatch != null) - return (moduleName, typeName); - } - - { - var matchingImportByAs = - imports.FirstOrDefault(import => - { - var asMatch = Regex.Match(import.Value, @"^\s+as\s+([\w\d_]+)"); - - return asMatch.Success && asMatch.Groups[1].Value == moduleName; - }); - - if (matchingImportByAs.Key != null) - return (matchingImportByAs.Key, typeName); - } - - return null; - } - else - { - foreach (var import in imports) - { - var exposingMatch = Regex.Match(import.Value, @"^\s*(|as\s+[\w\d_]+\s*)exposing\s*\(([^\)]*)\)"); - - if (!exposingMatch.Success) - continue; - - var exposedAggregated = exposingMatch.Groups[2].Value.Trim(); - - if (exposedAggregated == "..") - { - // resolving 'exposing(..)' in import is not implemented yet. - - continue; - } - - var exposedNames = - exposedAggregated - .Split(new[] { ',' }) - .Select(commaSeparatedValue => commaSeparatedValue.Trim()) - .ToImmutableList(); - - if (exposedNames.Contains(importedNameInModule)) - { - return (import.Key, importedNameInModule); - } - } - - return null; - } - } - - static public IImmutableList GetElmModuleTextLines(string moduleText) => - moduleText.Replace("\r", "").Split(new[] { '\n' }, StringSplitOptions.None) - .ToImmutableList(); - - static public string GetTypeDefinitionTextFromModuleText(string typeNameInModule, string moduleText) - { - // Assume: There are no empty lines and no comments in the type definition. - - var match = - Regex.Match( - moduleText.Replace("\r", ""), - @"(?<=(^|\n))type\s+(|alias\s+)" + typeNameInModule + @"\s+.+?(?=\n($|\n))", - RegexOptions.Singleline); - - if (!match.Success) - return null; - - return match.Value; - } - - public struct ElmType - { - public CustomStructure? Custom; - - public RecordStructure? Record; - - public AliasStructure? Alias; - - public (string typeName, IImmutableList parameters)? Instance; - - public IImmutableList Tuple; - - public struct AliasStructure - { - public string aliasLocalName; - - public IImmutableList parameters; - - public string aliasedText; - } - - public struct CustomStructure - { - public string typeLocalName; - - public IImmutableList parameters; - - public IImmutableDictionary> tags; - } - - public struct RecordStructure - { - public IImmutableList<(string name, string typeText, ElmType parsedType)> fields; - } - } - - public struct ExpressionsForType - { - public string encodeExpression; - - public string decodeExpression; - - public IImmutableSet referencedModules; - - public override bool Equals(object obj) - { - if (obj is ExpressionsForType sameType) - return Equals(sameType); - - return base.Equals(obj); - } - - public bool Equals(ExpressionsForType other) => - encodeExpression == other.encodeExpression && - decodeExpression == other.decodeExpression && - referencedModules.SetEquals(other.referencedModules); - } - - static public IEnumerable<(string elmType, ExpressionsForType result)> - EnumerateExpressionsResolvingAllDependencies( - Func getExpressionsAndDependenciesForType, - IImmutableSet rootTypes) - { - var remainingDependencies = new Queue(rootTypes); - - var alreadyResolved = new HashSet(); - - while (0 < remainingDependencies.Count) - { - var currentType = remainingDependencies.Dequeue(); - - if (alreadyResolved.Contains(currentType)) - continue; - - alreadyResolved.Add(currentType); - - var currentTypeResults = getExpressionsAndDependenciesForType(currentType); - - var currentTypeExpressions = currentTypeResults.compileExpressions(); - - foreach (var dependency in currentTypeExpressions.dependencies) - remainingDependencies.Enqueue(dependency); - - yield return - (currentTypeResults.canonicalTypeTextWithParameters ?? currentTypeResults.canonicalTypeText, - new ExpressionsForType - { - encodeExpression = currentTypeExpressions.encodeExpression, - decodeExpression = currentTypeExpressions.decodeExpression, - referencedModules = currentTypeResults.referencedModules, - }); - } - } - - static public IImmutableList generalSupportingFunctionsTexts => new[]{ - jsonEncodeFunctionNamePrefix + jsonCodeMaybeFunctionNameCommonPart + $@" encodeJust valueToEncode = - case valueToEncode of - Nothing -> - [ ( ""Nothing"", [] |> Json.Encode.list identity ) ] |> Json.Encode.object - - Just just -> - [ ( ""Just"", [ just ] |> Json.Encode.list encodeJust ) ] |> Json.Encode.object -", - jsonDecodeFunctionNamePrefix + jsonCodeMaybeFunctionNameCommonPart + $@" decoder = - Json.Decode.oneOf - [ Json.Decode.field ""Nothing"" (Json.Decode.succeed Nothing) - , Json.Decode.field ""Just"" ((Json.Decode.index 0 decoder) |> Json.Decode.map Just) - , Json.Decode.field ""Just"" (decoder |> Json.Decode.map Just) -- 2020-03-07 Support easy migration of apps: Support decode from older JSON format for now. - , Json.Decode.null Nothing -- Temporary backwardscompatibility: Map 'null' to Nothing - ] -", - - jsonEncodeFunctionNamePrefix + jsonCodeListFunctionNameCommonPart + $@" encoder = - Json.Encode.list encoder -", - jsonDecodeFunctionNamePrefix + jsonCodeListFunctionNameCommonPart + $@" decoder = - Json.Decode.list decoder -", - - jsonEncodeFunctionNamePrefix + jsonCodeSetFunctionNameCommonPart + $@" encoder = - Set.toList >> Json.Encode.list encoder -", - jsonDecodeFunctionNamePrefix + jsonCodeSetFunctionNameCommonPart + $@" decoder = - Json.Decode.list decoder |> Json.Decode.map Set.fromList -", - jsonEncodeFunctionNamePrefix + jsonCodeDictFunctionNameCommonPart + $@" encodeKey encodeValue = - Dict.toList >> Json.Encode.list (" + jsonEncodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + "2 encodeKey encodeValue)", - - jsonDecodeFunctionNamePrefix + jsonCodeDictFunctionNameCommonPart + $@" decodeKey decodeValue = - let - -- Support migrate applications automatically from older framework versions: - - oldElementDecoder = - Json.Decode.map2 Tuple.pair - (Json.Decode.field ""key"" decodeKey) - (Json.Decode.field ""value"" decodeValue) - in - Json.Decode.list (Json.Decode.oneOf [ " + jsonDecodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + $@"2 decodeKey decodeValue, oldElementDecoder ]) - |> Json.Decode.map Dict.fromList -", - jsonEncodeFunctionNamePrefix + jsonCodeResultFunctionNameCommonPart + $@" encodeErr encodeOk valueToEncode = - case valueToEncode of - Err valueToEncodeError -> - [ ( ""Err"", [ valueToEncodeError ] |> Json.Encode.list encodeErr ) ] |> Json.Encode.object - - Ok valueToEncodeOk -> - [ ( ""Ok"", [ valueToEncodeOk ] |> Json.Encode.list encodeOk ) ] |> Json.Encode.object -", - jsonDecodeFunctionNamePrefix + jsonCodeResultFunctionNameCommonPart + $@" decodeErr decodeOk = - Json.Decode.oneOf - [ Json.Decode.field ""Err"" (Json.Decode.index 0 decodeErr) |> Json.Decode.map Err - , Json.Decode.field ""Ok"" (Json.Decode.index 0 decodeOk) |> Json.Decode.map Ok - , Json.Decode.field ""Err"" decodeErr |> Json.Decode.map Err -- 2020-03-07 Support easy migration of apps: Support decode from older JSON format for now. - , Json.Decode.field ""Ok"" decodeOk |> Json.Decode.map Ok -- 2020-03-07 Support easy migration of apps: Support decode from older JSON format for now. - ] -", - jsonEncodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + $@"2 encodeA encodeB ( a, b ) = - [ a |> encodeA, b |> encodeB ] - |> Json.Encode.list identity -", - jsonDecodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + $@"2 decodeA decodeB = - Json.Decode.map2 (\a b -> ( a, b )) - (Json.Decode.index 0 decodeA) - (Json.Decode.index 1 decodeB) -", - jsonEncodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + $@"3 encodeA encodeB encodeC ( a, b, c ) = - [ a |> encodeA, b |> encodeB, c |> encodeC ] - |> Json.Encode.list identity -", - jsonDecodeFunctionNamePrefix + jsonCodeTupleFunctionNameCommonPart + $@"3 decodeA decodeB decodeC = - Json.Decode.map3 (\a b c -> ( a, b, c )) - (Json.Decode.index 0 decodeA) - (Json.Decode.index 1 decodeB) - (Json.Decode.index 2 decodeC) -", - $@"{{-| As found at --}} -jsonDecode_andMap : Json.Decode.Decoder a -> Json.Decode.Decoder (a -> b) -> Json.Decode.Decoder b -jsonDecode_andMap = - Json.Decode.map2 (|>) -", -$@" -json_encode_Bytes : Bytes.Bytes -> Json.Encode.Value -json_encode_Bytes bytes = - [ ( ""AsBase64"", bytes |> Base64.fromBytes |> Maybe.withDefault ""Error encoding to base64"" |> Json.Encode.string ) ] - |> Json.Encode.object -", -$@" -json_decode_Bytes : Json.Decode.Decoder Bytes.Bytes -json_decode_Bytes = - Json.Decode.field ""AsBase64"" - (Json.Decode.string - |> Json.Decode.andThen - (Base64.toBytes >> Maybe.map Json.Decode.succeed >> Maybe.withDefault (Json.Decode.fail ""Failed to decode base64."")) - ) -" - }.ToImmutableList(); - } -} \ No newline at end of file diff --git a/implement/elm-fullstack/ElmFullstack/ElmApp.cs b/implement/elm-fullstack/ElmFullstack/ElmApp.cs index 6090689d..3e62d852 100644 --- a/implement/elm-fullstack/ElmFullstack/ElmApp.cs +++ b/implement/elm-fullstack/ElmFullstack/ElmApp.cs @@ -3,7 +3,6 @@ using System.Collections.Immutable; using System.Linq; using System.Text; -using System.Text.RegularExpressions; using Pine; namespace ElmFullstack @@ -48,194 +47,12 @@ static public IImmutableDictionary, IImmutableList> static public IImmutableDictionary, IImmutableList> AsCompletelyLoweredElmApp( IImmutableDictionary, IImmutableList> sourceFiles, - ElmAppInterfaceConfig interfaceConfig, - Action logWriteLine) => + ElmAppInterfaceConfig interfaceConfig) => AsCompletelyLoweredElmApp( sourceFiles, rootModuleName: interfaceConfig.RootModuleName.Split('.').ToImmutableList(), interfaceToHostRootModuleName: InterfaceToHostRootModuleName.Split('.').ToImmutableList()); - static public IImmutableDictionary, IImmutableList> WithSupportForCodingElmType( - IImmutableDictionary, IImmutableList> originalAppFiles, - string elmTypeName, - string elmModuleToAddFunctionsIn, - Action logWriteLine, - out (string encodeFunctionName, string decodeFunctionName) functionNames) - { - var interfaceModuleFilePath = FilePathFromModuleName(elmModuleToAddFunctionsIn); - - if (!originalAppFiles.ContainsKey(interfaceModuleFilePath)) - { - throw new ArgumentException("Did not find the module '" + elmModuleToAddFunctionsIn + "'."); - } - - var interfaceModuleOriginalFile = originalAppFiles[interfaceModuleFilePath]; - - var interfaceModuleOriginalFileText = - Encoding.UTF8.GetString(interfaceModuleOriginalFile.ToArray()); - - string getOriginalModuleText(string moduleName) - { - var filePath = FilePathFromModuleName(moduleName); - - originalAppFiles.TryGetValue(filePath, out var moduleFile); - - if (moduleFile == null) - throw new Exception("Did not find the module named '" + moduleFile + "'"); - - return Encoding.UTF8.GetString(moduleFile.ToArray()); - } - - var allOriginalElmModulesNames = - originalAppFiles - .Select(originalAppFilePathAndContent => - { - var fileName = originalAppFilePathAndContent.Key.Last(); - - if (originalAppFilePathAndContent.Key.First() != "src" || !fileName.EndsWith(".elm")) - return null; - - return - (IEnumerable) - originalAppFilePathAndContent.Key.Skip(1).Reverse().Skip(1).Reverse() - .Concat(new[] { fileName.Substring(0, fileName.Length - 4) }) - .ToImmutableList(); - }) - .Where(module => module != null) - .OrderBy(module => string.Join(".", module)) - .ToImmutableHashSet(); - - var sourceModules = - allOriginalElmModulesNames - .Select(moduleName => string.Join(".", moduleName)) - .ToImmutableDictionary( - moduleName => moduleName, - moduleName => - { - var originalModuleText = getOriginalModuleText(moduleName); - - if (moduleName == elmModuleToAddFunctionsIn) - { - return - CompileElm.WithImportsAdded(originalModuleText, allOriginalElmModulesNames); - } - - return originalModuleText; - }); - - var getExpressionsAndDependenciesForType = new Func(canonicalTypeName => - { - return - CompileElmValueSerializer.ResolveType( - canonicalTypeName, - elmModuleToAddFunctionsIn, - sourceModules, - logWriteLine); - }); - - var functionCodingExpressions = - CompileElmValueSerializer.EnumerateExpressionsResolvingAllDependencies( - getExpressionsAndDependenciesForType, - ImmutableHashSet.Create(elmTypeName)) - .ToImmutableList(); - - var functionCodingExpressionsDict = - functionCodingExpressions - .ToImmutableDictionary(entry => entry.elmType, entry => entry.result); - - var appFilesAfterExposingCustomTypesInModules = - functionCodingExpressionsDict - .Select(exprResult => exprResult.Key) - .Aggregate( - originalAppFiles, - (partiallyUpdatedAppFiles, elmType) => - { - { - var enclosingParenthesesMatch = Regex.Match(elmType.Trim(), @"^\(([^,^\)]+)\)$"); - - if (enclosingParenthesesMatch.Success) - elmType = enclosingParenthesesMatch.Groups[1].Value; - } - - var qualifiedMatch = Regex.Match(elmType.Trim(), @"^(.+)\.([^\s^\.]+)(\s+[a-z][^\s^\.]*)*$"); - - if (!qualifiedMatch.Success) - return partiallyUpdatedAppFiles; - - var moduleName = qualifiedMatch.Groups[1].Value; - var localTypeName = qualifiedMatch.Groups[2].Value; - - var expectedFilePath = FilePathFromModuleName(moduleName); - - var moduleBefore = - partiallyUpdatedAppFiles - .FirstOrDefault(candidate => candidate.Key.SequenceEqual(expectedFilePath)); - - if (moduleBefore.Value == null) - return partiallyUpdatedAppFiles; - - var moduleTextBefore = Encoding.UTF8.GetString(moduleBefore.Value.ToArray()); - - var isCustomTypeMatch = Regex.Match( - moduleTextBefore, - @"^type\s+" + localTypeName + @"(\s+[a-z][^\s]*){0,}\s*=", RegexOptions.Multiline); - - if (!isCustomTypeMatch.Success) - return partiallyUpdatedAppFiles; - - var moduleText = CompileElm.ExposeCustomTypeAllTagsInElmModule(moduleTextBefore, localTypeName); - - return partiallyUpdatedAppFiles.SetItem(moduleBefore.Key, Encoding.UTF8.GetBytes(moduleText).ToImmutableList()); - }); - - var supportingCodingFunctions = - functionCodingExpressionsDict - .Select(typeResult => CompileElmValueSerializer.BuildJsonCodingFunctionTexts( - typeResult.Key, - typeResult.Value.encodeExpression, - typeResult.Value.decodeExpression)) - .SelectMany(encodeAndDecodeFunctions => new[] { encodeAndDecodeFunctions.encodeFunction, encodeAndDecodeFunctions.decodeFunction }) - .ToImmutableHashSet() - .Union(CompileElmValueSerializer.generalSupportingFunctionsTexts); - - var modulesToImport = - functionCodingExpressions - .SelectMany(functionReplacement => - functionReplacement.result.referencedModules.Select(moduleName => moduleName.Split("."))) - .ToImmutableHashSet(EnumerableExtension.EqualityComparer()) - .Remove(elmModuleToAddFunctionsIn.Split(".")) - .Add(new[] { "Set" }) - .Add(new[] { "Dict" }) - .Add(new[] { "Json.Decode" }) - .Add(new[] { "Json.Encode" }) - .Add(new[] { "Base64" }) - .Add(new[] { "Bytes" }) - .Add(new[] { "Bytes.Encode" }) - .Add(new[] { "Bytes.Decode" }); - - var interfaceModuleWithImports = - CompileElm.WithImportsAdded(interfaceModuleOriginalFileText, modulesToImport); - - var interfaceModuleWithSupportingFunctions = - supportingCodingFunctions - .Aggregate( - interfaceModuleWithImports, - (intermediateModuleText, supportingFunction) => CompileElm.WithFunctionAdded(intermediateModuleText, supportingFunction)); - - var elmTypeCodingFunctionNames = - CompileElmValueSerializer.GetFunctionNamesAndTypeParametersFromTypeText( - getExpressionsAndDependenciesForType(elmTypeName).canonicalTypeText); - - functionNames = - (encodeFunctionName: elmTypeCodingFunctionNames.functionNames.encodeFunctionName, - decodeFunctionName: elmTypeCodingFunctionNames.functionNames.decodeFunctionName); - - return - appFilesAfterExposingCustomTypesInModules.SetItem( - interfaceModuleFilePath, - Encoding.UTF8.GetBytes(interfaceModuleWithSupportingFunctions).ToImmutableList()); - } - static IImmutableDictionary, IImmutableList> AsCompletelyLoweredElmApp( IImmutableDictionary, IImmutableList> sourceFiles, IImmutableList rootModuleName, @@ -407,129 +224,8 @@ static public IImmutableList FilePathFromModuleName(IReadOnlyList FilePathFromModuleName(string moduleName) => FilePathFromModuleName(moduleName.Split(new[] { '.' }).ToImmutableList()); - static public string StateTypeNameFromRootElmModule(string elmModuleText) - { - var match = Regex.Match( - elmModuleText, - "^" + ElmAppInterfaceConvention.ProcessSerializedEventFunctionName + - @"\s*:\s*String\s*->\s*([\w\d_]+)\s*->\s*\(\s*", - RegexOptions.Multiline); - - if (!match.Success) - throw new System.Exception("Did not find the expected type anotation for function " + ElmAppInterfaceConvention.ProcessSerializedEventFunctionName); - - return match.Groups[1].Value; - } - static public string InterfaceToHostRootModuleName => "Backend.InterfaceToHost_Root"; - static public IImmutableList InterfaceToHostRootModuleFilePathFromSourceFiles( - IImmutableDictionary, IImmutableList> sourceFiles) => - FilePathFromModuleName(InterfaceToHostRootModuleName); - - static public string InitialRootElmModuleText( - string rootModuleNameBeforeLowering, - string stateTypeNameInRootModuleBeforeLowering) => - $@" -module " + InterfaceToHostRootModuleName + $@" exposing - ( State - , interfaceToHost_deserializeState - , interfaceToHost_initState - , interfaceToHost_processEvent - , interfaceToHost_serializeState - , main - ) - -import " + rootModuleNameBeforeLowering + $@" -import Platform - -type alias DeserializedState = " + rootModuleNameBeforeLowering + "." + stateTypeNameInRootModuleBeforeLowering + $@" - - -type State - = DeserializeFailed String - | DeserializeSuccessful DeserializedState - - -interfaceToHost_initState = " + rootModuleNameBeforeLowering + $@".interfaceToHost_initState |> DeserializeSuccessful - - -interfaceToHost_processEvent hostEvent stateBefore = - case stateBefore of - DeserializeFailed _ -> - ( stateBefore, ""[]"" ) - - DeserializeSuccessful deserializedState -> - deserializedState - |> " + rootModuleNameBeforeLowering + $@".interfaceToHost_processEvent hostEvent - |> Tuple.mapFirst DeserializeSuccessful - - -interfaceToHost_serializeState = jsonEncodeState >> Json.Encode.encode 0 - - -interfaceToHost_deserializeState = deserializeState - - --- Support function-level dead code elimination (https://elm-lang.org/blog/small-assets-without-the-headache) Elm code needed to inform the Elm compiler about our entry points. - - -main : Program Int State String -main = - Platform.worker - {{ init = \_ -> ( interfaceToHost_initState, Cmd.none ) - , update = - \event stateBefore -> - interfaceToHost_processEvent event (stateBefore |> interfaceToHost_serializeState |> interfaceToHost_deserializeState) |> Tuple.mapSecond (always Cmd.none) - , subscriptions = \_ -> Sub.none - }} - - --- Inlined helpers --> - - -{{-| Turn a `Result e a` to an `a`, by applying the conversion -function specified to the `e`. --}} -result_Extra_Extract : (e -> a) -> Result e a -> a -result_Extra_Extract f x = - case x of - Ok a -> - a - - Err e -> - f e - - --- Remember and communicate errors from state deserialization --> - - -jsonEncodeState : State -> Json.Encode.Value -jsonEncodeState state = - case state of - DeserializeFailed error -> - [ ( ""Interface_DeserializeFailed"", [ ( ""error"", error |> Json.Encode.string ) ] |> Json.Encode.object ) ] |> Json.Encode.object - - DeserializeSuccessful deserializedState -> - deserializedState |> jsonEncodeDeserializedState - - -deserializeState : String -> State -deserializeState serializedState = - serializedState - |> Json.Decode.decodeString jsonDecodeState - |> Result.mapError Json.Decode.errorToString - |> result_Extra_Extract DeserializeFailed - - -jsonDecodeState : Json.Decode.Decoder State -jsonDecodeState = - Json.Decode.oneOf - [ Json.Decode.field ""Interface_DeserializeFailed"" (Json.Decode.field ""error"" Json.Decode.string |> Json.Decode.map DeserializeFailed) - , jsonDecodeDeserializedState |> Json.Decode.map DeserializeSuccessful - ] - -"; static Lazy jsEngineToCompileElmApp = new Lazy(PrepareJsEngineToCompileElmApp); static public JavaScriptEngineSwitcher.Core.IJsEngine PrepareJsEngineToCompileElmApp() diff --git a/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm b/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm index 33c19455..44064f46 100644 --- a/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm +++ b/implement/elm-fullstack/ElmFullstack/compile-elm-program/src/CompileFullstackApp.elm @@ -74,6 +74,21 @@ elmAppInterfaceConvention = } +appStateMigrationInterfaceModuleName : String +appStateMigrationInterfaceModuleName = + "MigrateBackendState" + + +appStateMigrationRootModuleName : String +appStateMigrationRootModuleName = + appStateMigrationInterfaceModuleName ++ "Root" + + +appStateMigrationInterfaceFunctionName : String +appStateMigrationInterfaceFunctionName = + "migrate" + + type alias AppFiles = Dict.Dict (List String) Bytes.Bytes @@ -129,6 +144,7 @@ asCompletelyLoweredElmApp { sourceFiles, compilationInterfaceElmModuleNamePrefix , interfaceToHostRootModuleName = interfaceToHostRootModuleName } ) + |> Result.andThen (loweredForAppStateMigration { originalSourceModules = sourceModules }) loweredForSourceFiles : List String -> AppFiles -> Result String AppFiles @@ -186,91 +202,151 @@ loweredForAppStateSerializer : -> Result (List CompilationError) AppFiles loweredForAppStateSerializer { rootModuleName, interfaceToHostRootModuleName, originalSourceModules } sourceFiles = let - backendMainFilePath = - filePathFromElmModuleName (String.join "." rootModuleName) - interfaceToHostRootFilePath = filePathFromElmModuleName (String.join "." interfaceToHostRootModuleName) in - case Dict.get backendMainFilePath sourceFiles of + case Dict.get (String.join "." rootModuleName) originalSourceModules of Nothing -> -- App contains no backend. Ok sourceFiles - Just backendMainFile -> + Just backendMainModule -> if Dict.get interfaceToHostRootFilePath sourceFiles /= Nothing then -- Support integrating applications supplying their own lowered version. Ok sourceFiles else - case stringFromFileContent backendMainFile of - Nothing -> - Err [ OtherCompilationError "Failed to map file content to text" ] - - Just backendMainModuleText -> - parseAppStateElmTypeAndDependenciesRecursively originalSourceModules backendMainModuleText - |> Result.mapError ((++) "Failed to parse state type name: ") - |> Result.andThen - (\( stateTypeAnnotation, stateTypeDependencies ) -> - let - initialRootElmModuleText = - composeInitialRootElmModuleText - { interfaceToHostRootModuleName = String.join "." interfaceToHostRootModuleName - , rootModuleNameBeforeLowering = String.join "." rootModuleName - , stateTypeAnnotation = stateTypeAnnotation - } - in - mapAppFilesAndModuleTextToSupportJsonCoding + parseAppStateElmTypeAndDependenciesRecursively originalSourceModules backendMainModule + |> Result.mapError ((++) "Failed to parse state type name: ") + |> Result.map + (\( stateTypeAnnotation, stateTypeDependencies ) -> + let + ( appFiles, { generatedModuleName, modulesToImport } ) = + mapAppFilesToSupportJsonCoding + { generatedModuleNamePrefix = interfaceToHostRootModuleName } [ stateTypeAnnotation ] stateTypeDependencies - ( sourceFiles, initialRootElmModuleText ) - |> Result.map - (\( appFiles, interfaceModuleTextWithSupportingFunctions, generatedModuleName ) -> - let - functionsNamesInGeneratedModules = - buildJsonCodingFunctionsForTypeAnnotation stateTypeAnnotation - - encodeFunction = - "jsonEncodeDeserializedState =\n" - ++ indentElmCodeLines 1 - (generatedModuleName ++ "." ++ functionsNamesInGeneratedModules.encodeFunction.name) - - decodeFunction = - "jsonDecodeDeserializedState =\n" - ++ indentElmCodeLines 1 - (generatedModuleName ++ "." ++ functionsNamesInGeneratedModules.decodeFunction.name) - - interfaceModuleText = - [ interfaceModuleTextWithSupportingFunctions - , encodeFunction - , decodeFunction - ] - |> String.join "\n\n" - in - appFiles - |> updateFileContentAtPath - (always (fileContentFromString interfaceModuleText)) - interfaceToHostRootFilePath - ) - ) - |> Result.mapError (OtherCompilationError >> List.singleton) + sourceFiles + + functionsNamesInGeneratedModules = + buildJsonCodingFunctionsForTypeAnnotation stateTypeAnnotation + + encodeFunction = + "jsonEncodeDeserializedState =\n" + ++ indentElmCodeLines 1 + (generatedModuleName ++ "." ++ functionsNamesInGeneratedModules.encodeFunction.name) + + decodeFunction = + "jsonDecodeDeserializedState =\n" + ++ indentElmCodeLines 1 + (generatedModuleName ++ "." ++ functionsNamesInGeneratedModules.decodeFunction.name) + + rootElmModuleText = + composeAppRootElmModuleText + { interfaceToHostRootModuleName = String.join "." interfaceToHostRootModuleName + , rootModuleNameBeforeLowering = String.join "." rootModuleName + , stateTypeAnnotation = stateTypeAnnotation + , modulesToImport = modulesToImport + , encodeFunction = encodeFunction + , decodeFunction = decodeFunction + } + in + appFiles + |> updateFileContentAtPath + (always (fileContentFromString rootElmModuleText)) + interfaceToHostRootFilePath + ) + |> Result.mapError (OtherCompilationError >> List.singleton) -parseAppStateElmTypeAndDependenciesRecursively : Dict.Dict String Elm.Syntax.File.File -> String -> Result String ( ElmTypeAnnotation, Dict.Dict String ElmCustomTypeStruct ) -parseAppStateElmTypeAndDependenciesRecursively sourceModules moduleText = - case parseElmModuleText moduleText of +loweredForAppStateMigration : + { originalSourceModules : Dict.Dict String Elm.Syntax.File.File } + -> AppFiles + -> Result (List CompilationError) AppFiles +loweredForAppStateMigration { originalSourceModules } sourceFiles = + let + interfaceToHostRootFilePath = + filePathFromElmModuleName appStateMigrationRootModuleName + in + case Dict.get appStateMigrationInterfaceModuleName originalSourceModules of + Nothing -> + -- App contains no migrate module. + Ok sourceFiles + + Just originalInterfaceModule -> + if Dict.get interfaceToHostRootFilePath sourceFiles /= Nothing then + -- Support integrating applications supplying their own lowered version. + Ok sourceFiles + + else + parseAppStateMigrateElmTypeAndDependenciesRecursively originalSourceModules originalInterfaceModule + |> Result.mapError ((++) "Failed to parse state type name: ") + |> Result.map + (\( ( inputType, returnType ), stateTypeDependencies ) -> + let + ( appFiles, { generatedModuleName, modulesToImport } ) = + mapAppFilesToSupportJsonCoding + { generatedModuleNamePrefix = String.split "." appStateMigrationRootModuleName } + [ inputType, returnType ] + stateTypeDependencies + sourceFiles + + inputTypeNamesInGeneratedModules = + buildJsonCodingFunctionsForTypeAnnotation inputType + + returnTypeNamesInGeneratedModules = + buildJsonCodingFunctionsForTypeAnnotation returnType + + rootElmModuleText = + composeStateMigrationModuleText + { generatedModuleName = generatedModuleName + , decodeOrigTypeFunctionName = inputTypeNamesInGeneratedModules.decodeFunction.name + , encodeDestTypeFunctionName = returnTypeNamesInGeneratedModules.encodeFunction.name + , modulesToImport = modulesToImport + } + in + appFiles + |> updateFileContentAtPath + (always (fileContentFromString rootElmModuleText)) + interfaceToHostRootFilePath + ) + |> Result.mapError (OtherCompilationError >> List.singleton) + + +parseAppStateElmTypeAndDependenciesRecursively : Dict.Dict String Elm.Syntax.File.File -> Elm.Syntax.File.File -> Result String ( ElmTypeAnnotation, Dict.Dict String ElmCustomTypeStruct ) +parseAppStateElmTypeAndDependenciesRecursively sourceModules parsedModule = + case stateTypeAnnotationFromRootElmModule parsedModule of Err error -> - Err ("Failed to parse Elm module text: " ++ parserDeadEndsToString moduleText error) + Err ("Did not find state type annotation: " ++ error) - Ok parsedModule -> - case stateTypeAnnotationFromRootElmModule parsedModule of - Err error -> - Err ("Did not find state type annotation: " ++ error) + Ok stateTypeAnnotation -> + parseElmTypeAndDependenciesRecursivelyFromAnnotation + sourceModules + ( parsedModule, stateTypeAnnotation ) + + +parseAppStateMigrateElmTypeAndDependenciesRecursively : Dict.Dict String Elm.Syntax.File.File -> Elm.Syntax.File.File -> Result String ( ( ElmTypeAnnotation, ElmTypeAnnotation ), Dict.Dict String ElmCustomTypeStruct ) +parseAppStateMigrateElmTypeAndDependenciesRecursively sourceModules parsedModule = + case migrateStateTypeAnnotationFromElmModule parsedModule of + Err error -> + Err ("Did not find state type annotation: " ++ error) - Ok stateTypeAnnotation -> - parseElmTypeAndDependenciesRecursivelyFromAnnotation - sourceModules - ( parsedModule, stateTypeAnnotation ) + Ok ( originType, destinationType ) -> + parseElmTypeAndDependenciesRecursivelyFromAnnotation + sourceModules + ( parsedModule, originType ) + |> Result.andThen + (\( originTypeAnnotation, originTypeDependencies ) -> + parseElmTypeAndDependenciesRecursivelyFromAnnotation + sourceModules + ( parsedModule, destinationType ) + |> Result.map + (\( destinationTypeAnnotation, destinationTypeDependencies ) -> + ( ( originTypeAnnotation, destinationTypeAnnotation ) + , originTypeDependencies |> Dict.union destinationTypeDependencies + ) + ) + ) stateTypeAnnotationFromRootElmModule : Elm.Syntax.File.File -> Result String Elm.Syntax.TypeAnnotation.TypeAnnotation @@ -315,13 +391,58 @@ stateTypeAnnotationFromRootElmModule parsedModule = |> Maybe.withDefault (Err "Did not find function with matching name") -composeInitialRootElmModuleText : +migrateStateTypeAnnotationFromElmModule : Elm.Syntax.File.File -> Result String ( Elm.Syntax.TypeAnnotation.TypeAnnotation, Elm.Syntax.TypeAnnotation.TypeAnnotation ) +migrateStateTypeAnnotationFromElmModule parsedModule = + parsedModule.declarations + |> List.filterMap + (\declaration -> + case Elm.Syntax.Node.value declaration of + Elm.Syntax.Declaration.FunctionDeclaration functionDeclaration -> + if + Elm.Syntax.Node.value (Elm.Syntax.Node.value functionDeclaration.declaration).name + == appStateMigrationInterfaceFunctionName + then + Just functionDeclaration + + else + Nothing + + _ -> + Nothing + ) + |> List.head + |> Maybe.map + (\functionDeclaration -> + case functionDeclaration.signature of + Nothing -> + Err "Missing function signature" + + Just functionSignature -> + case Elm.Syntax.Node.value (Elm.Syntax.Node.value functionSignature).typeAnnotation of + Elm.Syntax.TypeAnnotation.FunctionTypeAnnotation inputType returnType -> + case Elm.Syntax.Node.value returnType of + Elm.Syntax.TypeAnnotation.FunctionTypeAnnotation _ _ -> + Err "Too many parameters." + + _ -> + Ok ( Elm.Syntax.Node.value inputType, Elm.Syntax.Node.value returnType ) + + _ -> + Err "Unexpected type annotation" + ) + |> Maybe.withDefault (Err "Did not find function with matching name") + + +composeAppRootElmModuleText : { interfaceToHostRootModuleName : String , rootModuleNameBeforeLowering : String , stateTypeAnnotation : ElmTypeAnnotation + , modulesToImport : List (List String) + , encodeFunction : String + , decodeFunction : String } -> String -composeInitialRootElmModuleText { interfaceToHostRootModuleName, rootModuleNameBeforeLowering, stateTypeAnnotation } = +composeAppRootElmModuleText { interfaceToHostRootModuleName, rootModuleNameBeforeLowering, stateTypeAnnotation, modulesToImport, encodeFunction, decodeFunction } = "module " ++ interfaceToHostRootModuleName ++ """ exposing ( State , interfaceToHost_deserializeState @@ -332,6 +453,7 @@ composeInitialRootElmModuleText { interfaceToHostRootModuleName, rootModuleNameB ) import """ ++ rootModuleNameBeforeLowering ++ """ +""" ++ (modulesToImport |> List.map (String.join "." >> (++) "import ") |> String.join "\n") ++ """ import Platform type alias DeserializedState = @@ -421,6 +543,60 @@ jsonDecodeState = , jsonDecodeDeserializedState |> Json.Decode.map DeserializeSuccessful ] +""" ++ encodeFunction ++ "\n\n" ++ decodeFunction + + +composeStateMigrationModuleText : + { generatedModuleName : String + , decodeOrigTypeFunctionName : String + , encodeDestTypeFunctionName : String + , modulesToImport : List (List String) + } + -> String +composeStateMigrationModuleText { generatedModuleName, decodeOrigTypeFunctionName, encodeDestTypeFunctionName, modulesToImport } = + String.trimLeft """ +module """ ++ appStateMigrationRootModuleName ++ """ exposing (decodeMigrateAndEncodeAndSerializeResult, main) + +import """ ++ appStateMigrationInterfaceModuleName ++ """ +import """ ++ generatedModuleName ++ """ +""" ++ (modulesToImport |> List.map (String.join "." >> (++) "import ") |> String.join "\n") ++ """ +import Json.Decode +import Json.Encode + + +decodeMigrateAndEncode : String -> Result String String +decodeMigrateAndEncode = + Json.Decode.decodeString """ ++ generatedModuleName ++ "." ++ decodeOrigTypeFunctionName ++ """ + >> Result.map (""" ++ appStateMigrationInterfaceModuleName ++ "." ++ appStateMigrationInterfaceFunctionName ++ """ >> """ ++ generatedModuleName ++ "." ++ encodeDestTypeFunctionName ++ """ >> Json.Encode.encode 0) + >> Result.mapError Json.Decode.errorToString + + +decodeMigrateAndEncodeAndSerializeResult : String -> String +decodeMigrateAndEncodeAndSerializeResult = + decodeMigrateAndEncode + >> jsonEncodeResult Json.Encode.string Json.Encode.string + >> Json.Encode.encode 0 + + +jsonEncodeResult : (err -> Json.Encode.Value) -> (ok -> Json.Encode.Value) -> Result err ok -> Json.Encode.Value +jsonEncodeResult encodeErr encodeOk valueToEncode = + case valueToEncode of + Err valueToEncodeError -> + [ ( "Err", [ valueToEncodeError ] |> Json.Encode.list encodeErr ) ] |> Json.Encode.object + + Ok valueToEncodeOk -> + [ ( "Ok", [ valueToEncodeOk ] |> Json.Encode.list encodeOk ) ] |> Json.Encode.object + + +main : Program Int {} String +main = + Platform.worker + { init = \\_ -> ( {}, Cmd.none ) + , update = + \\_ _ -> + ( decodeMigrateAndEncodeAndSerializeResult |> always {}, Cmd.none ) + , subscriptions = \\_ -> Sub.none + } """ @@ -450,6 +626,10 @@ mapJsonCodersModuleText { originalSourceModules } ( sourceFiles, moduleText ) = Err ("Failed to parse Elm module text: " ++ parserDeadEndsToString moduleText error) Ok parsedModule -> + let + interfaceModuleName = + Elm.Syntax.Module.moduleName (Elm.Syntax.Node.value parsedModule.moduleDefinition) + in parsedModule.declarations -- TODO: Also share the 'map all functions' part with `mapSourceFilesModuleText` |> List.filterMap @@ -498,163 +678,160 @@ mapJsonCodersModuleText { originalSourceModules } ( sourceFiles, moduleText ) = |> Result.Extra.combine |> Result.andThen (\functionsToReplace -> - mapAppFilesAndModuleTextToSupportJsonCoding - (functionsToReplace |> List.map .parsedTypeAnnotation) - (functionsToReplace |> List.map .dependencies |> List.foldl Dict.union Dict.empty) - ( sourceFiles, moduleText ) - |> Result.andThen - (\( appFiles, interfaceModuleText, generatedModuleName ) -> - functionsToReplace - |> listFoldlToAggregateResult - (\functionToReplace previousModuleText -> - let - functionName = - functionToReplace.functionName - - functionsNamesInGeneratedModules = - buildJsonCodingFunctionsForTypeAnnotation functionToReplace.parsedTypeAnnotation - - newFunction = - functionName - ++ " =\n " - ++ generatedModuleName - ++ "." - ++ (if functionToReplace.functionType.isDecoder then - functionsNamesInGeneratedModules.decodeFunction.name - - else - functionsNamesInGeneratedModules.encodeFunction.name - ) - - mapFunctionDeclarationLines originalFunctionTextLines = - [ originalFunctionTextLines |> List.take 1 - , [ newFunction ] - ] - |> List.concat - in - addOrUpdateFunctionInElmModuleText - { functionName = functionName - , mapFunctionLines = Maybe.withDefault [] >> mapFunctionDeclarationLines - } - previousModuleText - |> Result.mapError ((++) "Failed to replace function text: ") - ) - (Ok interfaceModuleText) - |> Result.map (Tuple.pair appFiles) + let + ( appFiles, { generatedModuleName, modulesToImport } ) = + mapAppFilesToSupportJsonCoding + { generatedModuleNamePrefix = interfaceModuleName } + (functionsToReplace |> List.map .parsedTypeAnnotation) + (functionsToReplace |> List.map .dependencies |> List.foldl Dict.union Dict.empty) + sourceFiles + in + functionsToReplace + |> listFoldlToAggregateResult + (\functionToReplace previousModuleText -> + let + functionName = + functionToReplace.functionName + + functionsNamesInGeneratedModules = + buildJsonCodingFunctionsForTypeAnnotation functionToReplace.parsedTypeAnnotation + + newFunction = + functionName + ++ " =\n " + ++ generatedModuleName + ++ "." + ++ (if functionToReplace.functionType.isDecoder then + functionsNamesInGeneratedModules.decodeFunction.name + + else + functionsNamesInGeneratedModules.encodeFunction.name + ) + + mapFunctionDeclarationLines originalFunctionTextLines = + [ originalFunctionTextLines |> List.take 1 + , [ newFunction ] + ] + |> List.concat + in + addOrUpdateFunctionInElmModuleText + { functionName = functionName + , mapFunctionLines = Maybe.withDefault [] >> mapFunctionDeclarationLines + } + previousModuleText + |> Result.mapError ((++) "Failed to replace function text: ") ) + (addImportsInElmModuleText + modulesToImport + moduleText + ) + |> Result.map (Tuple.pair appFiles) ) -mapAppFilesAndModuleTextToSupportJsonCoding : - List ElmTypeAnnotation +mapAppFilesToSupportJsonCoding : + { generatedModuleNamePrefix : List String } + -> List ElmTypeAnnotation -> Dict.Dict String ElmCustomTypeStruct - -> ( AppFiles, String ) - -> Result String ( AppFiles, String, String ) -mapAppFilesAndModuleTextToSupportJsonCoding typeAnnotationsBeforeDeduplicating customTypes ( appFilesBefore, moduleText ) = - case parseElmModuleText moduleText of - Err error -> - Err ("Failed to parse Elm module text: " ++ parserDeadEndsToString moduleText error) - - Ok parsedModule -> - let - interfaceModuleName = - Elm.Syntax.Module.moduleName (Elm.Syntax.Node.value parsedModule.moduleDefinition) + -> AppFiles + -> ( AppFiles, { generatedModuleName : String, modulesToImport : List (List String) } ) +mapAppFilesToSupportJsonCoding { generatedModuleNamePrefix } typeAnnotationsBeforeDeduplicating customTypes appFilesBefore = + let + modulesToImportForCustomTypes = + customTypes + |> Dict.keys + |> List.map moduleNameFromTypeName + |> Set.fromList + |> Set.toList + |> List.map (String.split ".") + + modulesToImport = + [ [ "Base64" ] + , [ "Dict" ] + , [ "Set" ] + , [ "Json", "Decode" ] + , [ "Json", "Encode" ] + , [ "Bytes" ] + , [ "Bytes", "Decode" ] + , [ "Bytes", "Encode" ] + ] + ++ modulesToImportForCustomTypes + + appFilesAfterExposingCustomTypesInModules = + modulesToImportForCustomTypes + |> List.foldl exposeAllInElmModuleInAppFiles appFilesBefore + + typeAnnotationsFunctions = + typeAnnotationsBeforeDeduplicating + |> listRemoveDuplicates + |> List.map buildJsonCodingFunctionsForTypeAnnotation + + typeAnnotationsFunctionsForGeneratedModule = + typeAnnotationsFunctions + |> List.concatMap + (\functionsForType -> + [ functionsForType.encodeFunction, functionsForType.decodeFunction ] + ) + |> List.map (\function -> { functionName = function.name, functionText = function.text }) - modulesToImportForCustomTypes = - customTypes - |> Dict.keys - |> List.map moduleNameFromTypeName - |> Set.fromList - |> Set.toList - |> List.map (String.split ".") - - modulesToImport = - [ [ "Base64" ] - , [ "Dict" ] - , [ "Set" ] - , [ "Json", "Decode" ] - , [ "Json", "Encode" ] - , [ "Bytes" ] - , [ "Bytes", "Decode" ] - , [ "Bytes", "Encode" ] - ] - ++ modulesToImportForCustomTypes - |> List.filter ((==) interfaceModuleName >> not) - - appFilesAfterExposingCustomTypesInModules = - modulesToImportForCustomTypes - |> List.foldl exposeAllInElmModuleInAppFiles appFilesBefore - - typeAnnotationsFunctions = - typeAnnotationsBeforeDeduplicating - |> listRemoveDuplicates - |> List.map buildJsonCodingFunctionsForTypeAnnotation - - typeAnnotationsFunctionsForGeneratedModule = - typeAnnotationsFunctions - |> List.concatMap - (\functionsForType -> - [ functionsForType.encodeFunction, functionsForType.decodeFunction ] - ) - |> List.map (\function -> { functionName = function.name, functionText = function.text }) - - dependenciesFunctions = - customTypes - |> Dict.toList - |> List.map - (\( customTypeName, customType ) -> - jsonCodingFunctionFromCustomType - { customTypeName = customTypeName - , encodeValueExpression = jsonEncodeParamName - , typeArgLocalName = "type_arg" - } - customType - ) - |> List.concatMap - (\functionsForType -> - [ functionsForType.encodeFunction, functionsForType.decodeFunction ] - ) - |> List.map (\function -> { functionName = function.name, functionText = function.text }) + dependenciesFunctions = + customTypes + |> Dict.toList + |> List.map + (\( customTypeName, customType ) -> + jsonCodingFunctionFromCustomType + { customTypeName = customTypeName + , encodeValueExpression = jsonEncodeParamName + , typeArgLocalName = "type_arg" + } + customType + ) + |> List.concatMap + (\functionsForType -> + [ functionsForType.encodeFunction, functionsForType.decodeFunction ] + ) + |> List.map (\function -> { functionName = function.name, functionText = function.text }) - functionsForGeneratedModule = - typeAnnotationsFunctionsForGeneratedModule ++ dependenciesFunctions ++ generalSupportingFunctionsTexts + functionsForGeneratedModule = + typeAnnotationsFunctionsForGeneratedModule ++ dependenciesFunctions ++ generalSupportingFunctionsTexts - generatedModuleTextWithoutModuleDeclaration = - [ modulesToImport |> List.map (String.join "." >> (++) "import ") - , functionsForGeneratedModule |> List.map .functionText - ] - |> List.concat - |> String.join "\n\n" + generatedModuleTextWithoutModuleDeclaration = + [ modulesToImport |> List.map (String.join "." >> (++) "import ") + , functionsForGeneratedModule |> List.map .functionText + ] + |> List.concat + |> String.join "\n\n" - generatedModuleHash = - generatedModuleTextWithoutModuleDeclaration - |> SHA256.fromString - |> SHA256.toHex + generatedModuleHash = + generatedModuleTextWithoutModuleDeclaration + |> SHA256.fromString + |> SHA256.toHex - generatedModuleName = - (interfaceModuleName |> String.join ".") - ++ ".Generated_" - ++ String.left 8 generatedModuleHash + generatedModuleName = + (generatedModuleNamePrefix |> String.join ".") + ++ ".Generated_" + ++ String.left 8 generatedModuleHash - generatedModulePath = - filePathFromElmModuleName generatedModuleName + generatedModulePath = + filePathFromElmModuleName generatedModuleName - generatedModuleText = - [ "module " ++ generatedModuleName ++ " exposing (..)" - , generatedModuleTextWithoutModuleDeclaration - ] - |> String.join "\n\n" + generatedModuleText = + [ "module " ++ generatedModuleName ++ " exposing (..)" + , generatedModuleTextWithoutModuleDeclaration + ] + |> String.join "\n\n" - appFiles = - appFilesAfterExposingCustomTypesInModules - |> updateFileContentAtPath - (always (fileContentFromString generatedModuleText)) - generatedModulePath - in - addImportsInElmModuleText - ([ String.split "." generatedModuleName ] ++ modulesToImport) - moduleText - |> Result.map (\moduleTextWithImport -> ( appFiles, moduleTextWithImport, generatedModuleName )) + appFiles = + appFilesAfterExposingCustomTypesInModules + |> updateFileContentAtPath + (always (fileContentFromString generatedModuleText)) + generatedModulePath + in + ( appFiles + , { generatedModuleName = generatedModuleName + , modulesToImport = String.split "." generatedModuleName :: modulesToImport + } + ) buildJsonCodingFunctionsForTypeAnnotation : @@ -2612,11 +2789,6 @@ parserProblemToString p = "bad repeat" -stringStartsWithLowercaseLetter : String -> Bool -stringStartsWithLowercaseLetter = - String.toList >> List.head >> Maybe.map Char.isLower >> Maybe.withDefault False - - listFoldlToAggregateResult : (a -> b -> Result e b) -> Result e b -> List a -> Result e b listFoldlToAggregateResult getElementResult = List.foldl diff --git a/implement/elm-fullstack/ElmFullstack/compile-elm-program/tests/Tests.elm b/implement/elm-fullstack/ElmFullstack/compile-elm-program/tests/Tests.elm index b7192862..d620fea1 100644 --- a/implement/elm-fullstack/ElmFullstack/compile-elm-program/tests/Tests.elm +++ b/implement/elm-fullstack/ElmFullstack/compile-elm-program/tests/Tests.elm @@ -130,16 +130,33 @@ interfaceToHost_processEvent = (\( testName, moduleText, expectedResult ) -> Test.test testName <| \() -> - let - sourceModules = - [ moduleText ] - |> CompileFullstackApp.elmModulesDictFromFilesTexts - |> Dict.map (always Tuple.second) - in - CompileFullstackApp.parseAppStateElmTypeAndDependenciesRecursively - sourceModules - moduleText - |> Expect.equal expectedResult + moduleText + |> CompileFullstackApp.parseElmModuleText + |> Result.mapError + (\error -> + "Failed to parse supporting module '" + ++ (moduleText + |> String.lines + |> List.head + |> Maybe.withDefault "???" + ) + ++ "': " + ++ CompileFullstackApp.parserDeadEndsToString moduleText error + ) + |> Result.map + (\parsedModule -> + let + sourceModules = + [ moduleText ] + |> CompileFullstackApp.elmModulesDictFromFilesTexts + |> Dict.map (always Tuple.second) + in + CompileFullstackApp.parseAppStateElmTypeAndDependenciesRecursively + sourceModules + parsedModule + |> Expect.equal expectedResult + ) + |> Result.Extra.unpack Expect.fail identity ) |> Test.describe "state type name from root Elm module" diff --git a/implement/elm-fullstack/Program.cs b/implement/elm-fullstack/Program.cs index bcbe7d9c..9e97f327 100644 --- a/implement/elm-fullstack/Program.cs +++ b/implement/elm-fullstack/Program.cs @@ -398,8 +398,6 @@ static int Main(string[] args) ElmFullstack.WebHost.PersistentProcess.PersistentProcessVolatileRepresentation.TreeToFlatDictionaryWithPathComparer( loadFromPathResult.Ok.tree); - var compilationLog = new List(); - string compilationException = null; Composition.TreeWithStringPath compiledTree = null; @@ -407,8 +405,7 @@ static int Main(string[] args) { var loweredAppFiles = ElmFullstack.ElmApp.AsCompletelyLoweredElmApp( sourceFiles: sourceFiles, - ElmFullstack.ElmAppInterfaceConfig.Default, - compilationLog.Add); + ElmFullstack.ElmAppInterfaceConfig.Default); compiledTree = Composition.SortedTreeFromSetOfBlobsWithStringPath(loweredAppFiles); @@ -455,7 +452,6 @@ static int Main(string[] args) sourceCompositionId = sourceCompositionId, sourceSummary = sourceSummary, compilationException = compilationException, - compilationLog = compilationLog.ToImmutableList(), compilationTimeSpentMilli = (int)compilationTimeSpentMilli, compiledCompositionId = compiledCompositionId, }; diff --git a/implement/elm-fullstack/WebHost/PersistentProcessVolatileRepresentation.cs b/implement/elm-fullstack/WebHost/PersistentProcessVolatileRepresentation.cs index 8cfa5620..24e401c2 100644 --- a/implement/elm-fullstack/WebHost/PersistentProcessVolatileRepresentation.cs +++ b/implement/elm-fullstack/WebHost/PersistentProcessVolatileRepresentation.cs @@ -80,27 +80,23 @@ public struct CompositionEventWithLoadedDependencies } static public (IDisposableProcessWithStringInterface process, - (string javascriptFromElmMake, string javascriptPreparedToRun) buildArtifacts, - IReadOnlyList log) + (string javascriptFromElmMake, string javascriptPreparedToRun) buildArtifacts) ProcessFromWebAppConfig( Composition.TreeWithStringPath appConfig, ElmAppInterfaceConfig? overrideElmAppInterfaceConfig = null) { - var log = new List(); - var sourceFiles = TreeToFlatDictionaryWithPathComparer(appConfig); var loweredAppFiles = ElmApp.AsCompletelyLoweredElmApp( sourceFiles: sourceFiles, - ElmAppInterfaceConfig.Default, - log.Add); + ElmAppInterfaceConfig.Default); var processFromLoweredElmApp = ProcessFromElm019Code.ProcessFromElmCodeFiles( loweredAppFiles, overrideElmAppInterfaceConfig: overrideElmAppInterfaceConfig); - return (processFromLoweredElmApp.process, processFromLoweredElmApp.buildArtifacts, log); + return (processFromLoweredElmApp.process, processFromLoweredElmApp.buildArtifacts); } static public IImmutableDictionary, IImmutableList> TreeToFlatDictionaryWithPathComparer( @@ -271,7 +267,7 @@ static public PersistentProcessVolatileRepresentation RestoreFromCompositionEven if (compositionLogRecord.reduction != null) { - var (newElmAppProcess, (javascriptFromElmMake, javascriptPreparedToRun), _) = + var (newElmAppProcess, (javascriptFromElmMake, javascriptPreparedToRun)) = ProcessFromWebAppConfig( compositionLogRecord.reduction.Value.appConfigAsTree, overrideElmAppInterfaceConfig: overrideElmAppInterfaceConfig); @@ -410,7 +406,7 @@ static PersistentProcessVolatileRepresentationDuringRestore ApplyCompositionEven var prepareMigrateResult = PrepareMigrateSerializedValue(destinationAppConfigTree: appConfig); - var (newElmAppProcess, buildArtifacts, _) = + var (newElmAppProcess, buildArtifacts) = ProcessFromWebAppConfig( appConfig, overrideElmAppInterfaceConfig: overrideElmAppInterfaceConfig); @@ -453,7 +449,7 @@ static PersistentProcessVolatileRepresentationDuringRestore ApplyCompositionEven { var appConfig = compositionEvent.DeployAppConfigAndInitElmAppState; - var (newElmAppProcess, buildArtifacts, _) = + var (newElmAppProcess, buildArtifacts) = ProcessFromWebAppConfig( appConfig, overrideElmAppInterfaceConfig: overrideElmAppInterfaceConfig); @@ -586,129 +582,17 @@ static Result>> PrepareMigrateSerial var pathToInterfaceModuleFile = ElmApp.FilePathFromModuleName(MigrationElmAppInterfaceModuleName); var pathToCompilationRootModuleFile = ElmApp.FilePathFromModuleName(MigrationElmAppCompilationRootModuleName); - appConfigFiles.TryGetValue(pathToInterfaceModuleFile, out var migrateElmAppInterfaceModuleOriginalFile); - - if (migrateElmAppInterfaceModuleOriginalFile == null) + if (!appConfigFiles.TryGetValue(pathToInterfaceModuleFile, out var _)) return new Result>> { Err = "Did not find interface module at '" + string.Join("/", pathToInterfaceModuleFile) + "'", }; - var migrateElmAppInterfaceModuleOriginalText = - Encoding.UTF8.GetString(migrateElmAppInterfaceModuleOriginalFile.ToArray()); - - var migrateFunctionTypeAnnotation = - CompileElm.TypeAnnotationFromFunctionName(MigrateElmFunctionNameInModule, migrateElmAppInterfaceModuleOriginalText); - - if (migrateFunctionTypeAnnotation == null) - return new Result>> - { - Err = "Did not find type annotation for function '" + MigrateElmFunctionNameInModule + "'" - }; - - var typeAnnotationMatch = Regex.Match(migrateFunctionTypeAnnotation, @"^\s*([\w\d_\.]+)\s*->\s*([\w\d_\.]+)\s*$"); - - if (!typeAnnotationMatch.Success) - return new Result>> - { - Err = "Type annotation did not match expected pattern: '" + migrateFunctionTypeAnnotation + "'" - }; - - var inputTypeText = typeAnnotationMatch.Groups[1].Value; - var returnTypeText = typeAnnotationMatch.Groups[2].Value; - - var inputTypeCanonicalName = - inputTypeText.Contains(".") ? - inputTypeText : - MigrationElmAppInterfaceModuleName + "." + inputTypeText; - - var returnTypeCanonicalName = - returnTypeText.Contains(".") ? - returnTypeText : - MigrationElmAppInterfaceModuleName + "." + returnTypeText; - - var compilationRootModuleInitialText = @" -module " + MigrationElmAppCompilationRootModuleName + @" exposing(decodeMigrateAndEncodeAndSerializeResult, main) - -import " + MigrationElmAppInterfaceModuleName + @" -import Json.Decode -import Json.Encode - - -decodeMigrateAndEncode : String -> Result String String -decodeMigrateAndEncode = - Json.Decode.decodeString jsonDecodeBackendState - >> Result.map (" + MigrationElmAppInterfaceModuleName + "." + MigrateElmFunctionNameInModule + @" >> jsonEncodeBackendState >> Json.Encode.encode 0) - >> Result.mapError Json.Decode.errorToString - - -decodeMigrateAndEncodeAndSerializeResult : String -> String -decodeMigrateAndEncodeAndSerializeResult = - decodeMigrateAndEncode - >> jsonEncodeResult Json.Encode.string Json.Encode.string - >> Json.Encode.encode 0 - - -jsonEncodeResult : (err -> Json.Encode.Value) -> (ok -> Json.Encode.Value) -> Result err ok -> Json.Encode.Value -jsonEncodeResult encodeErr encodeOk valueToEncode = - case valueToEncode of - Err valueToEncodeError -> - [ ( ""Err"", [ valueToEncodeError ] |> Json.Encode.list encodeErr ) ] |> Json.Encode.object - - Ok valueToEncodeOk -> - [ ( ""Ok"", [ valueToEncodeOk ] |> Json.Encode.list encodeOk ) ] |> Json.Encode.object - - -main : Program Int {} String -main = - Platform.worker - { init = \_ -> ( {}, Cmd.none ) - , update = - \_ _ -> - ( decodeMigrateAndEncodeAndSerializeResult |> always {}, Cmd.none ) - , subscriptions = \_ -> Sub.none - } -"; - var compileCodingFunctionsLogLines = new System.Collections.Generic.List(); - try { - var migrateElmAppFilesBeforeAddingCodingSupport = - appConfigFiles.SetItem( - pathToCompilationRootModuleFile, - Encoding.UTF8.GetBytes(compilationRootModuleInitialText).ToImmutableList()); - - var appFilesWithInputCodingFunctions = - ElmApp.WithSupportForCodingElmType( - migrateElmAppFilesBeforeAddingCodingSupport, - inputTypeCanonicalName, - MigrationElmAppCompilationRootModuleName, - compileCodingFunctionsLogLines.Add, - out var inputTypeFunctionNames); - - var appFilesWithCodingFunctions = - ElmApp.WithSupportForCodingElmType( - appFilesWithInputCodingFunctions, - returnTypeCanonicalName, - MigrationElmAppCompilationRootModuleName, - compileCodingFunctionsLogLines.Add, - out var returnTypeFunctionNames); - - var rootModuleTextWithSupportAdded = - Encoding.UTF8.GetString(appFilesWithCodingFunctions[pathToCompilationRootModuleFile].ToArray()); - - var rootModuleText = - new[] - { - "jsonDecodeBackendState = " + inputTypeFunctionNames.decodeFunctionName, - "jsonEncodeBackendState = " + returnTypeFunctionNames.encodeFunctionName - } - .Aggregate(rootModuleTextWithSupportAdded, (intermediateModuleText, functionToAdd) => - CompileElm.WithFunctionAdded(intermediateModuleText, functionToAdd)); - - var migrateElmAppFiles = appFilesWithCodingFunctions.SetItem( - pathToCompilationRootModuleFile, - Encoding.UTF8.GetBytes(rootModuleText).ToImmutableList()); + var migrateElmAppFiles = ElmApp.AsCompletelyLoweredElmApp( + sourceFiles: appConfigFiles, + interfaceConfig: ElmAppInterfaceConfig.Default); var javascriptFromElmMake = ElmFullstack.ProcessFromElm019Code.CompileElmToJavascript( migrateElmAppFiles, @@ -783,7 +667,7 @@ Ok valueToEncodeOk -> { return new Result>> { - Err = "Failed with exception:\n" + e.ToString() + "\ncompileCodingFunctionsLogLines:\n" + String.Join("\n", compileCodingFunctionsLogLines) + Err = "Failed with exception:\n" + e.ToString() }; } } diff --git a/implement/test-elm-fullstack/TestModeledInElm.cs b/implement/test-elm-fullstack/TestModeledInElm.cs index ec794d61..d4b5e450 100644 --- a/implement/test-elm-fullstack/TestModeledInElm.cs +++ b/implement/test-elm-fullstack/TestModeledInElm.cs @@ -23,8 +23,7 @@ static IImmutableDictionary, IImmutableList> GetLow return ElmFullstack.ElmApp.AsCompletelyLoweredElmApp( sourceFiles: TestSetup.GetElmAppFromDirectoryPath(directoryPath), - ElmAppInterfaceConfig.Default, - Console.WriteLine); + ElmAppInterfaceConfig.Default); } /* diff --git a/implement/test-elm-fullstack/TestSetup.cs b/implement/test-elm-fullstack/TestSetup.cs index 17203272..81ca36fa 100644 --- a/implement/test-elm-fullstack/TestSetup.cs +++ b/implement/test-elm-fullstack/TestSetup.cs @@ -97,8 +97,7 @@ static public IImmutableDictionary, IImmutableList> IImmutableDictionary, IImmutableList> originalAppFiles) => ElmApp.AsCompletelyLoweredElmApp( sourceFiles: originalAppFiles, - ElmAppInterfaceConfig.Default, - Console.WriteLine); + ElmAppInterfaceConfig.Default); static public IProcessStoreReader EmptyProcessStoreReader() => new ProcessStoreReaderFromDelegates