A demonstration of pure-functional I/O using the free monad in C#

PureIO.cs

using System;

namespace PureIO {
  /*
    C# does not have proper sum types. They must be emulated.

    This data type is one of 4 possible values:
    - WriteOut, being a pair of a string and A
    - WriteErr, being a pair of a string and A
    - readLine, being a function from string to A
    - read, being a function from int to A

    It gives rise to a functor. See `Select` method.

    The Fold function deconstructs the data type into its one of 4 possibilities.
    The 4 static functions construct into one of the possibilities.
  */

  // $ Haskell $
  // data TerminalOperation a =
  //     WriteOut string a
  //   | WriteError string a
  //   | ReadLine (string -> a)
  //   | Read (int -> a)
  public abstract class TerminalOperation<A> {
    public abstract X Fold<X>(
      Func<string, A, X> writeOut
    , Func<string, A, X> writeErr
    , Func<Func<string, A>, X> readLine
    , Func<Func<int, A>, X> read
    );

    public Terminal<A> Lift {
      get {
        return Terminal<A>.more(this.Select<A, Terminal<A>>(Terminal<A>.done));
      }
    }

    internal class WriteOut : TerminalOperation<A> {
      private readonly string s;
      private readonly A a;

      public WriteOut(string s, A a) {
        this.s = s;
        this.a = a;
      }

      public override X Fold<X>(
        Func<string, A, X> writeOut
      , Func<string, A, X> writeErr
      , Func<Func<string, A>, X> readLine
      , Func<Func<int, A>, X> read
      ) {
        return writeOut(s, a);
      }
    }

    internal class WriteErr : TerminalOperation<A> {
      private readonly string s;
      private readonly A a;

      public WriteErr(string s, A a) {
        this.s = s;
        this.a = a;
      }

      public override X Fold<X>(
        Func<string, A, X> writeOut
      , Func<string, A, X> writeErr
      , Func<Func<string, A>, X> readLine
      , Func<Func<int, A>, X> read
      ) {
        return writeErr(s, a);
      }
    }

    internal class ReadLine : TerminalOperation<A> {
      private Func<string, A> f;

      public ReadLine(Func<string, A> f) {
        this.f = f;
      }

      public override X Fold<X>(
        Func<string, A, X> writeOut
      , Func<string, A, X> writeErr
      , Func<Func<string, A>, X> readLine
      , Func<Func<int, A>, X> read
      ) {
        return readLine(f);
      }
    }

    internal class Read : TerminalOperation<A> {
      private readonly Func<int, A> f;

      public Read(Func<int, A> f) {
        this.f = f;
      }

      public override X Fold<X>(
        Func<string, A, X> writeOut
      , Func<string, A, X> writeErr
      , Func<Func<string, A>, X> readLine
      , Func<Func<int, A>, X> read
      ) {
        return read(f);
      }
    }
  }

  // $ Haskell $
  // instance Functor TerminalOperation where
  //   fmap f (WriteOut s a) = WriteOut s (f a)
  //   fmap f (WriteErr s a) = WriteErr s (f a)
  //   fmap f (ReadLine g)   = ReadLine (\s -> f (g s))
  //   fmap f (Read g)       = Read (\i -> f (g i))
  public static class TerminalOperationFunctor {
    public static TerminalOperation<B> Select<A, B>(this TerminalOperation<A> o, Func<A, B> f) {
      /*
        The `TerminalOperation` data type is a functor.
        This is all that is necessary to provide the grammar (`Terminal`).
        Note that `Terminal` uses only `Select`
        (and no other `TerminalOperation` methods) to method to implement `SelectMany`
      */
      return o.Fold<TerminalOperation<B>>(
        (s, a) => new TerminalOperation<B>.WriteOut(s, f(a))
      , (s, a) => new TerminalOperation<B>.WriteErr(s, f(a))
      , g => new TerminalOperation<B>.ReadLine(s => f(g(s)))
      , g => new TerminalOperation<B>.Read(i => f(g(i)))
      );
    }
  }

  // $ Haskell $
  // data Terminal a =
  //     Done a
  //   | More (TerminalOperation (Terminal a))
  public abstract class Terminal<A> {
    public abstract X Fold<X>(
      Func<A, X> done
    , Func<TerminalOperation<Terminal<A>>, X> more
    );

    internal class Done : Terminal<A> {
      public readonly A a;

      public Done(A a) {
        this.a = a;
      }

