ParserClass.java

package example.playground.parserclass;

import lombok.AllArgsConstructor;
import lombok.EqualsAndHashCode;
import lombok.RequiredArgsConstructor;
import lombok.Value;
import lombok.experimental.Delegate;

import java.util.function.BiFunction;
import java.util.function.Function;
import java.util.function.Predicate;
import java.util.function.Supplier;

// ---

interface Hk<W, A> {
  default Hk<W, A> unwrap() {
    return this;
  }
}

class Lazy {
  static <W, A> Hk<W, A> lazy(Supplier<Hk<W, A>> f) {
    return new Hk<>() {
      @Override
      public Hk<W, A> unwrap() {
        return f.get();
      }
    };
  }
}

// ---

interface Show<A> {
  String show(A a);

  static <A> Show<A> builtin() {
    return Object::toString;
  }
}

interface Eq<A> {
  boolean eq(A x, A y);

  static <A> Eq<A> builtin() {
    return Object::equals;
  }
}

interface Ord<A> extends Eq<A> {

  Ord<Character> CHAR = of(Character::compare);

  int cmp(A x, A y);

  @Override
  default boolean eq(A x, A y) {
    return cmp(x, y) == 0;
  }

  static <A> Ord<A> of(BiFunction<A, A, Integer> f) {
    return f::apply;
  }
}

// ---

abstract class TyEq<A, B> {

  private TyEq() {}

  public abstract B castLTR(A a);
  public abstract A castRTL(B b);

  public abstract <C> TyEq<A, C> compose(TyEq<B, C> eqBC);

  public abstract TyEq<B, A> rot();

  public abstract <X> TyEq<Hk<A, X>, Hk<B, X>> liftL();
  public abstract <X> TyEq<Hk<X, A>, Hk<X, B>> liftR();

  public <W> Hk<W, B> castLTR(Hk<W, A> a) {
    return this.<W>liftR().castLTR(a);
  }
  public <W> Hk<W, A> castRTL(Hk<W, B> b) {
    return this.<W>liftR().castRTL(b);
  }

  static <A> TyEq<A, A> refl() {
    return new Refl<>();
  }

  @Value
  @EqualsAndHashCode(callSuper = false)
  private static class Refl<A> extends TyEq<A, A> {
    @Override
    public A castLTR(A a) {
      return a;
    }

    @Override
    public A castRTL(A a) {
      return a;
    }

    @Override
    public <C> TyEq<A, C> compose(TyEq<A, C> eqBC) {
      return eqBC;
    }

    @Override
    public TyEq<A, A> rot() {
      return this;
    }

    @Override
    public <X> TyEq<Hk<A, X>, Hk<A, X>> liftL() {
      return refl();
    }

    @Override
    public <X> TyEq<Hk<X, A>, Hk<X, A>> liftR() {
      return refl();
    }
  }
}

// ---

interface Functor<W> {
  <A, B> Hk<W, B> map(Function<A, B> f, Hk<W, A> fa);

  default <A, B> Hk<W, B> mapConst(Supplier<B> f, Hk<W, A> fa) {
    return map(a -> f.get(), fa);
  }

  // ---

  static <W> Wrap<W> wrap(Functor<W> fw) {
    return new Wrap<>(fw);
  }

  class Mu {}

  @RequiredArgsConstructor
  class Wrap<W> implements Hk<Functor.Mu, W>, Functor<W> {

    private final @Delegate Functor<W> self;

    static <W> Wrap<W> narrow(Hk<Functor.Mu, W> fw) {
      return (Wrap<W>) fw;
    }
  }
}

interface Applicative<W> extends Functor<W> {
  <A> Hk<W, A> pure(A a);
  <A, B, C> Hk<W, C> liftA2(BiFunction<A, B, C> f, Hk<W, A> pa, Hk<W, B> pb);

  // (<*)
  default <A> Hk<W, A> followedBy(Hk<W, A> pa, Hk<W, ?> px) {
    return liftA2((a, x) -> a, pa, px);
  }

  // ---

  static <W> Applicative.Wrap<W> wrap(Applicative<W> fw) {
    return new Applicative.Wrap<>(fw, fw);
  }

