MTL in Java

MTL.java

//usr/bin/env jbang "$0" "$@" ; exit $?
//JAVA 14+
//JAVAC_OPTIONS --enable-preview -source 14
//JAVA_OPTIONS --enable-preview

//DEPS com.github.tonivade:purefun-typeclasses:1.8
//DEPS com.github.tonivade:purefun-instances:1.8
//DEPS com.github.tonivade:purefun-transformer:1.8

import static com.github.tonivade.purefun.Matcher1.is;
import static com.github.tonivade.purefun.Producer.cons;
import static java.lang.String.format;
import static java.util.Comparator.comparing;
import static java.util.concurrent.ThreadLocalRandom.current;

import java.util.Comparator;

import com.github.tonivade.purefun.Function1;
import com.github.tonivade.purefun.Higher1;
import com.github.tonivade.purefun.Kind;
import com.github.tonivade.purefun.Pattern1;
import com.github.tonivade.purefun.Tuple;
import com.github.tonivade.purefun.Tuple2;
import com.github.tonivade.purefun.Unit;
import com.github.tonivade.purefun.data.ImmutableMap;
import com.github.tonivade.purefun.instances.EitherTInstances;
import com.github.tonivade.purefun.instances.IOInstances;
import com.github.tonivade.purefun.instances.KleisliInstances;
import com.github.tonivade.purefun.instances.StateTInstances;
import com.github.tonivade.purefun.monad.IO;
import com.github.tonivade.purefun.transformer.EitherT;
import com.github.tonivade.purefun.transformer.Kleisli;
import com.github.tonivade.purefun.transformer.StateT;
import com.github.tonivade.purefun.type.Either;
import com.github.tonivade.purefun.type.Option;
import com.github.tonivade.purefun.typeclasses.Console;
import com.github.tonivade.purefun.typeclasses.For;
import com.github.tonivade.purefun.typeclasses.Monad;
import com.github.tonivade.purefun.typeclasses.MonadError;
import com.github.tonivade.purefun.typeclasses.MonadReader;
import com.github.tonivade.purefun.typeclasses.MonadState;

public class MTL<F extends Kind> {

  private final Console<F> console;
  private final MonadError<F, Error> monadError;
  private final MonadState<F, Requests> monadState;
  private final MonadReader<F, Config> monadReader;
  
  public MTL(
      Console<F> console, 
      MonadError<F, Error> monadError, 
      MonadState<F, Requests> monadState,
      MonadReader<F, Config> monadReader) {
    this.console = console;
    this.monadError = monadError;
    this.monadState = monadState;
    this.monadReader = monadReader;
  }

  public Higher1<F, Unit> program() {
    return For.with(monadError)
        .andThen(() -> mainLoopAndRecover())
        .andThen(() -> program())
        .run();
  }

  private Higher1<F, Unit> mainLoopAndRecover() {
    return monadError.handleErrorWith(mainLoop(), 
        error -> console.println(format("Error: %s", error)));
  }

  private Higher1<F, Unit> mainLoop() {
    return For.with(monadError)
        .andThen(() -> hostAndPort())
        .flatMap(t -> t.applyTo((host, port) -> console.println(format("connecting to %s:%d", host, port))))
        .andThen(() -> askAndFetchAndPrint()).run();
  }
  
  private Higher1<F, Tuple2<String, Integer>> hostAndPort() {
    return For.with(monadError)
        .andThen(this::host)
        .andThen(this::port)
        .tuple();
  }

  private Higher1<F, String> host() {
    return monadReader.reader(Config::host);
  }
  
  private Higher1<F, Integer> port() {
    return monadReader.reader(Config::port);
  }
  
  private Higher1<F, Unit> askAndFetchAndPrint() {
    return For.with(monadError)
      .andThen(this::askAndFetch)
      .flatMap(t -> t.applyTo(
          (city, forecast) -> console.println(
              format("Forecast for city %s is %s", city.name(), forecast.temperature()))))
      .andThen(() -> hottestCity())
      .flatMap(hottest -> console.println(format("Hottest city so far: %s", hottest)))
      .run();
  }

