├── .gitignore
├── LICENSE
├── README.md
├── build.sbt
├── project
├── build.properties
└── plugins.sbt
└── src
├── main
└── scala
│ ├── CopK.scala
│ ├── CopKNat.scala
│ ├── DSL.scala
│ ├── Freek.scala
│ ├── Freekit.scala
│ ├── HasHoist.scala
│ ├── Interpreter.scala
│ ├── Onion.scala
│ ├── OnionT.scala
│ └── package.scala
└── test
└── scala
├── AppSpec.scala
├── FreekitSpec.scala
└── LongCompileSpec.scala
/.gitignore:
--------------------------------------------------------------------------------
1 | target/
2 | lib_managed/
3 | src_managed/
4 | project/boot/
5 | .history
6 | .cache
7 | .idea
8 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | This software is licensed under the Apache 2 license, quoted below.
2 |
3 | Licensed under the Apache License, Version 2.0 (the "License"); you may not use this project except in compliance with
4 | the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0.
5 |
6 | Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an
7 | "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific
8 | language governing permissions and limitations under the License.
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # Freek, a freaky simple Free to combine your DSL seamlessly
2 |
3 | > Pere Villega wrote a really cool introduction to Freek & Free before I could even move a finger and it's a really good one even if it was relying on previous version of the API but the ideas are still the same :D
4 | >
5 | > http://perevillega.com/freek-and-free-monads
6 | >
7 | > Thanks a lot Pere
8 |
9 |
10 |
11 |
12 | ## Current Version
13 |
14 | > All versions are published to bintray https://bintray.com/projectseptemberinc/
15 |
16 |
17 | ### v0.6.5:
18 |
19 | - first scala 2.12 support
20 | - cross-compiling 2.11.8 & 2.12
21 | - depends on cats 0.8.0
22 |
23 |
24 | ### v0.6.1/2:
25 |
26 | - added `Freekit`/`Freekito` helpers to reduce `.freek` boilerplate in basic cases
27 | - added `transpile` to flatten Free programs combining Free programs
28 | - added `:&&:` operator to combine group of interpreters
29 |
30 |
31 | ### v0.6.0:
32 |
33 | - renamed `FX` to `DSL` and `NilDSL` to `NilDSL` to represent better the fact that freek is more general than effects and about manipulating any DSL.
34 | - renamed helped `Program` to `DSL.Make`
35 | - renamed `CoproductK` to `CopK`
36 | - renamed `.onionP[O]` to `.onion[O]`
37 | - introduced `peelRight2 & peelRight2` & `onionT2 & onionT3`
38 | - removed unneeded specific OnionT implicit converters
39 | - build for cats-0.4.1/0.6.1/0.7.0
40 |
41 |
42 | ### v0.5.0:
43 |
44 | - introduced new model for CoproductK to improve compile-time globally (from O(n) to O(log2(n)))
45 | - introduced `Program[F <: FX]` to help scalac infer the output CoproductK when using the new optimized model
46 | - result type of a program based on `freek[PRG]` is no more `PRG.Cop` but `PRG.Cop` based on new `DSL.Make[PRG]`
47 | - optimized implicit order
48 |
49 |
50 | ### v0.4.3:
51 |
52 | - introduced `CoproductK.AppendK` to make it robust to combine programs containing sub-programs
53 |
54 |
55 | ### v0.4.2:
56 |
57 | - beta re-introducing operator `:||:` to combine programs to programs... WIP
58 |
59 |
60 | ### v0.4.1:
61 |
62 | - evaluating `.freeko[PRG, O]` which is equivalent to `.freek[PRG].onionT[O]`
63 | - renamed `dropRight -> peelRight` and `prepend -> wrap`
64 |
65 |
66 | ### v0.4.0:
67 |
68 | - replaced `type PRG[A] = (Log :|: KVS :|: File :|: NilDSL).Cop[A]` by `type PRG = Log :|: KVS :|: File :|: NilDSL` to simplify the whole API
69 | - introduced OnionT manipulations `.dropRight`, `.prepend`
70 |
71 |
72 | ### v0.3.0:
73 |
74 | - replaces Freenion by OnionT which generalized the Onion embedding to any structure of type `TC[_[_], _]` and not just Free
75 | - provides new `interpret` function solving order/redundancy issues with DSL vs interpreters
76 | - renames Interpreter combining operator `:|:` into `:&:` because combining interpreters is about a product between them, not a sum of them
77 |
78 | ## Freek: a freaky simple Free to combine your DSL seamlessly
79 |
80 | Freek is just a few helpers & tricks to make it straightforward to manipulate Free & DSL without hiding it's a Free.
81 |
82 | > This project has developed for [ProjectSeptember](http://www.projectseptember.com) which has kindly accepted that we opensource it under Apache2 License to make it as open & free as possible... Contributions & comments are welcome...
83 |
84 |
85 |
86 | ## Freek out-of-the-box
87 |
88 |
89 | ### Use it in your project
90 |
91 | ```
92 | # in build.sbt
93 |
94 | scalaVersion := "2.12.0" // (or 2.11.8)
95 |
96 | resolvers += Resolver.bintrayRepo("projectseptemberinc", "maven")
97 |
98 | scalacOptions := Seq("-Ypartial-unification") //if running 2.12
99 |
100 | libraryDependencies ++= Seq(
101 | "com.projectseptember" %% "freek" % "0.6.5"
102 | , "org.spire-math" %% "kind-projector" % "0.7.1"
103 | , "com.milessabin" %% "si2712fix-plugin" % "1.2.0"
104 | )
105 | ```
106 |
107 | ```
108 | # in plugins.sbt
109 | addSbtPlugin("me.lessis" % "bintray-sbt" % "0.3.0")
110 | ```
111 |
112 | `KindProjector` plugin isn't required but it makes higher-kinded types so nicer that I can't do anything else than advising to use it.
113 |
114 | `si2712fix-plugin` is required or you'll have weird compiling errors... Scalac 2.11 is not powerful enough to unify types in a correct as we would expect for Freek. But Scala 2.12 will be better as si2712fix has been merged into it thanks to Miles Sabin fantastic work.
115 |
116 | > Don't worry using this plugin seriously because it does it's job just at compile-time helping scalac to infer types in the right but it won't have any impact on runtime so no worry in any case.
117 |
118 |
119 |
120 |
121 | ### Combine your DSL(s) with operator `:|:` (OR)
122 |
123 | Imagine you have the following DSL(s):
124 |
125 | ```scala
126 | sealed trait Log[A]
127 | case class LogMsg(level: LogLevel, msg: String) extends Log[Unit]
128 | object Log {
129 | def debug(msg: String) = LogMsg(DebugLevel, msg)
130 | def info(msg: String) = LogMsg(InfoLevel, msg)
131 | }
132 |
133 | sealed trait KVS[A]
134 | object KVS {
135 | final case class Get(key: String) extends KVS[String]
136 | final case class Put(key: String, value: String) extends KVS[Unit]
137 | }
138 |
139 | sealed trait FileIO[A]
140 | object FileIO {
141 | final case class GetFile(name: String) extends FileIO[File]
142 | final case class DeleteFile(name: String) extends FileIO[Unit]
143 | ...
144 | }
145 | ```
146 |
147 | You want to build a program that manipulates the 3 DSL together.
148 | So this program will use Log `or` KVS `or` File which is a Sum/Coproduct of the 3 DSL.
149 |
150 | To represent the DSL summing them all, Freek provides you with the following notation:
151 |
152 | ```scala
153 | type PRG = Log :|: KVS :|: File :|: NilDSL
154 | val PRG = DSL.Make[PRG]
155 | ```
156 |
157 | Please note:
158 |
159 | - `NilDSL` is required at the end of the coproduct and represents the non-existing DSL
160 | - Some will complain on the ugly symbol `:|:` but in Scala, there is no other elegant way to combine types (words can't be used in this case)...
161 | - `val PRG = DSL.Make[PRG]` is the way to instantiate a value that represents your `PRG` type. It might seem artificial and actually it is completely: it is just required to convince scalac that it can infer the right coproduct combining all your DSL and this inferred Coproduct is represented `PRG.Cop` that will be used in all this tutorial.
162 |
163 |
164 |
165 | ### `.freek[PRG]` to lift all operations in for-comprehension
166 |
167 | Now, you want to write a program based on your DSL using Free Monads because it's an efficient way to describe your business logic without supposing how it will be executed.
168 |
169 | So, you're going to use your `DSL[_]` lifted into Free monads `Free[DSL[_], A]` using a classic monadic flow i.e. for-comprehension.
170 |
171 | In a for-comprehension, to compile successfully, every line should have the same type. Thus, you need to lift all `Free[DSL[_], A]` to the combined Free type `Free[PRG.Cop, A]` where `PRG.Cop` is the sum of all the DSL used in your program.
172 |
173 | In a summary, you need a conversion `DSL[A] => Free[DSL, A] => Free[PRG.Cop, A]`.
174 |
175 | This can be done in a trivial way using `.freek[PRG]` in your for-comprehension.
176 |
177 | ```scala
178 | type PRG = Log :|: KVS :|: File :|: NilDSL
179 | val PRG = DSL.Make[PRG]
180 |
181 | // Here the type is shown for doc but you can omit it, Scala can infer things
182 | def program(id: String): Free[PRG.Cop, File] =
183 | for {
184 | _ <- Log.debug(s"Searching for value id: $id").freek[PRG]
185 | name <- KVS.Get(id).freek[PRG]
186 | file <- File.Get(name).freek[PRG]
187 | _ <- Log.debug(s"Found file:$file").freek[PRG]
188 | } yield (file)
189 | ```
190 |
191 | - Every line is lifted by `.freek[PRG]` to `Free[PRG.Cop, A]`: `PRG.Cop` builds the real hidden Sum/Coproduct type combining all your DSL. It is a specialized implementation of Shapeless Coproduct for higher-kinded structures called `CopK` because Shapeless representation doesn't allow to manipulate `F[_]` as we need it.
192 | - Just remind that `PRG` alone is a facility to combine DSL and the real type combining all DSL is `PRG.Cop`.
193 | - The whole for-comprehension describes a program
194 | - The result type is `Free[PRG.Cop, ?]`.
195 |
196 | > Some people will think about a implicit conversion to avoid having to write `freek[PRG]` but believe my own experience, inference in for-comprehension isn't so logical in Scala and as soon as you manipulate more complex programs, implicit conversion makes inference break with hardly understandable errors.
197 |
198 |
199 |
200 | ### Combine interpreters using operator `:&:` (AND)
201 |
202 | Previous `program` just describes your sequence of operations but it doesn't suppose how it will be executed: it's just a data representation of your program, a description of your computation.
203 |
204 | Now, you need to _interpret_ this description into an effectful execution and this is done with `interpreters` in Freek.
205 | `Interpreters` in Freek are nothing else than classic Natural Transformation (aka FunctionK) `F[_] ~> G[_]` with some helpers to manipulate multiple combined DSL(s) defined above seamlessly.
206 |
207 | Let's suppose we use an async execution context based on Scala `Future` not to be too fancy.
208 |
209 |
210 | #### Define your interpreters per DSL
211 |
212 | ```scala
213 | val LogInterpreter = new (Log ~> Future) {
214 | def apply[A](a: Log[A]) = a match {
215 | case Log.LogMsg(lvl, msg) =>
216 | Future(println(s"$lvl $msg"))
217 | }
218 | }
219 |
220 | val FileInterpreter = new (File ~> Future) {
221 | def apply[A](a: DB[A]) = a match {
222 | case File.Get(name) =>
223 | Future {
224 | FileManager.get(name)
225 | }
226 |
227 | case File.Delete(name) =>
228 | Future {
229 | FileManager.delete(name)
230 | }
231 | }
232 | }
233 |
234 | val KVSInterpreter = new (KVS ~> Future) {
235 | val storage = ...
236 |
237 | def apply[A](a: DB[A]) = a match {
238 | case KVS.Get(id) =>
239 | Future {
240 | storage.get(id)
241 | }
242 | case KVS.Put(id, value) =>
243 | Future {
244 | storage.put(id, value)
245 | ()
246 | }
247 | }
248 | }
249 |
250 | ```
251 |
252 |
253 | #### Combine interpreters into a big interpreter with `:&:`
254 |
255 | Executing your `program` means you are able to interpret DSL `Log` and `KVS` and `File` into an effectful computation.
256 |
257 | So you need an interpreter which is the product of `KVSInterpreter` and `LogInterpreter` and `FileInterpreter`.
258 |
259 | In Freek, you can combine your interpreters using operator `:&:` (AND)
260 |
261 | ```scala
262 | val interpreter = KVSInterpreter :&: LogInterpreter :&: FileInterpreter
263 | ```
264 |
265 | Remark that:
266 |
267 | - there is no equivalent to `NilDSL` at the end of sequence (because not types but values)
268 | - `interpreter` is actually of type `Interpreter` which is just a wrapper around a `C ~> R` where `C[_] <: CopK[_]`. If you want to access the underlying NaturalTransformation/FunctionK `PRG ~> Future`, just call `interpreter.nat`.
269 |
270 |
271 | #### Execute your program using `interpret`
272 |
273 | `program` is just a `Free[PRG.Cop, A]`, right?
274 |
275 | So you could use simply `foldMap/compile` with your `interpreter.nat`.
276 |
277 | But Freek provides a smarter function called `interpret` that makes the order of DSL vs interpreters not relevant as it will be shown further in this documentation.
278 |
279 | ```scala
280 | val fut = program.interpret(interpreter) // this returns a Future[Unit]
281 | ```
282 |
283 |
284 |
285 | ### Combine programs together with same operator `:|:` (SUPER-OR)
286 |
287 | The big interest of Free programs is that you can call a Free program inside a Free program. In this case, logically, you need to combine the DSL of both programs into one single DSL and lift all your Free to this bigger DSL.
288 |
289 |
290 | #### Introduce new DSL & program
291 |
292 | ```scala
293 | // New DSL
294 | object DB {
295 |
296 | sealed trait DSL[A]
297 | case class FindById(id: String) extends DSL[Entity]
298 |
299 | }
300 |
301 | // the new program
302 | object DBService {
303 | import DB._
304 |
305 | type PRG = Log.DSL :|: DB.DSL :|: NilDSL
306 | val PRG = DSL.Make[PRG]
307 |
308 | /** the program */
309 | // Here the type is indicated for doc but you can omit it, Scala can infer things
310 | def findById(id: String): Free[PRG.Cop, Entity] =
311 | for {
312 | _ <- Log.debug("Searching for entity id:"+id).freek[PRG]
313 | res <- FindById(id).freek[PRG]
314 | _ <- Log.debug("Search result:"+res).freek[PRG]
315 | } yield (res)
316 | }
317 | ```
318 |
319 |
320 | #### Combine programs
321 |
322 |
323 | To prepend one or more DSL to an existing combination of DSL into a new program, use the operator `:|:` also (in the same semantics as `+:` for `Seq`):
324 |
325 | ```scala
326 |
327 | type PRG = Log :|: KVS :|: File :|: DBService.PRG
328 | val PRG = DSL.Make[PRG]
329 |
330 | // Here the type is indicated for doc but you can omit it, Scala can infer things
331 | def program2(id: String): Free[PRG.Cop, File] =
332 | for {
333 | _ <- Log.debug(s"Searching for value id: $id").freek[PRG]
334 | name <- KVS.Get(id).freek[PRG]
335 | e <- DB.findById(id).expand[PRG]
336 | file <- File.Get(e.file).freek[PRG]
337 | _ <- Log.debug(s"Found file:$file").freek[PRG]
338 | } yield (file)
339 |
340 | ```
341 |
342 | Please note:
343 |
344 | - there is no `NilDSL` at the end because it's brought by `DBService.PRG`
345 | - `:|:` also appends a list of DSL at the end
346 | - the use of the `expand` function instead of `freek` for the findById operation, the `expand` function allows the use of a program defined with a smaller DSL in one with a bigger DSL
347 |
348 |
349 |
350 | #### What about DSL redundancy & order?
351 |
352 | You have remarked that `Log` is redundant in `PRG & `DBService.PRG` so it might be an issue when declaring your sequence of interpreters. You might also wonder what happens if you don't respect order of DSL in the sequence of interpreters.
353 |
354 | If you were using classic `foldMap/compile` to execute your Free program, you would have to respect the exact order and redundancy of interpreters vs DSL which is a pain.
355 |
356 | This is where Freek `interpret` really becomes interesting as it is order & redundancy-agnostic.
357 |
358 | So, for previous combined programs, you can just do:
359 |
360 | ```scala
361 |
362 | val interpreter2 = DBInterpreter :&: KVSInterpreter :&: LogInterpreter :&: FileInterpreter
363 |
364 | val fut2 = program2.interpret(interpreter2) // this returns a Future[Unit]
365 | ```
366 |
367 |
368 |
369 |
370 | ### Manipulate Stack of result types
371 |
372 | Ok till now we have focused on the DSL side F of `Free[F[_], A]`. We have nice tools to combine different DSL and interpret them. But what about the result type?
373 |
374 | In previous samples, we had simple return types in our DSL but this return type often represents the results of operations in your business logic including error types.
375 |
376 | Let's define this kind of DSL:
377 |
378 |
379 | ```scala
380 | sealed trait Foo[A]
381 | final case class Foo1(s: String) extends Foo[Option[Int]]
382 | final case class Foo2(i: Int) extends Foo[Xor[String, Int]]
383 | final case object Foo3 extends Foo[Unit]
384 | final case class Foo4(i: Int) extends Foo[Xor[String, Option[Int]]]
385 |
386 | sealed trait Bar[A]
387 | final case class Bar1(s: String) extends Bar[Option[String]]
388 | final case class Bar2(i: Int) extends Bar[Xor[String, String]]
389 | ```
390 |
391 | Here you see some return type `Option[Int]` or `Xor[String, Int]`.
392 |
393 | In general, you want to write programs like:
394 |
395 | ```scala
396 | for {
397 | i <- Foo1("5").freek[PRG] // => here result is Option[String]
398 | _ <- Bar2(i).freek[PRG] // => here result is Xor[String, String]
399 | ...
400 | } yield (())
401 | ```
402 |
403 | But you see clearly that `i` is an Option and types on both lines aren't the same.
404 |
405 | If you try to solve those naively in your program, you'll end with something like that:
406 |
407 | ```scala
408 | for {
409 | optI <- Foo1("5").freek[PRG] // => here result is Option[String]
410 | _ <- optI match {
411 | case Some(i) => Bar2(i).freek[PRG] // => here result is Xor[String, String]
412 | case None => ... // => What to return here???
413 | }
414 | ...
415 | } yield (())
416 | ```
417 |
418 | It's ugly and still needs to unify Xor[String, String] and Option[String] in a common type.
419 |
420 | The natural approach is to stack your complex return types to be able to manage all cases (order matters naturally):
421 |
422 | ```scala
423 | Xor[String, Option[String]] or Option[Xor[String, String]]
424 |
425 | // orders matters naturally and depends on your business rules
426 | ```
427 |
428 | As you may know, the classic approach to this is to use _MonadTransformers_ (`OptionT` & `XorT`) which work well with Freek but Freek also provides new typesafe facilities called `Onion` & `OnionT` to make it a bit more trivial.
429 |
430 |
431 | #### Onion, stack of monads/traverses
432 |
433 | `Onion` is just a way to manipulate a stack of monadic & traversable structures like:
434 |
435 | ```scala
436 | type Stack[A] = F[G[H[I[A]]]] (where F/G/H/I must be monads & traversables to allow all features provided by Onion)
437 | ```
438 |
439 | You can represent it using `Onion` facilty:
440 |
441 | ```scala
442 | // Build your Onion like that
443 | type O = F :&: G :&: H :&: I :&: Bulb
444 |
445 | // then you could get the Stack again (but in general you don't need it)
446 | type Stack[A] = O#Layers[A]
447 | ```
448 |
449 | _Bulb is just the terminator of the `Onion` stack (like NilDSL for combination of DSL)_
450 |
451 |
452 | Let's go back to our original program now and try type unification on every line:
453 |
454 |
455 | ```scala
456 | for {
457 | i <- Foo1("5").freek[PRG] // => here result is Option[String]
458 | s <- Bar2(i).freek[PRG] // => here result is Xor[String, String]
459 | ...
460 | } yield (())
461 | ```
462 |
463 | So, in the for-comprehension, we need to unify types on every line:
464 |
465 | ```scala
466 | Free[PRG.Cop, Option[A]]
467 | // and
468 | Free[PRG.Cop, Xor[String, A]]
469 |
470 | // into
471 | Free[PRG.Cop, Xor[String, Option[A]]]
472 |
473 | // which is
474 | type O = Xor[String, ?] :&: Option :&: Bulb
475 | Free[PRG.Cop, O#Layers]
476 | ```
477 |
478 | As you can expect, that's not enough, you need something more to do what we want.
479 |
480 |
481 | #### OnionT, the missing link
482 |
483 | For `Option`, the Monad Transformer is called `OptionT`
484 | For `Xor`, the Monad Transformer is called `XorT`
485 |
486 | For `Onion`, Freek provides `OnionT[TC[_[_], _], F[_], O <: Onion, A]`...
487 |
488 | Freaky, isn't it? Don't worry, you don't have to see it most of the time like monad transformers :D
489 |
490 | > Let's say loud that _`OnionT` is not a Monad Transformer_: is an Onion stack of monadic & traversable layers embedded as result type of a monad `TC[F[_], ?]` (like `Free[F[_], ?]`).
491 |
492 | Finally, if you are able to lift all your `Free[PRG.Cop, Option[A] or Xor[String, A]]` to `OnionT[Free, PRG.Cop, O, A]`, victory!
493 | ... And you can do it with `.onionT[O]`
494 |
495 | Let's give an example of it:
496 |
497 | ```scala
498 | type PRG = Bar :|: Foo :|: Log.DSL :|: NilDSL
499 | type O = Xor[String, ?] :&: Option :&: Bulb
500 |
501 | // Here the type is indicated for doc but you can omit it, Scala can infer things
502 | val prg: OnionT[Free, PRG.Cop, O, Int] = for {
503 | i <- Foo1("5").freek[PRG].onionT[O]
504 | i2 <- Foo2(i).freek[PRG].onionT[O]
505 | _ <- Log.info("toto " + i).freek[PRG].onionT[O]
506 | _ <- Foo3.freek[PRG].onionT[O]
507 | s <- Bar1(i2.toString).freek[PRG].onionT[O]
508 | i3 <- Foo4(i2).freek[PRG].onionT[O]
509 | } yield (i3)
510 | ```
511 |
512 | Remark that `.oniontT[O]` is used in all cases to lift to `OnionT[Free, PRG, O, A]`
513 |
514 |
515 | #### Execute an OnionT with `.value`
516 |
517 | `prg` has type `OnionT[Free, PRG.Cop, O, A]` but you want to execute it as a Free Monad, not this weird OnionT-stuff.
518 |
519 | It's as simple as you would do with Monad Transformers: access the underlying Free with `.value`
520 |
521 | ```scala
522 | val fut = prg.value.interpret(interpreters)
523 | ```
524 |
525 |
526 | #### `.freeko[PRG, O]` for the very lazy
527 |
528 | Ok, writing `.freek[PRG].onionT[O]` on each line is boring, right?
529 |
530 | Freek provides a shortcut called `freeko` that combines both calls in one single.
531 |
532 | > `freeko` is still in evaluation as it requires some type crafting so if you see weird cases, don't hesitate to report
533 |
534 | Here is your program with `freeko`:
535 |
536 | ```scala
537 | type PRG = Bar :|: Foo :|: Log.DSL :|: NilDSL
538 | type O = Xor[String, ?] :&: Option :&: Bulb
539 |
540 | // Here the type is indicated for doc but you can omit it, Scala can infer things
541 | val prg: OnionT[Free, PRG.Cop, O, Int] = for {
542 | i <- Foo1("5").freeko[PRG, O]
543 | i2 <- Foo2(i).freeko[PRG, O]
544 | _ <- Log.info("toto " + i).freeko[PRG, O]
545 | _ <- Foo3.freeko[PRG, O]
546 | s <- Bar1(i2.toString).freeko[PRG, O]
547 | i3 <- Foo4(i2).freeko[PRG, O]
548 | } yield (i3)
549 | ```
550 |
551 | Ok, that's enough simplifications...
552 |
553 |
554 | #### Combine sub-programs together with `:||:`
555 |
556 | Finally, you can combine existing programs together and also define local programs.
557 |
558 | [Debasish Gosh](https://twitter.com/debasishg) asked me how I would define local programs & re-use them in bigger programs.
559 |
560 | Let's take his classic example from his great book [Functional and Reactive Domain Modeling](https://www.manning.com/books/functional-and-reactive-domain-modeling) that is clearly related to Freek domain.
561 |
562 |
563 | ##### Define local programs
564 |
565 | ```scala
566 | // Repository DSL
567 | sealed trait Repo[A]
568 | case class Query(no: String) extends Repo[Xor[String, Account]]
569 | case class Store(account: Account) extends Repo[Xor[String, Account]]
570 | case class Delete(no: String) extends Repo[Xor[String, Unit]]
571 |
572 | // Repository local program
573 | object Repo {
574 | type PRG = Repo :|: Log :|: NilDSL
575 | val PRG = DSL.Make[PRG]
576 |
577 | type O = Xor[String, ?] :&: Bulb
578 |
579 | // here you can define a local program re-usable in other programs
580 | def update(no: String, f: Account => Account) = for {
581 | a <- Query(no).freeko[PRG, O]
582 | _ <- Store(f(a)).freeko[PRG, O]
583 | } yield (())
584 | }
585 |
586 | sealed trait Foo[A]
587 | ...
588 |
589 | // Foo can use Repo sub-program
590 | object Foo {
591 | type PRG = Foo :|: Log.DSL :|: Repo.PRG
592 |
593 | def subFoo(...): Free[PRG.Cop, ...] = ...
594 | }
595 |
596 | sealed trait Bar[A]
597 | ...
598 |
599 | // Bar can use Repo sub-program too
600 | object Bar {
601 | type PRG = Bar :|: Log.DSL :|: Repo.PRG
602 | val PRG = DSL.Make[PRG]
603 |
604 | def subBar(...): Free[PRG.Cop, ...] = ...
605 | }
606 | ```
607 |
608 | You can see that `NilDSL` isn't used in `Bar.PRG` and `Foo.PRG` because `:|:` prepends an element DSL to a (coproduct) sequence of DSL and `Repo.PRG` is already a (coproduct) sequence of DSL.
609 |
610 |
611 | ##### Combine programs with `:||:`
612 |
613 | ```scala
614 | type O = List :&: Xor[String, ?] :&: Option :&: Bulb
615 |
616 | // Combine all programs using :||:
617 | type PRG = Log.DSL :|: Bar.PRG :||: Foo.PRG
618 | val PRG = DSL.Make[PRG]
619 |
620 | // Here the type is indicated for doc but you can omit it
621 | val prg: OnionT[Free, PRG.Cop, O, Int] = for {
622 | ... <- Foo.subFoo(...).freeko[PRG, O]
623 | ... <- Bar.subBar(...).freeko[PRG, O]
624 | _ <- Repo.update(.).freeko[PRG, O]
625 | } yield (...)
626 | ```
627 |
628 | To make the difference between `:|:` and `:||:`, please remind the following:
629 |
630 | - `:|:` is like operator `+:` for Scala `Seq`, it prepends an element DSL to a (coproduct) sequence of DSL.
631 |
632 | - `:||:` is like operator `++` for Scala `Seq`, it appends 2 (coproduct) sequences of DSL.
633 |
634 |
635 | #### Combine group of interpreters with `:&&:`
636 |
637 | ```scala
638 | val fooInterpreters = barInterpreter :&: logInterpreter :|: repoInterpreter
639 | val barInterpreters = fooInterpreter :&: logInterpreter :|: repoInterpreter
640 |
641 | val interpreters = fooInterpreters :&&: barInterpreters
642 | ```
643 |
644 | - `:&&:` is like operator `++` for Scala `Seq`, it appends 2 sequences of interpreters.
645 |
646 |
647 | #### Unstack results with `.peelRight` / `.peelRight2` / `.peelRight3`
648 |
649 | Sometimes, you have a Free returning an Onion `Xor[String, ?] :&: Option :&: Bulb` but you want to manipulate the hidden `Option[A]` in your program and not `A`.
650 |
651 | You can do that using `.dropRight` that will unstack `Option` from the onion `Xor[String, ?] :&: Option :&: Bulb` and return a `(Xor[String, ?] :&: Bulb)#Layers[Option[A]]`. Then you have access to `Option[A]` but naturally, you have to lift all lines of the program to the same level.
652 |
653 | For example, you could do the following:
654 |
655 | ```scala
656 | val prg: OnionT[Free, PRG.Cop, Xor[String, ?] :&: Bulb, Option[A]] = for {
657 | iOpt <- Foo1("5").freek[PRG].onionT[O].peelRight
658 | i2 <- iOpt match {
659 | case Some(i) => Foo2(i).freek[PRG].onionT[O].peelRight
660 | case None => Foo2(0).freek[PRG].onionT[O].peelRight
661 | }
662 | ...
663 | }
664 | ```
665 |
666 | - If you need to peel 2 layers, use `.peelRight2`
667 |
668 | - If you need to peel 3 layers, use `.peelRight3`
669 |
670 | > there is also a `.wrap[F[_]]` that can wrap the existing Onion in `F[_]`
671 |
672 |
673 | #### Difference between `.onionT` and `.onion`
674 |
675 | - When you have a `Free[PRG.Cop, F[A]]` and want to lift info `OnionT[Free, PRG.Cop, O, A]` and Onion `O` contains `F[_]`, then use `Free[PRG.Cop, F[A]].onionT[O]`
676 |
677 |
678 | - When you have a `Free[PRG.Cop, F[A]]` into `OnionT[Free, PRG.Cop, O, F[A]]` (Onion `O` can contain `F[_]`), then use `Free[PRG.Cop, F[A]].onion[O]`
679 |
680 | #### `.onionT1` / `.onionT2` / `.onionT3`
681 |
682 | Instead of `Foo2(i).freek[PRG].onionT[O].peelRight`, you can write `Foo2(i).freek[PRG].onionT1[O]`
683 |
684 | Instead of `Foo2(i).freek[PRG].onionT[O].peelRight2`, you can write `Foo2(i).freek[PRG].onionT2[O]`
685 |
686 | Instead of `Foo2(i).freek[PRG].onionT[O].peelRight3`, you can write `Foo2(i).freek[PRG].onionT3[O]`
687 |
688 |
689 | #### Bored adding `.free[PRG]` on each line? Use `Freekit` trick
690 |
691 | ```scala
692 | type PRG = Foo1 :|: Foo2 :|: Log :|: NilDSL
693 | val PRG = DSL.Make[PRG]
694 |
695 | // remark that you pass the value PRG here
696 | object M extends Freekit(PRG) {
697 | val prg = for {
698 | aOpt <- Foo1.Bar1(7)
699 | _ <- Log.Info(s"aOpt:$aOpt")
700 | a <- aOpt match {
701 | case Some(a) => for {
702 | a <- Foo2.Bar21(a)
703 | _ <- Log.Info(s"a1:$a")
704 | } yield (a)
705 | case None => for {
706 | a <- Foo2.Bar22
707 | _ <- Log.Info(s"a2:$a")
708 | } yield (a)
709 | }
710 | } yield (a)
711 | }
712 | ```
713 |
714 | This works in basic cases & naturally as soon as you have embedded `for-comprehension`, scalac inference makes it less efficient.
715 |
716 |
717 | #### Bored adding `.free[PRG].onionT[O]` on each line? Use `Freekito` trick
718 |
719 | ```scala
720 | type PRG = Foo1 :|: Foo2 :|: Log :|: NilDSL
721 | val PRG = DSL.Make[PRG]
722 |
723 | // remark that you pass the value PRG here
724 | object MO extends Freekito(PRG) {
725 | // you need to create this type O to reify the Onion
726 | type O = Option :&: Bulb
727 |
728 | val prg = for {
729 | a <- Foo1.Bar1(7)
730 | _ <- Log.Info(s"a:$a")
731 | a <- Foo2.Bar21(a)
732 | } yield (a)
733 | }
734 | ```
735 |
736 | This works in basic cases & naturally as soon as you have embedded `for-comprehension`, scalac inference makes it less efficient.
737 |
738 |
739 |
740 |
741 | ## Reminding motivations
742 |
743 | At [ProjectSeptember](http://www.projectseptember.com), we love typesafe & functional programming.
744 |
745 | We also like the concept of `Free Monad` which decouples completely the description of your program from its execution.
746 |
747 | Free has a cost in terms of performance & short-term structures allocation but in our domain, IO is much more the bottleneck than these aspects so we can use those concepts without remorse.
748 |
749 | We also believe current implementations can be improved progressively using theoretical and even more brutal tools like compiler plugin/optimizations. So we want to push those concepts further and further.
750 |
751 | In Cats & Scalaz, `Free[F[_], A]` representation has already been optimized into a right associated structure and now embeds Coyoneda trick removing the dependency on Functor. Now we can use any DSL `F[_]` in a `Free[F, A]`.
752 |
753 | Free is a generic way to manipulate DSL and convert them into computations and thus can be used to represent some sort of effects combination. But in this context, there are more specialized & interesting approaches in Scala world:
754 |
755 | - [Emm](https://github.com/djspiewak/emm) : A very clever idea to represent stack of effects and a nice implementation (from which a few ideas have been stolen for `freek`). It's interesting because it can use existing structures but it has many implicits meaning it has a cost at compile-time and a few questioning about its pure Monadic nature (TBD)...
756 |
757 | - [Scala Eff](http://atnos-org.github.io/eff-cats/): a more theoretical and deeply interesting implementation based on [Freer Monads, more extensible effects](http://okmij.org/ftp/Haskell/extensible/more.pdf)'s paper by Oleg Kiselyov & friends. It's the next-gen of effects management but it also requires more _aware developers_ certainly... Next step of evangelization ;)... Please note that Eric has recently introduced a model in Eff that got inspired by our latest compile-time optimized CopK model: that's the power of OSS ;)
758 |
759 | - [Idris Eff port](https://github.com/mandubian/scalaeff): this is my personal toy... In Idris, it's (almost) nice, in Scala, it's almost a monster and more an experiment showing it could work. But it's the _next-gen + 1/2/3/4_ IMHO so let's be patient and make it grow...
760 |
761 | > But for now, `Free` concept starts to enter in mind of people so we want to use it as is (with a few enhancements).
762 |
763 |
764 |
765 | ## Tribute to SI2712 patch
766 |
767 | SI2712 recent patch released by @milessabin has changed a lot the way we can build type-intensive libraries because we aren't limited by this terrible issue.
768 |
769 | > That [PR](https://github.com/scala/scala/pull/5102#issuecomment-219868111) has been merged in Scala 2.12 and it changes things a lot...
770 |
771 | Without it, Freek would be much uglier & less fun to use.
772 |
773 | Thanks @milessabin again!
774 |
775 |
776 | Deeper sample can be found in [AppSpec](https://github.com/ProjectSeptemberInc/freek/blob/master/src/test/scala/AppSpec.scala)
777 |
778 |
779 | > By the way, all of that is also called
780 |
781 | #### COMPILE-TIME DEPENDENCY INJECTION
782 |
783 | ;););)
784 |
785 | THE END...
786 |
--------------------------------------------------------------------------------
/build.sbt:
--------------------------------------------------------------------------------
1 | lazy val commonSettings = Seq(
2 | organization := "com.projectseptember"
3 | , version := "0.6.7"
4 | , resolvers ++= Seq(
5 | Resolver.mavenLocal
6 | , Resolver.sonatypeRepo("releases")
7 | , Resolver.sonatypeRepo("snapshots"))
8 | , scalaVersion := "2.11.8"
9 | , crossScalaVersions := Seq("2.11.8", "2.12.0", "2.12.1")
10 | , bintrayOrganization := Some("projectseptemberinc")
11 | , licenses += ("Apache-2.0", url("http://www.apache.org/licenses/LICENSE-2.0"))
12 | , addCompilerPlugin("org.spire-math" % "kind-projector" % "0.9.3" cross CrossVersion.binary)
13 | )
14 |
15 | def scalacOptionsVersion(scalaVersion: String) = {
16 | Seq(
17 | "-feature"
18 | , "-language:higherKinds"
19 | ) ++ (CrossVersion.partialVersion(scalaVersion) match {
20 | case Some((2, scalaMajor)) if scalaMajor == 12 => Seq("-Ypartial-unification")
21 | case _ => Nil
22 | })
23 | }
24 |
25 | lazy val root = (project in file("."))
26 | .settings(commonSettings: _*)
27 | .settings(
28 | name := "freek",
29 | scalacOptions ++= scalacOptionsVersion(scalaVersion.value)
30 | )
31 | .settings(
32 | libraryDependencies ++= Seq(
33 | "org.typelevel" %% "cats-free" % "0.9.0"
34 | , "org.scalatest" %% "scalatest" % "3.0.0" % Test
35 | ) ++ (CrossVersion.partialVersion(scalaVersion.value) match {
36 | case Some((2, scalaMajor)) if scalaMajor == 11 =>
37 | compilerPlugin("com.milessabin" % "si2712fix-plugin" % "1.2.0" cross CrossVersion.full) :: Nil
38 | case _ => Nil
39 | })
40 | )
41 |
--------------------------------------------------------------------------------
/project/build.properties:
--------------------------------------------------------------------------------
1 | sbt.version=0.13.13
2 |
--------------------------------------------------------------------------------
/project/plugins.sbt:
--------------------------------------------------------------------------------
1 | addSbtPlugin("me.lessis" % "bintray-sbt" % "0.3.0")
2 |
--------------------------------------------------------------------------------
/src/main/scala/CopK.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.~>
4 |
5 |
6 | /** Higher-Kinded Coproduct (exactly like shapeless Coproduct but higher-kinded)
7 | *
8 | * Using shapeless syntax, it represents a M[t] = F[t] :+: G[t] :+: H[t] :+: CNilk[t]
9 | */
10 | sealed trait CopK[A] extends Product with Serializable
11 |
12 | sealed trait CNilK[A] extends CopK[A]
13 |
14 | // classic model
15 | // sealed trait ConsK[H[_], L[_] <: CopK[_], A] extends CopK[A] {
16 | // type Cop[t] = ConsK[H, L, t]
17 | // }
18 | // final case class Inlk[H[_], T[_] <: CopK[_], A](head : H[A]) extends ConsK[H, T, A]
19 | // final case class Inrk[H[_], T[_] <: CopK[_], A](tail : T[A]) extends ConsK[H, T, A]
20 |
21 | final case class In1[H[_], A](head: H[A]) extends CopK[A]
22 |
23 | sealed trait In2[H1[_], H2[_], A] extends CopK[A]
24 | final case class In2l[H1[_], H2[_], A](left: H1[A]) extends In2[H1, H2, A]
25 | final case class In2r[H1[_], H2[_], A](right: H2[A]) extends In2[H1, H2, A]
26 |
27 | sealed trait In3[H1[_], H2[_], H3[_], A] extends CopK[A]
28 | final case class In3l[H1[_], H2[_], H3[_], A](left: H1[A]) extends In3[H1, H2, H3, A]
29 | final case class In3m[H1[_], H2[_], H3[_], A](middle: H2[A]) extends In3[H1, H2, H3, A]
30 | final case class In3r[H1[_], H2[_], H3[_], A](right: H3[A]) extends In3[H1, H2, H3, A]
31 |
32 | // Used to lazily delays CopK flattening as long as possible
33 | sealed trait AppendK[L[_] <: CopK[_], R[_] <: CopK[_], A] extends CopK[A]
34 | final case class Aplk[L[_] <: CopK[_], R[_] <: CopK[_], A](left: L[A]) extends AppendK[L, R, A]
35 | final case class Aprk[L[_] <: CopK[_], R[_] <: CopK[_], A](right: R[A]) extends AppendK[L, R, A]
36 |
37 | trait ContainsHK[L[_] <: CopK[_], H[_]] extends Serializable {
38 | def extract[A](la: L[A]): Option[H[A]]
39 | def build[A](ha: H[A]): L[A]
40 | }
41 |
42 |
43 | object ContainsHK extends LowerContainsHK {
44 |
45 | def apply[L[_] <: CopK[_], H[_]]
46 | (implicit containsHK: ContainsHK[L, H])/*: Aux[L, H, containsHK.R]*/ = containsHK
47 |
48 | implicit def in1[H[_]]: ContainsHK[In1[H, ?], H] =
49 | new ContainsHK[In1[H, ?], H] {
50 |
51 | def extract[A](la: In1[H, A]): Option[H[A]] = Some(la.head)
52 |
53 | def build[A](ha: H[A]): In1[H, A] = In1(ha)
54 | }
55 |
56 | implicit def in2[H1[_], H2[_]]: ContainsHK[In2[H1, H2, ?], H1] =
57 | new ContainsHK[In2[H1, H2, ?], H1] {
58 |
59 | def extract[A](la: In2[H1, H2, A]): Option[H1[A]] = la match {
60 | case In2l(l) => Some(l)
61 | case In2r(r) => None
62 | }
63 |
64 | def build[A](ha: H1[A]): In2[H1, H2, A] = In2l(ha)
65 | }
66 |
67 | implicit def in3l[H1[_], H2[_], H3[_]]: ContainsHK[In3[H1, H2, H3, ?], H1] =
68 | new ContainsHK[In3[H1, H2, H3, ?], H1] {
69 |
70 | def extract[A](la: In3[H1, H2, H3, A]): Option[H1[A]] = la match {
71 | case In3l(l) => Some(l)
72 | case In3m(_) => None
73 | case In3r(_) => None
74 | }
75 |
76 | def build[A](ha: H1[A]): In3[H1, H2, H3, A] = In3l(ha)
77 | }
78 |
79 | }
80 |
81 | trait LowerContainsHK extends LowerContainsHK2 {
82 |
83 | implicit def in2r[H1[_], H2[_]]: ContainsHK[In2[H1, H2, ?], H2] =
84 | new ContainsHK[In2[H1, H2, ?], H2] {
85 |
86 | def extract[A](la: In2[H1, H2, A]): Option[H2[A]] = la match {
87 | case In2l(l) => None
88 | case In2r(r) => Some(r)
89 | }
90 |
91 | def build[A](ha: H2[A]): In2[H1, H2, A] = In2r(ha)
92 | }
93 |
94 | implicit def in3m[H1[_], H2[_], H3[_]]: ContainsHK[In3[H1, H2, H3, ?], H2] =
95 | new ContainsHK[In3[H1, H2, H3, ?], H2] {
96 |
97 | def extract[A](la: In3[H1, H2, H3, A]): Option[H2[A]] = la match {
98 | case In3l(l) => None
99 | case In3m(m) => Some(m)
100 | case In3r(_) => None
101 | }
102 |
103 | def build[A](ha: H2[A]): In3[H1, H2, H3, A] = In3m(ha)
104 | }
105 |
106 | }
107 |
108 |
109 | trait LowerContainsHK2 extends LowerContainsHK3 {
110 |
111 | implicit def in3r[H1[_], H2[_], H3[_]]: ContainsHK[In3[H1, H2, H3, ?], H3] =
112 | new ContainsHK[In3[H1, H2, H3, ?], H3] {
113 |
114 | def extract[A](la: In3[H1, H2, H3, A]): Option[H3[A]] = la match {
115 | case In3l(_) => None
116 | case In3m(_) => None
117 | case In3r(r) => Some(r)
118 | }
119 |
120 | def build[A](ha: H3[A]): In3[H1, H2, H3, A] = In3r(ha)
121 | }
122 |
123 |
124 | implicit def appendLeft[L1[_] <: CopK[_], L2[_] <: CopK[_], H[_]](
125 | implicit containsLeft: ContainsHK[L1, H]
126 | ): ContainsHK[AppendK[L1, L2, ?], H] =
127 | new ContainsHK[AppendK[L1, L2, ?], H] {
128 |
129 | def extract[A](la: AppendK[L1, L2, A]): Option[H[A]] = la match {
130 | case Aplk(l) => containsLeft.extract(l)
131 | case Aprk(_) => None
132 | }
133 |
134 | def build[A](ha: H[A]): AppendK[L1, L2, A] = Aplk(containsLeft.build(ha))
135 | }
136 |
137 | }
138 |
139 | trait LowerContainsHK3 {
140 |
141 | implicit def appendRight[L1[_] <: CopK[_], L2[_] <: CopK[_], H[_]](
142 | implicit containsRight: ContainsHK[L2, H]
143 | ): ContainsHK[AppendK[L1, L2, ?], H] =
144 | new ContainsHK[AppendK[L1, L2, ?], H] {
145 |
146 | def extract[A](la: AppendK[L1, L2, A]): Option[H[A]] = la match {
147 | case Aplk(_) => None
148 | case Aprk(r) => containsRight.extract(r)
149 | }
150 |
151 | def build[A](ha: H[A]): AppendK[L1, L2, A] = Aprk(containsRight.build(ha))
152 | }
153 |
154 | // implicit def corec[H[_], K[_], L[_] <: CopK[_]](
155 | // implicit next: ContainsHK[L, H]
156 | // ): ContainsHK[ConsK[K, L, ?], H] =
157 | // new ContainsHK[ConsK[K, L, ?], H] {
158 |
159 | // def extract[A](la: ConsK[K, L, A]): Option[H[A]] = la match {
160 | // case Inlk(h) => None
161 | // case Inrk(r) => next.extract(r)
162 | // }
163 |
164 | // def build[A](ha: H[A]): ConsK[K, L, A] = Inrk(next.build(ha))
165 | // }
166 |
167 | }
168 |
169 |
170 |
171 | trait SubCop[L[_] <: CopK[_], L2[_] <: CopK[_]] {
172 | def apply[A](l: L[A]): L2[A]
173 | }
174 |
175 | object SubCop extends LowerSubCop {
176 |
177 | def apply[L[_] <: CopK[_], R[_] <: CopK[_]]
178 | (implicit subCop: SubCop[L, R]): SubCop[L, R] = subCop
179 |
180 | implicit def in1[H[_], L[_] <: CopK[_]](
181 | implicit contains: ContainsHK[L, H]
182 | ) = new SubCop[In1[H, ?], L] {
183 | def apply[A](l: In1[H, A]): L[A] = contains.build(l.head)
184 | }
185 |
186 | implicit def in2[H1[_], H2[_], L[_] <: CopK[_]](
187 | implicit contains1: ContainsHK[L, H1], contains2: ContainsHK[L, H2]
188 | ) = new SubCop[In2[H1, H2, ?], L] {
189 | def apply[A](l: In2[H1, H2, A]): L[A] = l match {
190 | case In2l(l) => contains1.build(l)
191 | case In2r(r) => contains2.build(r)
192 | }
193 | }
194 |
195 | implicit def in3[H1[_], H2[_], H3[_], L[_] <: CopK[_]](
196 | implicit contains1: ContainsHK[L, H1], contains2: ContainsHK[L, H2], contains3: ContainsHK[L, H3]
197 | ) = new SubCop[In3[H1, H2, H3, ?], L] {
198 | def apply[A](l: In3[H1, H2, H3, A]): L[A] = l match {
199 | case In3l(l) => contains1.build(l)
200 | case In3m(m) => contains2.build(m)
201 | case In3r(r) => contains3.build(r)
202 | }
203 | }
204 |
205 | }
206 |
207 | trait LowerSubCop extends LowerSubCop2 {
208 |
209 | // implicit def single[H[_], L[_] <: CopK[_]](
210 | // implicit contains: ContainsHK[L, H]
211 | // ) = new SubCop[ConsK[H, CNilK, ?], L] {
212 | // def apply[A](l: ConsK[H, CNilK, A]): L[A] = l match {
213 | // case Inlk(h) => contains.build(h)
214 | // case Inrk(_) => throw new RuntimeException("impossible case")
215 | // }
216 | // }
217 |
218 | implicit def appendkNil[L[_] <: CopK[_], L2[_] <: CopK[_]](
219 | implicit subLeft: SubCop[L, L2]
220 | ) = new SubCop[AppendK[L, CNilK, ?], L2] {
221 | def apply[A](la: AppendK[L, CNilK, A]): L2[A] = la match {
222 | case Aplk(l) => subLeft(l)
223 | case Aprk(r) => throw new RuntimeException("impossible case")
224 | }
225 | }
226 |
227 | }
228 |
229 | trait LowerSubCop2 {
230 |
231 | implicit def appendk[L[_] <: CopK[_], R[_] <: CopK[_], L2[_] <: CopK[_]](
232 | implicit subLeft: SubCop[L, L2], subRight: SubCop[R, L2]
233 | ) = new SubCop[AppendK[L, R, ?], L2] {
234 | def apply[A](la: AppendK[L, R, A]): L2[A] = la match {
235 | case Aplk(l) => subLeft(l)
236 | case Aprk(r) => subRight(r)
237 | }
238 | }
239 |
240 | // implicit def corec[H[_], L[_] <: CopK[_], L2[_] <: CopK[_]](
241 | // implicit contains: ContainsHK[L2, H], next: SubCop[L, L2]
242 | // ) = new SubCop[ConsK[H, L, ?], L2] {
243 | // def apply[A](l: ConsK[H, L, A]): L2[A] = l match {
244 | // case Inlk(h) => contains.build(h)
245 | // case Inrk(r) => next(r)
246 | // }
247 | // }
248 |
249 | }
250 |
251 | //
252 |
253 |
254 |
255 | trait PrependHK[H[_], L[_] <: CopK[_]] {
256 | type Out[_] <: CopK[_]
257 |
258 | def apply[A](ha: L[A]): Out[A]
259 | def single[A](ha: H[A]): Out[A]
260 |
261 | def nat[R[_], A](out: Out[A], nat1: H ~> R, nat2: L ~> R): R[A]
262 | }
263 |
264 | object PrependHK extends PrependHKLower {
265 |
266 | def apply[H[_], L[_] <: CopK[_]]
267 | (implicit prep: PrependHK[H, L]): Aux[H, L, prep.Out] = prep
268 |
269 | type Aux[H[_], L[_] <: CopK[_], Out0[_] <: CopK[_]] = PrependHK[H, L] { type Out[t] = Out0[t] }
270 |
271 | implicit def in1[H1[_], H2[_]]: Aux[H1, In1[H2, ?], In2[H1, H2, ?]] =
272 | new PrependHK[H1, In1[H2, ?]] {
273 | type Out[t] = In2[H1, H2, t]
274 |
275 | def apply[A](c: In1[H2, A]): Out[A] = In2r(c.head)
276 | def single[A](ha: H1[A]): Out[A] = In2l(ha)
277 |
278 | def nat[R[_], A](out: In2[H1, H2, A], nat1: H1 ~> R, nat2: In1[H2, ?] ~> R): R[A] = out match {
279 | case In2l(l) => nat1(l)
280 | case In2r(r) => nat2(In1(r))
281 | }
282 | }
283 |
284 | implicit def in2[H1[_], H2[_], H3[_]]: Aux[H1, In2[H2, H3, ?], In3[H1, H2, H3, ?]] =
285 | new PrependHK[H1, In2[H2, H3, ?]] {
286 | type Out[t] = In3[H1, H2, H3, t]
287 |
288 | def apply[A](c: In2[H2, H3, A]): Out[A] = c match {
289 | case In2l(left) => In3m(left)
290 | case In2r(right) => In3r(right)
291 | }
292 |
293 | def single[A](ha: H1[A]): Out[A] = In3l(ha)
294 |
295 | def nat[R[_], A](out: In3[H1, H2, H3, A], nat1: H1 ~> R, nat2: In2[H2, H3, ?] ~> R): R[A] = out match {
296 | case In3l(l) => nat1(l)
297 | case In3m(m) => nat2(In2l(m))
298 | case In3r(r) => nat2(In2r(r))
299 | }
300 | }
301 |
302 | implicit def in3[H1[_], H2[_], H3[_], H4[_]]: Aux[H1, In3[H2, H3, H4, ?], AppendK[In1[H1, ?], In3[H2, H3, H4, ?], ?]] =
303 | new PrependHK[H1, In3[H2, H3, H4, ?]] {
304 | type Out[t] = AppendK[In1[H1, ?], In3[H2, H3, H4, ?], t]
305 |
306 | def apply[A](c: In3[H2, H3, H4, A]): Out[A] = Aprk(c)
307 |
308 | def single[A](ha: H1[A]): Out[A] = Aplk(In1(ha))
309 |
310 | def nat[R[_], A](out: AppendK[In1[H1, ?], In3[H2, H3, H4, ?], A], nat1: H1 ~> R, nat2: In3[H2, H3, H4, ?] ~> R): R[A] = out match {
311 | case Aplk(In1(l)) => nat1(l)
312 | case Aprk(m) => nat2(m)
313 | }
314 | }
315 |
316 | implicit def append1[H1[_], H2[_], R[_] <: CopK[_], C[_] <: CopK[_]]: Aux[H1, AppendK[In1[H2, ?], R, ?], AppendK[In2[H1, H2, ?], R, ?]] =
317 | new PrependHK[H1, AppendK[In1[H2, ?], R, ?]] {
318 | type Out[t] = AppendK[In2[H1, H2, ?], R, t]
319 |
320 | def apply[A](c: AppendK[In1[H2, ?], R, A]): Out[A] = c match {
321 | case Aplk(In1(l)) => Aplk(In2r(l))
322 | case Aprk(r) => Aprk(r)
323 | }
324 |
325 | def single[A](ha: H1[A]): Out[A] = Aplk(In2l(ha))
326 |
327 | def nat[RR[_], A](out: AppendK[In2[H1, H2, ?], R, A], nat1: H1 ~> RR, nat2: AppendK[In1[H2, ?], R, ?] ~> RR): RR[A] = out match {
328 | case Aplk(In2l(h1)) => nat1(h1)
329 | case Aplk(In2r(h2)) => nat2(Aplk(In1(h2)))
330 | case Aprk(r) => nat2(Aprk(r))
331 | }
332 | }
333 |
334 | implicit def append2[H1[_], H2[_], H3[_], R[_] <: CopK[_], C[_] <: CopK[_]]: Aux[H1, AppendK[In2[H2, H3, ?], R, ?], AppendK[In3[H1, H2, H3, ?], R, ?]] =
335 | new PrependHK[H1, AppendK[In2[H2, H3, ?], R, ?]] {
336 | type Out[t] = AppendK[In3[H1, H2, H3, ?], R, t]
337 |
338 | def apply[A](c: AppendK[In2[H2, H3, ?], R, A]): Out[A] = c match {
339 | case Aplk(In2l(h2)) => Aplk(In3m(h2))
340 | case Aplk(In2r(h3)) => Aplk(In3r(h3))
341 | case Aprk(r) => Aprk(r)
342 | }
343 |
344 | def single[A](ha: H1[A]): Out[A] = Aplk(In3l(ha))
345 |
346 | def nat[RR[_], A](out: AppendK[In3[H1, H2, H3, ?], R, A], nat1: H1 ~> RR, nat2: AppendK[In2[H2, H3, ?], R, ?] ~> RR): RR[A] = out match {
347 | case Aplk(In3l(h1)) => nat1(h1)
348 | case Aplk(In3m(h2)) => nat2(Aplk(In2l(h2)))
349 | case Aplk(In3r(h3)) => nat2(Aplk(In2r(h3)))
350 | case Aprk(r) => nat2(Aprk(r))
351 | }
352 | }
353 |
354 | }
355 |
356 | trait PrependHKLower {
357 |
358 |
359 | implicit def append[H[_], L[_] <: CopK[_], R[_] <: CopK[_], C[_] <: CopK[_]]: PrependHK.Aux[H, AppendK[L, R, ?], AppendK[In1[H, ?], AppendK[L, R, ?], ?]] =
360 | new PrependHK[H, AppendK[L, R, ?]] {
361 | type Out[t] = AppendK[In1[H, ?], AppendK[L, R, ?], t]
362 |
363 | def apply[A](c: AppendK[L, R, A]): Out[A] = Aprk(c)
364 |
365 | def single[A](ha: H[A]): Out[A] = Aplk(In1(ha))
366 |
367 | def nat[RR[_], A](out: AppendK[In1[H, ?], AppendK[L, R, ?], A], nat1: H ~> RR, nat2: AppendK[L, R, ?] ~> RR): RR[A] = out match {
368 | case Aplk(In1(h)) => nat1(h)
369 | case Aprk(r) => nat2(r)
370 | }
371 | }
372 |
373 |
374 | }
375 |
376 |
377 | trait AppendHK[L[_] <: CopK[_], H[_]] {
378 | type Out[_] <: CopK[_]
379 |
380 | def apply[A](ha: L[A]): Out[A]
381 | def single[A](ha: H[A]): Out[A]
382 |
383 | def nat[R[_], A](out: Out[A], nat2: L ~> R, nat1: H ~> R): R[A]
384 | }
385 |
386 | object AppendHK extends AppendHKLower {
387 |
388 | def apply[L[_] <: CopK[_], H[_]]
389 | (implicit prep: AppendHK[L, H]): Aux[L, H, prep.Out] = prep
390 |
391 | type Aux[L[_] <: CopK[_], H[_], Out0[_] <: CopK[_]] = AppendHK[L, H] { type Out[t] = Out0[t] }
392 |
393 | implicit def in1[H1[_], H2[_]]: Aux[In1[H1, ?], H2, In2[H1, H2, ?]] =
394 | new AppendHK[In1[H1, ?], H2] {
395 | type Out[t] = In2[H1, H2, t]
396 |
397 | def apply[A](c: In1[H1, A]): Out[A] = In2l(c.head)
398 | def single[A](ha: H2[A]): Out[A] = In2r(ha)
399 |
400 | def nat[R[_], A](out: In2[H1, H2, A], nat1: In1[H1, ?] ~> R, nat2: H2 ~> R): R[A] = out match {
401 | case In2l(l) => nat1(In1(l))
402 | case In2r(r) => nat2(r)
403 | }
404 | }
405 |
406 | implicit def in2[H1[_], H2[_], H3[_]]: Aux[In2[H1, H2, ?], H3, In3[H1, H2, H3, ?]] =
407 | new AppendHK[In2[H1, H2, ?], H3] {
408 | type Out[t] = In3[H1, H2, H3, t]
409 |
410 | def apply[A](c: In2[H1, H2, A]): Out[A] = c match {
411 | case In2l(left) => In3l(left)
412 | case In2r(right) => In3m(right)
413 | }
414 |
415 | def single[A](ha: H3[A]): Out[A] = In3r(ha)
416 |
417 | def nat[R[_], A](out: In3[H1, H2, H3, A], nat1: In2[H1, H2, ?] ~> R, nat2: H3 ~> R): R[A] = out match {
418 | case In3l(l) => nat1(In2l(l))
419 | case In3m(m) => nat1(In2r(m))
420 | case In3r(r) => nat2(r)
421 | }
422 | }
423 |
424 | implicit def in3[H1[_], H2[_], H3[_], H4[_]]: Aux[In3[H1, H2, H3, ?], H4, AppendK[In3[H1, H2, H3, ?], In1[H4, ?], ?]] =
425 | new AppendHK[In3[H1, H2, H3, ?], H4] {
426 | type Out[t] = AppendK[In3[H1, H2, H3, ?], In1[H4, ?], t]
427 |
428 | def apply[A](c: In3[H1, H2, H3, A]): Out[A] = Aplk(c)
429 |
430 | def single[A](ha: H4[A]): Out[A] = Aprk(In1(ha))
431 |
432 | def nat[R[_], A](out: AppendK[In3[H1, H2, H3, ?], In1[H4, ?], A], nat1: In3[H1, H2, H3, ?] ~> R, nat2: H4 ~> R): R[A] = out match {
433 | case Aplk(m) => nat1(m)
434 | case Aprk(In1(l)) => nat2(l)
435 | }
436 | }
437 |
438 | implicit def append1[H1[_], H2[_], L[_] <: CopK[_]]: Aux[AppendK[L, In1[H1, ?], ?], H2, AppendK[L, In2[H1, H2, ?], ?]] =
439 | new AppendHK[AppendK[L, In1[H1, ?], ?], H2] {
440 | type Out[t] = AppendK[L, In2[H1, H2, ?], t]
441 |
442 | def apply[A](c: AppendK[L, In1[H1, ?], A]): Out[A] = c match {
443 | case Aplk(l) => Aplk(l)
444 | case Aprk(In1(r)) => Aprk(In2l(r))
445 | }
446 |
447 | def single[A](ha: H2[A]): Out[A] = Aprk(In2r(ha))
448 |
449 | def nat[RR[_], A](out: AppendK[L, In2[H1, H2, ?], A], nat1: AppendK[L, In1[H1, ?], ?] ~> RR, nat2: H2 ~> RR): RR[A] = out match {
450 | case Aplk(r) => nat1(Aplk(r))
451 | case Aprk(In2l(h1)) => nat1(Aprk(In1(h1)))
452 | case Aprk(In2r(h2)) => nat2(h2)
453 | }
454 | }
455 |
456 | implicit def append2[H1[_], H2[_], H3[_], L[_] <: CopK[_]]: Aux[AppendK[L, In2[H1, H2, ?], ?], H3, AppendK[L, In3[H1, H2, H3, ?], ?]] =
457 | new AppendHK[AppendK[L, In2[H1, H2, ?], ?], H3] {
458 | type Out[t] = AppendK[L, In3[H1, H2, H3, ?], t]
459 |
460 | def apply[A](c: AppendK[L, In2[H1, H2, ?], A]): Out[A] = c match {
461 | case Aplk(r) => Aplk(r)
462 | case Aprk(In2l(h1)) => Aprk(In3l(h1))
463 | case Aprk(In2r(h2)) => Aprk(In3m(h2))
464 | }
465 |
466 | def single[A](ha: H3[A]): Out[A] = Aprk(In3r(ha))
467 |
468 | def nat[RR[_], A](out: AppendK[L, In3[H1, H2, H3, ?], A], nat1: AppendK[L, In2[H1, H2, ?], ?] ~> RR, nat2: H3 ~> RR): RR[A] = out match {
469 | case Aplk(l) => nat1(Aplk(l))
470 | case Aprk(In3l(h1)) => nat1(Aprk(In2l(h1)))
471 | case Aprk(In3m(h2)) => nat1(Aprk(In2r(h2)))
472 | case Aprk(In3r(h3)) => nat2(h3)
473 | }
474 | }
475 |
476 | }
477 |
478 |
479 | trait AppendHKLower {
480 |
481 | implicit def append[H[_], L[_] <: CopK[_], R[_] <: CopK[_]]: AppendHK.Aux[AppendK[L, R, ?], H, AppendK[AppendK[L, R, ?], In1[H, ?], ?]] =
482 | new AppendHK[AppendK[L, R, ?], H] {
483 | type Out[t] = AppendK[AppendK[L, R, ?], In1[H, ?], t]
484 |
485 | def apply[A](c: AppendK[L, R, A]): Out[A] = Aplk(c)
486 |
487 | def single[A](ha: H[A]): Out[A] = Aprk(In1(ha))
488 |
489 | def nat[RR[_], A](out: AppendK[AppendK[L, R, ?], In1[H, ?], A], nat1: AppendK[L, R, ?] ~> RR, nat2: H ~> RR): RR[A] = out match {
490 | case Aplk(l) => nat1(l)
491 | case Aprk(In1(h)) => nat2(h)
492 | }
493 | }
494 |
495 |
496 | }
497 |
498 | trait Replace[C[_] <: CopK[_], F[_], G[_]] {
499 |
500 | type Out[_] <: CopK[_]
501 |
502 | def replace[A](c: C[A])(nat: F ~> G): Out[A]
503 |
504 | }
505 |
506 | object Replace extends ReplaceLower {
507 |
508 | type Aux[C[_] <: CopK[_], F[_], G[_], Out0[_] <: CopK[_]] = Replace[C, F, G] { type Out[t] = Out0[t] }
509 |
510 | implicit def in1[F[_], G[_]]: Replace.Aux[In1[F, ?], F, G, In1[G, ?]] = new Replace[In1[F, ?], F, G] {
511 | type Out[t] = In1[G, t]
512 |
513 | def replace[A](c: In1[F, A])(nat: F ~> G): In1[G, A] = In1(nat(c.head))
514 | }
515 |
516 | implicit def in2l[F[_], G[_], H[_]]: Replace.Aux[In2[F, G, ?], F, H, In2[H, G, ?]] = new Replace[In2[F, G, ?], F, H] {
517 | type Out[t] = In2[H, G, t]
518 |
519 | def replace[A](c: In2[F, G, A])(nat: F ~> H): In2[H, G, A] = c match {
520 | case In2l(l) => In2l(nat(l))
521 | case In2r(r) => In2r(r)
522 | }
523 | }
524 |
525 | implicit def in2r[F[_], G[_], H[_]]: Replace.Aux[In2[F, G, ?], G, H, In2[F, H, ?]] = new Replace[In2[F, G, ?], G, H] {
526 | type Out[t] = In2[F, H, t]
527 |
528 | def replace[A](c: In2[F, G, A])(nat: G ~> H): In2[F, H, A] = c match {
529 | case In2l(l) => In2l(l)
530 | case In2r(r) => In2r(nat(r))
531 | }
532 | }
533 |
534 | implicit def in3l[F[_], G[_], H[_], I[_]]: Replace.Aux[In3[F, G, H, ?], F, I, In3[I, G, H, ?]] = new Replace[In3[F, G, H, ?], F, I] {
535 | type Out[t] = In3[I, G, H, t]
536 |
537 | def replace[A](c: In3[F, G, H, A])(nat: F ~> I): In3[I, G, H, A] = c match {
538 | case In3l(l) => In3l(nat(l))
539 | case In3m(m) => In3m(m)
540 | case In3r(r) => In3r(r)
541 | }
542 | }
543 |
544 | implicit def in3m[F[_], G[_], H[_], I[_]]: Replace.Aux[In3[F, G, H, ?], G, I, In3[F, I, H, ?]] = new Replace[In3[F, G, H, ?], G, I] {
545 | type Out[t] = In3[F, I, H, t]
546 |
547 | def replace[A](c: In3[F, G, H, A])(nat: G ~> I): In3[F, I, H, A] = c match {
548 | case In3l(l) => In3l(l)
549 | case In3m(m) => In3m(nat(m))
550 | case In3r(r) => In3r(r)
551 | }
552 | }
553 |
554 | implicit def in3r[F[_], G[_], H[_], I[_]]: Replace.Aux[In3[F, G, H, ?], H, I, In3[F, G, I, ?]] = new Replace[In3[F, G, H, ?], H, I] {
555 | type Out[t] = In3[F, G, I, t]
556 |
557 | def replace[A](c: In3[F, G, H, A])(nat: H ~> I): In3[F, G, I, A] = c match {
558 | case In3l(l) => In3l(l)
559 | case In3m(m) => In3m(m)
560 | case In3r(r) => In3r(nat(r))
561 | }
562 | }
563 |
564 | implicit def appendl[L[_] <: CopK[_], R[_] <: CopK[_], F[_], G[_], O[_] <: CopK[_]](
565 | implicit rep: Replace.Aux[L, F, G, O]
566 | ): Replace.Aux[AppendK[L, R, ?], F, G, AppendK[O, R, ?]] = new Replace[AppendK[L, R, ?], F, G] {
567 | type Out[t] = AppendK[O, R, t]
568 |
569 | def replace[A](c: AppendK[L, R, A])(nat: F ~> G) = c match {
570 | case Aplk(l) => Aplk(rep.replace(l)(nat))
571 | case Aprk(r) => Aprk(r)
572 | }
573 | }
574 | }
575 |
576 | trait ReplaceLower {
577 |
578 | implicit def appendr[L[_] <: CopK[_], R[_] <: CopK[_], F[_], G[_], O[_] <: CopK[_]](
579 | implicit rep: Replace.Aux[R, F, G, O]
580 | ): Replace.Aux[AppendK[L, R, ?], F, G, AppendK[L, O, ?]] = new Replace[AppendK[L, R, ?], F, G] {
581 | type Out[t] = AppendK[L, O, t]
582 |
583 | def replace[A](c: AppendK[L, R, A])(nat: F ~> G) = c match {
584 | case Aplk(l) => Aplk(l)
585 | case Aprk(r) => Aprk(rep.replace(r)(nat))
586 | }
587 | }
588 | }
589 |
590 | trait Flattener[F[_] <: CopK[_], TC[_[_], _]] {
591 | type Out[_] <: CopK[_]
592 | def flatten[A](t: TC[F, A]): TC[Out, A]
593 | }
594 |
595 | object Flattener extends FlattenerLower{
596 | import cats.free.Free
597 |
598 | type Aux[F[_] <: CopK[_], TC[_[_], _], Out0[_] <: CopK[_]] = Flattener[F, TC] { type Out[t] = Out0[t] }
599 |
600 | implicit def in1[F[_] <: CopK[_]]: Flattener.Aux[In1[Free[F, ?], ?], Free, F] =
601 | new Flattener[In1[Free[F, ?], ?], Free] {
602 | type Out[t] = F[t]
603 |
604 | def flatten[A](tca: Free[In1[Free[F, ?], ?], A]): Free[F, A] =
605 | tca.foldMap(new (In1[Free[F, ?], ?] ~> Free[F, ?]) {
606 | def apply[A](in: In1[Free[F, ?], A]): Free[F, A] = in match {
607 | case In1(free) => free
608 | }
609 | })
610 | }
611 |
612 | implicit def in2Left[F[_] <: CopK[_], R[_], O[_] <: CopK[_]](
613 | implicit ap: AppendHK.Aux[F, R, O]
614 | ): Flattener.Aux[In2[Free[F, ?], R, ?], Free, O] =
615 | new Flattener[In2[Free[F, ?], R, ?], Free] {
616 | type Out[t] = O[t]
617 |
618 | def flatten[A](tca: Free[In2[Free[F, ?], R, ?], A]): Free[O, A] =
619 | tca.foldMap(new (In2[Free[F, ?], R, ?] ~> Free[O, ?]) {
620 | def apply[A](in: In2[Free[F, ?], R, A]): Free[O, A] = in match {
621 | case In2l(free) => free.compile(new (F ~> O) {
622 | def apply[A](fa: F[A]): O[A] = ap(fa)
623 | })
624 |
625 | case In2r(r) => Free.liftF(ap.single(r))
626 | }
627 | })
628 | }
629 |
630 | implicit def in3Left[F[_] <: CopK[_], M[_], R[_], O1[_] <: CopK[_], O2[_] <: CopK[_]](
631 | implicit ap1: AppendHK.Aux[F, M, O1]
632 | , ap2: AppendHK.Aux[O1, R, O2]
633 | ): Flattener.Aux[In3[Free[F, ?], M, R, ?], Free, O2] =
634 | new Flattener[In3[Free[F, ?], M, R, ?], Free] {
635 | type Out[t] = O2[t]
636 |
637 | def flatten[A](tca: Free[In3[Free[F, ?], M, R, ?], A]): Free[O2, A] =
638 | tca.foldMap(new (In3[Free[F, ?], M, R, ?] ~> Free[O2, ?]) {
639 | def apply[A](in: In3[Free[F, ?], M, R, A]): Free[O2, A] = in match {
640 | case In3l(free) => free.compile(new (F ~> O2) {
641 | def apply[A](fa: F[A]): O2[A] = ap2(ap1(fa))
642 | })
643 |
644 | case In3m(m) => Free.liftF(ap2(ap1.single(m)))
645 |
646 | case In3r(r) => Free.liftF(ap2.single(r))
647 | }
648 | })
649 | }
650 |
651 | }
652 |
653 | trait FlattenerLower extends FlattenerLower2 {
654 | import cats.free.Free
655 |
656 | implicit def in2Right[F[_] <: CopK[_], L[_], O[_] <: CopK[_]](
657 | implicit pr: PrependHK.Aux[L, F, O]
658 | ): Flattener.Aux[In2[L, Free[F, ?], ?], Free, O] =
659 | new Flattener[In2[L, Free[F, ?], ?], Free] {
660 | type Out[t] = O[t]
661 |
662 | def flatten[A](tca: Free[In2[L, Free[F, ?], ?], A]): Free[O, A] =
663 | tca.foldMap(new (In2[L, Free[F, ?], ?] ~> Free[O, ?]) {
664 | def apply[A](in: In2[L, Free[F, ?], A]): Free[O, A] = in match {
665 | case In2l(l) => Free.liftF(pr.single(l))
666 |
667 | case In2r(free) => free.compile(new (F ~> O) {
668 | def apply[A](fa: F[A]): O[A] = pr(fa)
669 | })
670 | }
671 | })
672 | }
673 |
674 | implicit def in3Middle[F[_] <: CopK[_], L[_], R[_], O1[_] <: CopK[_], O2[_] <: CopK[_]](
675 | implicit pr: PrependHK.Aux[L, F, O1]
676 | , ap: AppendHK.Aux[O1, R, O2]
677 | ): Flattener.Aux[In3[L, Free[F, ?], R, ?], Free, O2] =
678 | new Flattener[In3[L, Free[F, ?], R, ?], Free] {
679 | type Out[t] = O2[t]
680 |
681 | def flatten[A](tca: Free[In3[L, Free[F, ?], R, ?], A]): Free[O2, A] =
682 | tca.foldMap(new (In3[L, Free[F, ?], R, ?] ~> Free[O2, ?]) {
683 | def apply[A](in: In3[L, Free[F, ?], R, A]): Free[O2, A] = in match {
684 | case In3l(l) => Free.liftF(ap(pr.single(l)))
685 |
686 | case In3m(free) => free.compile(new (F ~> O2) {
687 | def apply[A](fa: F[A]): O2[A] = ap(pr(fa))
688 | })
689 |
690 | case In3r(r) => Free.liftF(ap.single(r))
691 | }
692 | })
693 | }
694 |
695 |
696 | implicit def apkLeft[F[_] <: CopK[_], L[_] <: CopK[_], R[_] <: CopK[_], O[_] <: CopK[_]](
697 | implicit flt: Flattener.Aux[L, Free, O]
698 | ): Flattener.Aux[AppendK[L, R, ?], Free, AppendK[O, R, ?]] = new Flattener[AppendK[L, R, ?], Free] {
699 | type Out[t] = AppendK[O, R, t]
700 |
701 | def flatten[A](tca: Free[AppendK[L, R, ?], A]): Free[AppendK[O, R, ?], A] =
702 |
703 | tca.foldMap(new (AppendK[L, R, ?] ~> Free[AppendK[O, R, ?], ?]) {
704 | def apply[A](in: AppendK[L, R, A]): Free[AppendK[O, R, ?], A] = in match {
705 | case Aplk(l) =>
706 | val free = Free.liftF(l)
707 | flt.flatten(free).compile(new (O ~> AppendK[O, R, ?]) {
708 | def apply[A](oa: O[A]): AppendK[O, R, A] = Aplk(oa)
709 | })
710 |
711 | case Aprk(r) => Free.liftF(Aprk(r))
712 | }
713 | })
714 | }
715 |
716 | }
717 |
718 | trait FlattenerLower2 {
719 | import cats.free.Free
720 |
721 | implicit def in3Right[F[_] <: CopK[_], L[_], M[_], O1[_] <: CopK[_], O2[_] <: CopK[_]](
722 | implicit pr1: PrependHK.Aux[M, F, O1]
723 | , pr2: PrependHK.Aux[L, O1, O2]
724 | ): Flattener.Aux[In3[L, M, Free[F, ?], ?], Free, O2] =
725 | new Flattener[In3[L, M, Free[F, ?], ?], Free] {
726 | type Out[t] = O2[t]
727 |
728 | def flatten[A](tca: Free[In3[L, M, Free[F, ?], ?], A]): Free[O2, A] =
729 | tca.foldMap(new (In3[L, M, Free[F, ?], ?] ~> Free[O2, ?]) {
730 | def apply[A](in: In3[L, M, Free[F, ?], A]): Free[O2, A] = in match {
731 | case In3l(l) => Free.liftF(pr2.single(l))
732 |
733 | case In3m(m) => Free.liftF(pr2(pr1.single(m)))
734 |
735 | case In3r(free) => free.compile(new (F ~> O2) {
736 | def apply[A](fa: F[A]): O2[A] = pr2(pr1(fa))
737 | })
738 |
739 | }
740 | })
741 | }
742 |
743 |
744 | implicit def ApkRight[F[_] <: CopK[_], L[_] <: CopK[_], R[_] <: CopK[_], O[_] <: CopK[_]](
745 | implicit flt: Flattener.Aux[R, Free, O]
746 | ): Flattener.Aux[AppendK[L, R, ?], Free, AppendK[L, O, ?]] = new Flattener[AppendK[L, R, ?], Free] {
747 | type Out[t] = AppendK[L, O, t]
748 |
749 | def flatten[A](tca: Free[AppendK[L, R, ?], A]): Free[AppendK[L, O, ?], A] =
750 |
751 | tca.foldMap(new (AppendK[L, R, ?] ~> Free[AppendK[L, O, ?], ?]) {
752 | def apply[A](in: AppendK[L, R, A]): Free[AppendK[L, O, ?], A] = in match {
753 | case Aplk(l) =>
754 | Free.liftF(Aplk(l))
755 |
756 | case Aprk(r) =>
757 | val free = Free.liftF(r)
758 | flt.flatten(free).compile(new (O ~> AppendK[L, O, ?]) {
759 | def apply[A](oa: O[A]): AppendK[L, O, A] = Aprk(oa)
760 | })
761 |
762 | }
763 | })
764 | }
765 | }
766 |
767 | // object CopAppend extends CopAppendLower {
768 |
769 | // def apply[L[_] <: CopK[_], R[_] <: CopK[_]](implicit copAppend: CopAppend[L, R]): CopAppend[L, R] = copAppend
770 |
771 | // type Aux[L[_] <: CopK[_], R[_] <: CopK[_], Out0[_] <: CopK[_]] = CopAppend[L, R] {
772 | // type Out[t] = Out0[t]
773 | // }
774 |
775 | // implicit def nil[H1[_], H2[_], R2[_] <: CopK[_]]: CopAppend.Aux[AppendK[In1[H1, ?], CNilK, ?], AppendK[In1[H2, ?], R2, ?], AppendK[In1[H1, ?], AppendK[In1[H2, ?], R2, ?], ?]] =
776 | // new CopAppend[AppendK[In1[H1, ?], CNilK, ?], AppendK[In1[H2, ?], R2, ?]] {
777 | // type Out[t] = AppendK[In1[H1, ?], AppendK[In1[H2, ?], R2, ?], t]
778 |
779 | // def left[A](l: AppendK[In1[H1, ?], CNilK, A]): Out[A] = l match {
780 | // case Aplk(in1) => Aplk(in1)
781 | // case Aprk(_) => throw new RuntimeException("impossible case")
782 | // }
783 |
784 | // def right[A](l: AppendK[In1[H2, ?], R2, A]): Out[A] = l match {
785 | // case Aplk(in2) => Aprk(Aplk(in2))
786 | // case Aprk(r2) => Aprk(Aprk(r2))
787 | // }
788 |
789 | // def extract[A](o: Out[A]): Xor[AppendK[In1[H1, ?], CNilK, A], AppendK[In1[H2, ?], R2, A]] = o match {
790 | // case Aplk(In1(h1)) => Xor.left(Aplk(In1(h1)))
791 | // case Aprk(Aplk(In1(h2))) => Xor.right(Aplk(In1(h2)))
792 | // case Aprk(Aprk(r2)) => Xor.right(Aprk(r2))
793 | // case _ => throw new RuntimeException("impossible case")
794 | // }
795 | // }
796 | // }
797 |
798 | // trait CopAppendLower {
799 | // implicit def rec[H1[_], R1[_] <: CopK[_], R2[_] <: CopK[_], O[_] <: CopK[_]](
800 | // implicit next: CopAppend.Aux[R1, R2, O]
801 | // ): CopAppend.Aux[AppendK[In1[H1, ?], R1, ?], R2, AppendK[In1[H1, ?], O, ?]] =
802 | // new CopAppend[AppendK[In1[H1, ?], R1, ?], R2] {
803 | // type Out[t] = AppendK[In1[H1, ?], O, t]
804 |
805 | // def left[A](l: AppendK[In1[H1, ?], R1, A]): Out[A] = l match {
806 | // case Aplk(in1) => Aplk(in1)
807 | // case Aprk(r1) => Aprk(next.left(r1))
808 | // }
809 |
810 | // def right[A](r2: R2[A]): Out[A] = Aprk(next.right(r2))
811 |
812 | // def extract[A](o: Out[A]): Xor[AppendK[In1[H1, ?], R1, A], R2[A]] = o match {
813 | // case Aplk(In1(h1)) => Xor.left(Aplk(In1(h1)))
814 | // case Aprk(o) => next.extract(o) match {
815 | // case Xor.Left(r1) => Xor.left(Aprk(r1))
816 | // case Xor.Right(r2) => Xor.right(r2)
817 | // }
818 | // }
819 | // }
820 | // }
821 |
822 | // trait CopIso[L[_] <: CopK[_], R[_] <: CopK[_]] {
823 | // def to[A](l: L[A]): R[A]
824 | // def from[A](r: R[A]): L[A]
825 | // }
826 |
827 | // object CopIso extends CopIsoLower {
828 |
829 | // def apply[L[_] <: CopK[_], R[_] <: CopK[_]](implicit copIso: CopIso[L, R]): CopIso[L, R] = copIso
830 |
831 | // implicit def in1[H[_]] = new CopIso[In1[H, ?], AppendK[In1[H, ?], CNilK, ?]] {
832 | // def to[A](l: In1[H, A]): AppendK[In1[H, ?], CNilK, A] = Aplk(l)
833 | // def from[A](r: AppendK[In1[H, ?], CNilK, A]): In1[H, A] = r match {
834 | // case Aplk(l) => l
835 | // case Aprk(_) => throw new RuntimeException("impossible case")
836 | // }
837 | // }
838 |
839 | // implicit def in2[H1[_], H2[_]] = new CopIso[In2[H1, H2, ?], AppendK[In1[H1, ?], AppendK[In1[H2, ?], CNilK, ?], ?]] {
840 | // def to[A](l: In2[H1, H2, A]): AppendK[In1[H1, ?], AppendK[In1[H2, ?], CNilK, ?], A] = l match {
841 | // case In2l(l) => Aplk(In1(l))
842 | // case In2r(r) => Aprk(Aplk(In1(r)))
843 | // }
844 | // def from[A](r: AppendK[In1[H1, ?], AppendK[In1[H2, ?], CNilK, ?], A]): In2[H1, H2, A] = r match {
845 | // case Aplk(In1(l)) => In2l(l)
846 | // case Aprk(Aplk(In1(r))) => In2r(r)
847 | // case _ => throw new RuntimeException("impossible case")
848 | // }
849 | // }
850 |
851 | // implicit def in3[H1[_], H2[_], H3[_]] = new CopIso[In3[H1, H2, H3, ?], AppendK[In1[H1, ?], AppendK[In1[H2, ?], AppendK[In1[H3, ?], CNilK, ?], ?], ?]] {
852 | // def to[A](l: In3[H1, H2, H3, A]): AppendK[In1[H1, ?], AppendK[In1[H2, ?], AppendK[In1[H3, ?], CNilK, ?], ?], A] = l match {
853 | // case In3l(l) => Aplk(In1(l))
854 | // case In3m(m) => Aprk(Aplk(In1(m)))
855 | // case In3r(r) => Aprk(Aprk(Aplk(In1(r))))
856 | // }
857 | // def from[A](r: AppendK[In1[H1, ?], AppendK[In1[H2, ?], AppendK[In1[H3, ?], CNilK, ?], ?], A]): In3[H1, H2, H3, A] = r match {
858 | // case Aplk(In1(l)) => In3l(l)
859 | // case Aprk(Aplk(In1(m))) => In3m(m)
860 | // case Aprk(Aprk(Aplk(In1(r)))) => In3r(r)
861 | // case _ => throw new RuntimeException("impossible case")
862 | // }
863 | // }
864 |
865 | // }
866 |
867 | // trait CopIsoLower {
868 | // implicit def rec[L[_] <: CopK[_], R[_] <: CopK[_], OL[_] <: CopK[_], OR[_] <: CopK[_], O[_] <: CopK[_]](
869 | // implicit
870 | // leftIso: CopIso[L, OL]
871 | // , rightIso: CopIso[R, OR]
872 | // , ap: CopAppend.Aux[OL, OR, O]
873 | // ) = new CopIso[AppendK[L, R, ?], O] {
874 |
875 | // def to[A](l: AppendK[L, R, A]): O[A] = l match {
876 | // case Aplk(l) => ap.left(leftIso.to(l))
877 | // case Aprk(r) => ap.right(rightIso.to(r))
878 | // }
879 | // def from[A](o: O[A]): AppendK[L, R, A] = ap.extract(o) match {
880 | // case Xor.Left(l) => Aplk(leftIso.from(l))
881 | // case Xor.Right(r) => Aprk(rightIso.from(r))
882 | // }
883 | // }
884 | // }
885 |
886 | // trait CopAppend[L[_] <: CopK[_], R[_] <: CopK[_]] {
887 | // type Out[_] <: CopK[_]
888 |
889 | // def left[A](l: L[A]): Out[A]
890 | // def right[A](l: R[A]): Out[A]
891 | // def extract[A](o: Out[A]): Xor[L[A], R[A]]
892 | // }
893 |
894 | // trait MergeOneRightHK[L[_] <: CopK[_], H[_]] {
895 | // type Out[_] <: CopK[_]
896 |
897 | // def apply[A](ha: L[A]): Out[A]
898 | // def single[A](ha: H[A]): Out[A]
899 | // }
900 |
901 | // object MergeOneRightHK extends LowerMergeOneRightHK {
902 |
903 | // def apply[L[_] <: CopK[_], H[_]]
904 | // (implicit mergeOneRightHK: MergeOneRightHK[L, H]): Aux[L, H, mergeOneRightHK.Out] = mergeOneRightHK
905 |
906 | // type Aux[L[_] <: CopK[_], H[_], Out0[_] <: CopK[_]] = MergeOneRightHK[L, H] { type Out[t] = Out0[t] }
907 |
908 | // implicit def singleton[H[_], G[_]]: Aux[ConsK[H, CNilK, ?], G, ConsK[H, ConsK[G, CNilK, ?], ?]] =
909 | // new MergeOneRightHK[ConsK[H, CNilK, ?], G] {
910 | // type Out[t] = ConsK[H, ConsK[G, CNilK, ?], t]
911 |
912 | // def apply[A](c: ConsK[H, CNilK, A]): Out[A] = c match {
913 | // case Inlk(h) => Inlk(h)
914 | // case Inrk(t) => Inrk(Inrk(t))
915 | // }
916 |
917 | // def single[A](ga: G[A]): Out[A] = Inrk(Inlk(ga))
918 | // }
919 |
920 | // }
921 |
922 | // trait LowerMergeOneRightHK extends LowerMergeOneRightHK2 {
923 |
924 | // implicit def contains[H[_], T[_] <: CopK[_]]
925 | // (implicit
926 | // contains: ContainsHK[T, H]
927 | // ): MergeOneRightHK.Aux[T, H, T] =
928 | // new MergeOneRightHK[T, H] {
929 | // type Out[t] = T[t]
930 |
931 | // def apply[A](c: T[A]): Out[A] = c
932 |
933 | // def single[A](ha: H[A]): Out[A] = contains.build(ha)
934 | // }
935 |
936 | // }
937 |
938 | // trait LowerMergeOneRightHK2 {
939 | // implicit def corec[H[_], K[_], T[_] <: CopK[_], T2[_] <: CopK[_]]
940 | // (implicit next: MergeOneRightHK.Aux[T, H, T2]): MergeOneRightHK.Aux[ConsK[K, T, ?], H, ConsK[K, T2, ?]] =
941 | // new MergeOneRightHK[ConsK[K, T, ?], H] {
942 | // type Out[t] = ConsK[K, T2, t]
943 |
944 | // def apply[A](c: ConsK[K, T, A]): Out[A] = c match {
945 | // case Inlk(h) => Inlk(h)
946 | // case Inrk(t) => Inrk(next(t))
947 | // }
948 |
949 | // def single[A](ha: H[A]): Out[A] = Inrk(next.single(ha))
950 | // }
951 | // }
952 |
953 | // trait MergeCopHK[L[_] <: CopK[_], R[_] <: CopK[_]] {
954 | // type Out[_] <: CopK[_]
955 |
956 | // def fromLeft[A](la: L[A]): Out[A]
957 |
958 | // def fromRight[A](ra: R[A]): Out[A]
959 | // }
960 |
961 |
962 | // object MergeCopHK extends LowerMergeCopHK {
963 |
964 | // def apply[L[_] <: CopK[_], R[_] <: CopK[_]]
965 | // (implicit mergeCopHK: MergeCopHK[L, R]): Aux[L, R, mergeCopHK.Out] = mergeCopHK
966 |
967 | // type Aux[L[_] <: CopK[_], R[_] <: CopK[_], Out0[_] <: CopK[_]] = MergeCopHK[L, R] { type Out[t] = Out0[t] }
968 |
969 | // implicit def one[L[_] <: CopK[_], H[_], LH[_] <: CopK[_]](
970 | // implicit mergeOne: MergeOneRightHK.Aux[L, H, LH]
971 | // ): Aux[L, ConsK[H, CNilK, ?], LH] =
972 | // new MergeCopHK[L, ConsK[H, CNilK, ?]] {
973 | // type Out[t] = LH[t]
974 |
975 | // def fromLeft[A](la: L[A]): Out[A] = mergeOne(la)
976 |
977 | // def fromRight[A](ra: ConsK[H, CNilK, A]): Out[A] = ra match {
978 | // case Inlk(ha) => mergeOne.single(ha)
979 | // case Inrk(_) => throw new RuntimeException("impossible case")
980 | // }
981 | // }
982 | // }
983 |
984 | // trait LowerMergeCopHK {
985 | // implicit def corec[L[_] <: CopK[_], H[_], LH[_] <: CopK[_], T[_] <: CopK[_], T2[_] <: CopK[_]](
986 | // implicit mergeOne: MergeOneRightHK.Aux[L, H, LH], next: MergeCopHK.Aux[LH, T, T2]
987 | // ): MergeCopHK.Aux[L, ConsK[H, T, ?], T2] =
988 | // new MergeCopHK[L, ConsK[H, T, ?]] {
989 | // type Out[t] = T2[t]
990 |
991 | // def fromLeft[A](la: L[A]): Out[A] = next.fromLeft(mergeOne(la))
992 | // def fromRight[A](ra: ConsK[H, T, A]): Out[A] = ra match {
993 | // case Inlk(ha) => next.fromLeft(mergeOne.single(ha))
994 | // case Inrk(ta) => next.fromRight(ta)
995 | // }
996 | // }
997 | // }
998 |
999 |
1000 |
1001 | /*trait ContainsHKLub[L[_] <: CopK[_], H[_]] extends Serializable {
1002 | type R[_] <: CopK[_]
1003 |
1004 | type Lub[_]
1005 |
1006 | def extract[A](la: L[A]): Option[Lub[A]]
1007 | def build[A](ha: H[A]): L[A]
1008 | }
1009 |
1010 |
1011 | object ContainsHKLub extends LowerContainsHKLub {
1012 |
1013 | type Aux[L[_] <: CopK[_], H[_], R0[_] <: CopK[_], Lub0[_]] =
1014 | ContainsHKLub[L, H] { type R[t] = R0[t]; type Lub[t] = Lub0[t] }
1015 |
1016 | def apply[L[_] <: CopK[_], H[_]]
1017 | (implicit containsHK: ContainsHKLub[L, H]): Aux[L, H, containsHK.R, containsHK.Lub] = containsHK
1018 |
1019 | implicit def head[H[_], K[_], L[_] <: CopK[_]](
1020 | implicit ev: H[_] <:< K[_]
1021 | ): ContainsHKLub.Aux[ConsK[K, L, ?], H, L, K] =
1022 | new ContainsHKLub[ConsK[K, L, ?], H] {
1023 | type R[t] = L[t]
1024 | type Lub[t] = K[t]
1025 |
1026 | def extract[A](la: ConsK[K, L, A]): Option[K[A]] = la match {
1027 | case Inlk(h) => Some(h)
1028 | case Inrk(_) => None
1029 | }
1030 |
1031 | def build[A](ha: H[A]): ConsK[K, L, A] = Inlk(ha.asInstanceOf[K[A]])
1032 | }
1033 |
1034 | }
1035 |
1036 |
1037 | trait LowerContainsHKLub {
1038 |
1039 | implicit def corec[H[_], K[_], L[_] <: CopK[_], RT[_] <: CopK[_], RTLub[_]](
1040 | implicit next: ContainsHKLub.Aux[L, H, RT, RTLub]
1041 | ): ContainsHKLub.Aux[ConsK[K, L, ?], H, ConsK[K, RT, ?], RTLub] =
1042 | new ContainsHKLub[ConsK[K, L, ?], H] {
1043 | type R[t] = ConsK[K, RT, t]
1044 | type Lub[t] = RTLub[t]
1045 |
1046 | def extract[A](la: ConsK[K, L, A]): Option[RTLub[A]] = la match {
1047 | case Inlk(h) => None
1048 | case Inrk(r) => next.extract(r)
1049 | }
1050 |
1051 | def build[A](ha: H[A]): ConsK[K, L, A] = Inrk(next.build(ha))
1052 | }
1053 | }*/
1054 |
1055 |
1056 |
1057 |
--------------------------------------------------------------------------------
/src/main/scala/CopKNat.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.~>
4 |
5 |
6 | trait CopKNat[C[_] <: CopK[_]] {
7 |
8 | def replace[F[_], G[_], D[_] <: CopK[_]](nat: F ~> G)(
9 | implicit replaceF: Replace.Aux[C, F, G, D]
10 | ): C ~> D = new (C ~> D) {
11 | def apply[A](ca: C[A]): D[A] = replaceF.replace(ca)(nat)
12 | }
13 |
14 | }
15 |
16 | object CopKNat {
17 | def apply[C[_] <: CopK[_]] = new CopKNat[C] {}
18 | }
--------------------------------------------------------------------------------
/src/main/scala/DSL.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | /** a type helper to build Coproduct of effects F[_] with a clean syntax
4 | *
5 | * NilDSL is equivalent to higher-kinded CNil
6 | * to build the equivalent of [t => F[t] :+: G[t] :+: CNilk[t]], use following syntax
7 | *
8 | */
9 | sealed trait DSL
10 |
11 | final class :|:[H[_], T <: DSL] extends DSL
12 |
13 | final class :||:[T1 <: DSL, T2 <: DSL] extends DSL
14 |
15 | trait NilDSL extends DSL
16 | case object NilDSL extends NilDSL
17 |
18 | object DSL {
19 | class Make[DSL0 <: DSL, C[_] <: CopK[_]] {
20 | type Cop[t] = C[t]
21 | type DSL = DSL0
22 | }
23 |
24 | object Make {
25 | def apply[DSL0 <: DSL](implicit toCop: ToCopK[DSL0]) = new Make[DSL0, toCop.Cop] {}
26 | }
27 | }
28 |
29 | trait ToCopK[F <: DSL] {
30 | type Cop[_] <: CopK[_]
31 | }
32 |
33 | object ToCopK extends LowerToCopK {
34 |
35 | def apply[F <: DSL](implicit toCopK: ToCopK[F]) = toCopK
36 |
37 | type Aux[F <: DSL, C[_] <: CopK[_]] = ToCopK[F] {
38 | type Cop[t] = C[t]
39 | }
40 |
41 | implicit val NilDSL: ToCopK.Aux[NilDSL, CNilK] = new ToCopK[NilDSL] {
42 | type Cop[t] = CNilK[t]
43 | }
44 |
45 | implicit def one[H[_]]: ToCopK.Aux[:|:[H, NilDSL], In1[H, ?]] =
46 | new ToCopK[:|:[H, NilDSL]] {
47 | type Cop[t] = In1[H, t]
48 | }
49 |
50 | implicit def two[H[_], H2[_]]: ToCopK.Aux[:|:[H, :|:[H2, NilDSL]], In2[H, H2, ?]] =
51 | new ToCopK[:|:[H, :|:[H2, NilDSL]]] {
52 | type Cop[t] = In2[H, H2, t]
53 | }
54 |
55 | implicit def three[H[_], H2[_], H3[_]]: ToCopK.Aux[:|:[H, :|:[H2, :|:[H3, NilDSL]]], In3[H, H2, H3, ?]] =
56 | new ToCopK[:|:[H, :|:[H2, :|:[H3, NilDSL]]]] {
57 | type Cop[t] = In3[H, H2, H3, t]
58 | }
59 |
60 | }
61 |
62 | trait LowerToCopK {
63 |
64 | implicit def rec[H[_], T <: DSL, C[_] <: CopK[_], O[_] <: CopK[_]](
65 | implicit
66 | next: ToCopK.Aux[T, C]
67 | , prep: PrependHK.Aux[H, C, O]
68 | ): ToCopK.Aux[:|:[H, T], O] =
69 | new ToCopK[:|:[H, T]] {
70 | type Cop[t] = O[t]
71 | }
72 |
73 | implicit def merge[T1 <: DSL, T2 <: DSL, C1[_] <: CopK[_], C2[_] <: CopK[_]](
74 | implicit
75 | toCopK1: ToCopK.Aux[T1, C1]
76 | , toCopK2: ToCopK.Aux[T2, C2]
77 | ): ToCopK.Aux[:||:[T1, T2], AppendK[C1, C2, ?]] =
78 | new ToCopK[:||:[T1, T2]] {
79 | type Cop[t] = AppendK[C1, C2, t]
80 | }
81 |
82 | }
83 |
84 | trait SubDSL[C[_] <: CopK[_], F <: DSL] {
85 | type Cop[_] <: CopK[_]
86 |
87 | val sub: SubCop[C, Cop]
88 | }
89 |
90 | object SubDSL {
91 |
92 | def apply[C[_] <: CopK[_], F <: DSL](implicit subDSLDSL: SubDSL[C, F]) = subDSLDSL
93 |
94 | implicit def subDSL[C[_] <: CopK[_], F <: DSL, FC[_] <: CopK[_]](
95 | implicit
96 | toCopK: ToCopK.Aux[F, FC]
97 | , sub0: SubCop[C, FC]
98 | ) = new SubDSL[C, F] {
99 | type Cop[t] = FC[t]
100 | val sub = sub0
101 | }
102 |
103 | }
104 |
105 | trait SubDSL1[F[_], DSL0 <: DSL] {
106 | type Cop[_] <: CopK[_]
107 |
108 | val sub: SubCop[In1[F, ?], Cop]
109 | }
110 |
111 | object SubDSL1 {
112 |
113 | def apply[F[_], DSL0 <: DSL](implicit subdsl: SubDSL1[F, DSL0]) = subdsl
114 |
115 | implicit def subDSL1[F[_], DSL0 <: DSL, FC[_] <: CopK[_]](
116 | implicit
117 | toCopK: ToCopK.Aux[DSL0, FC]
118 | , sub0: SubCop[In1[F, ?], FC]
119 | ) = new SubDSL1[F, DSL0] {
120 | type Cop[t] = FC[t]
121 | val sub = sub0
122 | }
123 |
124 | }
125 |
126 |
--------------------------------------------------------------------------------
/src/main/scala/Freek.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.free.Free
4 | import cats.{Functor, ~>, Monad}
5 |
6 |
7 | /** Just some helpers to enhance Free with CopK */
8 | object Freek {
9 |
10 | def apply[F[_], A](fa: F[A]): Free[In1[F, ?], A] = {
11 | Free.liftF(In1(fa))
12 | }
13 |
14 | def expand[F[_] <: CopK[_], Super[_] <: CopK[_], A](free: Free[F, A])(
15 | implicit sub: SubCop[F, Super]
16 | ): Free[Super, A] = free.compile(
17 | new (F ~> Super) {
18 | def apply[A](ga: F[A]): Super[A] = sub(ga)
19 | }
20 | )
21 |
22 | // def flatten[F[_] <: CopK[_]](free: Free[F, A])(
23 | // implicit flt: Flattener[F]
24 | // ): Free[flt.Out, A]
25 |
26 | }
27 |
--------------------------------------------------------------------------------
/src/main/scala/Freekit.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import scala.reflect.macros.{ blackbox, whitebox }
4 | import scala.reflect.macros.Context
5 | import scala.language.experimental.macros
6 | import scala.annotation.StaticAnnotation
7 | import scala.annotation.compileTimeOnly
8 |
9 | import cats.free.Free
10 |
11 | import scala.language.implicitConversions
12 |
13 |
14 | class Freekit[DSL0 <: DSL, C0[_] <: CopK[_]](val PRG: DSL.Make[DSL0, C0]) {
15 | type PRG = PRG.DSL
16 | type Cop[t] = PRG.Cop[t]
17 |
18 | implicit def liftFA[F[_], A](fa: F[A])(
19 | implicit sub0: SubCop[In1[F, ?], Cop]
20 | ): Free[Cop, A] = {
21 | Freek.expand[In1[F, ?], Cop, A](Freek(fa))(sub0)
22 | }
23 |
24 | }
25 |
26 | class Freekito[DSL0 <: DSL, C0[_] <: CopK[_]](val PRG: DSL.Make[DSL0, C0]) {
27 |
28 | type PRG = PRG.DSL
29 | type Cop[t] = PRG.Cop[t]
30 | type O <: Onion
31 |
32 | implicit def liftFGHA[F[_], G[_], HA, A](fga: F[G[HA]])(
33 | implicit
34 | ga: HKK.Aux[G[HA], A]
35 | , sub0: SubCop[In1[F, ?], PRG.Cop]
36 | , lifter2: Lifter2.Aux[G[HA], O, A]
37 | , pointer: Pointer[O]
38 | , mapper: Mapper[O]
39 | , binder: Binder[O]
40 | , traverser: Traverser[O]
41 | ): OnionT[Free, PRG.Cop, O, A] =
42 | OnionT.liftTHK(Freek.expand[In1[F, ?], PRG.Cop, G[HA]](Freek(fga))(sub0))
43 |
44 | implicit def liftFA[F[_], A](fa: F[A])(
45 | implicit
46 | sub0: SubCop[In1[F, ?], PRG.Cop]
47 | , pointer: Pointer[O]
48 | , mapper: Mapper[O]
49 | , binder: Binder[O]
50 | , traverser: Traverser[O]
51 | ): OnionT[Free, PRG.Cop, O, A] =
52 | toOnionT0(
53 | Freek.expand[In1[F, ?], PRG.Cop, A](Freek(fa))(sub0)
54 | ).onionT[O]
55 |
56 | }
57 |
58 |
59 |
--------------------------------------------------------------------------------
/src/main/scala/HasHoist.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import scala.language.higherKinds
4 |
5 | import cats.data.{ OptionT, EitherT }
6 | import cats.Functor
7 | import cats.free._
8 |
9 |
10 | trait HasHoist[M[_]] {
11 | type T[_[_], _]
12 | def liftT[F[_], A](f: F[M[A]]): T[F, A]
13 | def liftF[F[_] : Functor, A](f: F[A]): T[F, A]
14 | }
15 |
16 | class EitherHasHoist[A] extends HasHoist[λ[t => Either[A, t]]] {
17 | type T[F[_], B] = EitherT[F, A, B]
18 | def liftT[F[_], B](f: F[Either[A, B]]): EitherT[F, A, B] = EitherT.apply(f)
19 | def liftF[F[_] : Functor, B](f: F[B]): EitherT[F, A, B] = EitherT.right(f)
20 | }
21 |
22 | object HasHoist {
23 | type Aux[M[_], T0[_[_], _]] = HasHoist[M] { type T[F[_], A] = T0[F, A] }
24 |
25 | def apply[M[_]](implicit h: HasHoist[M]): Aux[M, h.T] = h
26 |
27 | implicit val optionHasHoist: HasHoist.Aux[Option, OptionT] = new HasHoist[Option] {
28 | type T[F[_], A] = OptionT[F, A]
29 | def liftT[F[_], A](f: F[Option[A]]): OptionT[F, A] = OptionT(f)
30 | def liftF[F[_] : Functor, B](f: F[B]): OptionT[F, B] = OptionT.liftF(f)
31 | }
32 |
33 | implicit def eitherHasHoist[A]: HasHoist.Aux[λ[t => Either[A, t]], λ[(f[_], b) => EitherT[f, A, b]]] =
34 | new EitherHasHoist[A]
35 |
36 | }
37 |
38 | /**
39 | * Helpers for Precepte wrapped in Monad Transformers (OptionT, ListT, EitherT)
40 | */
41 | trait HK {
42 |
43 | implicit class toTrans1[F[_], G[_], A](m: F[G[A]]) {
44 |
45 | def liftT[G0[_]](implicit hh: HasHoist[G0], witness: F[G[A]] =:= F[G0[A]]): hh.T[F, A] =
46 | hh.liftT[F, A](witness(m))
47 |
48 | }
49 |
50 |
51 | implicit class toTrans2[F[_] : Functor, A](m: F[A]) {
52 |
53 | def liftF[G[_]](implicit hh: HasHoist[G]): hh.T[F, A] =
54 | hh.liftF[F, A](m)
55 |
56 | }
57 |
58 |
59 | }
60 |
61 | package object hk extends HK
--------------------------------------------------------------------------------
/src/main/scala/Interpreter.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.~>
4 |
5 | /** helper to combine natural transformations
6 | * (F ~> R :@: G ~> R:@: H ~> R) gives (F :@: G :@: H :@: CNilK ~> R)
7 | */
8 | class Interpreter[C[_] <: CopK[_], R[_]](
9 | val nat: C ~> R
10 | ) {
11 |
12 | def :&:[F[_], O[_] <: CopK[_]](f: F ~> R)(implicit prep: PrependHK.Aux[F, C, O]): Interpreter[O, R] = new Interpreter(
13 | new ~>[O, R] {
14 | def apply[A](c: O[A]): R[A] = prep.nat(c, f, nat)
15 | }
16 | )
17 |
18 | // TBD
19 | // def :&&:[D[_] <: CopK[_]](f: Interpreter[D])(
20 | // implicit merge: MergeCopHK[D, C]
21 | // ): Interpreter[ConsK[F, C, ?], R] = new Interpreter(
22 | // // TBD
23 | // )
24 |
25 | def :&&:[D[_] <: CopK[_]](f: Interpreter[D, R]): Interpreter[AppendK[C, D, ?], R] = new Interpreter(
26 | new ~>[AppendK[C, D, ?], R] {
27 | def apply[A](c: AppendK[C, D, A]): R[A] = c match {
28 | case Aplk(l) => nat.nat(l)
29 | case Aprk(r) => f.nat(r)
30 | }
31 | }
32 | )
33 |
34 | def andThen[R2[_]](r2: R ~> R2): Interpreter[C, R2] = new Interpreter(
35 | nat andThen r2
36 | )
37 | }
38 |
39 | object Interpreter {
40 | def apply[F[_], R[_]](nat: F ~> R): Interpreter[In1[F, ?], R] =
41 | new Interpreter[In1[F, ?], R](
42 | new ~>[In1[F, ?], R] {
43 | def apply[A](c: In1[F, A]): R[A] = c match {
44 | case In1(fa) => nat(fa)
45 | case _ => throw new RuntimeException("impossible case")
46 | }
47 | }
48 | )
49 | }
--------------------------------------------------------------------------------
/src/main/scala/Onion.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.free.Free
4 | import cats.{Applicative, Functor, FlatMap, Monad, Traverse}
5 | import scala.annotation.implicitNotFound
6 |
7 |
8 | /** Monadic Onion */
9 | sealed trait Onion {
10 | type Layers[t]
11 | }
12 |
13 | sealed trait :&:[H[_], T <: Onion] extends Onion {
14 | type Layers[t] = H[T#Layers[t]]
15 | }
16 |
17 | sealed trait Bulb extends Onion {
18 | type Layers[t] = t
19 | }
20 |
21 | object Onion {
22 |
23 | class Make[O0 <: Onion, L0[_]] {
24 | type O = O0
25 | type Layers[t] = L0[t]
26 | }
27 |
28 | object Make {
29 | def apply[O0 <: Onion] = new Make[O0, O0#Layers] {}
30 | }
31 |
32 | def point[S <: Onion, A](a: A)(implicit pointer: Pointer[S]): S#Layers[A] = pointer.point(a)
33 |
34 | def lift[S <: Onion, H[_], A](ha: H[A])(implicit lifter: Lifter[H, S]): S#Layers[A] = lifter.lift(ha)
35 |
36 | }
37 |
38 |
39 | @implicitNotFound("could not prove onion ${S} is pointed; one of the element of the stack might lack an Applicative")
40 | trait Pointer[S <: Onion] {
41 | def point[A](a: A): S#Layers[A]
42 | }
43 |
44 | object Pointer {
45 |
46 | def apply[S <: Onion](implicit pointer: Pointer[S]) = pointer
47 |
48 | implicit val bulb = new Pointer[Bulb] {
49 | def point[A](a: A): Bulb#Layers[A] = a
50 | }
51 |
52 | implicit def cons[H[_]:Applicative, T <: Onion](
53 | implicit next: Pointer[T]
54 | ) = new Pointer[H :&: T] {
55 | def point[A](a: A): (H :&: T)#Layers[A] = Applicative[H].pure(next.point(a))
56 | }
57 |
58 | }
59 |
60 | @implicitNotFound("could not lift ${H} into Onion ${S}; either ${S} does not contain a constructor of ${H}, or there is no Applicative Functor for a constructor of ${S}")
61 | trait Lifter[H[_], S <: Onion] {
62 | def lift[A](ha: H[A]): S#Layers[A]
63 | }
64 |
65 | object Lifter extends LifterLow {
66 |
67 | def apply[H[_], S <: Onion](implicit lifter: Lifter[H, S]) = lifter
68 |
69 | implicit def first2[H[_]:Applicative, I[_], T <: Onion](
70 | implicit next: Lifter[I, T]
71 | ): Lifter[λ[t => H[I[t]]], H :&: T] = new Lifter[λ[t => H[I[t]]], H :&: T] {
72 | def lift[A](hia: H[I[A]]): (H :&: T)#Layers[A] = Functor[H].map(hia)(ia => next.lift(ia))
73 | }
74 |
75 | implicit def cons2[H[_]:Applicative, I[_], K[_]:Applicative, T <: Onion](
76 | implicit next: Lifter[λ[t => H[I[t]]], T]
77 | ): Lifter[λ[t => H[I[t]]], K :&: T] = new Lifter[λ[t => H[I[t]]], K :&: T] {
78 | def lift[A](hia: H[I[A]]): (K :&: T)#Layers[A] = Applicative[K].pure(next.lift(hia))
79 | }
80 | }
81 |
82 | trait LifterLow {
83 |
84 | // here Applicative isn't needed (just Functor) but you need it to add more elements to onion so...
85 | implicit def first[H[_]:Applicative, T <: Onion](
86 | implicit nextPointer: Pointer[T]
87 | ): Lifter[H, H :&: T] = new Lifter[H, H :&: T] {
88 | def lift[A](ha: H[A]): (H :&: T)#Layers[A] = Functor[H].map(ha)(a => nextPointer.point(a))
89 | }
90 |
91 | implicit def cons[H[_]:Functor:Applicative, K[_]:Applicative, T <: Onion](
92 | implicit next: Lifter[H, T]
93 | ): Lifter[H, K :&: T] = new Lifter[H, K :&: T] {
94 | def lift[A](ha: H[A]): (K :&: T)#Layers[A] = Applicative[K].pure(next.lift(ha))
95 | }
96 |
97 | }
98 |
99 | @implicitNotFound("could not compute a method for mapping over onion ${S}; either a member of the stack lacks a Functor, or its Functor instance is ambiguous")
100 | trait Mapper[S <: Onion] {
101 | def map[A, B](fa: S#Layers[A])(f: A => B): S#Layers[B]
102 | }
103 |
104 | object Mapper {
105 |
106 | def apply[S <: Onion](implicit mapper: Mapper[S]) = mapper
107 |
108 | implicit val bulb = new Mapper[Bulb] {
109 | def map[A, B](fa: Bulb#Layers[A])(f: A => B): Bulb#Layers[B] = f(fa)
110 | }
111 |
112 | implicit def cons[H[_]:Functor, T <: Onion](
113 | implicit next: Mapper[T]
114 | ) = new Mapper[H :&: T] {
115 | def map[A, B](fa: (H :&: T)#Layers[A])(f: A => B): (H :&: T)#Layers[B] = Functor[H].map(fa)(ta => next.map(ta)(f))
116 | }
117 | }
118 |
119 | @implicitNotFound("could not prove onion ${S} is a valid traversable stack; perhaps an element of the stack is lacking a Traverse")
120 | trait Traverser[S <: Onion] {
121 | def traverse[G[_]: Applicative, A, B](sa: S#Layers[A])(f: A => G[B]): G[S#Layers[B]]
122 | }
123 |
124 | object Traverser {
125 |
126 | def apply[S <: Onion](implicit traverser: Traverser[S]) = traverser
127 |
128 | implicit val bulb = new Traverser[Bulb] {
129 | def traverse[G[_]: Applicative, A, B](sa: Bulb#Layers[A])(f: A => G[B]): G[Bulb#Layers[B]] =
130 | f(sa)
131 | }
132 |
133 | implicit def cons[H[_]:Traverse, T <: Onion](
134 | implicit next: Traverser[T]
135 | ) = new Traverser[H :&: T] {
136 | def traverse[G[_]: Applicative, A, B](hta: (H :&: T)#Layers[A])(f: A => G[B]): G[(H :&: T)#Layers[B]] =
137 | Traverse[H].traverse(hta){ ta =>
138 | next.traverse[G, A, B](ta)(f)
139 | }
140 | }
141 | }
142 |
143 | @implicitNotFound("could not prove onion ${S} is a valid monadic stack; perhaps an element is lacking a Monad, or one of the sub-onion is lacking a Traverser")
144 | trait Binder[S <: Onion] {
145 | def bind[A, B](fa: S#Layers[A])(f: A => S#Layers[B]): S#Layers[B]
146 | }
147 |
148 | object Binder {
149 |
150 | def apply[S <: Onion](implicit binder: Binder[S]) = binder
151 |
152 | implicit val nil = new Binder[Bulb] {
153 | def bind[A, B](fa: Bulb#Layers[A])(f: A => Bulb#Layers[B]): Bulb#Layers[B] = f(fa)
154 | }
155 |
156 | // H must be a Functor, a FlatMap & an Applicative (for traverse)
157 | implicit def cons[H[_]:Monad, T <: Onion](
158 | implicit nextTraverser: Traverser[T], nextBinder: Binder[T]
159 | ) = new Binder[H :&: T] {
160 | def bind[A, B](fa: (H :&: T)#Layers[A])(f: A => (H :&: T)#Layers[B]): (H :&: T)#Layers[B] =
161 | FlatMap[H].flatMap(fa){ ta =>
162 | val htb: H[T#Layers[T#Layers[B]]] = nextTraverser.traverse(ta){ a => f(a) }
163 | FlatMap[H].map(htb){ ttb => nextBinder.bind(ttb){ tb => tb } }
164 | }
165 | }
166 | }
167 |
168 |
169 | @implicitNotFound("could not expand Onion ${S1} into Onion ${S2}; either ${S1} must be a sub-onion of ${S2}")
170 | trait Expander[S1 <: Onion, S2 <: Onion] {
171 | def expand[A](s1: S1#Layers[A]): S2#Layers[A]
172 | }
173 |
174 | object Expander {
175 |
176 | def apply[S1 <: Onion, S2 <: Onion](implicit expander: Expander[S1, S2]) = expander
177 |
178 | implicit val bulb = new Expander[Bulb, Bulb] {
179 | def expand[A](s1a: Bulb#Layers[A]): Bulb#Layers[A] = s1a
180 | }
181 |
182 | // H must be a Functor, a FlatMap & an Applicative (for traverse)
183 | implicit def first[H[_]:Functor, S1 <: Onion, S2 <: Onion](
184 | implicit next: Expander[S1, S2]
185 | ) = new Expander[H :&: S1, H :&: S2] {
186 | def expand[A](sS1a: (H :&: S1)#Layers[A]): (H :&: S2)#Layers[A] =
187 | Functor[H].map(sS1a){ S1a => next.expand(S1a) }
188 | }
189 |
190 | // H must be a Functor, a FlatMap & an Applicative (for traverse)
191 | implicit def cons[H[_]:Applicative, S1 <: Onion, S2 <: Onion](
192 | implicit next: Expander[S1, S2]
193 | ) = new Expander[S1, H :&: S2] {
194 | def expand[A](hs1a: S1#Layers[A]): (H :&: S2)#Layers[A] =
195 | Applicative[H].pure(next.expand(hs1a))
196 | }
197 | }
198 |
199 |
200 |
201 | trait PeelRight[S <: Onion] {
202 | type OutS <: Onion
203 | type Out[_]
204 |
205 | def peelRight[A](s: S#Layers[A]): OutS#Layers[Out[A]]
206 | }
207 |
208 | object PeelRight {
209 |
210 | type Aux[S <: Onion, OutS0 <: Onion, Out0[_]] = PeelRight[S] { type OutS = OutS0; type Out[t] = Out0[t] }
211 |
212 | def apply[S <: Onion](implicit dr: PeelRight[S]) = dr
213 |
214 | implicit def first[H[_]]: PeelRight.Aux[H :&: Bulb, Bulb, H] = new PeelRight[H :&: Bulb] {
215 | type OutS = Bulb
216 | type Out[t] = H[t]
217 |
218 | def peelRight[A](hka: (H :&: Bulb)#Layers[A]): Bulb#Layers[H[A]] = {
219 | hka
220 | }
221 | }
222 |
223 | implicit def cons[H[_]:Functor, S <: Onion, NextS <: Onion, Next[_]](
224 | implicit next: PeelRight.Aux[S, NextS, Next]
225 | ): PeelRight.Aux[H :&: S, H :&: NextS, Next] = new PeelRight[H :&: S] {
226 | type OutS = H :&: NextS
227 | type Out[t] = Next[t]
228 |
229 | def peelRight[A](hsa: (H :&: S)#Layers[A]): (H :&: NextS)#Layers[Next[A]] =
230 | Functor[H].map(hsa){ sa => next.peelRight(sa) }
231 | }
232 | }
233 |
234 |
235 | trait PeelRight2[S <: Onion] {
236 | type OutS <: Onion
237 | type Out[_]
238 |
239 | def peelRight[A](s: S#Layers[A]): OutS#Layers[Out[A]]
240 | }
241 |
242 |
243 | object PeelRight2 {
244 |
245 | type Aux[S <: Onion, OutS0 <: Onion, Out0[_]] = PeelRight2[S] { type OutS = OutS0; type Out[t] = Out0[t] }
246 |
247 | def apply[S <: Onion](implicit dr: PeelRight[S]) = dr
248 |
249 | implicit def two[S <: Onion, OutS1 <: Onion, Out1[_], OutS2 <: Onion, Out2[_]](
250 | implicit
251 | peel1: PeelRight.Aux[S, OutS1, Out1]
252 | , peel2: PeelRight.Aux[OutS1, OutS2, Out2]
253 | ): PeelRight2.Aux[S, OutS2, λ[t => Out2[Out1[t]]]] = new PeelRight2[S] {
254 | type OutS = OutS2
255 | type Out[t] = Out2[Out1[t]]
256 |
257 | def peelRight[A](hka: S#Layers[A]): OutS2#Layers[Out2[Out1[A]]] = {
258 | peel2.peelRight(peel1.peelRight(hka))
259 | }
260 | }
261 |
262 | }
263 |
264 | trait PeelRight3[S <: Onion] {
265 | type OutS <: Onion
266 | type Out[_]
267 |
268 | def peelRight[A](s: S#Layers[A]): OutS#Layers[Out[A]]
269 | }
270 |
271 |
272 | object PeelRight3 {
273 |
274 | type Aux[S <: Onion, OutS0 <: Onion, Out0[_]] = PeelRight3[S] { type OutS = OutS0; type Out[t] = Out0[t] }
275 |
276 | def apply[S <: Onion](implicit dr: PeelRight[S]) = dr
277 |
278 | implicit def three[S <: Onion, OutS1 <: Onion, Out1[_], OutS2 <: Onion, Out2[_], OutS3 <: Onion, Out3[_]](
279 | implicit
280 | peel1: PeelRight.Aux[S, OutS1, Out1]
281 | , peel2: PeelRight.Aux[OutS1, OutS2, Out2]
282 | , peel3: PeelRight.Aux[OutS2, OutS3, Out3]
283 | ): PeelRight3.Aux[S, OutS3, λ[t => Out3[Out2[Out1[t]]]]] = new PeelRight3[S] {
284 | type OutS = OutS3
285 | type Out[t] = Out3[Out2[Out1[t]]]
286 |
287 | def peelRight[A](hka: S#Layers[A]): OutS3#Layers[Out3[Out2[Out1[A]]]] = {
288 | peel3.peelRight(peel2.peelRight(peel1.peelRight(hka)))
289 | }
290 | }
291 |
292 | }
293 |
294 | trait Wrap[H[_], S <: Onion] {
295 | type Out <: Onion
296 |
297 | def wrap[A](s: S#Layers[A]): Out#Layers[A]
298 | }
299 |
300 |
301 | object Wrap {
302 |
303 | def apply[H[_], S <: Onion](implicit Wrap: Wrap[H, S]) = Wrap
304 |
305 | implicit def Layers[H[_]: Applicative, S <: Onion] = new Wrap[H, S] {
306 | type Out = H :&: S
307 | def wrap[A](s: S#Layers[A]): (H :&: S)#Layers[A] = Applicative[H].pure(s)
308 | }
309 | }
310 |
311 | @implicitNotFound("could not decompose ${FA} into a stack of type containers F[G[...X[A]]]")
312 | trait HKK[FA] {
313 | type A
314 | }
315 |
316 | object HKK extends HKK3 {
317 |
318 | type Aux[FA, A0] = HKK[FA] { type A = A0 }
319 |
320 | }
321 |
322 | trait HKK3 extends HKK2 {
323 | implicit def hk3[F[_], G[_], H[_], A0]: HKK.Aux[F[G[H[A0]]], A0] = new HKK[F[G[H[A0]]]] {
324 | type A = A0
325 | }
326 | }
327 |
328 | trait HKK2 extends HKK1 {
329 | implicit def hk2[F[_], G[_], A0]: HKK.Aux[F[G[A0]], A0] = new HKK[F[G[A0]]] {
330 | type A = A0
331 | }
332 | }
333 |
334 | trait HKK1 {
335 | implicit def hk1[F[_], A0]: HKK.Aux[F[A0], A0] = new HKK[F[A0]] {
336 | type A = A0
337 | }
338 | }
339 |
340 | @implicitNotFound("could not lift2 ${HA} into Onion ${S}; either ${S} does not contain a constructor of ${HA}, or there is no Applicative Functor for a constructor of ${S}")
341 | trait Lifter2[HA, S <: Onion] {
342 | type A
343 | def lift2(ha: HA): S#Layers[A]
344 | }
345 |
346 | object Lifter2 extends Lifter2Low {
347 | type Aux[HA, S <: Onion, A0] = Lifter2[HA, S] { type A = A0 }
348 |
349 | def apply[HA, S <: Onion](implicit lifter: Lifter2[HA, S]) = lifter
350 |
351 | implicit def cons2[H[_]:Applicative, IA, T <: Onion](
352 | implicit next: Lifter2[IA, T]
353 | ): Lifter2.Aux[H[IA], H :&: T, next.A] = new Lifter2[H[IA], H :&: T] {
354 | type A = next.A
355 | def lift2(hia: H[IA]): (H :&: T)#Layers[A] = Functor[H].map(hia)(ia => next.lift2(ia))
356 | }
357 | }
358 |
359 | trait Lifter2Low {
360 | implicit def first[H[_]:Applicative, A0, T <: Onion](
361 | implicit nextPointer: Pointer[T]
362 | ): Lifter2.Aux[H[A0], H :&: T, A0] = new Lifter2[H[A0], H :&: T] {
363 | type A = A0
364 | def lift2(ha: H[A0]): (H :&: T)#Layers[A] = Functor[H].map(ha)(a => nextPointer.point(a))
365 | }
366 |
367 | implicit def cons[H[_]:Functor:Applicative, A0, K[_]:Applicative, T <: Onion](
368 | implicit next: Lifter2[H[A0], T]
369 | ): Lifter2.Aux[H[A0], K :&: T, next.A] = new Lifter2[H[A0], K :&: T] {
370 | type A = next.A
371 | def lift2(ha: H[A0]): (K :&: T)#Layers[A] = Applicative[K].pure(next.lift2(ha))
372 | }
373 |
374 |
375 | }
376 |
377 |
378 | trait PartialLifter1[HA, S <: Onion] {
379 | type GA
380 | def partialLift(ha: HA): S#Layers[GA]
381 | }
382 |
383 | object PartialLifter1 {
384 | type Aux[HA, S <: Onion, GA0] = PartialLifter1[HA, S] { type GA = GA0 }
385 |
386 | def apply[HA, S <: Onion](implicit lifter: PartialLifter1[HA, S]) = lifter
387 |
388 |
389 | implicit def fga[F[_], GA0, O <: Onion](
390 | implicit lifter: Lifter[F, O]
391 | ): PartialLifter1.Aux[F[GA0], O, GA0] = new PartialLifter1[F[GA0], O] {
392 | type GA = GA0
393 | def partialLift(fga: F[GA0]): O#Layers[GA0] = lifter.lift(fga)
394 | }
395 |
396 | // implicit def fga[F[_]: Functor, G[_], A0, O <: Onion](
397 | // implicit lifter: Lifter[F, O]
398 | // ): PartialLifter1.Aux[F[G[A0]], O, G[A0]] = new PartialLifter1[F[G[A0]], O] {
399 | // type GA = G[A0]
400 | // def partialLift(fga: F[G[A0]]): O#Layers[G[A0]] = lifter.lift(fga)
401 | // }
402 |
403 | }
404 |
405 | trait PartialLifter2[HA, S <: Onion] {
406 | type GA
407 | def partialLift(ha: HA): S#Layers[GA]
408 | }
409 |
410 | object PartialLifter2 {
411 | type Aux[HA, S <: Onion, GA0] = PartialLifter2[HA, S] { type GA = GA0 }
412 |
413 | def apply[HA, S <: Onion](implicit lifter: PartialLifter2[HA, S]) = lifter
414 |
415 | implicit def fga[F[_], G[_], HA0, O <: Onion](
416 | implicit lifter: Lifter[λ[t => F[G[t]]], O]
417 | ): PartialLifter2.Aux[F[G[HA0]], O, HA0] = new PartialLifter2[F[G[HA0]], O] {
418 | type GA = HA0
419 | def partialLift(fga: F[G[HA0]]): O#Layers[HA0] = lifter.lift(fga)
420 | }
421 |
422 | // implicit def fga[F[_]: Functor, G[_], A0, O <: Onion](
423 | // implicit lifter: Lifter[F, O]
424 | // ): PartialLifter1.Aux[F[G[A0]], O, G[A0]] = new PartialLifter1[F[G[A0]], O] {
425 | // type GA = G[A0]
426 | // def partialLift(fga: F[G[A0]]): O#Layers[G[A0]] = lifter.lift(fga)
427 | // }
428 |
429 | }
--------------------------------------------------------------------------------
/src/main/scala/OnionT.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 | import cats.free.Free
4 | import cats.{Applicative, Functor, FlatMap, Monad, Traverse, Eq}
5 |
6 |
7 | /** The OnionT transformer to manipulate monadic stack of results */
8 | case class OnionT[TC[_[_], _], F[_], S <: Onion, A](value: TC[F, S#Layers[A]]) extends Product with Serializable {
9 |
10 | def map[B](f: A => B)(
11 | implicit
12 | tcMonad: Monad[TC[F, ?]]
13 | , mapper: Mapper[S]
14 | ): OnionT[TC, F, S, B] =
15 | OnionT(tcMonad.map(value){ a => mapper.map(a)(f) })
16 |
17 | def flatMap[B](f: A => OnionT[TC, F, S, B])(
18 | implicit
19 | tcMonad: Monad[TC[F, ?]]
20 | , binder: Binder[S]
21 | , traverser: Traverser[S]
22 | ): OnionT[TC, F, S, B] =
23 | OnionT(
24 | tcMonad.flatMap(value){ sba: S#Layers[A] =>
25 | val subsbb = traverser.traverse(sba){ a => f(a).value }
26 | tcMonad.map(subsbb) { sbb => binder.bind(sbb){ sb => sb } }
27 | }
28 | )
29 |
30 | def peelRight(
31 | implicit
32 | tcMonad: Monad[TC[F, ?]]
33 | , dr: PeelRight[S]
34 | ): OnionT[TC, F, dr.OutS, dr.Out[A]] =
35 | OnionT[TC, F, dr.OutS, dr.Out[A]](
36 | tcMonad.map(value){ sba: S#Layers[A] =>
37 | dr.peelRight(sba)
38 | }
39 | )
40 |
41 | def peelRight2(
42 | implicit
43 | tcMonad: Monad[TC[F, ?]]
44 | , dr: PeelRight2[S]
45 | ): OnionT[TC, F, dr.OutS, dr.Out[A]] =
46 | OnionT[TC, F, dr.OutS, dr.Out[A]](
47 | tcMonad.map(value){ sba: S#Layers[A] =>
48 | dr.peelRight(sba)
49 | }
50 | )
51 |
52 | def peelRight3(
53 | implicit
54 | tcMonad: Monad[TC[F, ?]]
55 | , dr: PeelRight3[S]
56 | ): OnionT[TC, F, dr.OutS, dr.Out[A]] =
57 | OnionT[TC, F, dr.OutS, dr.Out[A]](
58 | tcMonad.map(value){ sba: S#Layers[A] =>
59 | dr.peelRight(sba)
60 | }
61 | )
62 |
63 |
64 | def wrap[H[_]](
65 | implicit
66 | tcMonad: Monad[TC[F, ?]]
67 | , ul: Wrap[H, S]
68 | ): OnionT[TC, F, ul.Out, A] =
69 | OnionT[TC, F, ul.Out, A](
70 | tcMonad.map(value){ sba: S#Layers[A] =>
71 | ul.wrap(sba)
72 | }
73 | )
74 |
75 | def expand[S2 <: Onion](
76 | implicit
77 | tcMonad: Monad[TC[F, ?]]
78 | , expander: Expander[S, S2]
79 | ): OnionT[TC, F, S2, A] =
80 | OnionT(
81 | tcMonad.map(value){ sba: S#Layers[A] =>
82 | expander.expand(sba)
83 | }
84 | )
85 |
86 | }
87 |
88 |
89 | object OnionT extends OnionTInstances {
90 |
91 | def pure[TC[_[_], _], F[_], S <: Onion, A](a: A)(
92 | implicit
93 | tcMonad: Monad[TC[F, ?]]
94 | , pointer: Pointer[S]
95 | , mapper: Mapper[S]
96 | , binder: Binder[S]
97 | , traverser: Traverser[S]
98 | ): OnionT[TC, F, S, A] =
99 | liftP(tcMonad.pure(a))
100 |
101 | def liftF[TC[_[_], _], F[_], S <: Onion, G[_], A](fa: G[A])(
102 | implicit
103 | tcMonad: Monad[TC[F, ?]]
104 | , lifter: Lifter[G, S]
105 | , mapper: Mapper[S]
106 | , binder: Binder[S]
107 | , traverser: Traverser[S]
108 | ): OnionT[TC, F, S, A] =
109 | liftT(tcMonad.pure(fa))
110 |
111 | def liftP[TC[_[_], _], F[_], S <: Onion, A](fa: TC[F, A])(
112 | implicit
113 | tcMonad: Monad[TC[F, ?]]
114 | , pointer: Pointer[S]
115 | , mapper: Mapper[S]
116 | , binder: Binder[S]
117 | , traverser: Traverser[S]
118 | ): OnionT[TC, F, S, A] =
119 | OnionT(tcMonad.map(fa) (a => pointer.point(a)))
120 |
121 | def liftT[TC[_[_], _], F[_], S <: Onion, G[_], A](fa: TC[F, G[A]])(
122 | implicit
123 | tcMonad: Monad[TC[F, ?]]
124 | , lifter: Lifter[G, S]
125 | , mapper: Mapper[S]
126 | , binder: Binder[S]
127 | , traverser: Traverser[S]
128 | ): OnionT[TC, F, S, A] =
129 | OnionT(tcMonad.map(fa){ fa => lifter.lift(fa) })
130 |
131 | def liftT2[TC[_[_], _], F[_], S <: Onion, G[_], H[_], A](fa: TC[F, G[H[A]]])(
132 | implicit
133 | tcMonad: Monad[TC[F, ?]]
134 | , lifter: Lifter[λ[t => G[H[t]]], S]
135 | , mapper: Mapper[S]
136 | , binder: Binder[S]
137 | , traverser: Traverser[S]
138 | ): OnionT[TC, F, S, A] =
139 | OnionT(tcMonad.map(fa){ fa => lifter.lift(fa) })
140 |
141 | def liftTHK[TC[_[_], _], F[_], S <: Onion, GA, A](fa: TC[F, GA])(
142 | implicit
143 | tcMonad: Monad[TC[F, ?]]
144 | , lifter2: Lifter2.Aux[GA, S, A]
145 | , mapper: Mapper[S]
146 | , binder: Binder[S]
147 | , traverser: Traverser[S]
148 | ): OnionT[TC, F, S, A] =
149 | OnionT(tcMonad.map(fa){ fa => lifter2.lift2(fa) })
150 |
151 | def liftTPartial1[TC[_[_], _], F[_], S <: Onion, GA, A](fa: TC[F, GA])(
152 | implicit
153 | tcMonad: Monad[TC[F, ?]]
154 | , liftp: PartialLifter1[GA, S]
155 | , mapper: Mapper[S]
156 | , binder: Binder[S]
157 | // , traverser: Traverser[S]
158 | ): OnionT[TC, F, S, liftp.GA] =
159 | OnionT(tcMonad.map(fa){ fa => liftp.partialLift(fa) })
160 |
161 | def liftTPartial2[TC[_[_], _], F[_], S <: Onion, GA, A](fa: TC[F, GA])(
162 | implicit
163 | tcMonad: Monad[TC[F, ?]]
164 | , liftp: PartialLifter2[GA, S]
165 | , mapper: Mapper[S]
166 | , binder: Binder[S]
167 | // , traverser: Traverser[S]
168 | ): OnionT[TC, F, S, liftp.GA] =
169 | OnionT(tcMonad.map(fa){ fa => liftp.partialLift(fa) })
170 | }
171 |
172 | trait OnionTInstances {
173 |
174 | implicit def monad[TC[_[_], _], F[_], S <: Onion](
175 | implicit
176 | tcMonad: Monad[TC[F, ?]]
177 | , pointer: Pointer[S]
178 | , mapper: Mapper[S]
179 | , binder: Binder[S]
180 | , traverser: Traverser[S]
181 | ): Monad[OnionT[TC, F, S, ?]] = new Monad[OnionT[TC, F, S, ?]] {
182 | def pure[A](a: A) = OnionT(tcMonad.pure(pointer.point(a)))
183 |
184 | def flatMap[A, B](fa: OnionT[TC, F, S, A])(f: A => OnionT[TC, F, S, B]): OnionT[TC, F, S, B] =
185 | fa.flatMap(f)
186 |
187 | override def map[A, B](fa: OnionT[TC, F, S, A])(f: A => B): OnionT[TC, F, S, B] =
188 | fa.map(f)
189 |
190 | // unsafe
191 | def tailRecM[A, B](a: A)(f: A => OnionT[TC, F, S, Either[A, B]]): OnionT[TC, F, S, B] =
192 | f(a).flatMap {
193 | case Left(nextA) => tailRecM(nextA)(f)
194 | case Right(b) => pure(b)
195 | }
196 | }
197 |
198 |
199 | }
200 |
201 |
--------------------------------------------------------------------------------
/src/main/scala/package.scala:
--------------------------------------------------------------------------------
1 | import scala.language.implicitConversions
2 |
3 | import cats.{~>, Monad}
4 | import cats.free.Free
5 |
6 | /** a few implicit conversions */
7 | package object freek extends LowerImplicits with HK {
8 |
9 | /** Will deconstruct G[HA] using HKK & Lifter2 if HA is not simply */
10 | implicit class ToFreek2[F[_], G[_], HA, A](fa: F[G[HA]])(implicit ga: HKK.Aux[G[HA], A]) {
11 | @inline def freek0: Free[In1[F, ?], G[HA]] = Freek(fa)
12 |
13 | @inline def freek[C <: DSL](implicit subdsl: SubDSL1[F, C]): Free[subdsl.Cop, G[HA]] =
14 | Freek.expand[In1[F, ?], subdsl.Cop, G[HA]](freek0)(subdsl.sub)
15 |
16 | @inline def upcast[T](implicit f: F[G[HA]] <:< T): T = fa
17 |
18 | @inline def freeko[C <: DSL, O <: Onion](
19 | implicit
20 | subdsl: SubDSL1[F, C]
21 | , lifter2: Lifter2.Aux[G[HA], O, A]
22 | , pointer: Pointer[O]
23 | , mapper: Mapper[O]
24 | , binder: Binder[O]
25 | , traverser: Traverser[O]
26 | ): OnionT[Free, subdsl.Cop, O, A] = OnionT.liftTHK(freek[C])
27 | }
28 |
29 | implicit class ToFreek1[F[_], A](val fa: F[A]) extends AnyVal {
30 | @inline def freek0: Free[In1[F, ?], A] = Freek(fa)
31 |
32 | @inline def freek[C <: DSL](implicit subdsl: SubDSL1[F, C]): Free[subdsl.Cop, A] =
33 | Freek.expand[In1[F, ?], subdsl.Cop, A](freek0)(subdsl.sub) //.asInstanceOf[Free[subdsl.Cop, A]]
34 |
35 | @inline def upcast[T](implicit f: F[A] <:< T): T = fa
36 |
37 | @inline def freeko[C <: DSL, O <: Onion](
38 | implicit
39 | subdsl: SubDSL1[F, C]
40 | , pointer: Pointer[O]
41 | , mapper: Mapper[O]
42 | , binder: Binder[O]
43 | , traverser: Traverser[O]
44 | ): OnionT[Free, subdsl.Cop, O, A] = toOnionT0(freek[C]).onionT[O]
45 | }
46 |
47 | implicit class FreeExtendCopK[F[_] <: CopK[_], A](val free: Free[F, A]) extends AnyVal {
48 | @inline def expand[C <: DSL](implicit subdsl: SubDSL[F, C]): Free[subdsl.Cop, A] =
49 | Freek.expand[F, subdsl.Cop, A](free)(subdsl.sub) //.asInstanceOf[Free[subdsl.Cop, A]]
50 |
51 | def interpret[F2[_] <: CopK[_], G[_]: Monad](i: Interpreter[F2, G])(
52 | implicit sub:SubCop[F, F2]
53 | ): G[A] = free.foldMap(new (F ~> G) {
54 | def apply[A](fa: F[A]): G[A] = i.nat(sub(fa))
55 | })
56 |
57 | def flatten[O[_] <: CopK[_]](implicit flt: Flattener.Aux[F, Free, O]): Free[O, A] = flt.flatten(free)
58 |
59 | def transpile[F2[_] <: CopK[_], G[_] <: CopK[_], O[_] <: CopK[_]](i: Interpreter[F2, G])(
60 | implicit
61 | sub:SubCop[F, F2]
62 | , flt: Flattener.Aux[G, Free, O]
63 | ): Free[O, A] = flt.flatten(free.compile(new (F ~> G) {
64 | def apply[A](fa: F[A]): G[A] = i.nat(sub(fa))
65 | }))
66 |
67 | def transpile[F2[_] <: CopK[_], G[_] <: CopK[_], O[_] <: CopK[_]](i: F2 ~> G)(
68 | implicit
69 | sub:SubCop[F, F2]
70 | , flt: Flattener.Aux[G, Free, O]
71 | ): Free[O, A] = flt.flatten(free.compile(new (F ~> G) {
72 | def apply[A](fa: F[A]): G[A] = i(sub(fa))
73 | }))
74 | }
75 |
76 | implicit class FreeExtend[F[_], A](val free: Free[F, A]) extends AnyVal {
77 | @inline def expand[C <: DSL](implicit subdsl: SubDSL[In1[F, ?], C]): Free[subdsl.Cop, A] =
78 | free.compile(new (F ~> In1[F, ?]) {
79 | def apply[A](fa: F[A]): In1[F, A] = In1(fa)
80 | }).expand[C]
81 | }
82 |
83 | implicit class toOnionTGA[TC[_[_], _], F[_], GA, A](val tc: TC[F, GA])(
84 | implicit ga: HKK.Aux[GA, A]
85 | ) {
86 |
87 | @inline def onionT[O <: Onion](
88 | implicit
89 | tcMonad: Monad[TC[F, ?]]
90 | , lifter2: Lifter2.Aux[GA, O, A]
91 | , pointer: Pointer[O]
92 | , mapper: Mapper[O]
93 | , binder: Binder[O]
94 | , traverser: Traverser[O]
95 | ): OnionT[TC, F, O, A] = OnionT.liftTHK(tc)
96 |
97 | @inline def onionT1[O <: Onion](
98 | implicit
99 | tcMonad: Monad[TC[F, ?]]
100 | , lifter2: Lifter2.Aux[GA, O, A]
101 | , pointer: Pointer[O]
102 | , mapper: Mapper[O]
103 | , binder: Binder[O]
104 | , traverser: Traverser[O]
105 | , pr: PeelRight[O]
106 | ): OnionT[TC, F, pr.OutS, pr.Out[A]] = OnionT.liftTHK(tc).peelRight
107 |
108 | @inline def onionT2[O <: Onion](
109 | implicit
110 | tcMonad: Monad[TC[F, ?]]
111 | , lifter2: Lifter2.Aux[GA, O, A]
112 | , pointer: Pointer[O]
113 | , mapper: Mapper[O]
114 | , binder: Binder[O]
115 | , traverser: Traverser[O]
116 | , pr2: PeelRight2[O]
117 | ): OnionT[TC, F, pr2.OutS, pr2.Out[A]] = OnionT.liftTHK(tc).peelRight2
118 |
119 | @inline def onionT3[O <: Onion](
120 | implicit
121 | tcMonad: Monad[TC[F, ?]]
122 | , lifter2: Lifter2.Aux[GA, O, A]
123 | , pointer: Pointer[O]
124 | , mapper: Mapper[O]
125 | , binder: Binder[O]
126 | , traverser: Traverser[O]
127 | , pr3: PeelRight3[O]
128 | ): OnionT[TC, F, pr3.OutS, pr3.Out[A]] = OnionT.liftTHK(tc).peelRight3
129 |
130 | @inline def onion[O <: Onion](
131 | implicit
132 | tcMonad: Monad[TC[F, ?]]
133 | , pointer: Pointer[O]
134 | , mapper: Mapper[O]
135 | , binder: Binder[O]
136 | , traverser: Traverser[O]
137 | ): OnionT[TC, F, O, GA] = OnionT.liftP(tc)
138 |
139 |
140 | @inline def onionX1[O <: Onion](
141 | implicit
142 | tcMonad: Monad[TC[F, ?]]
143 | , liftp: PartialLifter1[GA, O]
144 | , mapper: Mapper[O]
145 | , binder: Binder[O]
146 | ): OnionT[TC, F, O, liftp.GA] = OnionT.liftTPartial1(tc)
147 |
148 | @inline def onionX2[O <: Onion](
149 | implicit
150 | tcMonad: Monad[TC[F, ?]]
151 | , liftp: PartialLifter2[GA, O]
152 | , mapper: Mapper[O]
153 | , binder: Binder[O]
154 | ): OnionT[TC, F, O, liftp.GA] = OnionT.liftTPartial2(tc)
155 |
156 | }
157 |
158 | implicit class toOnionExpand[C[_]<: CopK[_], O <: Onion, A](val onion: OnionT[Free, C, O, A]) {
159 |
160 | def freeko[F <: DSL, O2 <: Onion](
161 | implicit
162 | subdslDSL: SubDSL[C, F]
163 | , expander: Expander[O, O2]
164 | ): OnionT[Free, subdslDSL.Cop, O2, A] = {
165 | OnionT(onion.value.expand[F]).expand[O2]
166 | }
167 |
168 | }
169 | /*
170 | implicit class toOnionT2[TC[_[_], _], F[_], G[_], H[_], A](val tc: TC[F, G[H[A]]]) extends AnyVal {
171 |
172 | @inline def onionT[O <: Onion](
173 | implicit
174 | tcMonad: Monad[TC[F, ?]]
175 | , lifter: Lifter[λ[t => G[H[t]]], O]
176 | , pointer: Pointer[O]
177 | , mapper: Mapper[O]
178 | , binder: Binder[O]
179 | , traverser: Traverser[O]
180 | ): OnionT[TC, F, O, A] =
181 | OnionT.liftT2(tc)
182 |
183 | @inline def onion[O <: Onion](
184 | implicit
185 | tcMonad: Monad[TC[F, ?]]
186 | , pointer: Pointer[O]
187 | , mapper: Mapper[O]
188 | , binder: Binder[O]
189 | , traverser: Traverser[O]
190 | ): OnionT[TC, F, O, G[H[A]]] = OnionT.liftP(tc)
191 |
192 | }
193 |
194 | implicit class toOnionT1[TC[_[_], _], F[_], G[_], A](val tc: TC[F, G[A]]) extends AnyVal {
195 |
196 | @inline def onionT[O <: Onion](
197 | implicit
198 | tcMonad: Monad[TC[F, ?]]
199 | , lifter: Lifter[G, O]
200 | , pointer: Pointer[O]
201 | , mapper: Mapper[O]
202 | , binder: Binder[O]
203 | , traverser: Traverser[O]
204 | ): OnionT[TC, F, O, A] = OnionT.liftT(tc)
205 |
206 | @inline def onion[O <: Onion](
207 | implicit
208 | tcMonad: Monad[TC[F, ?]]
209 | , pointer: Pointer[O]
210 | , mapper: Mapper[O]
211 | , binder: Binder[O]
212 | , traverser: Traverser[O]
213 | ): OnionT[TC, F, O, G[A]] = OnionT.liftP(tc)
214 |
215 | }
216 | */
217 |
218 | }
219 |
220 | package freek {
221 | trait LowerImplicits extends LowerImplicits2 {
222 | implicit class toOnionT0[TC[_[_], _], F[_], A](val tc: TC[F, A]) {
223 |
224 | @inline def onionT[O <: Onion](
225 | implicit
226 | tcMonad: Monad[TC[F, ?]]
227 | , pointer: Pointer[O]
228 | , mapper: Mapper[O]
229 | , binder: Binder[O]
230 | , traverser: Traverser[O]
231 | ): OnionT[TC, F, O, A] =
232 | OnionT.liftP(tc)
233 |
234 | }
235 |
236 | implicit def toInterpreterCopK[F[_] <: CopK[_], R[_]](nat: F ~> R): Interpreter[F, R] = new Interpreter(nat)
237 |
238 | }
239 |
240 | trait LowerImplicits2 {
241 | implicit def toInterpreter[F[_], R[_]](nat: F ~> R): Interpreter[In1[F, ?], R] = Interpreter(nat)
242 | }
243 | }
--------------------------------------------------------------------------------
/src/test/scala/AppSpec.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 |
4 | /**
5 | * Copyright 2014 Pascal Voitot (@mandubian)
6 | */
7 | import org.scalatest._
8 |
9 | import cats.free.{Free, Trampoline}
10 | // import cats.data.Either
11 | import cats.{~>, Id}
12 |
13 | import scala.concurrent._
14 | import scala.concurrent.duration._
15 |
16 | // import cats.derived._, functor._, legacy._
17 | import cats.Functor
18 | import cats.instances.future._
19 | import cats.instances.option._
20 | import cats.instances.list._
21 | import cats.instances.either._
22 | import ExecutionContext.Implicits.global
23 |
24 | import freek._
25 |
26 |
27 | //////////////////////////////////////////////////////////////////////////
28 | // Declare DSLs
29 |
30 | //////////////////////////////////////////////////////////////////////////
31 | // LOG DSL
32 | object Log {
33 | sealed trait LogLevel
34 | case object ErrorLevel extends LogLevel
35 | case object WarnLevel extends LogLevel
36 | case object InfoLevel extends LogLevel
37 | case object DebugLevel extends LogLevel
38 |
39 | trait DSL[A]
40 | case class LogMsg(level: LogLevel, msg: String) extends DSL[Unit]
41 |
42 | /** just helpers without any weird implicits */
43 | def debug(msg: String) = LogMsg(DebugLevel, msg)
44 | def info(msg: String) = LogMsg(InfoLevel, msg)
45 | def infoF(msg: String): Free[DSL, Unit] = Free.liftF(info(msg))
46 | }
47 |
48 | //////////////////////////////////////////////////////////////////////////
49 | // DB DSL
50 | object DB {
51 |
52 | // DB DSL
53 | type Entity = Map[String, String]
54 |
55 | sealed trait DBError
56 | case object NotFound extends DBError
57 |
58 | sealed trait DSL[A]
59 | case class FindById(id: String) extends DSL[Either[DBError, Entity]]
60 |
61 | }
62 |
63 |
64 |
65 | //////////////////////////////////////////////////////////////////////////
66 | // Http DSL
67 | object Http {
68 |
69 | // Http DSL
70 | sealed trait HttpVerb
71 | case object Get extends HttpVerb
72 | case object Post extends HttpVerb
73 |
74 | sealed trait HttpStatus { val value: Int }
75 | case object Ok extends HttpStatus { val value = 200 }
76 | case object BadRequest extends HttpStatus { val value = 400 }
77 | case object InternalServerError extends HttpStatus { val value = 500 }
78 |
79 | type Params = Map[String, Seq[String]]
80 | type Headers = Map[String, Seq[String]]
81 |
82 | sealed trait HttpReq {
83 | val verb: HttpVerb
84 | val url: String
85 | val params: Params
86 | val headers: Headers
87 | }
88 |
89 | case class GetReq(
90 | url: String,
91 | params: Params = Map.empty[String, Seq[String]],
92 | headers: Headers = Map.empty[String, Seq[String]]
93 | ) extends HttpReq {
94 | val verb = Get
95 | }
96 |
97 | case class PostReq(
98 | url: String,
99 | params: Params = Map.empty[String, Seq[String]],
100 | headers: Headers = Map.empty[String, Seq[String]],
101 | body: String
102 | ) extends HttpReq {
103 | val verb = Post
104 | }
105 |
106 | case class HttpResp (
107 | status: HttpStatus,
108 | headers: Headers = Map.empty[String, Seq[String]],
109 | body: String = ""
110 | )
111 |
112 | sealed trait RecvError
113 | case object ClientDisconnected extends RecvError
114 | case object Timeout extends RecvError
115 |
116 | sealed trait SendStatus
117 | case object Ack extends SendStatus
118 | case object NAck extends SendStatus
119 |
120 | sealed trait HttpInteract[A]
121 | case object HttpReceive extends HttpInteract[Either[RecvError, HttpReq]]
122 | case class HttpRespond(data: HttpResp) extends HttpInteract[SendStatus]
123 | case class Stop(error: Either[RecvError, SendStatus]) extends HttpInteract[Either[RecvError, SendStatus]]
124 |
125 | object HttpInteract {
126 | def receive() = HttpReceive
127 | def respond(data: HttpResp) = HttpRespond(data)
128 | def stop(err: Either[RecvError, SendStatus]) = Stop(err)
129 | }
130 |
131 | sealed trait HttpHandle[A]
132 | case class HttpHandleResult(resp: HttpResp) extends HttpHandle[HttpResp]
133 |
134 | object HttpHandle {
135 | def result(resp: HttpResp) = HttpHandleResult(resp)
136 | }
137 | }
138 |
139 |
140 | class AppSpec extends FlatSpec with Matchers {
141 |
142 | /** weird this is not provided in cats apparently */
143 | implicit val fc = new cats.Comonad[Function0] {
144 | def extract[A](x: () => A): A = x()
145 | def coflatMap[A, B](fa: () => A)(f: (() => A) => B): () => B = () => f(fa)
146 | def map[A, B](fa: () => A)(f: A => B): () => B = () => f(fa())
147 | }
148 |
149 |
150 | "ShapeApp" should "freek" in {
151 |
152 | object DBService {
153 | import DB._
154 |
155 | // APP DEFINITION
156 | // DSL.Make DSL in a higher-kinded coproduct
157 | // Log.DSL :@: DB.DSL :@: NilDSL builds (A => Log.DSL[A] :+: DB.DSL[A] :+: CNilK[A])
158 | // NilDSL corresponds to a higher-kinded CNil or no-effect combinator
159 | // without it, it's impossible to build to higher-kinded coproduct in a clea way
160 | type PRG = Log.DSL :|: DB.DSL :|: NilDSL
161 | val PRG = DSL.Make[PRG]
162 |
163 | /** the DSL.Make */
164 | def findById(id: String): Free[PRG.Cop, Either[DBError, Entity]] =
165 | for {
166 | _ <- Log.debug("Searching for entity id:"+id).freek[PRG]
167 | res <- FindById(id).freek[PRG]
168 | _ <- Log.debug("Search result:"+res).freek[PRG]
169 | } yield (res)
170 | }
171 |
172 | object HttpService {
173 | import Http._
174 |
175 | /** Combining DSL in a type alias */
176 | type PRG = Log.DSL :|: HttpInteract :|: HttpHandle :|: DBService.PRG
177 | val PRG = DSL.Make[PRG]
178 |
179 | // Handle action
180 | // :@@: DSL.Makes a F[_] with an existing higher-kinded coproduct
181 | def handle(req: HttpReq): Free[PRG.Cop, HttpResp] = req.url match {
182 | case "/foo" =>
183 | for {
184 | _ <- Log.debug("/foo").freek[PRG]
185 | dbRes <- DBService.findById("foo").expand[PRG]
186 |
187 | resp <- HttpHandle.result(
188 | dbRes match {
189 | case Left(err) => HttpResp(status = InternalServerError)
190 | case Right(e) => HttpResp(status = Ok, body = e.toString)
191 | }
192 | ).freek[PRG]
193 | } yield (resp)
194 |
195 | case _ => HttpHandle.result(HttpResp(status = InternalServerError)).freek[PRG]
196 | }
197 |
198 | // server DSL.Make
199 | // this is the worst case: recursive call so need to help scalac a lot
200 | // but in classic cases, it should be much more straighforward
201 | def serve() : Free[PRG.Cop, Either[RecvError, SendStatus]] =
202 | for {
203 | recv <- HttpInteract.receive().freek[PRG]
204 | _ <- Log.info("HttpReceived Request:"+recv).freek[PRG]
205 | res <- recv match {
206 | case Left(err) => HttpInteract.stop(Left(err)).freek[PRG]
207 |
208 | case Right(req) =>
209 | for {
210 | resp <- handle(req)
211 | _ <- Log.info("Sending Response:"+resp).freek[PRG]
212 | ack <- HttpInteract.respond(resp).freek[PRG]
213 | res <- if(ack == Ack) serve()
214 | else HttpInteract.stop(Right(ack)).freek[PRG]
215 | } yield (res)
216 | }
217 | } yield (res)
218 |
219 | }
220 |
221 |
222 | //////////////////////////////////////////////////////////////////////////
223 | // Interpreters as simple TransNat
224 | object Logger extends (Log.DSL ~> cats.Id) {
225 | def apply[A](a: Log.DSL[A]) = a match {
226 | case Log.LogMsg(lvl, msg) =>
227 | println(s"$lvl $msg")
228 | }
229 | }
230 |
231 | object DBManager extends (DB.DSL ~> cats.Id) {
232 | def apply[A](a: DB.DSL[A]) = a match {
233 | case DB.FindById(id) =>
234 | println(s"DB Finding $id")
235 | Right(Map("id" -> id, "name" -> "toto"))
236 | }
237 | }
238 |
239 | object HttpHandler extends (Http.HttpHandle ~> cats.Id) {
240 | def apply[A](a: Http.HttpHandle[A]) = a match {
241 | case Http.HttpHandleResult(resp) =>
242 | println(s"Handling $resp")
243 | resp
244 | }
245 | }
246 |
247 | object HttpInteraction extends (Http.HttpInteract ~> cats.Id) {
248 | var i = 0
249 | def apply[A](a: Http.HttpInteract[A]) = a match {
250 | case Http.HttpReceive =>
251 | if(i < 10000) {
252 | i+=1
253 | Right(Http.GetReq("/foo"))
254 | } else {
255 | Left(Http.ClientDisconnected)
256 | }
257 |
258 | case Http.HttpRespond(resp) => Http.Ack
259 |
260 | case Http.Stop(err) => err
261 | }
262 | }
263 |
264 | /** let's DSL.Make interpreters into a big interpreter
265 | * (F ~> R) :+: (G ~> R) => [t => F[t] :+: G[t] :+: CNilK[t]] ~> R
266 | */
267 | val interpreter = HttpInteraction :&: Logger :&: HttpHandler :&: DBManager
268 |
269 | /** as we use a recursive DSL.Make, we need to trampoline it in order to prevent stack overflow */
270 | object Trampolined extends (cats.Id ~> Trampoline) {
271 | def apply[A](a: cats.Id[A]) = Trampoline.done(a)
272 | }
273 |
274 | // execute final DSL.Make as a simple free with DSL.Maked interpreter composed with a trampoline
275 | HttpService.serve().interpret(interpreter andThen Trampolined).run
276 | println(HttpInteraction.i)
277 |
278 | }
279 |
280 |
281 | "freek" should "manage monad transformers" in {
282 | import cats.instances.future._
283 | import cats.data.OptionT
284 | import ExecutionContext.Implicits.global
285 | // import hk._
286 |
287 | sealed trait Foo[A]
288 | final case class Bar(s: String) extends Foo[Option[Int]]
289 | final case class Bar2(i: Int) extends Foo[Either[String, Int]]
290 | final case object Bar3 extends Foo[Unit]
291 |
292 | type PRG = Foo :|: Log.DSL :|: NilDSL
293 | val PRG = DSL.Make[PRG]
294 |
295 | val prg = for {
296 | i <- Bar("5").freek[PRG].liftT[Option].liftF[Either[String, ?]]
297 | i <- Bar2(i).freek[PRG].liftF[Option].liftT[Either[String, ?]]
298 | _ <- Log.info("toto " + i).freek[PRG].liftF[Option].liftF[Either[String, ?]]
299 | _ <- Log.infoF("").expand[PRG].liftF[Option].liftF[Either[String, ?]]
300 | _ <- Bar3.freek[PRG].liftF[Option].liftF[Either[String, ?]]
301 | } yield (())
302 |
303 | val logger2FutureSkip = new (Log.DSL ~> Future) {
304 | def apply[A](a: Log.DSL[A]) = a match {
305 | case Log.LogMsg(lvl, msg) =>
306 | Future.successful(println(s"$lvl $msg"))
307 | }
308 | }
309 |
310 | val foo2FutureSkip = new (Foo ~> Future) {
311 | def apply[A](a: Foo[A]) = a match {
312 | case Bar(s) => Future { Some(s.toInt) } // if you put None here, it stops prg before Log
313 | case Bar2(i) => Future(Right(i))
314 | case Bar3 => Future.successful(())
315 | }
316 | }
317 |
318 | val interpreters = foo2FutureSkip :&: logger2FutureSkip
319 |
320 | Await.result(prg.value.value.interpret(interpreters), 10.seconds)
321 |
322 | }
323 |
324 | "freek" should "manage monadic onions of result types" in {
325 | import cats.instances.future._
326 | import cats.instances.option._
327 | import cats.instances.list._
328 | import ExecutionContext.Implicits.global
329 |
330 | sealed trait Foo[A]
331 | final case class Foo1(s: String) extends Foo[List[Option[Int]]]
332 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
333 | final case object Foo3 extends Foo[Unit]
334 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
335 |
336 | sealed trait Bar[A]
337 | final case class Bar1(s: String) extends Bar[Option[String]]
338 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
339 |
340 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
341 |
342 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
343 |
344 | type PRG = Foo :|: Log.DSL :|: PRG2
345 | val PRG = DSL.Make[PRG]
346 |
347 | val prg = for {
348 | i <- Foo1("5").freek[PRG].onionT[O]
349 | i2 <- Foo2(i).freek[PRG].onionT[O]
350 | _ <- Log.info("toto " + i).freek[PRG].onionT[O]
351 | _ <- Foo3.freek[PRG].onionT[O]
352 | s <- Bar1(i2.toString).freek[PRG].onionT[O]
353 | i3 <- Foo4(i2).freek[PRG].onionT[O]
354 | } yield (i3)
355 |
356 | val logger2Future = new (Log.DSL ~> Future) {
357 | def apply[A](a: Log.DSL[A]) = a match {
358 | case Log.LogMsg(lvl, msg) =>
359 | Future.successful(println(s"$lvl $msg"))
360 | }
361 | }
362 |
363 | val foo2Future = new (Foo ~> Future) {
364 | def apply[A](a: Foo[A]) = a match {
365 | case Foo1(s) => Future { List(Some(s.toInt)) } // if you put None here, it stops prg before Log
366 | case Foo2(i) => Future(Right(i))
367 | case Foo3 => Future.successful(())
368 | case Foo4(i) => Future.successful(Right(Some(i)))
369 | }
370 | }
371 |
372 | val bar2Future = new (Bar ~> Future) {
373 | def apply[A](a: Bar[A]) = a match {
374 | case Bar1(s) => Future { Some(s) } // if you put None here, it stops prg before Log
375 | case Bar2(i) => Future(Right(i.toString))
376 | }
377 | }
378 |
379 | val interpreters = foo2Future :&: logger2Future :&: bar2Future
380 |
381 | Await.result(prg.value.interpret(interpreters), 10.seconds)
382 |
383 | }
384 |
385 | "freek" should "manage monadic onions of result types manipulating Option[A] using Onion" in {
386 | import cats.instances.future._
387 | import cats.instances.option._
388 | import cats.instances.list._
389 | import ExecutionContext.Implicits.global
390 |
391 | sealed trait Foo[A]
392 | final case class Foo1(s: String) extends Foo[Option[Int]]
393 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
394 | final case object Foo3 extends Foo[Unit]
395 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
396 |
397 | sealed trait Bar[A]
398 | final case class Bar1(s: String) extends Bar[List[Option[String]]]
399 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
400 |
401 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
402 |
403 | type O = List :&: Either[String, ?] :&: Bulb
404 |
405 | type PRG = Foo :|: Log.DSL :|: PRG2
406 | val PRG = DSL.Make[PRG]
407 |
408 | val prg = for {
409 | iOpt <- Foo1("5").freek[PRG].onion[O]
410 | i2 <- iOpt match {
411 | case Some(i) => Foo2(i).freek[PRG].onionT[O]
412 | case None => Foo2(0).freek[PRG].onionT[O]
413 | }
414 | _ <- Log.info("toto " + i2).freek[PRG].onionT[O]
415 | _ <- Foo3.freek[PRG].onionT[O]
416 | s <- Bar1(i2.toString).freek[PRG].onion[O]
417 | i3 <- Foo4(i2).freek[PRG].onion[O]
418 | } yield (i3)
419 |
420 | val logger2Future = new (Log.DSL ~> Future) {
421 | def apply[A](a: Log.DSL[A]) = a match {
422 | case Log.LogMsg(lvl, msg) =>
423 | Future.successful(println(s"$lvl $msg"))
424 | }
425 | }
426 |
427 | val foo2Future = new (Foo ~> Future) {
428 | def apply[A](a: Foo[A]) = a match {
429 | case Foo1(s) => Future { Some(s.toInt) } // if you put None here, it stops prg before Log
430 | case Foo2(i) => Future(Right(i))
431 | case Foo3 => Future.successful(())
432 | case Foo4(i) => Future.successful(Right(Some(i)))
433 | }
434 | }
435 |
436 | val bar2Future = new (Bar ~> Future) {
437 | def apply[A](a: Bar[A]) = a match {
438 | case Bar1(s) => Future { List(Some(s)) } // if you put None here, it stops prg before Log
439 | case Bar2(i) => Future(Right(i.toString))
440 | }
441 | }
442 |
443 | val interpreters = foo2Future :&: logger2Future :&: bar2Future
444 |
445 | Await.result(prg.value.interpret(interpreters), 10.seconds)
446 |
447 | }
448 |
449 | "freek" should "manage monadic onions of result types 3" in {
450 | import cats.instances.future._
451 | import cats.instances.option._
452 | import cats.instances.list._
453 | import ExecutionContext.Implicits.global
454 |
455 | sealed trait Foo[A]
456 | final case class Foo1(s: String) extends Foo[Option[Int]]
457 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
458 | final case object Foo3 extends Foo[Unit]
459 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
460 |
461 | sealed trait Bar[A]
462 | final case class Bar1(s: String) extends Bar[List[Option[String]]]
463 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
464 |
465 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
466 |
467 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
468 |
469 | type PRG = Foo :|: Log.DSL :|: PRG2
470 | val PRG = DSL.Make[PRG]
471 |
472 | val prg = for {
473 | iOpt <- Foo1("5").freek[PRG].onionT[O].peelRight
474 | i2 <- iOpt match {
475 | case Some(i) => Foo2(i).freek[PRG].onionT[O].peelRight
476 | case None => Foo2(0).freek[PRG].onionT[O].peelRight
477 | }
478 | _ <- Log.info("toto " + i2).freek[PRG].onionT[O].peelRight
479 | _ <- Foo3.freek[PRG].onionT[O].peelRight
480 | s <- Bar1(i2.toString).freek[PRG].onionT[O].peelRight
481 | i3 <- i2 match {
482 | case Some(i) => Foo4(i).freek[PRG].onionT[O].peelRight
483 | case None => Foo4(0).freek[PRG].onionT[O].peelRight
484 | }
485 | } yield (i3)
486 |
487 | val logger2Future = new (Log.DSL ~> Future) {
488 | def apply[A](a: Log.DSL[A]) = a match {
489 | case Log.LogMsg(lvl, msg) =>
490 | Future.successful(println(s"$lvl $msg"))
491 | }
492 | }
493 |
494 | val foo2Future = new (Foo ~> Future) {
495 | def apply[A](a: Foo[A]) = a match {
496 | case Foo1(s) => Future { Some(s.toInt) } // if you put None here, it stops prg before Log
497 | case Foo2(i) => Future(Right(i))
498 | case Foo3 => Future.successful(())
499 | case Foo4(i) => Future.successful(Right(Some(i)))
500 | }
501 | }
502 |
503 | val bar2Future = new (Bar ~> Future) {
504 | def apply[A](a: Bar[A]) = a match {
505 | case Bar1(s) => Future { List(Some(s)) } // if you put None here, it stops prg before Log
506 | case Bar2(i) => Future(Right(i.toString))
507 | }
508 | }
509 |
510 | val interpreters = foo2Future :&: logger2Future :&: bar2Future
511 |
512 | Await.result(prg.value.interpret(interpreters), 10.seconds)
513 |
514 | }
515 |
516 | "freek" should "manage monadic onions of result types with phantom types (upcasting)" in {
517 | import cats.instances.future._
518 | import cats.instances.option._
519 | import cats.instances.list._
520 | import ExecutionContext.Implicits.global
521 |
522 |
523 | sealed trait KVS[K, V, E]
524 | case class Get[K, V](key: K) extends KVS[K, V, V]
525 | case class Put[K, V](key: K, value: V) extends KVS[K, V, Unit]
526 |
527 | sealed trait Foo[A]
528 | final case class Foo1(s: String) extends Foo[List[Option[Int]]]
529 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
530 | final case object Foo3 extends Foo[Unit]
531 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
532 |
533 | sealed trait Bar[A]
534 | final case class Bar1(s: String) extends Bar[Option[String]]
535 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
536 |
537 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
538 |
539 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
540 |
541 | type PRG = Foo :|: Log.DSL :|: KVS[String, Int, ?] :|: PRG2
542 | val PRG = DSL.Make[PRG]
543 |
544 | val prg = for {
545 | i <- Foo1("5").freek[PRG].onionT[O]
546 | i2 <- Foo2(i).freek[PRG].onionT[O]
547 | _ <- Put[String, Int](i.toString, i2).upcast[KVS[String, Int, Unit]].freek[PRG].onionT[O]
548 | _ <- Get[String, Int](i.toString).upcast[KVS[String, Int, Int]].freek[PRG].onionT[O]
549 | _ <- Log.info("toto " + i).freek[PRG].onionT[O]
550 | _ <- Foo3.freek[PRG].onionT[O]
551 | s <- Bar1(i2.toString).freek[PRG].onionT[O]
552 | i3 <- Foo4(i2).freek[PRG].onionT[O]
553 | } yield (i3)
554 |
555 | val logger2Future = new (Log.DSL ~> Future) {
556 | def apply[A](a: Log.DSL[A]) = a match {
557 | case Log.LogMsg(lvl, msg) =>
558 | Future.successful(println(s"$lvl $msg"))
559 | }
560 | }
561 |
562 | val foo2Future = new (Foo ~> Future) {
563 | def apply[A](a: Foo[A]) = a match {
564 | case Foo1(s) => Future { List(Some(s.toInt)) } // if you put None here, it stops prg before Log
565 | case Foo2(i) => Future(Right(i))
566 | case Foo3 => Future.successful(())
567 | case Foo4(i) => Future.successful(Right(Some(i)))
568 | }
569 | }
570 |
571 | val bar2Future = new (Bar ~> Future) {
572 | def apply[A](a: Bar[A]) = a match {
573 | case Bar1(s) => Future { Some(s) } // if you put None here, it stops prg before Log
574 | case Bar2(i) => Future(Right(i.toString))
575 | }
576 | }
577 |
578 | val kvs2Future = new (KVS[String, Int, ?] ~> Future) {
579 | val map = scala.collection.mutable.Map[String, Int]()
580 |
581 | def apply[A](a: KVS[String, Int, A]) = a match {
582 | case get:Get[String, Int] => Future { map(get.key) }
583 | case put:Put[String, Int] => Future { map += (put.key -> put.value); () }
584 | }
585 | }
586 |
587 | val interpreters = foo2Future :&: logger2Future :&: bar2Future :&: kvs2Future
588 |
589 | Await.result(prg.value.interpret(interpreters), 10.seconds)
590 | }
591 |
592 | "freek" should "manage monadic onions of result types wrap/peelRight" in {
593 |
594 | sealed trait Foo[A]
595 | final case class Foo1(s: String) extends Foo[Option[Int]]
596 |
597 | sealed trait Bar[A]
598 | final case class Bar1(s: String) extends Bar[List[Option[String]]]
599 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
600 |
601 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
602 |
603 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
604 |
605 | type PRG = Foo :|: Log.DSL :|: PRG2
606 | val PRG = DSL.Make[PRG]
607 |
608 | val f: OnionT[Free, PRG.Cop, List :&: Either[String, ?] :&: Bulb, Option[Int]] =
609 | Foo1("5")
610 | .freek[PRG]
611 | .onionT[Either[String, ?] :&: Option :&: Bulb]
612 | .wrap[List]
613 | .peelRight
614 |
615 | }
616 |
617 | "freek" should "manage monadic onions with freeko" in {
618 | import cats.instances.future._
619 | import cats.instances.option._
620 | import cats.instances.list._
621 | import ExecutionContext.Implicits.global
622 |
623 | sealed trait Foo[A]
624 | final case class Foo1(s: String) extends Foo[List[Option[Int]]]
625 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
626 | final case object Foo3 extends Foo[Unit]
627 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
628 |
629 | sealed trait Bar[A]
630 | final case class Bar1(s: String) extends Bar[Option[String]]
631 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
632 |
633 | type PRG2 = Bar :|: Log.DSL :|: NilDSL
634 |
635 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
636 |
637 | type PRG = Foo :|: Log.DSL :|: PRG2
638 | val PRG = DSL.Make[PRG]
639 |
640 | val prg: OnionT[Free, PRG.Cop, O, Int] = for {
641 | i <- Foo1("5").freeko[PRG, O]
642 | i2 <- Foo2(i).freeko[PRG, O]
643 | _ <- Log.info("toto " + i).freeko[PRG, O]
644 | _ <- Foo3.freeko[PRG, O]
645 | s <- Bar1(i2.toString).freeko[PRG, O]
646 | i3 <- Foo4(i2).freeko[PRG, O]
647 | } yield (i3)
648 |
649 | val logger2Future = new (Log.DSL ~> Future) {
650 | def apply[A](a: Log.DSL[A]) = a match {
651 | case Log.LogMsg(lvl, msg) =>
652 | Future.successful(println(s"$lvl $msg"))
653 | }
654 | }
655 |
656 | val foo2Future = new (Foo ~> Future) {
657 | def apply[A](a: Foo[A]) = a match {
658 | case Foo1(s) => Future { List(Some(s.toInt)) } // if you put None here, it stops prg before Log
659 | case Foo2(i) => Future(Right(i))
660 | case Foo3 => Future.successful(())
661 | case Foo4(i) => Future.successful(Right(Some(i)))
662 | }
663 | }
664 |
665 | val bar2Future = new (Bar ~> Future) {
666 | def apply[A](a: Bar[A]) = a match {
667 | case Bar1(s) => Future { Some(s) } // if you put None here, it stops prg before Log
668 | case Bar2(i) => Future(Right(i.toString))
669 | }
670 | }
671 |
672 | val interpreters = foo2Future :&: logger2Future :&: bar2Future
673 |
674 | Await.result(prg.value.interpret(interpreters), 10.seconds)
675 |
676 | }
677 |
678 | "freek" should "allow declaring local DSL.Makes" in {
679 |
680 | trait RepositoryLayer {
681 | sealed trait Account
682 |
683 | sealed trait RepoF[A]
684 |
685 | sealed trait Repo[A]
686 | case class Query(no: String) extends Repo[Either[String, Account]]
687 | case class Store(account: Account) extends Repo[Either[String, Account]]
688 | case class Delete(no: String) extends Repo[Either[String, Unit]]
689 |
690 | object Repo {
691 | type PRG = Repo :|: NilDSL
692 | type O = Either[String, ?] :&: Bulb
693 | }
694 |
695 | def query(no: String) = Query(no)
696 | def store(account: Account) = Store(account)
697 | def delete(no: String) = Delete(no)
698 |
699 | // How do I write this function here ?
700 | def update(no: String, f: Account => Account) = for {
701 | a <- Query(no).freeko[Repo.PRG, Repo.O]
702 | _ <- Store(f(a)).freeko[Repo.PRG, Repo.O]
703 | } yield (())
704 | }
705 |
706 | trait FooLayer extends RepositoryLayer {
707 | sealed trait Foo[A]
708 | final case class Foo1(s: String) extends Foo[List[Option[Int]]]
709 | final case class Foo2(i: Int) extends Foo[Either[String, Int]]
710 | final case object Foo3 extends Foo[Unit]
711 | final case class Foo4(i: Int) extends Foo[Either[String, Option[Int]]]
712 |
713 | object Foo {
714 | type PRG = Foo :|: Log.DSL :|: Repo.PRG
715 | }
716 | }
717 |
718 | trait BarLayer extends RepositoryLayer {
719 |
720 | sealed trait Bar[A]
721 | final case class Bar1(s: String) extends Bar[Option[String]]
722 | final case class Bar2(i: Int) extends Bar[Either[String, String]]
723 |
724 | object Bar {
725 | type PRG = Bar :|: Log.DSL :|: Repo.PRG
726 | }
727 |
728 | }
729 |
730 | object Prg
731 | extends FooLayer
732 | with BarLayer {
733 |
734 | type O = List :&: Either[String, ?] :&: Option :&: Bulb
735 |
736 | type PRG = Log.DSL :|: Bar.PRG :||: Foo.PRG
737 | val PRG = DSL.Make[PRG]
738 |
739 | val prg: OnionT[Free, PRG.Cop, O, Int] = for {
740 | i <- Foo1("5").freeko[PRG, O]
741 | i2 <- Foo2(i).freeko[PRG, O]
742 | _ <- Log.info("toto " + i).freeko[PRG, O]
743 | _ <- Foo3.freeko[PRG, O]
744 | s <- Bar1(i2.toString).freeko[PRG, O]
745 | i3 <- Foo4(i2).freeko[PRG, O]
746 | _ <- update(i.toString, identity).freeko[PRG, O]
747 | } yield (i)
748 |
749 | val logger2Future = new (Log.DSL ~> Future) {
750 | def apply[A](a: Log.DSL[A]) = a match {
751 | case Log.LogMsg(lvl, msg) =>
752 | Future.successful(println(s"$lvl $msg"))
753 | }
754 | }
755 |
756 | val foo2Future = new (Foo ~> Future) {
757 | def apply[A](a: Foo[A]) = a match {
758 | case Foo1(s) => Future { println(s); List(Some(s.toInt)) } // if you put None here, it stops prg before Log
759 | case Foo2(i) => Future(Right(i))
760 | case Foo3 => Future.successful(())
761 | case Foo4(i) => Future.successful(Right(Some(i)))
762 | }
763 | }
764 |
765 | val bar2Future = new (Bar ~> Future) {
766 | def apply[A](a: Bar[A]) = a match {
767 | case Bar1(s) => Future { Some(s) } // if you put None here, it stops prg before Log
768 | case Bar2(i) => Future(Right(i.toString))
769 | }
770 | }
771 |
772 | val repo2Future = new (Repo ~> Future) {
773 | def apply[A](a: Repo[A]) = a match {
774 | case Query(s) => Future { Right(new Account {}) }
775 | case Store(acc) => Future { Right(new Account {}) }
776 | case Delete(no) => Future { Right(()) }
777 | }
778 | }
779 |
780 | val fooInterpreters = foo2Future :&: logger2Future :&: repo2Future
781 | val barInterpreters = bar2Future :&: logger2Future :&: repo2Future
782 |
783 | val interpreters = foo2Future :&: logger2Future :&: bar2Future :&: repo2Future
784 | val interpreters2 = logger2Future :&: fooInterpreters :&&: barInterpreters
785 | }
786 | val r = Await.result(Prg.prg.value.interpret(Prg.interpreters), 10.seconds)
787 | println("result:"+r)
788 | val r2 = Await.result(Prg.prg.value.interpret(Prg.interpreters2), 10.seconds)
789 | println("result:"+r2)
790 | }
791 |
792 |
793 | "freek" should "special cases" in {
794 | sealed trait Foo[A]
795 | final case class Foo1(s: String) extends Foo[List[String]]
796 |
797 | sealed trait Bar[A]
798 | final case class Bar1(s: String) extends Bar[Option[String]]
799 |
800 | sealed trait KVS[K, V, E]
801 | case class Get[K, V](key: K) extends KVS[K, V, Option[V]]
802 | case class Put[K, V](key: K, value: V) extends KVS[K, V, Unit]
803 |
804 | type KVSA[A] = KVS[String, Int, A]
805 | type PRG = KVSA :|: KVS[Float, Double, ?] :|: Foo :|: Bar :|: NilDSL
806 | val PRG = DSL.Make[PRG]
807 | type O = Option :&: Bulb
808 |
809 | val f1 = for {
810 | _ <- Bar1("bar1").freek[PRG].onionT[O]
811 | _ <- Foo1("foo1").freek[PRG].onion[O]
812 | } yield (())
813 |
814 | val f2: Free[PRG.Cop, Option[Int]] = for {
815 | i <- Get[String, Int]("toto").upcast[KVSA[Option[Int]]].freek[PRG]
816 | } yield (i)
817 |
818 | val f3: Free[PRG.Cop, Option[Int]] = Get[String, Int]("toto").upcast[KVSA[Option[Int]]].freek[PRG]
819 | }
820 |
821 | "freek" should "special cases 2" in {
822 | sealed trait Foo1[A]
823 | final case class Bar1(s: Int) extends Foo1[List[Int]]
824 |
825 | sealed trait Foo2[A]
826 | final case class Bar21(s: Int) extends Foo2[Option[Int]]
827 | final case class Bar22(s: Int) extends Foo2[List[Option[Int]]]
828 |
829 | sealed trait Foo3[A]
830 | final case class Bar31(s: Long) extends Foo3[Either[String, Long]]
831 | final case class Bar32(s: Float) extends Foo3[Either[String, List[Float]]]
832 | final case class Bar33(s: Double) extends Foo3[Either[String, Option[Boolean]]]
833 |
834 | type PRG = Foo1 :|: Foo2 :|: Foo3 :|: NilDSL
835 | val PRG = DSL.Make[PRG]
836 | type O = Either[String, ?] :&: List :&: Option :&: Bulb
837 |
838 | val f1: Free[PRG.Cop, Either[String, List[Option[Unit]]]] = (for {
839 | i <- Bar1(3).freek[PRG].onionT[O]
840 | i <- Bar21(i).freek[PRG].onionT[O]
841 | i <- Bar22(i).freek[PRG].onionT[O]
842 | l <- Bar31(i.toLong).freek[PRG].onionT[O]
843 | l <- Bar32(l.toFloat).freek[PRG].onionT[O]
844 | _ <- Bar33(l.toDouble).freek[PRG].onionT[O]
845 | } yield (())).value
846 |
847 | }
848 |
849 | "freek" should "special cases 3" in {
850 | sealed trait Foo1[A]
851 | final case class Bar1(s: Int) extends Foo1[List[Int]]
852 |
853 | sealed trait Foo2[A]
854 | final case class Bar21(s: Int) extends Foo2[Option[Int]]
855 | final case class Bar22(s: Int) extends Foo2[List[Option[Int]]]
856 |
857 | sealed trait Foo3[A]
858 | final case class Bar31(s: Int) extends Foo3[Either[String, Long]]
859 | final case class Bar32(s: Float) extends Foo3[Either[String, List[Float]]]
860 | final case class Bar33(s: Double) extends Foo3[Either[String, Option[Boolean]]]
861 | final case class Bar34(s: Double) extends Foo3[Either[String, List[Option[Boolean]]]]
862 |
863 | type PRG = Foo1 :|: Foo2 :|: Foo3 :|: NilDSL
864 | val PRG = DSL.Make[PRG]
865 | type O = Either[String, ?] :&: List :&: Option :&: Bulb
866 |
867 | // ugly head & get :D
868 | val f1: Free[PRG.Cop, Either[String, String]] = (for {
869 | i <- Bar1(3).freek[PRG].onionT2[O]
870 | i <- Bar21(i.head.get).freek[PRG].onionT2[O]
871 | i <- Bar22(i.head.get).freek[PRG].onionT2[O]
872 | i <- Bar31(i.head.get).freek[PRG].onionT2[O]
873 | i <- Bar32(i.head.get.toFloat).freek[PRG].onionT2[O]
874 | i <- Bar33(i.head.get.toDouble).freek[PRG].onionT2[O]
875 | } yield (i.toString)).value
876 |
877 | }
878 |
879 | "freek" should "special cases 4" in {
880 | sealed trait Foo1[A]
881 | final case class Bar11(s: Int) extends Foo1[Either[String, List[Int]]]
882 | final case class Bar12(s: List[Int]) extends Foo1[Either[String, Option[Int]]]
883 |
884 | sealed trait Foo2[A]
885 | final case class Bar21(s: Int) extends Foo1[Either[Long, Option[List[Int]]]]
886 | final case class Bar22(s: List[Int]) extends Foo1[Either[Long, Option[Int]]]
887 |
888 | type PRG = Foo1 :|: Foo2 :|: NilDSL
889 | val PRG = DSL.Make[PRG]
890 | type O = Either[String, ?] :&: Either[Long, ?] :&: Option :&: Bulb
891 |
892 | val f1: OnionT[Free, PRG.Cop, O, Unit] = for {
893 | l1 <- Bar11(5).freek[PRG].onionX1[O]
894 | _ <- Bar12(l1).freek[PRG].onionT[O]
895 | l2 <- Bar21(6).freek[PRG].onionX2[O]
896 | _ <- Bar22(l2).freek[PRG].onionT[O]
897 | } yield (())
898 |
899 | }
900 |
901 | "freek" should "extend DSL" in {
902 | object Program {
903 | sealed trait Foo1[A]
904 | final case class Bar11(s: Int) extends Foo1[String]
905 |
906 | sealed trait Foo2[A]
907 | final case class Bar21(s: String) extends Foo2[Int]
908 |
909 | type PRG = Foo1 :|: Foo2 :|: NilDSL
910 | val PRG = DSL.Make[PRG]
911 |
912 | val program = for {
913 | s <- Bar11(5).freek[PRG]
914 | i <- Bar21(s).freek[PRG]
915 | } yield (i)
916 | }
917 |
918 | object OtherProgram {
919 | import Program._
920 |
921 | sealed trait Foo3[A]
922 | case class Bar31[A](bar11: Foo1[A]) extends Foo3[A]
923 | case class Bar32(i: Int) extends Foo3[String]
924 |
925 | type PRG = Foo3 :|: Foo2 :|: NilDSL
926 | val PRG = DSL.Make[PRG]
927 |
928 | val copknat = CopKNat[Program.PRG.Cop].replace(
929 | new (Foo1 ~> Foo3) {
930 | def apply[A](foo1: Foo1[A]): Foo3[A] = Bar31(foo1)
931 | }
932 | )
933 |
934 | val program = for {
935 | i <- Program.program.compile(copknat)
936 | s <- Bar32(i).freek[PRG]
937 | } yield (s)
938 |
939 | }
940 |
941 | import Program._
942 | import OtherProgram._
943 |
944 | val foo1Future = new (Foo1 ~> Future) {
945 | def apply[A](a: Foo1[A]) = a match {
946 | case Bar11(i) => Future { i.toString }
947 | }
948 | }
949 |
950 | val foo2Future = new (Foo2 ~> Future) {
951 | def apply[A](a: Foo2[A]) = a match {
952 | case Bar21(s) => Future { s.toInt }
953 | }
954 | }
955 |
956 | def foo3Future(foo1Nat: Foo1 ~> Future) = new (Foo3 ~> Future) {
957 | def apply[A](a: Foo3[A]) = a match {
958 | case Bar31(foo1) => foo1Nat(foo1)
959 | case Bar32(i) => Future { i.toString }
960 | }
961 | }
962 |
963 | val interpreter = foo2Future :&: foo3Future(foo1Future)
964 |
965 | val fut = OtherProgram.program.interpret(interpreter)
966 |
967 | ()
968 | }
969 |
970 | "freek" should "append DSL" in {
971 | object Program {
972 | sealed trait Foo1[A]
973 | final case class Bar11(s: Int) extends Foo1[String]
974 |
975 | sealed trait Foo2[A]
976 | final case class Bar21(s: String) extends Foo2[Int]
977 |
978 | type PRG = Foo1 :|: Foo2 :|: NilDSL
979 | val PRG = DSL.Make[PRG]
980 |
981 | val program = for {
982 | s <- Bar11(5).freek[PRG]
983 | i <- Bar21(s).freek[PRG]
984 | } yield (i)
985 | }
986 |
987 | object OtherProgram {
988 | import Program._
989 |
990 | sealed trait Foo3[A]
991 | case class Bar31[A](bar11: Foo1[A]) extends Foo3[A]
992 | case class Bar32(i: Int) extends Foo3[String]
993 |
994 | type PRG = Foo3 :|: Foo2 :|: NilDSL
995 | val PRG = DSL.Make[PRG]
996 |
997 | val copknat = CopKNat[Program.PRG.Cop].replace(
998 | new (Foo1 ~> Foo3) {
999 | def apply[A](foo1: Foo1[A]): Foo3[A] = Bar31(foo1)
1000 | }
1001 | )
1002 |
1003 | val program = for {
1004 | i <- Program.program.compile(copknat)
1005 | s <- Bar32(i).freek[PRG]
1006 | } yield (s)
1007 |
1008 | }
1009 |
1010 | import Program._
1011 | import OtherProgram._
1012 |
1013 | val foo1Future = new (Foo1 ~> Future) {
1014 | def apply[A](a: Foo1[A]) = a match {
1015 | case Bar11(i) => Future { i.toString }
1016 | }
1017 | }
1018 |
1019 | val foo2Future = new (Foo2 ~> Future) {
1020 | def apply[A](a: Foo2[A]) = a match {
1021 | case Bar21(s) => Future { s.toInt }
1022 | }
1023 | }
1024 |
1025 | def foo3Future(foo1Nat: Foo1 ~> Future) = new (Foo3 ~> Future) {
1026 | def apply[A](a: Foo3[A]) = a match {
1027 | case Bar31(foo1) => foo1Nat(foo1)
1028 | case Bar32(i) => Future { i.toString }
1029 | }
1030 | }
1031 |
1032 | val interpreter = foo2Future :&: foo3Future(foo1Future)
1033 |
1034 | val fut = OtherProgram.program.interpret(interpreter)
1035 |
1036 | ()
1037 | }
1038 |
1039 | "freek" should "transpile" in {
1040 | object Program {
1041 | sealed trait Foo1[A]
1042 | final case class Bar11(s: Int) extends Foo1[Int]
1043 |
1044 | sealed trait Foo2[A]
1045 | final case class Bar21(s: String) extends Foo2[String]
1046 |
1047 | type PRG = Foo1 :|: Foo2 :|: NilDSL
1048 | val PRG = DSL.Make[PRG]
1049 |
1050 | val program = for {
1051 | _ <- Bar11(5).freek[PRG]
1052 | _ <- Bar21("1.234").freek[PRG]
1053 | } yield (())
1054 | }
1055 |
1056 | object OtherProgram {
1057 |
1058 | sealed trait Foo3[A]
1059 | final case class Bar31(s: String) extends Foo3[Float]
1060 |
1061 | sealed trait Foo4[A]
1062 | final case class Bar41(s: Float) extends Foo4[String]
1063 |
1064 | type PRG = Foo3 :|: Foo4 :|: NilDSL
1065 | val PRG = DSL.Make[PRG]
1066 |
1067 | // this is our transpiler transforming a Foo2 into another free program
1068 | val transpiler = new (Program.Foo2 ~> Free[PRG.Cop, ?]) {
1069 |
1070 | def apply[A](f: Program.Foo2[A]): Free[PRG.Cop, A] = f match {
1071 | case Program.Bar21(s) =>
1072 | for {
1073 | f <- Bar31(s).freek[PRG]
1074 | s <- Bar41(f).freek[PRG]
1075 | } yield (s)
1076 | }
1077 | }
1078 | }
1079 |
1080 | import Program._
1081 | import OtherProgram._
1082 |
1083 | // 1/ CopKNat[Program.PRG.Cop] creates a Program.PRG.Cop ~> Program.PRG.Cop
1084 | // 2/ .replace creates a natural trans that replaces Program.Foo2 in Program.PRG.Cop by Free[OtherProgram.PRG.Cop, ?] using transpiler
1085 | // 3/ The result is a terrible natural transformation (don't try to write that type, it's too ugly, let's scalac do it) :
1086 | // (Foo1 :|: Foo2 :|: NilDSL) ~> (Foo1 :|: Free[OtherProgram.PRG.Cop, ?] :|: NilDSL)
1087 | val transpileNat = CopKNat[Program.PRG.Cop].replace(OtherProgram.transpiler)
1088 |
1089 | // Transpile does 2 operations:
1090 | // 1/ Replaces Foo2 in Program.PRG.Cop by Free[OtherProgram.PRG.Cop, A]
1091 | // -> OtherProgram.transpiler natural transformation converts Foo2 into the free program Free[OtherProgram.PRG.Cop, A]
1092 | // -> New PRG.Cop is then Foo1 :|: Free[OtherProgram.PRG.Cop, ?] :|: NilDSL
1093 | //
1094 | // 2/ Flattens Free[(Foo1 :|: Free[(Foo3 :|: Foo4 :|: NilDSL)#Cop, ?] :|: NilDSL)#Cop, A] into
1095 | // Free[(Foo1 :|: Foo3 :|: Foo4 :|: NilDSL)#Cop, A]
1096 | val free = Program.program.transpile(transpileNat)
1097 | // Same as
1098 | // val free2 = Program.f.compile(transpileNat).flatten
1099 |
1100 | // Write our interpreters for new program (Foo1, Foo3, Foo4)
1101 | val foo1Future = new (Foo1 ~> Future) {
1102 | def apply[A](a: Foo1[A]) = a match {
1103 | case Bar11(i) => Future { i }
1104 | }
1105 | }
1106 |
1107 | val foo3Future = new (Foo3 ~> Future) {
1108 | def apply[A](a: Foo3[A]) = a match {
1109 | case Bar31(s) => Future { s.toFloat }
1110 | }
1111 | }
1112 |
1113 | val foo4Future = new (Foo4 ~> Future) {
1114 | def apply[A](a: Foo4[A]) = a match {
1115 | case Bar41(s) => Future { s.toString }
1116 | }
1117 | }
1118 |
1119 | val r = Await.result(free.interpret(foo1Future :&: foo3Future :&: foo4Future), 2.seconds)
1120 | println("r:"+r)
1121 | ()
1122 | }
1123 |
1124 | // "freek" should "special case" in {
1125 | // import java.io.File
1126 |
1127 | // sealed trait KVS[A]
1128 | // object KVS {
1129 | // case class Get(key: String) extends KVS[String]
1130 | // case class Put(key: String, value: String) extends KVS[Unit]
1131 | // }
1132 |
1133 | // sealed trait FileIO[A]
1134 | // object FileIO {
1135 | // case class Get(name: String) extends FileIO[File]
1136 | // case class Delete(name: String) extends FileIO[Unit]
1137 | // }
1138 |
1139 | // val FileInterpreter = new (FileIO ~> Lambda[A => Future[Either[Exception, A]]]) {
1140 | // override def apply[A](fa: FileIO[A]): Future[Either[Exception, A]] = fa match {
1141 | // case FileIO.Get(name) =>
1142 | // Future {
1143 | // Right(new File(name))
1144 | // }
1145 |
1146 | // case FileIO.Delete(name) =>
1147 | // Future {
1148 | // new File(name).delete()
1149 | // Right(())
1150 | // }
1151 | // }
1152 | // }
1153 |
1154 | // val KVSInterpreter = new (KVS ~> Lambda[A => Future[Either[Exception, A]]]) {
1155 | // def apply[A](a: KVS[A]): Future[Either[Exception, A]] = a match {
1156 | // case KVS.Get(id) =>
1157 | // Future {
1158 | // Right("123")
1159 | // }
1160 | // case KVS.Put(id, value) =>
1161 | // Future {
1162 | // Right(())
1163 | // }
1164 | // }
1165 | // }
1166 |
1167 |
1168 | // val interpreter = KVSInterpreter :&: toInterpreter(FileInterpreter)
1169 |
1170 | // }
1171 |
1172 | }
1173 |
1174 |
--------------------------------------------------------------------------------
/src/test/scala/FreekitSpec.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 |
4 | /**
5 | * Copyright 2014 Pascal Voitot (@mandubian)
6 | */
7 | import org.scalatest._
8 |
9 | import cats.free.{Free, Trampoline}
10 | import cats.{~>, Id}
11 |
12 | import scala.concurrent._
13 | import scala.concurrent.duration._
14 |
15 | // import cats.derived._, functor._, legacy._
16 | import cats.Functor
17 | import cats.instances.future._
18 | import cats.instances.option._
19 | import cats.instances.list._
20 | import cats.instances.either._
21 | import ExecutionContext.Implicits.global
22 |
23 | import freek._
24 |
25 |
26 | class FreekitSpec extends FlatSpec with Matchers {
27 |
28 | "Freek" should "macro" in {
29 |
30 | //////////////////////////////////////////////////////////////////////////
31 | // LOG DSL
32 | sealed trait Log[A]
33 | object Log {
34 | case class Info(msg: String) extends Log[Unit]
35 | }
36 |
37 | sealed trait Foo1[A]
38 | object Foo1 {
39 | final case class Bar1(a: Int) extends Foo1[Option[Int]]
40 | }
41 |
42 | sealed trait Foo2[A]
43 | object Foo2 {
44 | final case class Bar21(a: Int) extends Foo2[Int]
45 | final case object Bar22 extends Foo2[Int]
46 | }
47 |
48 |
49 | type PRG = Foo1 :|: Foo2 :|: Log :|: NilDSL
50 | val PRG = DSL.Make[PRG]
51 |
52 | object M extends Freekit(PRG) {
53 | val prg = for {
54 | aOpt <- Foo1.Bar1(7)
55 | _ <- Log.Info(s"aOpt:$aOpt")
56 | a <- aOpt match {
57 | case Some(a) => for {
58 | a <- Foo2.Bar21(a)
59 | _ <- Log.Info(s"a1:$a")
60 | } yield (a)
61 | case None => for {
62 | a <- Foo2.Bar22
63 | _ <- Log.Info(s"a2:$a")
64 | } yield (a)
65 | }
66 | } yield (a)
67 | }
68 |
69 | object MO extends Freekito(PRG) {
70 | type O = Option :&: Bulb
71 |
72 | val prg = for {
73 | a <- Foo1.Bar1(7)
74 | _ <- Log.Info(s"a:$a")
75 | a <- Foo2.Bar21(a)
76 | } yield (a)
77 | }
78 |
79 | val foo1I = new (Foo1 ~> Future) {
80 | import Foo1._
81 |
82 | def apply[A](f: Foo1[A]): Future[A] = f match {
83 | case Bar1(a) => Future(Some(a))
84 |
85 | }
86 | }
87 |
88 | val foo2I = new (Foo2 ~> Future) {
89 | import Foo2._
90 |
91 | def apply[A](f: Foo2[A]): Future[A] = f match {
92 | case Bar21(a) => Future(a)
93 | case Bar22 => Future(0)
94 | }
95 | }
96 |
97 |
98 | val logI = new (Log ~> Future) {
99 | def apply[A](a: Log[A]) = a match {
100 | case Log.Info(msg) =>
101 | Future.successful(println(s"[info] $msg"))
102 | }
103 | }
104 |
105 | val f = M.prg.interpret(foo1I :&: foo2I :&: logI)
106 | Await.result(f, 10.seconds)
107 |
108 | val f2 = MO.prg.value.interpret(foo1I :&: foo2I :&: logI)
109 | Await.result(f2, 10.seconds)
110 | }
111 |
112 |
113 | "Freekit" should "special cases 4" in {
114 | sealed trait Foo1[A]
115 | final case class Bar11(s: Int) extends Foo1[Either[String, List[Int]]]
116 | final case class Bar12(s: List[Int]) extends Foo1[Either[String, Option[Int]]]
117 |
118 | sealed trait Foo2[A]
119 | final case class Bar21(s: Int) extends Foo1[Either[Long, Option[List[Int]]]]
120 | final case class Bar22(s: List[Int]) extends Foo1[Either[Long, Option[Int]]]
121 |
122 | type PRG = Foo1 :|: Foo2 :|: NilDSL
123 | val PRG = DSL.Make[PRG]
124 |
125 | object F1 extends Freekito(PRG) {
126 | type O = Either[String, ?] :&: Either[Long, ?] :&: Option :&: Bulb
127 |
128 | val prg = for {
129 | l1 <- Bar11(5).freek[PRG].onionX1[O]
130 | _ <- Bar12(l1)
131 | l2 <- Bar21(6).freek[PRG].onionX2[O]
132 | _ <- Bar22(l2)
133 | } yield (())
134 | }
135 | }
136 |
137 | "Freekit" should "freek" in {
138 | import Http._
139 | import DB._
140 |
141 | object DBService extends Freekit(DSL.Make[Log.DSL :|: DB.DSL :|: NilDSL]) {
142 |
143 | /** the DSL.Make */
144 | def findById(id: String): Free[PRG.Cop, Either[DBError, Entity]] =
145 | for {
146 | _ <- Log.debug("Searching for entity id:"+id)
147 | res <- FindById(id)
148 | _ <- Log.debug("Search result:"+res)
149 | } yield (res)
150 | }
151 |
152 | object HttpService extends Freekit(DSL.Make[Log.DSL :|: HttpInteract :|: HttpHandle :|: DBService.PRG]) {
153 |
154 | def handle(req: HttpReq): Free[PRG.Cop, HttpResp] = req.url match {
155 | case "/foo" =>
156 | for {
157 | _ <- Log.debug("/foo")
158 | dbRes <- DBService.findById("foo").expand[PRG]
159 |
160 | resp <- HttpHandle.result(
161 | dbRes match {
162 | case Left(err) => HttpResp(status = InternalServerError)
163 | case Right(e) => HttpResp(status = Ok, body = e.toString)
164 | }
165 | )
166 | } yield (resp)
167 |
168 | case _ => HttpHandle.result(HttpResp(status = InternalServerError))
169 | }
170 |
171 | def serve() : Free[PRG.Cop, Either[RecvError, SendStatus]] =
172 | for {
173 | recv <- HttpInteract.receive()
174 | _ <- Log.info("HttpReceived Request:"+recv)
175 | res <- recv match {
176 | case Left(err) => HttpInteract.stop(Left(err)).freek[PRG]
177 |
178 | case Right(req) =>
179 | for {
180 | resp <- handle(req)
181 | _ <- Log.info("Sending Response:"+resp)
182 | ack <- HttpInteract.respond(resp)
183 | res <- if(ack == Ack) serve()
184 | else HttpInteract.stop(Right(ack)).freek[PRG]
185 | } yield (res)
186 | }
187 | } yield (res)
188 |
189 | }
190 | }
191 | "Freek" should "work" in {
192 | import cats._
193 | import cats.free.Free
194 | import cats.implicits._
195 |
196 | import freek._
197 |
198 | object Test {
199 | sealed trait Instruction[T]
200 | // Seq[Int] doesn't represent and error but is the return type of Get
201 | final case class Get() extends Instruction[List[Int]]
202 |
203 | type PRG = Instruction :|: NilDSL
204 | val PRG = freek.DSL.Make[PRG]
205 | type O = Option :&: List :&: Bulb
206 |
207 | Get().freek[PRG].onionT[O]
208 | }
209 | }
210 |
211 | }
--------------------------------------------------------------------------------
/src/test/scala/LongCompileSpec.scala:
--------------------------------------------------------------------------------
1 | package freek
2 |
3 |
4 | /**
5 | * Copyright 2014 Pascal Voitot (@mandubian)
6 | */
7 | import org.scalatest._
8 |
9 | import cats.free.{Free, Trampoline}
10 | import cats.{~>, Id}
11 |
12 | import scala.concurrent._
13 | import scala.concurrent.duration._
14 |
15 | // import cats.derived._, functor._, legacy._
16 | import cats.Functor
17 | import cats.instances.future._
18 | import cats.instances.option._
19 | import cats.instances.list._
20 | import cats.instances.either._
21 | import ExecutionContext.Implicits.global
22 |
23 | import freek._
24 |
25 |
26 | class LongCompileSpec extends FlatSpec with Matchers {
27 |
28 | /** weird this is not provided in cats apparently */
29 | implicit val fc = new cats.Comonad[Function0] {
30 | def extract[A](x: () => A): A = x()
31 | def coflatMap[A, B](fa: () => A)(f: (() => A) => B): () => B = () => f(fa)
32 | def map[A, B](fa: () => A)(f: A => B): () => B = () => f(fa())
33 | }
34 |
35 | case class Foo1[A](a: A)
36 | case class Foo2[A](a: A)
37 | case class Foo3[A](a: A)
38 | case class Foo4[A](a: A)
39 | case class Foo5[A](a: A)
40 | case class Foo6[A](a: A)
41 | case class Foo7[A](a: A)
42 | case class Foo8[A](a: A)
43 | case class Foo9[A](a: A)
44 | case class Foo10[A](a: A)
45 | case class Foo11[A](a: A)
46 | case class Foo12[A](a: A)
47 | case class Foo13[A](a: A)
48 | case class Foo14[A](a: A)
49 | case class Foo15[A](a: A)
50 | case class Foo16[A](a: A)
51 | case class Foo17[A](a: A)
52 | case class Foo18[A](a: A)
53 | case class Foo19[A](a: A)
54 | case class Foo20[A](a: A)
55 |
56 | "Freek" should "long compile" in {
57 |
58 | type PRG =
59 | Foo1 :|: Foo2 :|: Foo3 :|: Foo4 :|: Foo5 :|: Foo6 :|: Foo7 :|: Foo8 :|: Foo9 :|: Foo10 :|:
60 | Foo11 :|: Foo12 :|: Foo13 :|: Foo14 :|: Foo15 :|: Foo16 :|: Foo17 :|: Foo18 :|: Foo19 :|: Foo20 :|:
61 | NilDSL
62 |
63 | val PRG = DSL.Make[PRG]
64 |
65 |
66 | val prg: Free[PRG.Cop, Int] = for {
67 | a <- Foo1(5).freek[PRG]
68 | a <- Foo2(a).freek[PRG]
69 | a <- Foo3(a).freek[PRG]
70 | a <- Foo4(a).freek[PRG]
71 | a <- Foo5(a).freek[PRG]
72 | a <- Foo6(a).freek[PRG]
73 | a <- Foo7(a).freek[PRG]
74 | a <- Foo8(a).freek[PRG]
75 | a <- Foo9(a).freek[PRG]
76 | a <- Foo10(a).freek[PRG]
77 | a <- Foo11(a).freek[PRG]
78 | a <- Foo12(a).freek[PRG]
79 | a <- Foo13(a).freek[PRG]
80 | a <- Foo14(a).freek[PRG]
81 | a <- Foo15(a).freek[PRG]
82 | a <- Foo16(a).freek[PRG]
83 | a <- Foo17(a).freek[PRG]
84 | a <- Foo18(a).freek[PRG]
85 | a <- Foo19(a).freek[PRG]
86 | a <- Foo20(a).freek[PRG]
87 | } yield (a)
88 |
89 | object Foo1I extends (Foo1 ~> cats.Id) {
90 | def apply[A](a: Foo1[A]) = a match {
91 | case Foo1(a) => a
92 | }
93 | }
94 |
95 | object Foo2I extends (Foo2 ~> cats.Id) {
96 | def apply[A](a: Foo2[A]) = a match {
97 | case Foo2(a) => a
98 | }
99 | }
100 |
101 | object Foo3I extends (Foo3 ~> cats.Id) {
102 | def apply[A](a: Foo3[A]) = a match {
103 | case Foo3(a) => a
104 | }
105 | }
106 |
107 | object Foo4I extends (Foo4 ~> cats.Id) {
108 | def apply[A](a: Foo4[A]) = a match {
109 | case Foo4(a) => a
110 | }
111 | }
112 |
113 | object Foo5I extends (Foo5 ~> cats.Id) {
114 | def apply[A](a: Foo5[A]) = a match {
115 | case Foo5(a) => a
116 | }
117 | }
118 |
119 | object Foo6I extends (Foo6 ~> cats.Id) {
120 | def apply[A](a: Foo6[A]) = a match {
121 | case Foo6(a) => a
122 | }
123 | }
124 |
125 | object Foo7I extends (Foo7 ~> cats.Id) {
126 | def apply[A](a: Foo7[A]) = a match {
127 | case Foo7(a) => a
128 | }
129 | }
130 |
131 | object Foo8I extends (Foo8 ~> cats.Id) {
132 | def apply[A](a: Foo8[A]) = a match {
133 | case Foo8(a) => a
134 | }
135 | }
136 |
137 | object Foo9I extends (Foo9 ~> cats.Id) {
138 | def apply[A](a: Foo9[A]) = a match {
139 | case Foo9(a) => a
140 | }
141 | }
142 |
143 | object Foo10I extends (Foo10 ~> cats.Id) {
144 | def apply[A](a: Foo10[A]) = a match {
145 | case Foo10(a) => a
146 | }
147 | }
148 |
149 | object Foo11I extends (Foo11 ~> cats.Id) {
150 | def apply[A](a: Foo11[A]) = a match {
151 | case Foo11(a) => a
152 | }
153 | }
154 |
155 | object Foo12I extends (Foo12 ~> cats.Id) {
156 | def apply[A](a: Foo12[A]) = a match {
157 | case Foo12(a) => a
158 | }
159 | }
160 |
161 | object Foo13I extends (Foo13 ~> cats.Id) {
162 | def apply[A](a: Foo13[A]) = a match {
163 | case Foo13(a) => a
164 | }
165 | }
166 |
167 | object Foo14I extends (Foo14 ~> cats.Id) {
168 | def apply[A](a: Foo14[A]) = a match {
169 | case Foo14(a) => a
170 | }
171 | }
172 |
173 | object Foo15I extends (Foo15 ~> cats.Id) {
174 | def apply[A](a: Foo15[A]) = a match {
175 | case Foo15(a) => a
176 | }
177 | }
178 |
179 | object Foo16I extends (Foo16 ~> cats.Id) {
180 | def apply[A](a: Foo16[A]) = a match {
181 | case Foo16(a) => a
182 | }
183 | }
184 |
185 | object Foo17I extends (Foo17 ~> cats.Id) {
186 | def apply[A](a: Foo17[A]) = a match {
187 | case Foo17(a) => a
188 | }
189 | }
190 |
191 | object Foo18I extends (Foo18 ~> cats.Id) {
192 | def apply[A](a: Foo18[A]) = a match {
193 | case Foo18(a) => a
194 | }
195 | }
196 |
197 | object Foo19I extends (Foo19 ~> cats.Id) {
198 | def apply[A](a: Foo19[A]) = a match {
199 | case Foo19(a) => a
200 | }
201 | }
202 |
203 | object Foo20I extends (Foo20 ~> cats.Id) {
204 | def apply[A](a: Foo20[A]) = a match {
205 | case Foo20(a) => a
206 | }
207 | }
208 |
209 | val interpreter =
210 | Foo1I :&: Foo2I :&: Foo3I :&: Foo4I :&: Foo5I :&: Foo6I :&: Foo7I :&: Foo8I :&: Foo9I :&: Foo10I :&:
211 | Foo11I :&: Foo12I :&: Foo13I :&: Foo14I :&: Foo15I :&: Foo16I :&: Foo17I :&: Foo18I :&: Foo19I :&: Foo20I
212 |
213 | val res = prg.interpret(interpreter)
214 | println(s"Res: $res")
215 | }
216 | }
217 |
--------------------------------------------------------------------------------