Skip to content

Commit

Permalink
Add adapter to support reuse of classic JSON-based state shim
Browse files Browse the repository at this point in the history
  • Loading branch information
Viir committed Feb 8, 2025
1 parent 3fcedff commit 44a1803
Show file tree
Hide file tree
Showing 4 changed files with 385 additions and 14 deletions.
35 changes: 27 additions & 8 deletions implement/pine/Elm/Platform/WebServiceInterface.cs
Original file line number Diff line number Diff line change
Expand Up @@ -146,7 +146,8 @@ public record WebServiceEventResponse(

public record WebServiceConfig(
WebServiceEventResponse Init,
ElmInteractiveEnvironment.FunctionRecord Subscriptions)
ElmInteractiveEnvironment.FunctionRecord Subscriptions,
ElmTimeJsonAdapter.Parsed JsonAdapter)
{
public static WebServiceEventResponse
EventHttpRequest(
Expand Down Expand Up @@ -1291,7 +1292,11 @@ public static WebServiceConfig ConfigFromSourceFilesAndEntryFileName(
ElmAppCompilation.AsCompletelyLoweredElmApp(
PineValueComposition.TreeToFlatDictionaryWithPathComparer(sourceFiles),
workingDirectoryRelative: [],
ElmAppInterfaceConfig.Default);
ElmAppInterfaceConfig.Default
with
{
compilationRootFilePath = entryFileName
});

if (loweringResult.IsErrOrNull() is { } loweringErr)
{
Expand All @@ -1306,10 +1311,13 @@ public static WebServiceConfig ConfigFromSourceFilesAndEntryFileName(
var loweredTree =
PineValueComposition.SortedTreeFromSetOfBlobsWithStringPath(loweringOk.result.compiledFiles);

var loweredTreeCleaned =
ElmTimeJsonAdapter.CleanUpFromLoweredForJavaScript(loweredTree);

var compilationUnitsPrepared =
ElmAppDependencyResolution.AppCompilationUnitsForEntryPoint(
loweredTree,
entryFileName);
loweredTreeCleaned,
["src", "Backend", "InterfaceToHost_Root.elm"]);

PineValue build()
{
Expand All @@ -1330,17 +1338,27 @@ PineValue build()
var (declValue, _) =
ElmInteractiveEnvironment.ParseFunctionFromElmModule(
compiledModulesValue,
moduleName: string.Join(".", compilationUnitsPrepared.entryModuleName),
moduleName: "Backend.Main",
declarationName: "webServiceMain",
parseCache)
.Extract(err => throw new Exception(
$"Failed parsing webServiceMain declaration from module {string.Join(".", compilationUnitsPrepared.entryModuleName)}: {err}"));

return ConfigFromDeclarationValue(declValue);
var parseJsonAdapterResult =
ElmTimeJsonAdapter.Parsed.ParseFromCompiled(
compiledModulesValue,
parseCache);

var parsedJsonAdapter =
parseJsonAdapterResult
.Extract(err => throw new Exception("Failed parsing JsonAdapter: " + err));

return ConfigFromDeclarationValue(declValue, parsedJsonAdapter);
}

public static WebServiceConfig ConfigFromDeclarationValue(
PineValue webServiceMainDeclValue)
PineValue webServiceMainDeclValue,
ElmTimeJsonAdapter.Parsed jsonAdapter)
{
var webServiceMainRecordResult =
ElmValueEncoding.ParsePineValueAsRecordTagged(webServiceMainDeclValue);
Expand Down Expand Up @@ -1380,6 +1398,7 @@ public static WebServiceConfig ConfigFromDeclarationValue(

return new WebServiceConfig(
Init: initResult,
Subscriptions: subscriptionsFunctionRecord);
Subscriptions: subscriptionsFunctionRecord,
jsonAdapter);
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -500,12 +500,7 @@ composeRootElmModuleTextWithStateShim config =
in
"module "
++ config.interfaceToHostRootModuleName
++ """ exposing
( State
, interfaceToHost_initState
, interfaceToHost_processEvent
, main
)
++ """ exposing (..)
import """
++ config.appRootDeclarationModuleName
Expand Down
285 changes: 285 additions & 0 deletions implement/pine/ElmTime/JsonAdapter.cs
Original file line number Diff line number Diff line change
@@ -0,0 +1,285 @@
using ElmTime.ElmInteractive;
using ElmTime.ElmSyntax;
using Pine.Core;
using Pine.Core.PineVM;
using Pine.ElmInteractive;
using Pine.PineVM;
using System.Collections.Generic;
using System.Linq;

namespace ElmTime;

/// <summary>
/// Json adapter implements a bridge from the JSON-based interface to Elm backend apps as used from 2018 to 2024.
/// </summary>
public class ElmTimeJsonAdapter
{
public static IReadOnlyList<string> RootFilePath =>
["src", "Backend", "InterfaceToHost_Root.elm"];

public const string RootModuleName = "Backend.InterfaceToHost_Root";

public record Parsed(
/*
* jsonEncodeAppState : Backend.Main.State -> Json.Encode.Value
* */
ElmInteractiveEnvironment.FunctionRecord JsonEncodeAppState,
/*
* jsonDecodeAppState : Json.Decode.Decoder Backend.Main.State
* */
PineValue JsonDecodeAppState,
/*
* The Elm app compiler emits the 'parseMigrationConfig' declaration only if the Elm app has a migration module.
* */
PineValue? JsonDecodeMigratePreviousState,
/*
* https://package.elm-lang.org/packages/elm/json/latest/Json-Decode#decodeValue
* Decoder a -> Value -> Result Error a
* */
ElmInteractiveEnvironment.FunctionRecord JsonDecodeDecodeValue)
{
public static Result<string, Parsed> ParseFromCompiled(
PineValue compiledApp,
PineVMParseCache parseCache)
{
var parseEnvResult =
ElmInteractiveEnvironment.ParseInteractiveEnvironment(compiledApp);

{
if (parseEnvResult.IsErrOrNull() is { } err)
{
return err;
}
}

if (parseEnvResult.IsOkOrNull() is not { } parseEnvOk)
{
throw new System.Exception(
"Unexpected null parseEnvResult: " + parseEnvResult);
}

var moduleRoot =
parseEnvOk.Modules
.FirstOrDefault(module => module.moduleName is RootModuleName);

if (moduleRoot.moduleValue is null)
{
return
"Root module " + RootModuleName + " not found among " +
parseEnvOk.Modules.Count + " modules: " +
string.Join(", ", parseEnvOk.Modules.Select(module => module.moduleName));
}

/*
jsonDecodeAppState : Json.Decode.Decoder Backend.Main.State
jsonDecodeAppState =
Backend.InterfaceToHost_Root.Generated_JsonConverters.jsonDecode_1615808600
jsonDecodeMigratePreviousState : Json.Decode.Decoder Backend.MigrateState.PreviousBackendState
jsonDecodeMigratePreviousState =
Backend.InterfaceToHost_Root.Generated_JsonConverters.jsonDecode_4168357374
jsonEncodeAppState : Backend.Main.State -> Json.Encode.Value
jsonEncodeAppState =
Backend.InterfaceToHost_Root.Generated_JsonConverters.jsonEncode_1615808600
* */

moduleRoot.moduleContent.FunctionDeclarations.TryGetValue(
"jsonEncodeAppState",
out var jsonEncodeAppStateValue);

moduleRoot.moduleContent.FunctionDeclarations.TryGetValue(
"jsonDecodeAppState",
out var jsonDecodeAppStateValue);

moduleRoot.moduleContent.FunctionDeclarations.TryGetValue(
"jsonDecodeMigratePreviousState",
out var jsonDecodeMigratePreviousStateValue);

if (jsonEncodeAppStateValue is null)
{
return "Function 'jsonEncodeAppState' not found in root module " + RootModuleName;
}

if (jsonDecodeAppStateValue is null)
{
return "Function 'jsonDecodeAppState' not found in root module " + RootModuleName;
}

var parseJsonEncodeAppStateResult =
ElmInteractiveEnvironment.ParseFunctionRecordFromValueTagged(
jsonEncodeAppStateValue,
parseCache);

{
if (parseJsonEncodeAppStateResult.IsErrOrNull() is { } err)
{
return
"Failed to parse 'jsonEncodeAppState' function: " + err;
}
}

if (parseJsonEncodeAppStateResult.IsOkOrNull() is not { } parseJsonEncodeAppStateOk)
{
throw new System.Exception(
"Unexpected parseJsonEncodeAppStateResult: " + parseJsonEncodeAppStateResult);
}

var moduleJsonDecode =
parseEnvOk.Modules
.FirstOrDefault(module => module.moduleName is "Json.Decode");

if (moduleJsonDecode.moduleValue is null)
{
return
"Module 'Json.Decode' not found among " +
parseEnvOk.Modules.Count + " modules: " +
string.Join(", ", parseEnvOk.Modules.Select(module => module.moduleName));
}

moduleJsonDecode.moduleContent.FunctionDeclarations.TryGetValue(
"decodeValue",
out var decodeValueFunctionValue);

if (decodeValueFunctionValue is null)
{
return "Function 'decodeValue' not found in module 'Json.Decode'";
}

var parseDecodeValueFunctionResult =
ElmInteractiveEnvironment.ParseFunctionRecordFromValueTagged(
decodeValueFunctionValue,
parseCache);
{
if (parseDecodeValueFunctionResult.IsErrOrNull() is { } err)
{
return
"Failed to parse 'decodeValue' function: " + err;
}
}

if (parseDecodeValueFunctionResult.IsOkOrNull() is not { } parseDecodeValueFunctionOk)
{
throw new System.Exception(
"Unexpected parseDecodeValueFunctionResult: " + parseDecodeValueFunctionResult);
}

return
new Parsed(
JsonEncodeAppState: parseJsonEncodeAppStateOk,
JsonDecodeAppState: jsonDecodeAppStateValue,
JsonDecodeMigratePreviousState: jsonDecodeMigratePreviousStateValue,
JsonDecodeDecodeValue: parseDecodeValueFunctionOk);
}

public Result<string, PineValue> EncodeAppStateAsJsonValue(
PineValue appState,
IPineVM pineVM)
{
return ElmInteractiveEnvironment.ApplyFunction(pineVM, JsonEncodeAppState, [appState]);
}

public Result<string, PineValue> DecodeAppStateFromJsonValue(
PineValue jsonValue,
IPineVM pineVM)
{
var jsonDecodeApplyFunctionResult =
ElmInteractiveEnvironment.ApplyFunction(
pineVM,
JsonDecodeDecodeValue,
[JsonDecodeAppState, jsonValue]);

{
if (jsonDecodeApplyFunctionResult.IsErrOrNull() is { } err)
{
return err;
}
}

if (jsonDecodeApplyFunctionResult.IsOkOrNull() is not { } jsonDecodeApplyFunctionOk)
{
throw new System.Exception(
"Unexpected jsonDecodeApplyFunctionResult: " + jsonDecodeApplyFunctionResult);
}

return
ElmValueInterop.ParseElmResultValue(
jsonDecodeApplyFunctionOk,
err => "Failed to decode JSON value: " + err,
Result<string, PineValue>.ok,
invalid:
err => throw new System.Exception("Invalid: " + err));
}
}

/// <summary>
/// The original lowering implementation added a 'main' declaration to account for DCE.
/// </summary>
public static TreeNodeWithStringPath CleanUpFromLoweredForJavaScript(
TreeNodeWithStringPath loweredForJavaScript)
{
/*
{-| 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 () String
main =
Platform.worker
{ init = always ( (), Cmd.none )
, update =
{ a = interfaceToHost_processEvent
, b = interfaceToHost_initState
}
|> always ( (), Cmd.none )
|> always
|> always
, subscriptions = always Sub.none
}
* */

var rootFile =
loweredForJavaScript.GetNodeAtPath(RootFilePath);

if (rootFile is not TreeNodeWithStringPath.BlobNode rootFileNode)
{
throw new System.Exception("Root file not found at " + string.Join("/", RootFilePath));
}

var rootFileText =
System.Text.Encoding.UTF8.GetString(rootFileNode.Bytes.Span);

var inMainDeclaration = false;

IEnumerable<string> linesFiltered()
{
foreach (var line in rootFileText.ModuleLines())
{
if (line.StartsWith("main "))
{
inMainDeclaration = true;
}

if (line.Trim().Length is 0)
{
inMainDeclaration = false;
}

if (!inMainDeclaration)
{
yield return line;
}
}
}

var newRootFileText = string.Join("\n", linesFiltered());

return
loweredForJavaScript
.SetNodeAtPathSorted(
RootFilePath,
new TreeNodeWithStringPath.BlobNode(
System.Text.Encoding.UTF8.GetBytes(newRootFileText)));
}
}
Loading

0 comments on commit 44a1803

Please sign in to comment.