  private Higher1<F, Tuple2<City, Forecast>> askAndFetch() {
    return For.with(monadError)
        .andThen(this::askCity)
        .flatMap(this::fetchForecast)
        .yield(Tuple::of);
  }

  private Higher1<F, String> hottestCity() {
    return monadState.inspect(Requests::hottest);
  }
  
  private Higher1<F, Forecast> fetchForecast(City city) {
    return For.with(monadState)
      .andThen(() -> monadState.inspect(requests -> requests.get(city)))
      .flatMap(forecast -> forecast.fold(() -> forecast(city), monadState::<Forecast>pure))
      .flatMap(forecast -> monadState.modify(requests -> requests.put(city, forecast)))
      .yield((x, f, y) -> f);
  }
  
  private Higher1<F, City> askCity() {
    return For.with(monadError)
        .andThen(() -> console.println("What city?"))
        .andThen(console::readln)
        .flatMap(this::cityByName)
        .run();
  }
  
  private Higher1<F, City> cityByName(String name) {
    return Pattern1.<String, Higher1<F, City>>build()
      .when(is("Madrid")).then(n -> monadError.pure(new City(n)))
      .when(is("Getafe")).then(n -> monadError.pure(new City(n)))
      .otherwise().then(n -> monadError.raiseError(new UnknownCity(n)))
      .apply(name);
  }
  
  private Higher1<F, Forecast> forecast(City city) {
    return For.with(monadError)
        .and(current().nextInt(30))
        .map(Forecast::new)
        .run();
  }
  
  public static void main(String[] args) {
    EffectNInstances instances = new EffectNInstances();

    MTL<EffectN.µ> mtl = new MTL<>(instances, instances, instances, instances);
    
    EffectN<Unit> result = mtl.program().fix1(EffectN::narrowK);

    result.run(new Requests()).run(new Config("localhost", 8080)).run();
  }
}

interface Error { }

record UnknownCity(String name) implements Error { }

record Config(String host, Integer port) { }

record Requests(ImmutableMap<String, Forecast> map) {

  public Requests() {
    this(ImmutableMap.empty());
  }
  
  Option<Forecast> get(City city) {
    return map.get(city.name());
  }
  
  String hottest() {
    Comparator<Tuple2<String, Forecast>> comparator = comparing(entry -> entry.get2().temperature());
    return map.entries().asList().sort(comparator.reversed())
      .head().map(entry -> entry.get1()).getOrElse(cons(null));
  }

  Requests put(City city, Forecast forecast) {
    return new Requests(map.put(city.name(), forecast));
  }
}

record Forecast(Integer temperature) { }

record City(String name) { }

record Effect0<A>(EitherT<IO.µ, Error, A> value) implements Higher1<Effect0.µ, A>{
  
  static final class µ implements Kind { }
  
  public Either<Error, A> run() {
    return value.value().fix1(IO::narrowK).unsafeRunSync();
  }
  
  public static <A> Effect0<A> narrowK(Higher1<Effect0.µ, A> hkt) {
    return (Effect0<A>) hkt;
  }
}

record Effect1<A>(Kleisli<Effect0.µ, Config, A> value) implements Higher1<Effect1.µ, A> {

  static final class µ implements Kind { }

  public Effect0<A> run(Config config) {
    return value.run(config).fix1(Effect0::narrowK);
  }
  
  public static <A> Effect1<A> narrowK(Higher1<Effect1.µ, A> hkt) {
    return (Effect1<A>) hkt;
  }
}

record EffectN<A>(StateT<Effect1.µ, Requests, A> value) implements Higher1<EffectN.µ, A> {

  static final class µ implements Kind { }

  public Effect1<Tuple2<Requests, A>> run(Requests state) {
    return value.run(state).fix1(Effect1::narrowK);
  }
  
  public static <A> EffectN<A> narrowK(Higher1<EffectN.µ, A> hkt) {
    return (EffectN<A>) hkt;
  }
}

