Split project into individual files

src/main/java/com/garciat/typeclasses/TypeClasses.java

@@ -0,0 +1,205 @@
+package com.garciat.typeclasses;
+
+import static com.garciat.typeclasses.api.TypeClass.Witness.Overlap.OVERLAPPABLE;
+import static com.garciat.typeclasses.api.TypeClass.Witness.Overlap.OVERLAPPING;
+import static java.lang.reflect.AccessFlag.PUBLIC;
+import static java.lang.reflect.AccessFlag.STATIC;
+
+import com.garciat.typeclasses.api.Ctx;
+import com.garciat.typeclasses.api.Ty;
+import com.garciat.typeclasses.api.TypeClass;
+import com.garciat.typeclasses.impl.FuncType;
+import com.garciat.typeclasses.impl.ParsedType;
+import com.garciat.typeclasses.impl.Unification;
+import com.garciat.typeclasses.impl.utils.Lists;
+import com.garciat.typeclasses.impl.utils.ZeroOneMore;
+import com.garciat.typeclasses.types.Either;
+import com.garciat.typeclasses.types.Maybe;
+import java.lang.reflect.Method;
+import java.util.Arrays;
+import java.util.List;
+import java.util.stream.Collectors;
+import java.util.stream.Stream;
+
+public class TypeClasses {
+  public static <T> T witness(Ty<T> ty, Ctx<?>... context) {
+    return switch (summon(ParsedType.parse(ty.type()), parseContext(context))) {
+      case Either.Left<SummonError, Object>(SummonError error) ->
+          throw new WitnessResolutionException(error);
+      case Either.Right<SummonError, Object>(Object instance) -> {
+        @SuppressWarnings("unchecked")
+        T typedInstance = (T) instance;
+        yield typedInstance;
+      }
+    };
+  }
+
+  private static List<ContextInstance> parseContext(Ctx<?>[] context) {
+    return Arrays.stream(context)
+        .map(ctx -> new ContextInstance(ctx.instance(), ParsedType.parse(ctx.type())))
+        .toList();
+  }
+
+  public static class WitnessResolutionException extends RuntimeException {
+    private WitnessResolutionException(SummonError error) {
+      super(error.format());
+    }
+  }
+
+  private sealed interface SummonError {
+    record NotFound(ParsedType target) implements SummonError {}
+
+    record Ambiguous(ParsedType target, List<Candidate> candidates) implements SummonError {}
+
+    record Nested(ParsedType target, SummonError cause) implements SummonError {}
+
+    default String format() {
+      return switch (this) {
+        case NotFound(ParsedType target) -> "No witness found for type: " + target.format();
+        case Ambiguous(ParsedType target, List<Candidate> candidates) ->
+            "Ambiguous witnesses found for type: "
+                + target.format()
+                + "\nCandidates:\n"
+                + candidates.stream()
+                    .map(c -> c.rule().toString())
+                    .collect(Collectors.joining("\n"))
+                    .indent(2);
+        case Nested(ParsedType target, SummonError cause) ->
+            "While summoning witness for type: "
+                + target.format()
+                + "\nCaused by: "
+                + cause.format().indent(2);
+      };
+    }
+  }
+
+  private static Either<SummonError, Object> summon(
+      ParsedType target, List<ContextInstance> context) {
+    return switch (ZeroOneMore.of(findCandidates(target, context))) {
+      case ZeroOneMore.One<Candidate>(Candidate(var rule, var requirements)) ->
+          summonAll(requirements, context)
+              .map(rule::instantiate)
+              .mapLeft(error -> new SummonError.Nested(target, error));
+      case ZeroOneMore.Zero<Candidate>() -> Either.left(new SummonError.NotFound(target));
+      case ZeroOneMore.More<Candidate>(var candidates) ->
+          Either.left(new SummonError.Ambiguous(target, candidates));
+    };
+  }
+
+  private static Either<SummonError, List<Object>> summonAll(
+      List<ParsedType> targets, List<ContextInstance> context) {
+    return Either.traverse(targets, target -> summon(target, context));
+  }
+
+  private record Candidate(WitnessRule rule, List<ParsedType> requirements) {}
+
+  private static List<Candidate> findCandidates(ParsedType target, List<ContextInstance> context) {
+    return Stream.<WitnessRule>concat(
+            context.stream(), reduceOverlapping(findRules(target)).stream())
+        .flatMap(
+            rule ->
+                rule
+                    .tryMatch(target)
+                    .map(requirements -> new Candidate(rule, requirements))
+                    .stream())
+        .toList();
+  }
+
+  /**
+   * @implSpec <a href=
+   *     "https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/instances.html#overlapping-instances">6.8.8.5.
+   *     Overlapping instances</a>
+   */
+  private static List<InstanceConstructor> reduceOverlapping(List<InstanceConstructor> candidates) {
+    return candidates.stream()
+        .filter(
+            iX ->
+                candidates.stream().filter(iY -> iX != iY).noneMatch(iY -> isOverlappedBy(iX, iY)))
+        .toList();
+  }
+
+  private static boolean isOverlappedBy(InstanceConstructor iX, InstanceConstructor iY) {
+    return (iX.overlap() == OVERLAPPABLE || iY.overlap() == OVERLAPPING)
+        && isSubstitutionInstance(iX, iY)
+        && !isSubstitutionInstance(iY, iX);
+  }
+
+  private static boolean isSubstitutionInstance(
+      InstanceConstructor base, InstanceConstructor reference) {
+    return Unification.unify(base.func().returnType(), reference.func().returnType())
+        .fold(() -> false, map -> !map.isEmpty());
+  }
+
+  private static List<InstanceConstructor> findRules(ParsedType target) {
+    return switch (target) {
+      case ParsedType.App(var fun, var arg) -> Lists.concat(findRules(fun), findRules(arg));
+      case ParsedType.Const(var java) -> rulesOf(java);
+      case ParsedType.Var(var java) -> List.of();
+      case ParsedType.ArrayOf(var elem) -> List.of();
+      case ParsedType.Primitive(var java) -> List.of();
+    };
+  }
+
+  private static List<InstanceConstructor> rulesOf(Class<?> cls) {
+    return Arrays.stream(cls.getDeclaredMethods())
+        .filter(TypeClasses::isWitnessMethod)
+        .map(FuncType::parse)
+        .map(InstanceConstructor::new)
+        .toList();
+  }
+
+  private static boolean isWitnessMethod(Method m) {
+    return m.accessFlags().contains(PUBLIC)
+        && m.accessFlags().contains(STATIC)
+        && m.isAnnotationPresent(TypeClass.Witness.class);
+  }
+
+  private sealed interface WitnessRule {
+    Maybe<List<ParsedType>> tryMatch(ParsedType target);
+
+    Object instantiate(List<Object> dependencies);
+  }
+
+  private record ContextInstance(Object instance, ParsedType type) implements WitnessRule {
+    @Override
+    public Maybe<List<ParsedType>> tryMatch(ParsedType target) {
+      return target.equals(type) ? Maybe.just(List.of()) : Maybe.nothing();
+    }
+
+    @Override
+    public Object instantiate(List<Object> dependencies) {
+      return instance;
+    }
+
+    @Override
+    public String toString() {
+      return "context instance: " + type.format();
+    }
+  }
+
+  private record InstanceConstructor(FuncType func) implements WitnessRule {
+    public TypeClass.Witness.Overlap overlap() {
+      return func.java().getAnnotation(TypeClass.Witness.class).overlap();
+    }
+
+    @Override
+    public Maybe<List<ParsedType>> tryMatch(ParsedType target) {
+      return Unification.unify(func.returnType(), target)
+          .map(map -> Unification.substituteAll(map, func.paramTypes()));
+    }
+
+    @Override
+    public Object instantiate(List<Object> dependencies) {
+      try {
+        return func.java().invoke(null, dependencies.toArray());
+      } catch (Exception e) {
+        throw new RuntimeException(e);
+      }
+    }
+
+    @Override
+    public String toString() {
+      return func.format();
+    }
+  }
+}