  class Mu {}

  @RequiredArgsConstructor
  class Wrap<W> implements Hk<Applicative.Mu, W>, Applicative<W> {

    private final @Delegate Functor<W> functor;
    private final @Delegate Applicative<W> applicative;

    static <W> Applicative.Wrap<W> narrow(Hk<Applicative.Mu, W> fw) {
      return (Applicative.Wrap<W>) fw;
    }
  }
}

interface Alternative<W> extends Applicative<W> {
  <A> Hk<W, A> empty();
  <A> Hk<W, A> alt(Hk<W, A> fa1, Hk<W, A> fa2);

  default <A> Hk<W, Fwd<A>> some(Hk<W, A> fa) {
    return liftA2(Fwd::cons, fa, Lazy.lazy(() -> many(fa)));
  }

  default <A> Hk<W, Fwd<A>> many(Hk<W, A> fa) {
    return alt(some(fa), pure(Fwd.nil()));
  }

  // ---

  static <W> Alternative.Wrap<W> wrap(Alternative<W> fw) {
    return new Alternative.Wrap<>(fw, fw, fw);
  }

  class Mu {}

  @RequiredArgsConstructor
  class Wrap<W> implements Hk<Alternative.Mu, W>, Alternative<W> {

    private final @Delegate Functor<W> functor;
    private final @Delegate Applicative<W> applicative;
    private final @Delegate Alternative<W> alternative;

    static <W> Alternative.Wrap<W> narrow(Hk<Alternative.Mu, W> fw) {
      return (Alternative.Wrap<W>) fw;
    }
  }
}

// ---

@Value
class Unit {
  private Unit() {}

  static Unit get() {
    return new Unit();
  }
}

// ---

abstract class Maybe<A> {

  private Maybe() {}

  abstract <R> R accept(Visitor<R, A> visitor);

  <R> R match(Function<A, R> just, Supplier<R> nothing) {
    return accept(new Visitor<>() {
      @Override
      public R visit(Nothing<A> value) {
        return nothing.get();
      }

      @Override
      public R visit(Just<A> value) {
        return just.apply(value.getA());
      }
    });
  }

  <B> Maybe<B> map(Function<A, B> f) {
    return accept(new Visitor<>() {
      @Override
      public Maybe<B> visit(Nothing<A> value) {
        return new Nothing<>();
      }

      @Override
      public Maybe<B> visit(Just<A> value) {
        return new Just<>(f.apply(value.getA()));
      }
    });
  }

  <B> Maybe<B> flatMap(Function<A, Maybe<B>> f) {
    return accept(new Visitor<>() {
      @Override
      public Maybe<B> visit(Nothing<A> value) {
        return new Nothing<>();
      }

      @Override
      public Maybe<B> visit(Just<A> value) {
        return f.apply(value.getA());
      }
    });
  }

  Maybe<A> orElse(Supplier<Maybe<A>> fa) {
    return accept(new Visitor<>() {
      @Override
      public Maybe<A> visit(Nothing<A> value) {
        return fa.get();
      }

      @Override
      public Maybe<A> visit(Just<A> value) {
        return value;
      }
    });
  }

  static <A> Maybe<A> nothing() {
    return new Nothing<>();
  }

  static <A> Maybe<A> just(A a) {
    return new Just<>(a);
  }

