Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
A demonstration of pure-functional I/O using the free monad in C#
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();
}
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.
You signed in with another tab or window. Reload to refresh your session. You signed out in another tab or window. Reload to refresh your session.