class Effect0MonadError implements MonadError<Effect0.µ, Error> {

  private final MonadError<Higher1<Higher1<EitherT.µ, IO.µ>, Error>, Error> monad = 
      EitherTInstances.monadError(IOInstances.monad());

  @Override
  public <T> Higher1<Effect0.µ, T> pure(T value) {
    return new Effect0<>(monad.pure(value).fix1(EitherT::narrowK));
  }

  @Override
  public <T, R> Higher1<Effect0.µ, R> flatMap(Higher1<Effect0.µ, T> value, 
      Function1<T, ? extends Higher1<Effect0.µ, R>> map) {
    var flatMap = monad.flatMap(value.fix1(Effect0::narrowK).value(), x -> map.apply(x).fix1(Effect0::narrowK).value());
    return new Effect0<>(flatMap.fix1(EitherT::narrowK));
  }
  
  @Override
  public <A> Higher1<Effect0.µ, A> raiseError(Error error) {
    return new Effect0<>(monad.<A>raiseError(error).fix1(EitherT::narrowK));
  }
  
  @Override
  public <A> Higher1<Effect0.µ, A> handleErrorWith(Higher1<Effect0.µ, A> value,
      Function1<Error, ? extends Higher1<Effect0.µ, A>> handler) {
    var handleErrorWith = monad.handleErrorWith(value.fix1(Effect0::narrowK).value(), 
            error -> handler.apply(error).fix1(Effect0::narrowK).value());
    return new Effect0<>(handleErrorWith.fix1(EitherT::narrowK));
  }
}

class Effect1Monad implements Monad<Effect1.µ> {

  private final Monad<Higher1<Higher1<Kleisli.µ, Effect0.µ>, Config>> monad = 
      KleisliInstances.monad(new Effect0MonadError());

  @Override
  public <T> Higher1<Effect1.µ, T> pure(T value) {
    return new Effect1<>(monad.pure(value).fix1(Kleisli::narrowK));
  }

  @Override
  public <T, R> Higher1<Effect1.µ, R> flatMap(Higher1<Effect1.µ, T> value, 
      Function1<T, ? extends Higher1<Effect1.µ, R>> map) {
    var flatMap = monad.flatMap(value.fix1(Effect1::narrowK).value(), 
        t -> map.apply(t).fix1(Effect1::narrowK).value());
    return new Effect1<>(flatMap.fix1(Kleisli::narrowK));
  }
}

class Effect1MonadReader extends Effect1Monad implements MonadReader<Effect1.µ, Config> {

  private final MonadReader<Higher1<Higher1<Kleisli.µ, Effect0.µ>, Config>, Config> monad = 
      KleisliInstances.monadReader(new Effect0MonadError());

  @Override
  public Higher1<Effect1.µ, Config> ask() {
    return new Effect1<>(monad.ask().fix1(Kleisli::narrowK));
  }
}

class Effect1MonadError extends Effect1Monad implements MonadError<Effect1.µ, Error> {

  private final MonadError<Higher1<Higher1<Kleisli.µ, Effect0.µ>, Config>, Error> monadError = 
      KleisliInstances.monadError(new Effect0MonadError());
  
  @Override
  public <A> Higher1<Effect1.µ, A> raiseError(Error error) {
    var raiseError = monadError.<A>raiseError(error);
    return new Effect1<>(raiseError.fix1(Kleisli::narrowK));
  }
  
  @Override
  public <A> Higher1<Effect1.µ, A> handleErrorWith(
      Higher1<Effect1.µ, A> value, Function1<Error, ? extends Higher1<Effect1.µ, A>> handler) {
    var handleErrorWith = monadError.handleErrorWith(
        value.fix1(Effect1::narrowK).value(),  error -> handler.apply(error).fix1(Effect1::narrowK).value());
    return new Effect1<>(handleErrorWith.fix1(Kleisli::narrowK));
  }
}

