csharp C＃中的免费Monad实现（CSharp）

Posted 2021-05-12

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}");
    }
  }
}