Monad Coproducts / Data types à la carte

Open

#3,887 opened on Jun 8, 2024 3 comments 1 reaction 0 assignees View on GitHub

Dominant language: TeX
Stars: 2.9k
Forks: 239
Avg merge: 2d 18h
Merged PRs (30d): 14

Description

Hello everybody,

I wanted to share a technique that technically shouldn't be possible in Dart, but that is possible in Dart. It is based on a technique that Rúnar Bjarnason introduces in his talk [Composable application architecture with reasonably priced monads](https://www.youtube.com/watch?v=M258zVn4m2M) (in Scala) which he calls "Monad Coproducts", _but says that it is based on [Data Types à la Carte](https://www.cambridge.org/core/journals/journal-of-functional-programming/article/data-types-a-la-carte/14416CB20C4637164EA9F77097909409) by Wouter Swiestra_.

The interesting part is that, to implement this technique, higher kinded types are needed, which Scala officially supports, but Dart **doesn't**.

Erik Meijer and Gilad Bracha, both of whom were on the Dart team a long time ago, claim that "Dart can't have proper Monads because expressing the Monad interface would require higher kinded types", see: [Erik Meijer and Gilad Bracha: Dart, Monads, Continuations, and More (2012)](https://www.youtube.com/watch?v=QNpKYypLAO8), which, under a broad interpretation of their statement, is not correct, because we can simulate higher kinded types using [type defunctionalization](https://github.com/dart-lang/language/issues/844).

So, Dart "supports" higher kinded types, which means that Dart also supports expressing a proper Monad interface and so we can implement Monad Coproducts!

What follows is an example implementation of "Monad Coproducts"/"Data Types à la Carte" in Dart. _I'd recommend pasting it into an IDE that supports `// region` markers and to collapse them all before exploring it. There's a lot of boilerplate code that obscures the actual intent, and exploring it by regions makes that much easier_.

_Note: it makes heavy use of phantom types. A simpler introduction in a different context can be found here: https://github.com/dart-lang/language/issues/2865_

```dart
import 'dart:collection';
import 'dart:io';

/// Based on: https://www.youtube.com/watch?v=M258zVn4m2M
/// Please direct any feedback and questions to: https://github.com/modulovalue.
/// I'm very interested in finding out how to make this more digestible
/// without one having to learn anything about monads or coproducts.
// region main
void main() {
Program program({
required final IOAlgebra IO,
required final CloudFilesAlgebra CLOUD,
required final UserInteractionAlgebra UI,
required final LogAlgebra LOG,
}) => $()
.$((final void _) => LOG.log(LogLevel.debug, "Saying hello."))
.$((final void _) => UI.tell("Hello!"))
.$((final void _) => IO.delay(const Duration(milliseconds: 200)))
.$((final void _) => UI.tell("Please wait..."))
.$((final void _) => IO.delay(const Duration(milliseconds: 500)))
.$((final void _) => UI.tell("What's your name?"))
.$((final void _) => IO.read_ln())
.$((final String? name) {
final actual_name = name ?? "anonymous";
return $()
.$((final void _) => UI.tell("Hello '" + actual_name + "'"))
.$((final void _) => LOG.log(LogLevel.debug, "User '" + actual_name + "' has accessed the system."))
.$((final void _) => IO.delay(const Duration(milliseconds: 500)))
.$((final void _) => LOG.log(LogLevel.debug, "Listing all files."))
.$((final void _) => CLOUD.list_files())
.$((final List paths) {
late final Free program;
return program = $()
.$((final void files) => UI.tell("What follows is a list of all files:"))
.$((final void files) => UI.tell(paths.asMap().entries.map((final k) => k.value + " (" + k.key.toString() + ")").join(", ") + "."))
.$((final void _) => LOG.log(LogLevel.debug, "Provided a list of all files to '" + actual_name + "'"))
.$((final void _) => UI.ask("Which file do you want to see? (Or enter 'exit' to exit)"))
.$((final String path) {
if (path == "exit") {
return UI.tell("Exiting");
} else {
return $()
.$((final void _) {
final parsed = int.tryParse(path);
if (parsed == null) {
return UI.tell("Invalid path '" + path + "' given, an index was expected.");
} else {
if (paths.length > parsed) {
final path = paths[parsed];
return UI.tell(path);
} else {
return UI.tell("There's no file for index " + parsed.toString());
}
}
})
.$((final void _) => program);
}
});
});
});

final app = program<
ForCoproduct2<
ForCoproduct2<
ForCloudFilesF,
ForIOOp //
>,
ForCoproduct2<
ForUserInteraction,
ForLog //
> //
> //
>(
CLOUD: CloudFilesAlgebra(
i: (final a) => CoproductLeft(
value: CoproductLeft(
value: a,
),
),
),
IO: IOAlgebra(
i: (final a) => CoproductLeft(
value: CoproductRight(
value: a,
),
),
),
UI: UserInteractionAlgebra(
i: (final a) => CoproductRight(
value: CoproductLeft(
value: a,
),
),
),
LOG: LogAlgebra(
i: (final a) => CoproductRight(
value: CoproductRight(
value: a,
),
),
),
);
// run_free_with_info(app)(
// run_free_recovering(app)(
run_free(app)(
(final a) {
switch (a.DCoproduct) {
case CoproductLeft(: final value):
switch (value.DCoproduct) {
case CoproductLeft(: final value):
return interpret_cloud_files_algebra (
value: value.DCloudFiles,
);
case CoproductRight(: final value):
return interpret_io_algebra (
val: value.DIo,
);
}
case CoproductRight(: final value):
switch (value.DCoproduct) {
case CoproductLeft(: final value):
return interpret_user_interaction_algebra (
user_interaction: value.DUserInteraction,
);
case CoproductRight(: final value):
return () {
/// Use this interpreter to disable logging.
return interpret_log_algebra_noop;
/// Use this interpreter to enable logging.
// return interpret_log_algebra_print;
}()(
log: value.DLog,
);
}
}
},
);
}
// endregion

// region cloud algebra
// region boilerplate
interface class ForCloudFilesF {}

extension FixCloudFiles on Kind {
CloudFilesF get DCloudFiles => this as CloudFilesF ;
}
// endregion

// region dsl
sealed class CloudFilesF implements Kind {
A match({
required final List Function(ListFiles value) listFiles,
});
}

final class ListFiles implements CloudFilesF> {
const ListFiles();

@override
List match({
required final List Function(ListFiles value) listFiles,
}) =>
listFiles(this);
}
// endregion

// region algebra
final class CloudFilesAlgebra {
final PartialOuterTransformation i;

const CloudFilesAlgebra({
required this.i,
});

Free> list_files() => free_init(i(const ListFiles()));
}
// endregion

// region interpreter
A interpret_cloud_files_algebra ({
required final Kind value,
}) {
return value.DCloudFiles.match(
listFiles: (final a) => [
"file_1",
"file_2",
"file_3",
],
);
}
// endregion
// endregion

// region log algebra
// region boilerplate
interface class ForLog {}

extension FixLog on Kind {
Log get DLog => this as Log ;
}
// endregion

// region dsl
sealed class Log implements Kind {
A match({
required final void Function(JustLog v) log,
});
}

final class JustLog implements Log {
final LogLevel level;
final String message;

const JustLog({
required this.level,
required this.message,
});

@override
void match({
required final void Function(JustLog v) log,
}) {
log(this);
}
}
// endregion

// region supportive
enum LogLevel {
all,
debug,
info,
warn,
error,
fatal,
}
// endregion

// region algebra
final class LogAlgebra {
final PartialOuterTransformation i;

const LogAlgebra({
required this.i,
});

Free log(
final LogLevel level,
final String statement,
) =>
free_init(i(JustLog(level: level, message: statement)));
}
// endregion

// region interpreter
A interpret_log_algebra_print ({
required final Log log,
}) =>
log.match(
log: (final v) => print("LOG|" + DateTime.now().toString() + "|" + v.level.name + ": " + v.message),
);

A interpret_log_algebra_noop ({
required final Log log,
}) =>
log.match(
log: (final v) {
// Logging is disabled.
},
);
// endregion
// endregion

// region io algebra
// region boilerplate
interface class ForIOOp {}

extension FixIoOp on Kind {
IOOp get DIo => this as IOOp ;
}
// endregion

// region dsl
sealed class IOOp implements Kind {
const IOOp();

A match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
});
}

final class Readln implements IOOp {
const Readln();

@override
String? match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
}) =>
readln(this);
}

final class Println implements IOOp {
final String s;

const Println({
required this.s,
});

@override
void match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
}) =>
println(this);
}

final class OpenFile implements IOOp {
final String path;
final bool openForRead;

const OpenFile({
required this.path,
required this.openForRead,
});

@override
FileRef match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
}) =>
openFile(this);
}

final class ReadBytes implements IOOp> {
final FileRef file;
final int byteCount;

const ReadBytes({
required this.file,
required this.byteCount,
});

@override
UnmodifiableListView match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
}) =>
readBytes(this);
}

final class WriteBytes implements IOOp {
final FileRef file;
final Iterable bytes;

const WriteBytes({
required this.file,
required this.bytes,
});

final class CloseFile implements IOOp {
final FileRef file;

const CloseFile({
required this.file,
});

final class Execute implements IOOp {
final String command;
final Iterable arguments;

const Execute({
required this.command,
required this.arguments,
});

@override
ExecutionResult match({
required final String? Function(Readln node) readln,
required final void Function(Println node) println,
required final FileRef Function(OpenFile node) openFile,
required final UnmodifiableListView Function(ReadBytes node) readBytes,
required final void Function(WriteBytes node) writeBytes,
required final void Function(CloseFile node) closeFile,
required final ExecutionResult Function(Execute node) execute,
required final void Function(Delay node) delay,
}) =>
execute(this);
}

final class Delay implements IOOp {
final Duration duration;

const Delay({
required this.duration,
});

// region supportive
final class FileRef {
final RandomAccessFile f;

const FileRef({
required this.f,
});
}

final class ExecutionResult {
final int exitCode;
final String stdout;
final String stderr;

const ExecutionResult({
required this.exitCode,
required this.stdout,
required this.stderr,
});
}
// endregion

// region algebra
final class IOAlgebra {
final PartialOuterTransformation i;

const IOAlgebra({
required this.i,
});

Free read_ln() => free_init(i(const Readln()));

Free print_ln(
final String s,
) =>
free_init(i(Println(s: s)));

Free open_file(
final String path,
final bool openForRead,
) =>
free_init(i(OpenFile(path: path, openForRead: openForRead)));

Free> readBytes(
final FileRef file,
final int byteCount,
) =>
free_init(i(ReadBytes(file: file, byteCount: byteCount)));

Free write_bytes(
final FileRef file,
final Iterable bytes,
) =>
free_init(i(WriteBytes(file: file, bytes: bytes)));

Free close_file(
final FileRef ref,
) =>
free_init(i(CloseFile(file: ref)));

Free execute(
final String command,
final Iterable arguments,
) =>
free_init(i(Execute(command: command, arguments: arguments)));

Free delay(
final Duration duration,
) =>
free_init(i(Delay(duration: duration)));
}
// endregion

// region interpreter
B interpret_io_algebra({
required final Kind val,
}) =>
val.DIo.match(
closeFile: (final v) => v.file.f.closeSync(),
delay: (final v) => sleep(v.duration),
execute: (final v) {
final result = Process.runSync(
v.command,
v.arguments.toList(),
);
return ExecutionResult(
exitCode: result.exitCode,
stdout: result.stdout as String,
stderr: result.stderr as String,
);
},
openFile: (final v) => FileRef(
f: File(
v.path,
).openSync(
mode: () {
if (v.openForRead) {
return FileMode.read;
} else {
return FileMode.write;
}
}(),
),
),
println: (final p) => print(
p.s,
),
readBytes: (final v) => UnmodifiableListView(
v.file.f.readSync(
v.byteCount,
),
),
readln: (final r) => stdin.readLineSync(),
writeBytes: (final v) => v.file.f.writeFromSync(
v.bytes.toList(),
),
);
// endregion
// endregion

// region ui algebra
// region boilerplate
interface class ForUserInteraction {}

extension FixUserInteraction on Kind {
UserInteraction get DUserInteraction => this as UserInteraction ;
}
// endregion

// region dsl
sealed class UserInteraction implements Kind {
const UserInteraction();

A match({
required final void Function(Tell) tell,
required final String Function(Ask) ask,
});
}

final class Tell extends UserInteraction {
final String statement;

const Tell({
required this.statement,
});

@override
void match({
required final void Function(Tell) tell,
required final String Function(Ask) ask,
}) {
tell(this);
}
}

final class Ask extends UserInteraction {
final String question;

const Ask({
required this.question,
});

@override
String match({
required final void Function(Tell) tell,
required final String Function(Ask) ask,
}) =>
ask(this);
}
// endregion

// region algebra
final class UserInteractionAlgebra {
final PartialOuterTransformation i;

const UserInteractionAlgebra({
required this.i,
});

Free ask(
final String question,
) =>
free_init(i(Ask(question: question)));

Free tell(
final String statement,
) =>
free_init(i(Tell(statement: statement)));
}
// endregion

// region interpreter
A interpret_user_interaction_algebra ({
required final UserInteraction user_interaction,
}) =>
user_interaction.match(
tell: (final v) => print("> " + v.statement),
ask: (final v) {
print("> " + v.question);
return stdin.readLineSync()!;
},
);
// endregion
// endregion

// region framework
// region coproduct
// region boilerplate
extension KindCoproductFix on Kind, A> {
Coproduct get DCoproduct => this as Coproduct;
}

interface class ForCoproduct0 {}

interface class ForCoproduct1 implements Kind {}

interface class ForCoproduct2 implements Kind, G> {}

interface class ForCoproduct3 implements Kind, A> {}
// endregion

// region dsl
/// A "Coproduct" here is very similar to the concept of an "Either".
/// An "Either" shares the same "Kind" with all variants, but makes
/// the type parameter variable, whereas a Coproduct shares the
/// same type parameter with all variants, but makes the "Kind"
/// variable.
sealed class Coproduct implements ForCoproduct3 {}

final class CoproductLeft implements Coproduct {
final Kind value;

const CoproductLeft({
required this.value,
});
}

final class CoproductRight implements Coproduct {
final Kind value;

const CoproductRight({
required this.value,
});
}
// endregion
// endregion

// region free
// region boilerplate
extension KindFreeFix on Kind, A> {
Free get DFree => this as Free;
}

interface class ForFree0 {}

interface class ForFree1 implements Kind {}

interface class ForFree implements Kind, A> {}
// endregion

// region dsl
sealed class Free implements ForFree {
R match({
required final R Function(FreePure) pure,
required final R Function(Kind p, Free Function(B) f) bind,
});
}

final class FreePure implements Free {
final A a;

const FreePure({
required this.a,
});

@override
R match({
required final R Function(FreePure) pure,
required final R Function(
Kind p,
Free Function(B2 p1) f,
) bind,
}) =>
pure(this);
}

final class FreeBind implements Free {
final Kind p;
final Free Function(B) cont;

const FreeBind({
required this.p,
required this.cont,
});

@override
R match({
required final R Function(FreePure) pure,
required final R Function(
Kind p,
Free Function(B2 p1) f,
) bind,
}) =>
bind(
p,
(final FOO a) => cont(a),
);
}
// endregion

// region runners
A Function(B Function(Kind)) run_free(
final Free free,
) =>
(final eval) => free.match(
pure: (final a) => a.a,
bind: (final sub, final cont) {
final evaluated = eval(sub);
final continuation = cont(evaluated);
final next = run_free(continuation);
return next(eval);
},
);

A Function(B Function(Kind)) run_free_recovering(
final Free free,
) =>
(final eval) => free.match(
pure: (final a) => a.a,
bind: (final sub, final cont) {
final evaluated = eval(sub);
final continuation = cont(evaluated);
final next = run_free(continuation);
try {
return next(eval);
} on Object {
print(
"=" * 80,
);
print(
"The program crashed. Something unexpected happened!",
);
print(
"=" * 80,
);
rethrow;
}
},
);

void Function(B Function(Kind val) eval) run_free_with_info(
final Free free,
) =>
(final B Function(Kind val) eval) {
Free? current = free;
for (;;) {
final cur = current;
if (cur == null) {
break;
} else {
current = cur.match(
pure: (final p) {
print(
"===> End: " + p.toString(),
);
return null;
},
bind: (final p, final f) {
print(
"===> Evaluating: " + p.toString(),
);
final value = eval(p);
print(
"===> Evaluated to: " + value.toString()
);
return f(value);
},
);
}
}
};
// endregion

// region helpers
extension FreeExtension on Free {
Free $(
final Free Function(A) ff,
) =>
match(
pure: (final a) => ff(a.a),
bind: (final pure, final cont) => FreeBind(
p: pure,
cont: (final B2 val) => cont(val).$(ff).DFree,
),
);
}

typedef Program = Free;

FreeStart $() => FreeStart();

final class FreeStart {
const FreeStart();

Free $(
final Free Function(void) f,
) =>
f(Null);
}

Free free_init(
final Kind pure,
) =>
FreeBind(
p: pure,
cont: (final A a) => FreePure(
a: a,
),
);
// endregion
// endregion

// region core
interface class Kind {}

typedef PartialOuterTransformation = Kind Function(
Kind,
);
// endregion
// endregion
```

It implements 4 algebras (_that is, in this case, sets of operations_) called: UI, LOG, CLOUD and IO. They represent distinct concerns. With "Monad Coproducts", we can compose them in one compilation unit while having them exist in separate compilation units without them having to depend on each other, and we don't have to provide an interpretation strategy during composition-time. That is, we can construct a program, and interpret it later, possibly with different interpretation strategies, all without having to sacrifice type safety.

We can observe that:

- We can construct programs from different algebras while being able to defer how they interact to _after_ the program has been constructed.
- We can provide different interpretation strategies (_for each algebra separately_) to, for example, disable/enable logging without having to use "ad-hoc" toggles (e.g. `if (enableLogging) log(...)`) which would obscure the [intent](https://en.wikipedia.org/wiki/Intentional_programming) of the program.
- There's a lot of boilerplate needed to implement the higher-kinded-type-machinery which a language feature could eliminate.
- Dart has syntax sugar for chaining specific monads (e.g., Futures via asynchronous generators, Streams via synchronous generators, Lists via spreads, Statements via blocks and IIFEs), but no general mechanism for chaining free-monads (or arbitrary monads), which might be needed to make this technique ergonomic.
- To make this efficient in practice, it has to be possible to, given such a program and a specific interpretation strategy, compile them into a traditional program that does not contain the overhead that this representation has. There's a body of work known under the term of [Futamura projections](https://en.wikipedia.org/wiki/Partial_evaluation) which offers a solution to this problem. The Free-Monad and Coproduct machinery could be optimized into a traditional program by inlining all the components until there's none of the additional machinery left. After the process, we should be left with a program that we would have written by hand.

Any comments would be greatly appreciated.

Contributor guide

Open the contributing guide

Research direction

No repository file, test, or entry point is named. Start by reading the Dart example and the linked material, then determine whether a concrete language change or documentation request is intended. The issue does not define a specific change or completion criteria.

Written by the indexing model from the issue text.

Assessment

Tech stack: dart
Domain: compilers
Issue type: Feature
Difficulty: 5/5
Estimated time: Over a week
Activity status: Stale
Clarity: Needs clarification
Newbie friendliness: 15/100

Monad Coproducts / Data types à la carte

Description

Contributor guide

Research direction

Assessment

Get new issues in your inbox