src/main/java/com/garciat/typeclasses/api/Ctx.java

@@ -0,0 +1,23 @@
+package com.garciat.typeclasses.api;
+
+import static java.util.Objects.requireNonNull;
+
+import java.lang.reflect.ParameterizedType;
+import java.lang.reflect.Type;
+
+public abstract class Ctx<T> {
+  private final T instance;
+
+  public Ctx(T instance) {
+    this.instance = instance;
+  }
+
+  public T instance() {
+    return instance;
+  }
+
+  public Type type() {
+    return requireNonNull(
+        ((ParameterizedType) getClass().getGenericSuperclass()).getActualTypeArguments()[0]);
+  }
+}

src/main/java/com/garciat/typeclasses/api/Ty.java

@@ -0,0 +1,13 @@
+package com.garciat.typeclasses.api;
+
+import static java.util.Objects.requireNonNull;
+
+import java.lang.reflect.ParameterizedType;
+import java.lang.reflect.Type;
+
+public interface Ty<T> {
+  default Type type() {
+    return requireNonNull(
+        ((ParameterizedType) getClass().getGenericInterfaces()[0]).getActualTypeArguments()[0]);
+  }
+}

src/main/java/com/garciat/typeclasses/api/TypeClass.java

@@ -0,0 +1,22 @@
+package com.garciat.typeclasses.api;
+
+import java.lang.annotation.ElementType;
+import java.lang.annotation.Retention;
+import java.lang.annotation.RetentionPolicy;
+import java.lang.annotation.Target;
+
+@Target(ElementType.TYPE)
+@Retention(RetentionPolicy.RUNTIME)
+public @interface TypeClass {
+  @Target(ElementType.METHOD)
+  @Retention(RetentionPolicy.RUNTIME)
+  @interface Witness {
+    Overlap overlap() default Overlap.NONE;
+
+    enum Overlap {
+      NONE,
+      OVERLAPPING,
+      OVERLAPPABLE
+    }
+  }
+}

