PartialOrderExerciseTest.scala

import java.time.LocalDate
import java.time.temporal.ChronoUnit.{DAYS, MONTHS}

import cats.instances.AllInstances
import cats.kernel.laws.discipline.PartialOrderTests
import cats.{Foldable, Monad, Monoid, PartialOrder}
import eu.timepit.refined.api.Refined
import eu.timepit.refined.numeric.Positive
import eu.timepit.refined.refineV
import org.scalacheck.{Arbitrary, Gen}
import org.specs2.Specification
import org.typelevel.discipline.specs2.Discipline

class PartialOrderExerciseTest extends Specification with Discipline with AllInstances {
  // 約数 -------------
  type Nat = Int Refined Positive

  implicit val divisible: PartialOrder[Nat] = (a: Nat, b: Nat) => {
    def compare(x: Nat, y: Nat): Double = y.value % x.value
    (compare(a, b), compare(b, a)) match {
      case (0, 0) => 0.0
      case (0, _) => -1.0
      case (_, 0) => 1.0
      case _      => Double.NaN
    }
  }
  // 期間 -------------
  case class FromTo(from: LocalDate, to: LocalDate)

  implicit val periodInclusion: PartialOrder[FromTo] = (a: FromTo, b: FromTo) => {
    def compare(inner: FromTo, outer: FromTo): Boolean =
      (inner.from compareTo outer.from) >= 0 && (inner.to compareTo outer.to) <= 0

    (compare(a, b), compare(b, a)) match {
      case (true, true) => 0.0
      case (true, _)    => -1.0
      case (_,    true) => 1.0
      case _            => Double.NaN
    }
  }

  // 権限 -------------
  case class Permission private (bits: Int) {
    def +(x: Permission): Permission = Permission(bits | x.bits)
  }
  object Permissions {
    val Empty = Permission(0)
    val Exec  = Permission(1)
    val Write = Permission(2)
    val Read  = Permission(4)
  }
  implicit val permissionMonoid = new Monoid[Permission] {
    def empty: Permission = Permissions.Empty
    def combine(x: Permission, y: Permission): Permission = x + y
  }
  implicit val permissionInclusion: PartialOrder[Permission] = (a: Permission, b: Permission) => {
    def compare(a: Permission, b: Permission) = a + b == b
    (compare(a, b), compare(b, a)) match {
      case (true, true) => 0.0
      case (true, _   ) => -1.0
      case (_,    true) => 1.0
      case _            => Double.NaN
    }
  }

  // 共通 -------------
  private val smallIntGen = Gen.chooseNum[Int](1, 100)

  // 約数 -------------
  private val checkDivisibility = {
    implicit def arbNat: Arbitrary[Nat] = Arbitrary(
      smallIntGen.map(refineV[Positive](_).toOption.get))

    implicit val arbF: Arbitrary[Nat => Nat] =
      Arbitrary(smallIntGen.map(n => nat => refineV[Positive](nat.value + n).toOption.get))

    checkAll("nat divisibility", PartialOrderTests[Nat].partialOrder)
  }

  // 期間 -------------
  private val checkPeriodInclusion = {
    val d0 = LocalDate.of(2018, 1, 1)

    implicit val fromToArb: Arbitrary[FromTo] = Arbitrary(for {
      offset <- Gen.chooseNum(0, 11)
      period <- Gen.chooseNum(1, 12 - offset)
    } yield FromTo(d0.plus(offset, MONTHS), d0.plus(offset + period, MONTHS).minus(1, DAYS)))

    implicit val arbF: Arbitrary[FromTo => FromTo] =
      Arbitrary(smallIntGen.map(n => ft => FromTo(ft.from.plus(n, DAYS), ft.to.plus(n, DAYS))))

    checkAll("period inclusion", PartialOrderTests[FromTo].partialOrder)
  }

  // 権限 -------------
  implicit val genCatsMonad: Monad[Gen] = new Monad[Gen] {
    def pure[A](a: A): Gen[A] = Gen.const(a)
    def flatMap[A, B](fa: Gen[A])(f: A => Gen[B]): Gen[B] = fa flatMap f
    def tailRecM[A, B](a: A)(f: A => Gen[Either[A, B]]): Gen[B] =
      f(a).flatMap(_.fold(tailRecM(_)(f), pure))
  }

  private val checkPermissionInclusion = {
    import Permissions._

    val ifTrue: Permission => Gen[Permission] =
      p => Gen.oneOf(true, false).map(if (_) Empty else p)

    implicit val permissionArb: Arbitrary[Permission] =
      Arbitrary(Foldable[List].foldMapM(List(Exec, Read, Write))(ifTrue))

    implicit val arbF3: Arbitrary[Permission => Permission] =
      Arbitrary(Gen.chooseNum[Int](0, 7).map(n => p => Permission(n ^ p.bits)))

    checkAll("permission inclusion", PartialOrderTests[Permission].partialOrder)
  }

  // 実行 -------------
  def is = s2"""
  nat divisibility satisfies partial order laws $checkDivisibility
  period inclusion satisfies partial order laws $checkPeriodInclusion
  permission inclusion satisfies partial order laws $checkPermissionInclusion
  """
}