      override public X Fold<X>(
        Func<A, X> done
      , Func<TerminalOperation<Terminal<A>>, X> more
      ) {
        return done(a);
      }
    }

    public static Terminal<A> done(A a) {
      return new Done(a);
    }

    internal class More : Terminal<A> {
      public readonly TerminalOperation<Terminal<A>> a;

      public More(TerminalOperation<Terminal<A>> a) {
        this.a = a;
      }

      override public X Fold<X>(
        Func<A, X> done
      , Func<TerminalOperation<Terminal<A>>, X> more
      ) {
        return more(a);
      }
    }

    public static Terminal<A> more(TerminalOperation<Terminal<A>> a) {
      return new More(a);
    }
  }

  public static class Terminal {
    public static Terminal<Unit> WriteOut(string s) {
      return new TerminalOperation<Unit>.WriteOut(s, Unit.Value).Lift;
    }

    public static Terminal<Unit> WriteErr(string s) {
      return new TerminalOperation<Unit>.WriteErr(s, Unit.Value).Lift;
    }

    public static Terminal<string> ReadLine {
      get {
        return new TerminalOperation<string>.ReadLine(s => s).Lift;
      }
    }

    public static Terminal<int> Read {
      get {
        return new TerminalOperation<int>.Read(i => i).Lift;
      }
    }

    public static Terminal<Unit> WriteOut() {
      return WriteOut("");
    }
  }

  // $ Haskell $
  // instance Functor Terminal where
  //   fmap f (Done a) = Done (f a)
  //   fmap f (More a) = More (fmap (\k -> fmap f k) a)
  public static class TerminalFunctor {
    public static Terminal<B> Select<A, B>(this Terminal<A> t, Func<A, B> f) {
      return t.Fold<Terminal<B>>(
        a => Terminal<B>.done(f(a))
      , a => Terminal<B>.more(a.Select(k => k.Select(f)))
      );
    }

    /*
      The monad for Terminal.

      Note that `TerminalOperation#Select` is the only method that is specific to `TerminalOperation`.
      More to the point, some other structure with a `Select` method could be
      substituted here to give rise to a different kind of behaviour.
    */
    // $ Haskell $
    // instance Monad Terminal where
    //   f >>= Done a = f a
    //   f >>= More a = More (fmap (\k -> k >>= f) a)
    public static Terminal<B> SelectMany<A, B>(this Terminal<A> t, Func<A, Terminal<B>> f) {
      return t.Fold<Terminal<B>>(
        f
      , a => Terminal<B>.more(a.Select(k => k.SelectMany(f)))
      );
    }

    public static Terminal<C> SelectMany<A, B, C>(this Terminal<A> t, Func<A, Terminal<B>> u, Func<A, B, C> f) {
      return SelectMany(t, a => Select(u(a), b => f(a, b)));
    }
  }

  /*
    A data structure with only one possible value.
    It is similar to `void` but this can be used as a regular data type.
  */
  public struct Unit {
    public static readonly Unit Value = new Unit();
  }
  
  public class Demonstration {
    // $ Haskell $
    // do  _1 <- WriteOut "Hello, let us begin"
    //     _2 <- WriteOut("Please enter your name")
    //     _  <- ReadLine
    //     _3 <- WriteOut("How old are you?")
    //     _  <- ReadLine
    //     _4 <- WriteOut("Okey dokey, ready to tell the world?")
    //     _5 <- WriteOut("0. No")
    //     _6 <- WriteOut("1. Yes")
    //     _  <- Read
    //     _7 <- WriteOut()
    //     _8 <- if r == '0'
    //             then WriteErr(name ++ " is modest")
    //             else WriteOut(name ++ " is " ++ age ++ " years old")
    //     pure (r - 48)
    public static int Main() {
      Terminal<int> Program =
        from _1    in Terminal.WriteOut("Hello, let us begin")
        from _2    in Terminal.WriteOut("Please enter your name")
        from name  in Terminal.ReadLine
        from _3    in Terminal.WriteOut("How old are you?")
        from age   in Terminal.ReadLine
        from _4    in Terminal.WriteOut("Okey dokey, ready to tell the world?")
        from _5    in Terminal.WriteOut("0. No")
        from _6    in Terminal.WriteOut("1. Yes")
        from r     in Terminal.Read
        from _7    in Terminal.WriteOut()
        from _8    in r == '0' ?
                        Terminal.WriteErr(name + " is modest") :
                        Terminal.WriteOut(name + " is " + age + " years old")
        select r - 48;

      return Program.Interpret();
    }
  }

}