src/main/java/com/garciat/typeclasses/api/hkt/Kind.java

@@ -0,0 +1,12 @@
+package com.garciat.typeclasses.api.hkt;
+
+/** This is how we get basic kind checking in Java */
+public interface Kind<K extends Kind.Base> {
+  sealed interface Base {}
+
+  /** KStar = * */
+  final class KStar implements Base {}
+
+  /** KArr k = * -> k */
+  final class KArr<K extends Base> implements Base {}
+}

src/main/java/com/garciat/typeclasses/api/hkt/TApp.java

@@ -0,0 +1,11 @@
+package com.garciat.typeclasses.api.hkt;
+
+import com.garciat.typeclasses.api.hkt.Kind.KArr;
+import com.garciat.typeclasses.api.hkt.Kind.KStar;
+
+/**
+ * Full application of a unary type constructor.
+ *
+ * <p>TApp :: (* -> *) -> * -> *
+ */
+public interface TApp<Tag extends Kind<KArr<KStar>>, A> extends Kind<KStar> {}

src/main/java/com/garciat/typeclasses/api/hkt/TPar.java

@@ -0,0 +1,11 @@
+package com.garciat.typeclasses.api.hkt;
+
+import com.garciat.typeclasses.api.hkt.Kind.KArr;
+import com.garciat.typeclasses.api.hkt.Kind.KStar;
+
+/**
+ * Partial application of a binary type constructor.
+ *
+ * <p>TPar :: (* -> * -> *) -> * -> (* -> *)
+ */
+public interface TPar<Tag extends Kind<KArr<KArr<KStar>>>, A> extends Kind<KArr<KStar>> {}

src/main/java/com/garciat/typeclasses/api/hkt/TagBase.java

@@ -0,0 +1,3 @@
+package com.garciat.typeclasses.api.hkt;
+
+public abstract class TagBase<K extends Kind.Base> implements Kind<K> {}

src/main/java/com/garciat/typeclasses/classes/Alternative.java

@@ -0,0 +1,14 @@
+package com.garciat.typeclasses.classes;
+
+import com.garciat.typeclasses.api.TypeClass;
+import com.garciat.typeclasses.api.hkt.Kind;
+import com.garciat.typeclasses.api.hkt.Kind.KArr;
+import com.garciat.typeclasses.api.hkt.Kind.KStar;
+import com.garciat.typeclasses.api.hkt.TApp;
+
+@TypeClass
+public interface Alternative<F extends Kind<KArr<KStar>>> extends Applicative<F> {
+  <A> TApp<F, A> empty();
+
+  <A> TApp<F, A> alt(TApp<F, A> fa1, TApp<F, A> fa2);
+}

src/main/java/com/garciat/typeclasses/classes/Applicative.java

@@ -0,0 +1,37 @@
+package com.garciat.typeclasses.classes;
+
+import static java.util.function.Function.identity;
+
+import com.garciat.typeclasses.api.TypeClass;
+import com.garciat.typeclasses.api.hkt.Kind;
+import com.garciat.typeclasses.api.hkt.Kind.KArr;
+import com.garciat.typeclasses.api.hkt.Kind.KStar;
+import com.garciat.typeclasses.api.hkt.TApp;
+import com.garciat.typeclasses.types.FwdList;
+import com.garciat.typeclasses.types.JavaList;
+import java.util.function.BiFunction;
+import java.util.function.Function;
+
+@TypeClass
+public interface Applicative<F extends Kind<KArr<KStar>>> extends Functor<F> {
+  <A> TApp<F, A> pure(A a);
+
+  <A, B> TApp<F, B> ap(TApp<F, Function<A, B>> ff, TApp<F, A> fa);
+
+  @Override
+  default <A, B> TApp<F, B> map(Function<A, B> f, TApp<F, A> fa) {
+    return ap(pure(f), fa);
+  }
+
+  default <A, B, C> BiFunction<TApp<F, A>, TApp<F, B>, TApp<F, C>> lift(BiFunction<A, B, C> f) {
+    return (fa, fb) -> ap(ap(pure(a -> b -> f.apply(a, b)), fa), fb);
+  }
+
+  default <A> TApp<F, FwdList<A>> sequence(FwdList<? extends TApp<F, A>> fas) {
+    return fas.traverse(this, identity());
+  }
+
+  default <A> TApp<F, JavaList<A>> sequence(JavaList<? extends TApp<F, A>> fas) {
+    return fas.traverse(this, identity());
+  }
+}