Skip to content

Instantly share code, notes, and snippets.

@aitoroses
Created August 18, 2022 15:01
Show Gist options
  • Save aitoroses/d6376cdb85461da3705705661ea86f37 to your computer and use it in GitHub Desktop.
Save aitoroses/d6376cdb85461da3705705661ea86f37 to your computer and use it in GitHub Desktop.
Free Monads in ReasonML
module type Functor = {
type t('a);
let map: (t('a), 'a => 'b) => t('b);
};
module type Monad = {
type t('a);
let return: 'a => t('a);
let flatMap: (t('a), 'a => t('b)) => t('b);
};
module MonadUtils = (M: Monad) => {
module Functor = {
type t('a) = M.t('a);
let map = (fa, f) => fa->M.flatMap(a => M.return(f(a)));
};
module Bind = {
let let_ = M.flatMap;
};
module Map = {
let let_ = Functor.map;
};
};
module Free = (F: Functor) => {
type t('a) =
| Return('a)
| Wrap(F.t(t('a)));
let return = x => Return(x);
let rec flatMap = (x, f) =>
switch (x) {
| Return(x) => f(x)
| Wrap(x) => Wrap(x->F.map(m => m->flatMap(f)))
};
};
module IOOp = {
type t('a) =
| Print_string(string, 'a)
| Read_string(string => 'a);
let map = (x, f) =>
switch (x) {
| Print_string(s, cont) => Print_string(s, f(cont))
| Read_string(cont) => Read_string(str => f(cont(str)))
};
};
module FreeIO = Free(IOOp);
module IO = MonadUtils(FreeIO);
module IOInterp = {
let rec unsafePerform = m =>
switch (m) {
| FreeIO.Return(x) => x
| FreeIO.Wrap(x) =>
switch (x) {
| IOOp.Print_string(s, cont) =>
Js.log(s);
cont->unsafePerform;
| IOOp.Read_string(cont) => cont("hey there")->unsafePerform
}
};
};
let main: FreeIO.t(int) = {
let print_string = s => FreeIO.Wrap(IOOp.Print_string(s, FreeIO.Return()));
let read_string =
FreeIO.Wrap(IOOp.Read_string(str => FreeIO.Return(str)));
let%IO.Bind () = print_string("What's your name?");
let%IO.Bind name = read_string;
let%IO.Bind () = print_string("Hello, " ++ name ++ "!");
let%IO.Map () = print_string("\n");
0;
};
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment