├── .gitignore ├── LICENSE ├── README.md ├── build.sbt └── src ├── main └── scala │ ├── Instrumented.scala │ └── shapoyo.scala └── test └── scala └── AppSpec.scala /.gitignore: -------------------------------------------------------------------------------- 1 | logs 2 | project/project 3 | project/target 4 | target 5 | tmp 6 | .history 7 | dist 8 | /.idea 9 | /*.iml 10 | /out 11 | /.idea_modules 12 | /.classpath 13 | /.project 14 | /RUNNING_PID 15 | /.settings 16 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Scala 2014 Talk 2 | ### 20.000 leagues under the sea and Freemonads, Coproducts & pure functional DI 3 | 4 | - A freemonad/coproduct application sample using scalaz & shapeless 5 | 6 | * Slides: https://docs.google.com/presentation/d/1EL-uaCfwonRD-X1MuJSI6z_4TkKlLzJamLUPDmmWEN8/edit?usp=sharing 7 | 8 | - Based on ideas presented first by @runorama @scaladays 2014: 9 | 10 | * Slides : https://dl.dropboxusercontent.com/u/4588997/ReasonablyPriced.pdf 11 | * Code Sample : https://gist.github.com/runarorama/a8fab38e473fafa0921d 12 | -------------------------------------------------------------------------------- /build.sbt: -------------------------------------------------------------------------------- 1 | name := "injective" 2 | 3 | scalaVersion := "2.11.2" 4 | 5 | version := "1.0-SNAPSHOT" 6 | 7 | libraryDependencies ++= Seq( 8 | "com.chuusai" %% "shapeless" % "2.1.0-SNAPSHOT" changing(), 9 | "org.scalaz" %% "scalaz-core" % "7.1.0-M7", 10 | "org.scalatest" % "scalatest_2.11" % "2.1.3" % "test", 11 | "org.scala-lang" % "scala-reflect" % scalaVersion.value % "provided", 12 | "org.scala-lang" % "scala-compiler" % scalaVersion.value % "test", 13 | "nl.grons" %% "metrics-scala" % "3.2.1_a2.3" 14 | ) 15 | 16 | resolvers ++= Seq( 17 | Resolver.sonatypeRepo("releases"), 18 | Resolver.sonatypeRepo("snapshots") 19 | ) 20 | 21 | scalacOptions ++= Seq("-unchecked", "-deprecation", "-Xlog-implicits") 22 | 23 | fork in test := true 24 | 25 | javaOptions in test += "-Xmx4G" 26 | 27 | -------------------------------------------------------------------------------- /src/main/scala/Instrumented.scala: -------------------------------------------------------------------------------- 1 | 2 | trait Instrumented { 3 | def testTime[A](name: String)(body: => A): A = { 4 | val t1 = System.currentTimeMillis() 5 | val r = body 6 | val t2 = System.currentTimeMillis() 7 | println( "For " + name + " the tests took " + formatSeconds( (t2 - t1) * 0.001 )) 8 | r 9 | } 10 | 11 | def formatSeconds( seconds: Double ) : String = { 12 | val millisR = (seconds * 1000).toInt 13 | val sb = new StringBuilder( 10 ) 14 | val secsR = millisR / 1000 15 | val millis = millisR % 1000 16 | val mins = secsR / 60 17 | val secs = secsR % 60 18 | if( mins > 0 ) { 19 | sb.append( mins ) 20 | sb.append( ':' ) 21 | if( secs < 10 ) { 22 | sb.append( '0' ) 23 | } 24 | } 25 | sb.append( secs ) 26 | sb.append( '.' ) 27 | if( millis < 10 ) { 28 | sb.append( '0' ) 29 | } 30 | if( millis < 100 ) { 31 | sb.append( '0' ) 32 | } 33 | sb.append( millis ) 34 | sb.append( 's' ) 35 | sb.toString() 36 | } 37 | } 38 | 39 | -------------------------------------------------------------------------------- /src/main/scala/shapoyo.scala: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2014 Pascal Voitot (@mandubian) 3 | */ 4 | import shapeless.ops.coproduct.{Inject, Selector} 5 | import shapeless.{Coproduct, Inl, Inr, CNil, :+:, Poly1, Id, DepFn1} 6 | 7 | import scalaz.{Free, Coyoneda, Functor, Unapply, ~>, Monad} 8 | import Coyoneda.CoyonedaF 9 | 10 | 11 | /** FreeMonad[Coyoneda[Coproduct, ...]] helpers */ 12 | object Shapoyo { 13 | 14 | /** Lifts NatTrans to NatTrans of NatTrans of Coyoneda */ 15 | def liftCoyo[F[_], G[_]](fg: F ~> G): CoyonedaF[F]#A ~> CoyonedaF[G]#A = 16 | new (Coyoneda.CoyonedaF[F]#A ~> Coyoneda.CoyonedaF[G]#A) { 17 | def apply[A](c: Coyoneda[F, A]) = { 18 | Coyoneda.apply(fg(c.fi))(c.k) 19 | } 20 | } 21 | 22 | def liftCoyoLeft[F[_], G[_]: Functor](fg: F ~> G): CoyonedaF[F]#A ~> G = { 23 | type CF[A] = Coyoneda[F, A] 24 | type CG[A] = Coyoneda[G, A] 25 | 26 | val m: (CF ~> CG) = liftCoyo(fg) 27 | 28 | new (CF ~> G) { 29 | def apply[A](c: CF[A]) = m(c).run 30 | } 31 | } 32 | 33 | // Lifts a F ~> G into Free[F, _] ~> G running the free and using original NatTrans 34 | def liftFree[F[_]: Functor, G[_]: Monad](fg: F ~> G): ({ type l[A] = Free[F, A] })#l ~> G = { 35 | new (({ type l[A] = Free[F, A] })#l ~> G) { 36 | def apply[A](free: Free[F, A]) = free.foldMap(fg) 37 | } 38 | } 39 | 40 | /** Helper to inject a F[A] into Coproduct into Coyoneda into FreeMonad */ 41 | class Copoyo[C[_] <: Coproduct] { 42 | def apply[F[_], A](fa: F[A])(implicit inj: Inject[C[A], F[A]]): Free.FreeC[C, A] = 43 | Free.liftFC(Coproduct[C[A]](fa)) 44 | } 45 | 46 | object Copoyo { 47 | def apply[C[_] <: Coproduct] = new Copoyo[C] 48 | } 49 | 50 | /** Coproduct Natural Transformations */ 51 | implicit class RichNatT[F[_], R[_]](val f: F ~> R) extends AnyVal { 52 | 53 | def ||:[G[_]](g: G ~> R) = { 54 | 55 | new ~>[({ type l[T] = G[T] :+: F[T] :+: CNil })#l, R] { 56 | def apply[T](c: G[T] :+: F[T] :+: CNil) = c match { 57 | case Inl(h) => g(h) 58 | case Inr(Inl(t)) => f(t) 59 | case _ => throw new RuntimeException("impossible case") 60 | } 61 | } 62 | } 63 | } 64 | 65 | implicit class RichNatT2[G[_], H[_], R[_]](val g: ({ type l[T] = (G[T] :+: H[T] :+: CNil) })#l ~> R) { 66 | 67 | def ||:[F[_]](f: F ~> R) = { 68 | 69 | new ~>[({ type l[T] = F[T] :+: G[T] :+: H[T] :+: CNil })#l, R] { 70 | def apply[T](c: F[T] :+: G[T] :+: H[T] :+: CNil) = c match { 71 | case Inl(h) => f(h) 72 | case Inr(t) => g(t) 73 | case _ => throw new RuntimeException("impossible case") 74 | } 75 | } 76 | } 77 | } 78 | 79 | implicit class RichNatT3[G[_], H[_], I[_], R[_]](val g: ({ type l[T] = (G[T] :+: H[T] :+: I[T] :+: CNil) })#l ~> R) { 80 | 81 | def ||:[F[_]](f: F ~> R) = { 82 | //type L[T] = F[T] :+: G[T] 83 | 84 | new ~>[({ type l[T] = F[T] :+: G[T] :+: H[T] :+: I[T] :+: CNil })#l, R] { 85 | def apply[T](c: F[T] :+: G[T] :+: H[T] :+: I[T] :+: CNil) = c match { 86 | case Inl(h) => f(h) 87 | case Inr(t) => g(t) 88 | case _ => throw new RuntimeException("impossible case") 89 | } 90 | } 91 | } 92 | } 93 | 94 | implicit class RichNatT4[G[_], H[_], I[_], J[_], R[_]](val g: ({ type l[T] = (G[T] :+: H[T] :+: I[T] :+: J[T] :+: CNil) })#l ~> R) { 95 | 96 | def ||:[F[_]](f: F ~> R) = { 97 | //type L[T] = F[T] :+: G[T] 98 | 99 | new ~>[({ type l[T] = F[T] :+: G[T] :+: H[T] :+: I[T] :+: J[T] :+: CNil })#l, R] { 100 | def apply[T](c: F[T] :+: G[T] :+: H[T] :+: I[T] :+: J[T] :+: CNil) = c match { 101 | case Inl(h) => f(h) 102 | case Inr(t) => g(t) 103 | case _ => throw new RuntimeException("impossible case") 104 | } 105 | } 106 | } 107 | } 108 | 109 | 110 | 111 | /** Coproduct Functors */ 112 | implicit def CoproductFunctor1[F[_]](implicit F: Functor[F]) = 113 | new Functor[({ type l[A] = F[A] :+: CNil })#l] { 114 | 115 | def map[A, B](fa: F[A] :+: CNil)(f: A => B): F[B] :+: CNil = fa match { 116 | case Inl(h) => Coproduct[F[B] :+: CNil](F.map(h)(f)) 117 | case Inr(t) => throw new RuntimeException("impossible case") 118 | case _ => throw new RuntimeException("impossible case") 119 | } 120 | 121 | } 122 | 123 | implicit def CoproductFunctor2[F[_], G[_]](implicit F: Functor[F], G: Functor[({ type l[A] = G[A] :+: CNil })#l]) = 124 | new Functor[({ type l[A] = F[A] :+: G[A] :+: CNil })#l] { 125 | import Coproduct._ 126 | 127 | def map[A, B](fa: F[A] :+: G[A] :+: CNil)(f: A => B): F[B] :+: G[B] :+: CNil = fa match { 128 | case Inl(h) => Coproduct[F[B] :+: G[B] :+: CNil](F.map(h)(f)) 129 | case Inr(t) => G.map(t)(f).extendLeft[F[B]] 130 | case _ => throw new RuntimeException("impossible case") 131 | } 132 | 133 | } 134 | 135 | implicit def CoproductFunctor3[F[_], G[_], H[_]](implicit FH: Functor[F], FT: Functor[({ type l[A] = G[A] :+: H[A] :+: CNil })#l]) = 136 | new Functor[({ type l[A] = F[A] :+: G[A] :+: H[A] :+: CNil })#l] { 137 | import Coproduct._ 138 | 139 | def map[A, B](fa: F[A] :+: G[A] :+: H[A] :+: CNil)(f: A => B): F[B] :+: G[B] :+: H[B] :+: CNil = fa match { 140 | case Inl(h) => Coproduct[F[B] :+: G[B] :+: H[B] :+: CNil](FH.map(h)(f)) 141 | case Inr(t) => FT.map(t)(f).extendLeft[F[B]] 142 | case _ => throw new RuntimeException("impossible case") 143 | } 144 | 145 | } 146 | } 147 | 148 | 149 | 150 | -------------------------------------------------------------------------------- /src/test/scala/AppSpec.scala: -------------------------------------------------------------------------------- 1 | /** 2 | * Copyright 2014 Pascal Voitot (@mandubian) 3 | */ 4 | import org.scalatest._ 5 | 6 | import scalaz.{Free, Coyoneda, \/, -\/, \/-, Trampoline, ~>} 7 | 8 | import scala.concurrent._ 9 | 10 | class AppSpec extends FlatSpec with Matchers with Instrumented { 11 | import shapeless._ 12 | import ops.coproduct.{Inject, Selector} 13 | import Shapoyo._ 14 | 15 | "ShapeApp" should "Strict TFree" in { 16 | import Free._ 17 | 18 | // Global ADT 19 | sealed trait LogLevel 20 | case object ErrorLevel extends LogLevel 21 | case object WarnLevel extends LogLevel 22 | case object InfoLevel extends LogLevel 23 | case object DebugLevel extends LogLevel 24 | 25 | trait Log[A] 26 | case class LogMsg(level: LogLevel, msg: String) extends Log[Unit] 27 | 28 | 29 | ////////////////////////////////////////////////////////////////////////// 30 | // DB Interaction Application 31 | object DB { 32 | 33 | // DB ADT 34 | type Entity = Map[String, String] 35 | 36 | sealed trait DBError 37 | case object NotFound extends DBError 38 | 39 | sealed trait DBInteract[A] 40 | case class FindById(id: String) extends DBInteract[DBError \/ Entity] 41 | 42 | // APP DEFINITION 43 | type App[A] = DBInteract[A] :+: Log[A] :+: CNil 44 | type CoyoApp[A] = Coyoneda[App, A] 45 | type FreeApp[A] = Free.FreeC[App, A] 46 | 47 | // HELPERS 48 | object Log { 49 | def debug(msg: String) = Copoyo[App](LogMsg(DebugLevel, msg)) 50 | } 51 | 52 | def findById(id: String): FreeApp[DBError \/ Entity] = 53 | for { 54 | _ <- Log.debug("Searching for entity id:"+id) 55 | res <- Copoyo[App](FindById(id)) 56 | _ <- Log.debug("Search result:"+res) 57 | } yield (res) 58 | } 59 | 60 | ////////////////////////////////////////////////////////////////////////// 61 | // Http Server 62 | object Http { 63 | 64 | // Http ADT 65 | sealed trait HttpVerb 66 | case object Get extends HttpVerb 67 | case object Post extends HttpVerb 68 | 69 | sealed trait HttpStatus { val value: Int } 70 | case object Ok extends HttpStatus { val value = 200 } 71 | case object BadRequest extends HttpStatus { val value = 400 } 72 | case object InternalServerError extends HttpStatus { val value = 500 } 73 | 74 | type Params = Map[String, Seq[String]] 75 | type Headers = Map[String, Seq[String]] 76 | 77 | sealed trait HttpReq { 78 | val verb: HttpVerb 79 | val url: String 80 | val params: Params 81 | val headers: Headers 82 | } 83 | 84 | case class GetReq( 85 | url: String, 86 | params: Params = Map.empty[String, Seq[String]], 87 | headers: Headers = Map.empty[String, Seq[String]] 88 | ) extends HttpReq { 89 | val verb = Get 90 | } 91 | 92 | case class PostReq( 93 | url: String, 94 | params: Params = Map.empty[String, Seq[String]], 95 | headers: Headers = Map.empty[String, Seq[String]], 96 | body: String 97 | ) extends HttpReq { 98 | val verb = Post 99 | } 100 | 101 | case class HttpResp ( 102 | status: HttpStatus, 103 | headers: Headers = Map.empty[String, Seq[String]], 104 | body: String = "" 105 | ) 106 | 107 | sealed trait RecvError 108 | case object ClientDisconnected extends RecvError 109 | case object Timeout extends RecvError 110 | 111 | sealed trait SendStatus 112 | case object Ack extends SendStatus 113 | case object NAck extends SendStatus 114 | 115 | sealed trait HttpInteract[A] 116 | case object HttpReceive extends HttpInteract[RecvError \/ HttpReq] 117 | case class HttpRespond(data: HttpResp) extends HttpInteract[SendStatus] 118 | case class Stop(error: RecvError \/ SendStatus) extends HttpInteract[RecvError \/ SendStatus] 119 | 120 | sealed trait HttpHandle[A] 121 | case class HttpHandleResult(resp: HttpResp) extends HttpHandle[HttpResp] 122 | 123 | // APP DEFINITION 124 | type App[A] = HttpInteract[A] :+: HttpHandle[A] :+: Log[A] :+: DB.FreeApp[A] :+: CNil 125 | type CoyoApp[A] = Coyoneda[App, A] 126 | type FreeApp[A] = Free.FreeC[App, A] 127 | 128 | 129 | // HELPERS 130 | def lift[F[_], A](a: F[A])(implicit inj: Inject[App[A], F[A]]): FreeApp[A] = Copoyo[App](a) 131 | 132 | object HttpInteract { 133 | def receive() = lift(HttpReceive) 134 | def respond(data: HttpResp) = lift(HttpRespond(data)) 135 | def stop(err: RecvError \/ SendStatus) = lift(Stop(err)) 136 | } 137 | 138 | object Log { 139 | def info(msg: String) = lift(LogMsg(InfoLevel, msg)) 140 | } 141 | 142 | object HttpHandle { 143 | def result(resp: HttpResp) = lift(HttpHandleResult(resp)) 144 | } 145 | 146 | // Handle action 147 | def handle(req: HttpReq): FreeApp[HttpResp] = req.url match { 148 | case "/foo" => 149 | for { 150 | dbRes <- lift(DB.findById("foo")) 151 | 152 | resp <- HttpHandle.result( 153 | dbRes match { 154 | case -\/(err) => HttpResp(status = InternalServerError) 155 | case \/-(e) => HttpResp(status = Ok, body = e.toString) 156 | } 157 | ) 158 | } yield (resp) 159 | 160 | case _ => HttpHandle.result(HttpResp(status = InternalServerError)) 161 | } 162 | 163 | // Server 164 | def serve(): FreeApp[RecvError \/ SendStatus] = 165 | for { 166 | recv <- HttpInteract.receive() 167 | _ <- Log.info("HttpReceived Request:"+recv) 168 | res <- recv match { 169 | case -\/(err) => HttpInteract.stop(-\/(err)) 170 | 171 | case \/-(req) => for { 172 | resp <- handle(req) 173 | _ <- Log.info("Sending Response:"+resp) 174 | ack <- HttpInteract.respond(resp) 175 | res <- if(ack == Ack) serve() else HttpInteract.stop(\/-(ack)) 176 | } yield (res) 177 | } 178 | } yield (res) 179 | 180 | } 181 | 182 | 183 | ////////////////////////////////////////////////////////////////////////// 184 | // Compile Languages 185 | 186 | ///////////////////////////////////////////////////////////////// 187 | // Pure 188 | object Logger extends (Log ~> Id) { 189 | def apply[A](a: Log[A]) = a match { 190 | case LogMsg(lvl, msg) => 191 | println(s"$lvl $msg") 192 | } 193 | } 194 | 195 | object DBManager extends (DB.DBInteract ~> Id) { 196 | def apply[A](a: DB.DBInteract[A]) = a match { 197 | case DB.FindById(id) => 198 | println(s"DB Finding $id") 199 | \/-(Map("id" -> id, "name" -> "toto")) 200 | } 201 | } 202 | 203 | object HttpHandler extends (Http.HttpHandle ~> Id) { 204 | def apply[A](a: Http.HttpHandle[A]) = a match { 205 | case Http.HttpHandleResult(resp) => 206 | println(s"Handling $resp") 207 | resp 208 | } 209 | } 210 | 211 | object HttpInteraction extends (Http.HttpInteract ~> Id) { 212 | var i = 0 213 | def apply[A](a: Http.HttpInteract[A]) = a match { 214 | case Http.HttpReceive => 215 | if(i < 1000) { 216 | i+=1 217 | \/-(Http.GetReq("/foo")) 218 | } else { 219 | -\/(Http.ClientDisconnected) 220 | } 221 | 222 | case Http.HttpRespond(resp) => Http.Ack 223 | 224 | case Http.Stop(err) => err 225 | } 226 | } 227 | 228 | /** let's compose NatTrans to make it stacksafe */ 229 | object Trampolined extends (Id ~> Trampoline) { 230 | def apply[A](a: Id[A]) = Trampoline.done(a) 231 | } 232 | 233 | val dbInterpreter: DB.App ~> Id = DBManager ||: Logger 234 | val dbInterpreterCoyo: DB.CoyoApp ~> Id = liftCoyoLeft(dbInterpreter) 235 | val dbInterpreterFree: DB.FreeApp ~> Id = liftFree(dbInterpreterCoyo) 236 | 237 | val httpInterpreter: Http.App ~> Id = HttpInteraction ||: HttpHandler ||: Logger ||: dbInterpreterFree 238 | val httpInterpreterCoyo: Http.CoyoApp ~> Id = liftCoyoLeft(httpInterpreter) 239 | 240 | Http.serve().foldMap(Trampolined compose httpInterpreterCoyo).run 241 | 242 | } 243 | } 244 | 245 | 246 | 247 | 248 | --------------------------------------------------------------------------------