Merge pull request #1 from ComcastSamples/analyzing/programs

Code to support Analyzing Functional Programs talk

NOTICE

@@ -0,0 +1,15 @@
+Scala Pet Store
+Original code Copyright 2017 Scala Pet Store Contributors
+Subsequent updates Copyright 2017 Comcast Cable Communications Management, LLC
+
+Licensed under the Apache License, Version 2.0 (the "License");
+you may not use this file except in compliance with the License.
+You may obtain a copy of the License at
+
+http://www.apache.org/licenses/LICENSE-2.0
+
+Unless required by applicable law or agreed to in writing, software
+distributed under the License is distributed on an "AS IS" BASIS,
+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+See the License for the specific language governing permissions and
+limitations under the License.

build.sbt

@@ -15,6 +15,7 @@ val JodaTimeVersion   = "2.9.9"
 val LogbackVersion    = "1.2.3"
 val ScalaCheckVersion = "1.13.5"
 val ScalaTestVersion  = "3.0.4"
+val ScalaCheckCatsVersion = "0.3.3"
 
 libraryDependencies ++= Seq(
   "org.typelevel"  %% "cats-core"            % CatsVersion,
@@ -33,7 +34,8 @@ libraryDependencies ++= Seq(
   "org.http4s"     %% "http4s-dsl"           % Http4sVersion,
   "ch.qos.logback" %  "logback-classic"      % LogbackVersion,
   "org.scalacheck" %% "scalacheck"           % ScalaCheckVersion % Test,
-  "org.scalatest"  %% "scalatest"            % ScalaTestVersion  % Test
+  "org.scalatest"  %% "scalatest"            % ScalaTestVersion  % Test,
+  "io.github.amrhassan" %% "scalacheck-cats"      % ScalaCheckCatsVersion % Test
 )
 
 
@@ -88,3 +90,5 @@ scalacOptions ++= Seq(
 )
 
 enablePlugins(ScalafmtPlugin, JavaAppPackaging)
+
+addCompilerPlugin("org.spire-math" %% "kind-projector" % "0.9.4")

src/main/scala/io/github/pauljamescleary/petstore/service/OrderService.scala

@@ -1,14 +1,25 @@
 package io.github.pauljamescleary.petstore.service
 
-import io.github.pauljamescleary.petstore.model.Order
+import cats._
+import cats.data._
+import io.github.pauljamescleary.petstore.model.{Order, OrderStatus}
 import io.github.pauljamescleary.petstore.repository.OrderRepositoryAlgebra
 
 import scala.language.higherKinds
 
+sealed trait OrderError
+case class OrderNotFound(orderId: Long) extends OrderError
+
 class OrderService[F[_]](orderRepo: OrderRepositoryAlgebra[F]) {
 
   def placeOrder(order: Order): F[Order] = orderRepo.put(order)
 
+  def updateStatus(orderId: Long, status: OrderStatus)(implicit M: Monad[F]): EitherT[F, OrderError, Order] =
+    for {
+      order <- EitherT.fromOptionF(orderRepo.get(orderId), OrderNotFound(orderId))
+      updated = order.copy(status = status)
+      _ <- EitherT.right[OrderError](orderRepo.put(updated))
+    } yield updated
 }
 
 object OrderService {

src/test/scala/io/github/pauljamescleary/petstore/service/OrderServiceSpec.scala

@@ -0,0 +1,144 @@
+package io.github.pauljamescleary.petstore
+package service
+
+import org.scalatest._
+import org.scalatest.prop.PropertyChecks
+import org.scalacheck._
+import cats.{Monad, InjectK, ~>}
+import cats.data._
+import cats.free._
+import cats.instances.list._
+import org.scalacheck.support.cats._
+
+import model._
+import repository._
+
+class OrderServiceSpec
+    extends FunSuite
+    with Matchers
+    with PropertyChecks
+    with PetStoreArbitraries {
+
+  class OrderRepositoryGeneratingInterpreter(response: Gen[Option[Order]], genId: Gen[Long])(implicit longInput: Cogen[Long])
+      extends OrderRepositoryAlgebra[Gen] {
+
+    def put(order: Order): Gen[Order] =
+      for {
+        id <- order.id.map(Gen.const(_)).getOrElse(genId).map(Some(_))
+        order <- Gen.const(order.copy(id = id))
+      } yield order
+
+    def get(orderId: Long): Gen[Option[Order]] =
+      longInput.cogen(orderId, response)
+
+    def delete(orderId: Long): Gen[Option[Order]] =
+      longInput.cogen(orderId, response)
+
+  }
+
+
+  sealed trait OrderRepositoryTrace
+
+  case class TraceGet(orderId: Long) extends OrderRepositoryTrace
+  case class TracePut(order: Order) extends OrderRepositoryTrace
+  case class TraceDelete(orderId: Long) extends OrderRepositoryTrace
+
+  class OrderRepositoryTraceInterpreter[F[_]](wrapped: OrderRepositoryAlgebra[F])(implicit M: Monad[F]) extends OrderRepositoryAlgebra[WriterT[F, List[OrderRepositoryTrace], ?]] {
+
+
+    def log[A](message: OrderRepositoryTrace)(g: F[A]): WriterT[F, List[OrderRepositoryTrace], A] =
+      for {
+        _ <- WriterT.tell[F, List[OrderRepositoryTrace]](List(message))
+        result <- WriterT.lift[F, List[OrderRepositoryTrace], A](g)
+      } yield result
+
+    def put(order: Order): WriterT[F, List[OrderRepositoryTrace], Order] =
+      log(TracePut(order)) {
+        wrapped.put(order)
+      }
+
+    def get(orderId: Long): WriterT[F, List[OrderRepositoryTrace], Option[Order]] =
+      log(TraceGet(orderId)) {
+        wrapped.get(orderId)
+      }
+
+    def delete(orderId: Long): WriterT[F, List[OrderRepositoryTrace], Option[Order]] =
+      log(TraceDelete(orderId)) {
+        wrapped.delete(orderId)
+      }
+
+  }
+
+  test("never delete when updating status") {
+    val orderGenInterpreter = new OrderRepositoryGeneratingInterpreter(Gen.option(order.arbitrary), Gen.posNum[Long])
+    val orderRepo = new OrderRepositoryTraceInterpreter(orderGenInterpreter)
+    val orderService = OrderService(orderRepo)
+
+    implicit val arbitraryWalk: Arbitrary[List[OrderRepositoryTrace]] =
+      Arbitrary(orderService.updateStatus(5, Delivered).value.written)
+
+    forAll { (walk: List[OrderRepositoryTrace]) =>
+      println(walk)
+      assert(!walk.exists {
+        case TraceDelete(_) => true
+        case _ => false
+      })
+    }
+  }
+
+  sealed trait OrderRepositoryOp[A]
+
+  case class PutOp(order: Order) extends OrderRepositoryOp[Order]
+  case class GetOp(orderId: Long) extends OrderRepositoryOp[Option[Order]]
+  case class DeleteOp(orderId: Long) extends OrderRepositoryOp[Option[Order]]
+
+  class OrderRepositoryFree[F[_]](implicit I: InjectK[OrderRepositoryOp, F]) extends OrderRepositoryAlgebra[Free[F, ?]] {
+
+    def put(order: Order): Free[F, Order] =
+        Free.inject[OrderRepositoryOp, F](PutOp(order))
+
+    def get(orderId: Long): Free[F, Option[Order]] =
+      Free.inject[OrderRepositoryOp, F](GetOp(orderId))
+
+    def delete(orderId: Long): Free[F, Option[Order]] =
+      Free.inject[OrderRepositoryOp, F](DeleteOp(orderId))
+
+  }
+
+  class OrderRepositoryOpAsGen(genInterpreter: OrderRepositoryGeneratingInterpreter)
+      extends (OrderRepositoryOp ~> Gen) {
+
+    def apply[A](in: OrderRepositoryOp[A]): Gen[A] = in match {
+      case PutOp(order) => genInterpreter.put(order)
+      case GetOp(orderId) => genInterpreter.get(orderId)
+      case DeleteOp(orderId) => genInterpreter.delete(orderId)
+    }
+  }
+
+  class Trace[F[_], G[_]: Monad](nt: F ~> G) extends (F ~> WriterT[G, List[F[_]], ?]) {
+
+    def apply[A](f: F[A]): WriterT[G, List[F[_]], A] =
+      for {
+        _ <- WriterT.tell[G, List[F[_]]](List(f))
+        a <- WriterT.lift[G, List[F[_]], A](nt(f))
+      } yield a
+
+  }
+
+  test("never delete in update take 2") {
+    val orderGenInterpreter = new OrderRepositoryGeneratingInterpreter(Gen.option(order.arbitrary), Gen.posNum[Long])
+    val interpreter = new Trace(new OrderRepositoryOpAsGen(orderGenInterpreter))
+    val orderRepo = new OrderRepositoryFree[OrderRepositoryOp]
+    val orderService = OrderService(orderRepo)
+
+    implicit val arbitraryWalk: Arbitrary[List[OrderRepositoryOp[_]]] =
+      Arbitrary(orderService.updateStatus(5, Delivered).value.foldMap(interpreter).written)
+
+    forAll { (walk: List[OrderRepositoryOp[_]]) =>
+      assert(!walk.exists {
+        case DeleteOp(_) => true
+        case _ => false
+      })
+    }
+  }
+}