class EffectNInstances implements
    Console<EffectN.µ>,
    MonadState<EffectN.µ, Requests>, 
    MonadError<EffectN.µ, Error>, 
    MonadReader<EffectN.µ, Config> {

  private final Console<IO.µ> ioConsole = IOInstances.console();
  private final Monad<IO.µ> ioMonad = IOInstances.monad();
  private final MonadError<Effect0.µ, Error> monadError0 = new Effect0MonadError();
  private final Monad<Effect1.µ> monad1 = new Effect1Monad();
  private final MonadReader<Higher1<Higher1<StateT.µ, Effect1.µ>, Requests>, Config> monadReaderN = 
      StateTInstances.monadReader(new Effect1MonadReader());
  private final MonadError<Higher1<Higher1<StateT.µ, Effect1.µ>, Requests>, Error> monadErrorN = 
      StateTInstances.monadError(new Effect1MonadError());
  private final MonadState<Higher1<Higher1<StateT.µ, Effect1.µ>, Requests>, Requests> monadStateN = 
      StateTInstances.monadState(monad1);

  @Override
  public <T> Higher1<EffectN.µ, T> pure(T value) {
    return new EffectN<>(monadStateN.pure(value).fix1(StateT::narrowK));
  }

  @Override
  public <T, R> Higher1<EffectN.µ, R> flatMap(Higher1<EffectN.µ, T> value, 
      Function1<T, ? extends Higher1<EffectN.µ, R>> map) {
    var flatMap = monadStateN.flatMap(
        value.fix1(EffectN::narrowK).value(), 
        x -> map.apply(x).fix1(EffectN::narrowK).value());
    return new EffectN<>(flatMap.fix1(StateT::narrowK));
  }
  
  @Override
  public Higher1<EffectN.µ, Requests> get() {
    return new EffectN<>(monadStateN.get().fix1(StateT::narrowK));
  }
  
  @Override
  public Higher1<EffectN.µ, Unit> set(Requests state) {
    return new EffectN<>(monadStateN.set(state).fix1(StateT::narrowK));
  }
  
  @Override
  public <A> Higher1<EffectN.µ, A> raiseError(Error error) {
    var raiseError = monadErrorN.<A>raiseError(error);
    return new EffectN<>(raiseError.fix1(StateT::narrowK));
  }
  
  @Override
  public <A> Higher1<EffectN.µ, A> handleErrorWith(
      Higher1<EffectN.µ, A> value, Function1<Error, ? extends Higher1<EffectN.µ, A>> handler) {
    var handleErrorWith = monadErrorN.handleErrorWith(
        value.fix1(EffectN::narrowK).value(), 
        error -> handler.apply(error).fix1(EffectN::narrowK).value());
    return new EffectN<>(handleErrorWith.fix1(StateT::narrowK));
  }
  
  @Override
  public Higher1<EffectN.µ, Config> ask() {
    return new EffectN<>(monadReaderN.ask().fix1(StateT::narrowK));
  }

  @Override
  public Higher1<EffectN.µ, String> readln() {
    var readln = ioConsole.readln().fix1(IO::narrowK).map(Either::<Error, String>right);
    return effectN(effect1(effect0(readln)));
  }

  @Override
  public Higher1<EffectN.µ, Unit> println(String text) {
    var println = ioConsole.println(text).fix1(IO::narrowK).map(Either::<Error, Unit>right);
    return effectN(effect1(effect0(println)));
  }

  private <A> Effect0<A> effect0(IO<Either<Error, A>> value) {
    var eitherT = EitherT.of(ioMonad, value);
    return new Effect0<>(eitherT);
  }

  private <A> Effect1<A> effect1(Effect0<A> effect0) {
    var kleisli = Kleisli.<Effect0.µ, Config, A>of(monadError0, config -> effect0);
    return new Effect1<>(kleisli);
  }

  private <A> Higher1<EffectN.µ, A> effectN(Effect1<A> effect1) {
    var stateT = StateT.<Effect1.µ, Requests, A>state(monad1, 
        state -> monad1.map(effect1, x -> Tuple.of(state, x)));
    return new EffectN<>(stateT);
  }
}