validation.sc

//> using dep org.typelevel::cats-core:2.9.0
//> using dep com.lihaoyi::pprint:0.8.1
//> using dep dev.optics::monocle-core:3.2.0
//> using dep dev.optics::monocle-macro:3.2.0

import cats.implicits.*
import cats.data.EitherT
import cats.{Monad, Functor, Id}
import monocle.Lens
import monocle.macros.GenLens

object validation:

  // tag from shapeless
  object tag:
    def apply[U] = Tagger.asInstanceOf[Tagger[U]]

    trait Tagged[U] extends Any
    type @@[+T, U] = T with Tagged[U]

    class Tagger[U]:
      def apply[T](t: T): T @@ U = t.asInstanceOf[T @@ U]

    private object Tagger extends Tagger[Nothing]
  end tag

  import tag.*

  type Validation[A, E, T] = ValidationT[Id, A, E, T]

  object Validation:
    def lift[A, E, T](f: A => Either[E, A]): Validation[A, E, T] =
      ValidationT.lift(f)
  end Validation

  // Aに対するバリデーションをあらわす,結果はTでタグ付けされる
  // すなわちバリデーション結果の型はEither[E, A @@ T]
  final case class ValidationT[F[_]: Monad, A, E, T](
      apply: A => EitherT[F, E, A @@ T]
  ):
    def and[U](implicit
        v: ValidationT[F, A, E, T]
    ): ValidationT[F, A, E, T with U] = ValidationT { a =>
      for {
        _ <- apply(a)
        _ <- v.apply(a)
      } yield tag[T with U][A](a)
    }

  end ValidationT

  object ValidationT:
    def lift[F[_]: Monad, A, E, T](
        f: A => F[Either[E, A]]
    ): ValidationT[F, A, E, T] =
      ValidationT(a => EitherT(f(a).map(_.map(tag[T][A](_)))))

    given withFocus[F[_]: Monad, A, B, E, T](using
        lens: Lens[A, B],
        v: ValidationT[F, B, E, T]
    ): ValidationT[F, A, E, T] =
      ValidationT { a =>
        for {
          _ <- v.apply(lens.get(a))
        } yield tag[T][A](a)
      }

  end ValidationT

object usecase:
  import validation.*
  import tag.*

  // バリエーション対象
  final case class Bird(numWings: Int, likeSeeds: Boolean)

  type BirdCheckT[F[_], T] = ValidationT[F, Bird, String, T]
  type BirdCheck[T] = BirdCheckT[Id, T]

  // バリデーションの種類(=タグ)
  enum BirdValidation:
    case HasWings, LikeSeeds

  trait GetProperWingCount[F[_]]:
    def getCount: F[Int]
  end GetProperWingCount

  // バリデーションの実装
  given hasWingsF[F[_]: Monad: GetProperWingCount]
      : ValidationT[F, Int, String, BirdValidation.HasWings.type] =
    ValidationT.lift { numWings =>
      summon[GetProperWingCount[F]].getCount.map(c =>
        Either.cond(
          numWings === c,
          numWings,
          s"Inproper number of wings ${numWings.toString}"
        )
      )
    }

  given likeSeedsF[F[_]: Monad]: BirdCheckT[F, BirdValidation.LikeSeeds.type] =
    ValidationT.lift(b =>
      Monad[F].pure(
        Either.cond(b.likeSeeds, b, s"you know, No birds dislike seeds.")
      )
    )

  // 必要なバリデーションを列挙
  type ValidBird = BirdValidation.HasWings.type
    with BirdValidation.LikeSeeds.type

  // 必要なバリエーションに一致するように合成する
  given allValidations[F[_]: Monad: GetProperWingCount]
      : BirdCheckT[F, ValidBird] =
    summon[BirdCheckT[F, BirdValidation.HasWings.type]]
      .and[BirdValidation.LikeSeeds.type]

  given wingCount[F[_]: Monad]: GetProperWingCount[F] =
    new GetProperWingCount[F] {
      def getCount: F[Int] = Monad[F].pure(2)
    }

  given wingLens: Lens[Bird, Int] = GenLens[Bird](_.numWings)

end usecase

val res = usecase.allValidations[Option].apply(usecase.Bird(2, true))
pprint.pprintln(res)
//EitherT(value = Some(value = Right(value = Bird(numWings = 2, likeSeeds = true))))