  interface Visitor<R, A> {
    R visit(Nothing<A> value);
    R visit(Just<A> value);
  }

  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Nothing<A> extends Maybe<A> {
    @Override
    <R> R accept(Visitor<R, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Just<A> extends Maybe<A> {
    A a;

    @Override
    <R> R accept(Visitor<R, A> visitor) {
      return visitor.visit(this);
    }
  }
}

// ---

@Value
@AllArgsConstructor(staticName = "of")
class Pair<A, B> {

  A fst;
  B snd;

  <C, D> Pair<C, D> bimap(Function<A, C> fac, Function<B, D> fbd) {
    return new Pair<>(fac.apply(getFst()), fbd.apply(getSnd()));
  }

  static <A, B, C> Function<Pair<A, B>, Pair<C, B>> mappingFst(Function<A, C> f) {
    return pab -> pab.bimap(f, Function.identity());
  }
}

// ---

abstract class Fwd<A> {

  abstract <R> R accept(Visitor<R, A> visitor);

  static <A> Fwd<A> nil() {
    return new Nil<>();
  }

  static <A> Fwd<A> cons(A a, Fwd<A> as) {
    return new Cons<>(a, as);
  }

  interface Visitor<R, A> {
    R visit(Nil<A> value);
    R visit(Cons<A> value);
  }

  @Value
  @EqualsAndHashCode(callSuper = false)
  static class Nil<A> extends Fwd<A> {
    @Override
    <R> R accept(Visitor<R, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  static class Cons<A> extends Fwd<A> {
    A value;
    Fwd<A> next;

    @Override
    <R> R accept(Visitor<R, A> visitor) {
      return visitor.visit(this);
    }
  }
}

// ---

interface ParserClass<W, T> extends Alternative<W> {

  <A> Hk<W, A> tokenPrim(Function<T, Maybe<A>> f);

  Hk<W, Unit> eof();

  default <A> Hk<W, A> ann(Hk<W, A> pa, String name) {
    return pa;
  }

  // ---

  default Hk<W, T> satisfy(Predicate<T> p) {
    return tokenPrim(t -> p.test(t) ? Maybe.just(t) : Maybe.nothing());
  }

  default Hk<W, T> element(Eq<T> eqT, T t) {
    return satisfy(t2 -> eqT.eq(t, t2));
  }

  // ---

  default ParserClassChar<W> asChar(TyEq<T, Character> tyEq) {
    ParserClass<W, Character> cls = ParserClass.Wrap.narrow(tyEq.castLTR(ParserClass.wrap(this)));
    return new ParserClassChar.Wrap<>(cls, cls, cls, cls);
  }

  // ---

  default <A> Parser<W, T, A> fluent(Hk<W, A> pa) {
    return Parser.of(this, pa);
  }

  // ---

  static <W, T> ParserClass.Wrap<W, T> wrap(ParserClass<W, T> fw) {
    return new ParserClass.Wrap<>(fw, fw, fw, fw);
  }

  class Mu {}

  @RequiredArgsConstructor
  class Wrap<W, T> implements Hk<Hk<ParserClass.Mu, W>, T>, ParserClass<W, T> {

    private final @Delegate Functor<W> functor;
    private final @Delegate Applicative<W> applicative;
    private final @Delegate Alternative<W> alternative;
    private final @Delegate ParserClass<W, T> parserClass;

    static <W, T> ParserClass.Wrap<W, T> narrow(Hk<Hk<ParserClass.Mu, W>, T> fw) {
      return (ParserClass.Wrap<W, T>) fw;
    }
  }
}

interface ParserClassChar<W> extends ParserClass<W, Character> {

  default Hk<W, Character> char_(char c) {
    return ann(element(Eq.builtin(), c), String.format("'%c'", c));
  }

  default Hk<W, Unit> spaces() {
    return mapConst(Unit::get, many(satisfy(Character::isWhitespace)));
  }

  default Hk<W, Character> digit() {
    return ann(satisfy(Character::isDigit), "digit");
  }

  default Hk<W, Character> letter() {
    return ann(satisfy(Character::isAlphabetic), "letter");
  }

  @RequiredArgsConstructor
  class Wrap<W> implements ParserClassChar<W> {
    private final @Delegate Functor<W> functor;
    private final @Delegate Applicative<W> applicative;
    private final @Delegate Alternative<W> alternative;
    private final @Delegate ParserClass<W, Character> pc;
  }
}

/**
 * Fluent interface for {@link ParserClass}
 */
interface Parser<W, T, A> extends Hk<W, A> {

  ParserClass<W, T> cls();
  Hk<W, A> self();

  @Override
  default Hk<W, A> unwrap() {
    return self();
  }

  // Functor

  default <B> Parser<W, T, B> map(Function<A, B> f) {
    return kmap(pa -> cls().map(f, pa));
  }

  // Applicative

  default <B> Parser<W, T, B> appliedTo(Hk<W, Function<A, B>> pf) {
    return kmap(pa -> cls().liftA2((a, f) -> f.apply(a), pa, pf));
  }

  default Parser<W, T, A> followedBy(Hk<W, ?> px) {
    return kmap(pa -> cls().followedBy(pa, px));
  }

  // Alternative

  default Parser<W, T, Fwd<A>> some() {
    return kmap(pa -> cls().some(pa));
  }

  default Parser<W, T, Fwd<A>> many() {
    return kmap(pa -> cls().many(pa));
  }

  // ParserClass

  // (Administrative)

  default <B> Parser<W, T, B> kmap(Function<Hk<W, A>, Hk<W, B>> f) {
    return of(cls(), f.apply(Parser.this.self()));
  }

  static <W, T, A> Parser<W, T, A> of(ParserClass<W, T> pc, Hk<W, A> pa) {
    return new Parser<>() {
      @Override
      public ParserClass<W, T> cls() {
        return pc;
      }

      @Override
      public Hk<W, A> self() {
        return pa;
      }
    };
  }
}

// ---

abstract class ParserData<T, A> implements Hk<Hk<ParserData.Mu, T>, A> {

  private ParserData() {}

  public abstract <R> R accept(Visitor<R, T, A> visitor);

  public static <T, A> ParserData<T, A> narrow(Hk<Hk<Mu, T>, A> hk) {
    return (ParserData<T, A>) hk.unwrap();
  }

  public static class Mu {}

  interface Visitor<R, T, A> {
    // Functor
    <X> R visit(Map<T, X, A> value);
    // Applicative
    R visit(Pure<T, A> value);
    <X, Y> R visit(LiftA2<T, X, Y, A> value);
    R visit(FollowedBy<T, A> value);
    // Alternative
    R visit(Empty<T, A> value);
    R visit(Alt<T, A> value);
    <X> R visit(TyEq<A, Fwd<X>> teq, Many<T, X> value);
    <X> R visit(TyEq<A, Fwd<X>> teq, Some<T, X> value);
    // ParserClass
    R visit(TokenPrim<T, A> value);
    R visit(TyEq<A, Unit> teq, Eof<T> value);
    R visit(TyEq<A, T> teq, Element<T> value);
    // - Char
    R visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, Digit value);
    R visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, Letter letter);
  }

  // Functor
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Map<T, A, B> extends ParserData<T, B> {
    Function<A, B> f;
    ParserData<T, A> pa;

    @Override
    public <R> R accept(Visitor<R, T, B> visitor) {
      return visitor.visit(this);
    }
  }
  // Applicative
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Pure<T, A> extends ParserData<T, A> {
    A value;

    @Override
    public <R> R accept(Visitor<R, T, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class LiftA2<T, A, B, C> extends ParserData<T, C> {
    BiFunction<A, B, C> f;
    ParserData<T, A> pa;
    ParserData<T, B> pb;

    @Override
    public <R> R accept(Visitor<R, T, C> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class FollowedBy<T, A> extends ParserData<T, A> {
    ParserData<T, A> pa;
    ParserData<T, ?> px;

    @Override
    public <R> R accept(Visitor<R, T, A> visitor) {
      return visitor.visit(this);
    }
  }
  // Alternative
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Empty<T, A> extends ParserData<T, A> {

    @Override
    public <R> R accept(Visitor<R, T, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Alt<T, A> extends ParserData<T, A> {
    ParserData<T, A> pa1;
    ParserData<T, A> pa2;

    @Override
    public <R> R accept(Visitor<R, T, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Many<T, A> extends ParserData<T, Fwd<A>> {
    ParserData<T, A> pa;

    @Override
    public <R> R accept(Visitor<R, T, Fwd<A>> visitor) {
      return visitor.visit(TyEq.refl(), this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Some<T, A> extends ParserData<T, Fwd<A>> {
    ParserData<T, A> pa;

    @Override
    public <R> R accept(Visitor<R, T, Fwd<A>> visitor) {
      return visitor.visit(TyEq.refl(), this);
    }
  }
  // ParserClass
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class TokenPrim<T, A> extends ParserData<T, A> {
    Function<T, Maybe<A>> f;

    @Override
    public <R> R accept(Visitor<R, T, A> visitor) {
      return visitor.visit(this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Eof<T> extends ParserData<T, Unit> {

    @Override
    public <R> R accept(Visitor<R, T, Unit> visitor) {
      return visitor.visit(TyEq.refl(), this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Element<T> extends ParserData<T, T> {
    Eq<T> eqT;
    T t;

    @Override
    public <R> R accept(Visitor<R, T, T> visitor) {
      return visitor.visit(TyEq.refl(), this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Digit extends ParserData<Character, Character> {
    @Override
    public <R> R accept(Visitor<R, Character, Character> visitor) {
      return visitor.visit(TyEq.refl(), TyEq.refl(), this);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  public static class Letter extends ParserData<Character, Character> {
    @Override
    public <R> R accept(Visitor<R, Character, Character> visitor) {
      return visitor.visit(TyEq.refl(), TyEq.refl(), this);
    }
  }
}

class ParserDataInstances {

  @RequiredArgsConstructor
  static class ShowI<T> implements Show<ParserData<T, ?>> {

    private final Show<T> showT;

    @Override
    public String show(ParserData<T, ?> pa) {
      return go(pa);
    }

    private <A> String go(Hk<Hk<ParserData.Mu, T>, A> pa) {
      return ParserData.narrow(pa).accept(new ParserData.Visitor<>() {
        @Override
        public <X> String visit(ParserData.Map<T, X, A> value) {
          return "map(f, " + go(value.getPa()) + ")";
        }

        @Override
        public String visit(ParserData.Pure<T, A> value) {
          return "pure(a)";
        }

        @Override
        public <X, Y> String visit(ParserData.LiftA2<T, X, Y, A> value) {
          return "liftA2(f, " + go(value.getPa()) + ", " + go(value.getPb()) + ")";
        }

        @Override
        public String visit(ParserData.FollowedBy<T, A> value) {
          return "followedBy(" + go(value.getPa()) + ", " + go(value.getPx()) + ")";
        }

        @Override
        public String visit(ParserData.Empty<T, A> value) {
          return "empty";
        }

        @Override
        public String visit(ParserData.Alt<T, A> value) {
          return "alt(" + go(value.getPa1()) + ", " + go(value.getPa2()) + ")";
        }

        @Override
        public <X> String visit(TyEq<A, Fwd<X>> teq, ParserData.Many<T, X> value) {
          return "many(" + go(value.getPa()) + ")";
        }

        @Override
        public <X> String visit(TyEq<A, Fwd<X>> teq, ParserData.Some<T, X> value) {
          return "some(" + go(value.getPa()) + ")";
        }

        @Override
        public String visit(ParserData.TokenPrim<T, A> value) {
          return "tokenPrim(f)";
        }

        @Override
        public String visit(TyEq<A, Unit> teq, ParserData.Eof<T> value) {
          return "eof()";
        }

        @Override
        public String visit(TyEq<A, T> teq, ParserData.Element<T> value) {
          return "element(" + showT.show(value.getT()) + ")";
        }

        @Override
        public String visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Digit value) {
          return "digit()";
        }

        @Override
        public String visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Letter letter) {
          return "letter()";
        }
      });
    }
  }

  @RequiredArgsConstructor
  static class FunctorI<T> implements Functor<Hk<ParserData.Mu, T>> {

    @Override
    public <A, B> Hk<Hk<ParserData.Mu, T>, B> map(Function<A, B> f, Hk<Hk<ParserData.Mu, T>, A> pa) {
      return new ParserData.Map<>(f, ParserData.narrow(pa));
    }
  }

  @RequiredArgsConstructor
  static class ApplicativeI<T> implements Applicative<Hk<ParserData.Mu, T>> {

    private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, A> pure(A a) {
      return new ParserData.Pure<>(a);
    }

    @Override
    public <A, B, C> Hk<Hk<ParserData.Mu, T>, C> liftA2(BiFunction<A, B, C> f, Hk<Hk<ParserData.Mu, T>, A> pa, Hk<Hk<ParserData.Mu, T>, B> pb) {
      return new ParserData.LiftA2<>(f, ParserData.narrow(pa), ParserData.narrow(pb));
    }

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, A> followedBy(Hk<Hk<ParserData.Mu, T>, A> pa, Hk<Hk<ParserData.Mu, T>, ?> px) {
      return new ParserData.FollowedBy<>(ParserData.narrow(pa), ParserData.narrow(px));
    }
  }

  @RequiredArgsConstructor
  static class AlternativeI<T> implements Alternative<Hk<ParserData.Mu, T>> {

    private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
    private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, A> empty() {
      return new ParserData.Empty<>();
    }

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, A> alt(Hk<Hk<ParserData.Mu, T>, A> fa1, Hk<Hk<ParserData.Mu, T>, A> fa2) {
      return new ParserData.Alt<>(ParserData.narrow(fa1), ParserData.narrow(fa2));
    }

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, Fwd<A>> some(Hk<Hk<ParserData.Mu, T>, A> fa) {
      return new ParserData.Some<>(ParserData.narrow(fa));
    }

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, Fwd<A>> many(Hk<Hk<ParserData.Mu, T>, A> fa) {
      return new ParserData.Many<>(ParserData.narrow(fa));
    }
  }

  @RequiredArgsConstructor
  static class ParserClassI<T> implements ParserClass<Hk<ParserData.Mu, T>, T> {

    private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
    private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;
    private final @Delegate Alternative<Hk<ParserData.Mu, T>> alternative;

    @Override
    public <A> Hk<Hk<ParserData.Mu, T>, A> tokenPrim(Function<T, Maybe<A>> f) {
      return new ParserData.TokenPrim<>(f);
    }

    @Override
    public Hk<Hk<ParserData.Mu, T>, Unit> eof() {
      return new ParserData.Eof<>();
    }

    @Override
    public Hk<Hk<ParserData.Mu, T>, T> element(Eq<T> eqT, T t) {
      return new ParserData.Element<>(eqT, t);
    }

    @Override
    public ParserClassChar<Hk<ParserData.Mu, T>> asChar(TyEq<T, Character> tyEq) {
      var parserClassC = tyEq
              .<Hk<Mu, Hk<ParserData.Mu, T>>>liftR()
              .castLTR(ParserClass.wrap(this));
      return new ParserClassCharI<>(
              tyEq,
              functor,
              applicative,
              alternative,
              ParserClass.Wrap.narrow(parserClassC));
    }
  }

  @RequiredArgsConstructor
  static class ParserClassCharI<T> implements ParserClassChar<Hk<ParserData.Mu, T>> {

    private final TyEq<T, Character> teq;
    private final @Delegate Functor<Hk<ParserData.Mu, T>> functor;
    private final @Delegate Applicative<Hk<ParserData.Mu, T>> applicative;
    private final @Delegate Alternative<Hk<ParserData.Mu, T>> alternative;
    private final @Delegate ParserClass<Hk<ParserData.Mu, T>, Character> parserClass;

    @Override
    public Hk<Hk<ParserData.Mu, T>, Character> digit() {
      return teq.<ParserData.Mu>liftR().<Character>liftL().castRTL(new ParserData.Digit());
    }

    @Override
    public Hk<Hk<ParserData.Mu, T>, Character> letter() {
      return teq.<ParserData.Mu>liftR().<Character>liftL().castRTL(new ParserData.Letter());
    }
  }
}

class ParserDataReinterpret {

  public static <W, T, A> Hk<W, A> interpret(ParserClass<W, T> pc, ParserData<T, A> pa) {
    return pa.accept(new ParserData.Visitor<>() {
      @Override
      public <X> Hk<W, A> visit(ParserData.Map<T, X, A> value) {
        var px = interpret(pc, value.getPa());
        return pc.map(value.getF(), px);
      }

      @Override
      public Hk<W, A> visit(ParserData.Pure<T, A> value) {
        return pc.pure(value.getValue());
      }

      @Override
      public <X, Y> Hk<W, A> visit(ParserData.LiftA2<T, X, Y, A> value) {
        var px = interpret(pc, value.getPa());
        var py = interpret(pc, value.getPb());
        return pc.liftA2(value.getF(), px, py);
      }

      @Override
      public Hk<W, A> visit(ParserData.FollowedBy<T, A> value) {
        var pa_ = interpret(pc, value.getPa());
        var px_ = interpret(pc, value.getPx());
        return pc.followedBy(pa_, px_);
      }

      @Override
      public Hk<W, A> visit(ParserData.Empty<T, A> value) {
        return pc.empty();
      }

      @Override
      public Hk<W, A> visit(ParserData.Alt<T, A> value) {
        var pa1 = interpret(pc, value.getPa1());
        var pa2 = interpret(pc, value.getPa2());
        return pc.alt(pa1, pa2);
      }

      @Override
      public <X> Hk<W, A> visit(TyEq<A, Fwd<X>> teq, ParserData.Many<T, X> value) {
        var pa = interpret(pc, value.getPa());
        return teq.castRTL(pc.many(pa));
      }

      @Override
      public <X> Hk<W, A> visit(TyEq<A, Fwd<X>> teq, ParserData.Some<T, X> value) {
        var pa = interpret(pc, value.getPa());
        return teq.castRTL(pc.some(pa));
      }

      @Override
      public Hk<W, A> visit(ParserData.TokenPrim<T, A> value) {
        return pc.tokenPrim(value.getF());
      }

      @Override
      public Hk<W, A> visit(TyEq<A, Unit> teq, ParserData.Eof<T> value) {
        return teq.castRTL(pc.eof());
      }

      @Override
      public Hk<W, A> visit(TyEq<A, T> teq, ParserData.Element<T> value) {
        return teq.castRTL(pc.element(value.getEqT(), value.getT()));
      }

      @Override
      public Hk<W, A> visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Digit value) {
        return eqA.castRTL(pc.asChar(eqT).digit());
      }

      @Override
      public Hk<W, A> visit(TyEq<T, Character> eqT, TyEq<A, Character> eqA, ParserData.Letter letter) {
        return eqA.castRTL(pc.asChar(eqT).letter());
      }
    });
  }
}

// ---

interface Stream<T> {
  Maybe<Pair<T, Stream<T>>> read();
}

@Value
class StringStream implements Stream<Character> {
  String s;
  int i;

  @Override
  public Maybe<Pair<Character, Stream<Character>>> read() {
    if (i < s.length()) {
      return Maybe.just(Pair.of(s.charAt(i), new StringStream(s, i+1)));
    } else {
      return Maybe.nothing();
    }
  }

  static StringStream of(String s) {
    return new StringStream(s, 0);
  }
}

abstract class RealParser<T, A> implements Hk<RealParser.Mu1<T>, A> {

  public abstract Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts);

  public static <T, A> RealParser<T, A> narrow(Hk<Mu1<T>, A> hk) {
    return new Lazy<>(hk);
  }

  public static <T, A> RealParser<T, A> of(Function<Stream<T>, Maybe<Pair<A, Stream<T>>>> f) {
    return new Fun<>(f);
  }

  public static class Mu {}

  public static class Mu1<T> implements Hk<Mu, T> {}

  @Value
  @EqualsAndHashCode(callSuper = false)
  private static class Fun<T, A> extends RealParser<T, A> {
    Function<Stream<T>, Maybe<Pair<A, Stream<T>>>> f;

    @Override
    public Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts) {
      return f.apply(ts);
    }
  }
  @Value
  @EqualsAndHashCode(callSuper = false)
  private static class Lazy<T, A> extends RealParser<T, A> {
    Hk<Mu1<T>, A> hk;

    @Override
    public Maybe<Pair<A, Stream<T>>> parse(Stream<T> ts) {
      return ((RealParser<T, A>) hk.unwrap()).parse(ts);
    }
  }
}

class RealParserInstance<T> implements ParserClass<RealParser.Mu1<T>, T> {

  @Override
  public <A, B> Hk<RealParser.Mu1<T>, B> map(Function<A, B> f, Hk<RealParser.Mu1<T>, A> pa) {
    var pa_ = RealParser.narrow(pa);
    return RealParser.of(ts -> pa_.parse(ts).map(Pair.mappingFst(f)));
  }

  @Override
  public <A> Hk<RealParser.Mu1<T>, A> pure(A a) {
    return RealParser.of((ts -> Maybe.just(Pair.of(a, ts))));
  }

  @Override
  public <A, B, C> Hk<RealParser.Mu1<T>, C> liftA2(BiFunction<A, B, C> f, Hk<RealParser.Mu1<T>, A> pa, Hk<RealParser.Mu1<T>, B> pb) {
    var pa_ = RealParser.narrow(pa);
    var pb_ = RealParser.narrow(pb);
    return RealParser.of(ts -> pa_.parse(ts).flatMap(ra -> pb_.parse(ra.getSnd()).map(rb -> Pair.of(f.apply(ra.getFst(), rb.getFst()), rb.getSnd()))));
  }

  @Override
  public <A> Hk<RealParser.Mu1<T>, A> empty() {
    return RealParser.of(ts -> Maybe.nothing());
  }

  @Override
  public <A> Hk<RealParser.Mu1<T>, A> alt(Hk<RealParser.Mu1<T>, A> fa1, Hk<RealParser.Mu1<T>, A> fa2) {
    var fa1_ = RealParser.narrow(fa1);
    var fa2_ = RealParser.narrow(fa2);
    return RealParser.of(ts -> fa1_.parse(ts).orElse(() -> fa2_.parse(ts)));
  }

  @Override
  public <A> Hk<RealParser.Mu1<T>, A> tokenPrim(Function<T, Maybe<A>> f) {
    return RealParser.of(ts -> ts.read().flatMap(rt -> f.apply(rt.getFst()).map(a -> Pair.of(a, rt.getSnd()))));
  }

  @Override
  public Hk<RealParser.Mu1<T>, Unit> eof() {
    return RealParser.of(ts -> ts.read().match(t -> Maybe.nothing(), () -> Maybe.just(Pair.of(Unit.get(), ts))));
  }
}

// ---

public class Program {

  public static void main(String[] args) {
    var pd_parser = Program.<Character>parserData();
    var pd_show = new ParserDataInstances.ShowI<Character>(Show.builtin());

    var p = example1(pd_parser);

    var p_ = ParserDataReinterpret.interpret(new RealParserInstance<>(), ParserData.narrow(p));

    System.out.println(p);
    System.out.println(pd_show.show(ParserData.narrow(p)));
    System.out.println(RealParser.narrow(p_).parse(StringStream.of("")));

    // 2

    System.out.println(pd_show.show(ParserData.narrow(example2(parserData()))));
    System.out.println(RealParser.narrow(example2(new RealParserInstance<>())).parse(StringStream.of("1234.abc")));
  }

  private static <T> ParserDataInstances.ParserClassI<T> parserData() {
    var pd_functor = new ParserDataInstances.FunctorI<T>();
    var pd_applicative = new ParserDataInstances.ApplicativeI<T>(pd_functor);
    var pd_alternative = new ParserDataInstances.AlternativeI<T>(pd_functor, pd_applicative);
    return new ParserDataInstances.ParserClassI<>(pd_functor, pd_applicative, pd_alternative);
  }

  public static <W, T> Hk<W, Integer> example1(ParserClass<W, T> pc) {
    var pi = pc.liftA2(Integer::sum, pc.pure(1), pc.pure(2));
    return Parser.of(pc, pi).followedBy(pc.eof());
  }

  public static <W> Hk<W, String> example2(ParserClass<W, Character> pc) {
    var pcc = pc.asChar(TyEq.refl());
    return pc.fluent(pcc.digit())
            .many()
            .followedBy(pcc.char_('.'))
            .<String>appliedTo(
                    pc.fluent(pcc.letter())
                            .many()
                            .map(cs -> ds -> "digits: " + ds + "; chars: " + cs))
            .followedBy(pc.eof());
  }
}