Skip to content

Instantly share code, notes, and snippets.

@arturaz

arturaz/free_monad.cs

Last active April 10, 2023 09:01
Show Gist options
  • Save arturaz/4d01106a49bc2d2a1fc08e0af21fb9d3 to your computer and use it in GitHub Desktop.
Save arturaz/4d01106a49bc2d2a1fc08e0af21fb9d3 to your computer and use it in GitHub Desktop.
Download ZIP
Free Monad implementation in C# (CSharp)
Raw
free_monad.cs
using System;
namespace main {
// Modeled against
// https://medium.com/@olxc/free-monads-explained-pt-1-a5c45fbdac30
//
// Higher kind simulation from https://medium.com/@johnmcclean/simulating-higher-kinded-types-in-java-b52a18b72c74
static class Id {
public struct W {}
public static Id<A> a<A>(A a) => new Id<A>(a);
public static Id<A> narrow<A>(this HKT<W, A> hkt) => (Id<A>) hkt;
}
struct Id<A> : HKT<Id.W, A> {
public readonly A a;
public Id(A a) { this.a = a; }
public static implicit operator A(Id<A> id) => id.a;
public static implicit operator Id<A>(A a) => new Id<A>(a);
}
interface Functor<Witness> {
HKT<Witness, B> map<A, B>(HKT<Witness, A> data, Func<A, B> mapper);
}
interface Monad<Witness> : Functor<Witness> {
/// <summary>Wrap value in a monad context.</summary>
HKT<Witness, A> point<A>(A a);
HKT<Witness, B> flatMap<A, B>(
HKT<Witness, A> data,
Func<A, HKT<Witness, B>> mapper
);
}
class Monads : Monad<Id.W> {
public HKT<Id.W, B> map<A, B>(HKT<Id.W, A> data, Func<A, B> mapper) => Id.a(mapper(data.narrow()));
public HKT<Id.W, A> point<A>(A a) => Id.a(a);
public HKT<Id.W, B> flatMap<A, B>(HKT<Id.W, A> data, Func<A, HKT<Id.W, B>> mapper) => mapper(data.narrow());
}
public static class Exts {
public static Func<A, C> andThen<A, B, C>(this Func<A, B> ab, Func<B, C> bc) =>
a => bc(ab(a));
}
interface HKT<W, A> {}
interface Free<W, A> {
Free<W, B> map<B>(Func<A, B> f);
Free<W, B> flatMap<B>(Func<A, Free<W, B>> f);
Free<W, C> flatMap<B, C>(Func<A, Free<W, B>> f, Func<A, B, C> g);
HKT<GW, A> run<GW>(NaturalTransformation<W, GW> nt, Monad<GW> M);
}
static class Free {
public static Free<W, A> liftFree<W, A>(this HKT<W, A> fa) => Suspend.a(fa, _ => _);
//
public static Free<W, B> Select<W, A, B>(this Free<W, A> free, Func<A, B> f) => free.map(f);
public static Free<W, B> SelectMany<W, A, B>(this Free<W, A> opt, Func<A, Free<W, B>> f) => opt.flatMap(f);
public static Free<W, C> SelectMany<W, A, B, C>(
this Free<W, A> opt, Func<A, Free<W, B>> f, Func<A, B, C> g
) => opt.flatMap(f, g);
}
class Return<W, A> : Free<W, A> {
public readonly A a;
public Return(A a) { this.a = a; }
public Free<W, B> map<B>(Func<A, B> f) => new Return<W, B>(f(a));
public Free<W, B> flatMap<B>(Func<A, Free<W, B>> f) => f(a);
public Free<W, C> flatMap<B, C>(Func<A, Free<W, B>> f, Func<A, B, C> g) => f(a).map(b => g(a, b));
public HKT<GW, A> run<GW>(NaturalTransformation<W, GW> nt, Monad<GW> M) => M.point(a);
}
static class Suspend {
public static Suspend<W, I, A> a<W, I, A>(HKT<W, I> subsequentComputation, Func<I, A> mapper) =>
new Suspend<W, I, A>(subsequentComputation, mapper);
}
class Suspend<W, I, A> : Free<W, A> {
public readonly HKT<W, I> subsequentComputation;
public readonly Func<I, A> mapper;
public Suspend(HKT<W, I> subsequentComputation, Func<I, A> mapper) {
this.subsequentComputation = subsequentComputation;
this.mapper = mapper;
}
public Free<W, B> map<B>(Func<A, B> f) => new Suspend<W, I, B>(subsequentComputation, mapper.andThen(f));
public Free<W, B> flatMap<B>(Func<A, Free<W, B>> f) => FlatMap.a(subsequentComputation, mapper.andThen(f));
public Free<W, C> flatMap<B, C>(Func<A, Free<W, B>> f, Func<A, B, C> g) =>
FlatMap.a(subsequentComputation, i => {
var a = mapper(i);
return f(a).map(b => g(a, b));
});
public HKT<GW, A> run<GW>(NaturalTransformation<W, GW> nt, Monad<GW> M) =>
M.map(nt.transform(subsequentComputation), mapper);
}
static class FlatMap {
public static FlatMap<W, I, A> a<W, I, A>(HKT<W, I> subsequentComputation, Func<I, Free<W, A>> continuation) =>
new FlatMap<W,I,A>(subsequentComputation, continuation);
}
class FlatMap<W, I, A> : Free<W, A> {
public readonly HKT<W, I> subsequentComputation;
public readonly Func<I, Free<W, A>> continuation;
public FlatMap(HKT<W, I> subsequentComputation, Func<I, Free<W, A>> continuation) {
this.subsequentComputation = subsequentComputation;
this.continuation = continuation;
}
public Free<W, B> map<B>(Func<A, B> f) =>
flatMap(a => new Return<W, B>(f(a)));
public Free<W, B> flatMap<B>(Func<A, Free<W, B>> f) =>
FlatMap.a(subsequentComputation, continuation.andThen(free => free.flatMap(f)));
public Free<W, C> flatMap<B, C>(Func<A, Free<W, B>> f, Func<A, B, C> g) =>
FlatMap.a(subsequentComputation, continuation.andThen(free => free.flatMap(a => f(a).map(b => g(a, b)))));
public HKT<GW, A> run<GW>(NaturalTransformation<W, GW> nt, Monad<GW> M) =>
M.flatMap(nt.transform(subsequentComputation), i => continuation(i).run(nt, M));
}
// sealed trait NaturalTransformation[F[_], G[_]] {
// def transform[A](fa: F[A]): G[A] // <-- G[A] instead of just A
// }
interface NaturalTransformation<FWitness, GWitness> {
HKT<GWitness, A> transform<A>(HKT<FWitness, A> fa);
}
class UIExecutor : NaturalTransformation<UserInteraction.W, Id.W> {
public HKT<Id.W, A> transform<A>(HKT<UserInteraction.W, A> fa) => Id.a(UserInteraction.execute(fa.narrowK()));
}
interface UserInteraction<A> : HKT<UserInteraction.W, A> {}
static class UserInteraction {
public struct W {}
public static Free<W, A> tell<A>(A str) => new Tell<A>(str).liftFree();
public static Free<W, string> ask(string question) => new Ask<string>(question, _ => _).liftFree();
public static UserInteraction<A> narrowK<A>(this HKT<W, A> hkt) => (UserInteraction<A>) hkt;
public static A execute<A>(UserInteraction<A> ui) {
switch (ui) {
case Ask<A> ask:
Console.Out.WriteLine(ask.question.ToString());
return ask.c(Console.In.ReadLine());
case Tell<A> tell:
Console.Out.WriteLine(tell.statement.ToString());
return tell.statement;
default:
throw new ArgumentOutOfRangeException(nameof(ui));
}
}
}
public class Tell<A> : UserInteraction<A> {
public readonly A statement;
public Tell(A statement) { this.statement = statement; }
}
public class Ask<A> : UserInteraction<A> {
public readonly A question;
public readonly Func<string, A> c;
public Ask(A question, Func<string, A> c) {
this.question = question;
this.c = c;
}
}
class Program {
static void Main(string[] args) {
Console.WriteLine("Hello World!");
var x =
from _ in UserInteraction.tell("Hi there!")
from res in UserInteraction.ask("What's your name?")
from __ in UserInteraction.tell($"Hi, {res}!")
select res;
var result = x.run(new UIExecutor(), new Monads()).narrow().a;
Console.WriteLine($"result = {result}");
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment