Free Structures

sealed abstract class Free[S[_], A] {
  /** Map over the result value */
  def map[B](f: A => B): Free[S, B]
  
  /** Monadic bind operation */
  def flatMap[B](f: A => Free[S, B]): Free[S, B]
  
  /** Fold the free monad using a natural transformation */
  def foldMap[M[_]](f: S ~> M)(implicit M: Monad[M]): M[A]
  
  /** Run using Id (for pure functors) */
  def run(implicit S: Functor[S]): A
  
  /** Run a single step */
  def resume(implicit S: Functor[S]): S[Free[S, A]] \/ A
  
  /** Convert to FreeT */
  def toFreeT[M[_]](implicit M: Applicative[M]): FreeT[S, M, A]
  
  /** Hoist to another functor */
  def hoist[T[_]](f: S ~> T): Free[T, A]
  
  /** Inject into a coproduct */
  def inject[T[_]](implicit I: Inject[S, T]): Free[T, A]
}

/** Pure value in Free monad */
case class Return[S[_], A](a: A) extends Free[S, A]

/** Suspended computation in Free monad */
case class Suspend[S[_], A](sa: S[Free[S, A]]) extends Free[S, A]

object Free {
  /** Lift a pure value into Free */
  def pure[S[_], A](a: A): Free[S, A] = Return(a)
  
  /** Lift a functor value into Free */
  def liftF[S[_], A](sa: S[A])(implicit S: Functor[S]): Free[S, A] = 
    Suspend(S.map(sa)(Return(_)))
    
  /** Roll a suspended computation */
  def roll[S[_], A](sa: S[Free[S, A]]): Free[S, A] = Suspend(sa)
  
  /** Create from function */
  def unfold[S[_], A, B](a: A)(f: A => S[A] \/ B)(implicit S: Functor[S]): Free[S, B]
  
  /** Trampoline - Free monad over Function0 for stack safety */
  type Trampoline[A] = Free[Function0, A]
  
  /** Source - Free monad over (A, ?) for generating sequences */
  type Source[A, B] = Free[({ type f[x] = (A, x) })#f, B]
  
  /** Sink - Free monad over (=> A) for consuming sequences */  
  type Sink[A, B] = Free[({ type f[x] = (=> A) => x })#f, B]
}

import scalaz._
import scalaz.Free._

// Define DSL operations
sealed trait ConsoleOp[A]
case class PrintLine(msg: String) extends ConsoleOp[Unit]
case class ReadLine() extends ConsoleOp[String]

// Smart constructors
def printLine(msg: String): Free[ConsoleOp, Unit] = 
  liftF(PrintLine(msg))
def readLine: Free[ConsoleOp, String] = 
  liftF(ReadLine())

// Program using the DSL
val program = for {
  _    <- printLine("What's your name?")
  name <- readLine
  _    <- printLine(s"Hello, $name!")
} yield name

// Interpreter
val consoleInterpreter = new (ConsoleOp ~> Id) {
  def apply[A](op: ConsoleOp[A]): A = op match {
    case PrintLine(msg) => println(msg)
    case ReadLine()     => scala.io.StdIn.readLine()
  }
}

// Run the program
val result = program.foldMap(consoleInterpreter)

sealed abstract class FreeT[S[_], M[_], A] {
  /** Map over the result value */
  def map[B](f: A => B)(implicit M: Functor[M]): FreeT[S, M, B]
  
  /** Monadic bind operation */
  def flatMap[B](f: A => FreeT[S, M, B])(implicit M: Monad[M]): FreeT[S, M, B]
  
  /** Fold using natural transformation */
  def foldMap[N[_]](f: S ~> N)(implicit M: Monad[M], N: Monad[N]): M[A]
  
  /** Interpret into the base monad */
  def interpret[N[_]](f: S ~> ({ type λ[α] = FreeT[N, M, α] })#λ)(implicit M: Monad[M]): FreeT[N, M, A]
  
  /** Run the FreeT */
  def runFreeT(implicit M: Monad[M]): M[S[FreeT[S, M, A]] \/ A]
  
  /** Hoist the base monad */
  def hoist[N[_]](mn: M ~> N)(implicit M: Functor[M]): FreeT[S, N, A]
  
  /** Transform the functor */
  def mapSuspension[T[_]](f: S ~> T)(implicit M: Functor[M]): FreeT[T, M, A]
}

object FreeT {
  /** Lift a pure value */
  def point[S[_], M[_], A](a: A)(implicit M: Applicative[M]): FreeT[S, M, A]
  
  /** Lift a functor operation */
  def liftF[S[_], M[_], A](sa: S[A])(implicit S: Functor[S], M: Applicative[M]): FreeT[S, M, A]
  
  /** Lift base monad operation */
  def liftM[S[_], M[_], A](ma: M[A])(implicit M: Applicative[M]): FreeT[S, M, A]
  
  /** Roll a suspended computation */
  def roll[S[_], M[_], A](smf: S[FreeT[S, M, A]])(implicit M: Applicative[M]): FreeT[S, M, A]
}

sealed abstract class FreeAp[S[_], A] {
  /** Map over the result value */
  def map[B](f: A => B): FreeAp[S, B]
  
  /** Apply a function in FreeAp */
  def ap[B](f: FreeAp[S, A => B]): FreeAp[S, B]
  
  /** Fold using natural transformation */
  def foldMap[G[_]](f: S ~> G)(implicit G: Applicative[G]): G[A]
  
  /** Analyze the structure (for optimization) */
  def analyze[M](f: S ~> ({ type λ[α] = Const[M, α] })#λ)(implicit M: Monoid[M]): M
  
  /** Convert to Free monad */
  def toFree: Free[S, A]
  
  /** Hoist to another functor */
  def hoist[T[_]](f: S ~> T): FreeAp[T, A]
}

object FreeAp {
  /** Lift a pure value */
  def pure[S[_], A](a: A): FreeAp[S, A]
  
  /** Lift a functor operation */
  def liftF[S[_], A](sa: S[A]): FreeAp[S, A]
  
  /** Natural transformation to Free */
  def freeApToFree[S[_]]: FreeAp[S, ?] ~> Free[S, ?]
}

import scalaz._
import scalaz.Free._

// Validation DSL using FreeAp
sealed trait ValidateOp[A]
case class CheckLength(s: String, min: Int) extends ValidateOp[Boolean]
case class CheckEmail(s: String) extends ValidateOp[Boolean]

def checkLength(s: String, min: Int): FreeAp[ValidateOp, Boolean] = 
  FreeAp.liftF(CheckLength(s, min))
def checkEmail(s: String): FreeAp[ValidateOp, Boolean] = 
  FreeAp.liftF(CheckEmail(s))

// Parallel validation
val validation = (
  checkLength("John", 2) |@|
  checkEmail("john@example.com")
) { (lengthOk, emailOk) => lengthOk && emailOk }

// Interpreter can optimize parallel operations
val validator = new (ValidateOp ~> Id) {
  def apply[A](op: ValidateOp[A]): A = op match {
    case CheckLength(s, min) => s.length >= min
    case CheckEmail(s)       => s.contains("@")
  }
}

val result = validation.foldMap(validator)

sealed abstract class Cofree[S[_], A] {
  /** The head value */
  def head: A
  
  /** The tail structure */
  def tail: S[Cofree[S, A]]
  
  /** Map over all values */
  def map[B](f: A => B): Cofree[S, B]
  
  /** Cofree comonad extend operation */
  def extend[B](f: Cofree[S, A] => B): Cofree[S, B]
  
  /** Extract the head value */
  def extract: A = head
  
  /** Unfold from the current position */
  def unfold[B](f: Cofree[S, A] => (B, S[Cofree[S, A]])): Cofree[S, B]
  
  /** Convert to Free monad */
  def toFree: Free[S, A]
  
  /** Hoist to another functor */
  def hoist[T[_]](f: S ~> T): Cofree[T, A]
  
  /** Transform values with access to context */
  def cojoin: Cofree[S, Cofree[S, A]]
  
  /** Apply a natural transformation */
  def mapBranching[T[_]](f: S ~> T): Cofree[T, A]
}

case class Cofree[S[_], A](head: A, tail: S[Cofree[S, A]])

object Cofree {
  /** Create Cofree from head and tail */
  def apply[S[_], A](head: A, tail: S[Cofree[S, A]]): Cofree[S, A]
  
  /** Unfold a Cofree structure */
  def unfold[S[_], A, B](seed: A)(f: A => (B, S[A]))(implicit S: Functor[S]): Cofree[S, B]
  
  /** Create from a sequence */
  def fromSeq[A](seq: Seq[A]): Cofree[Option, A]
  
  /** Repeat a value infinitely */
  def repeat[A](a: A): Cofree[Function0, A]
  
  /** Iterate a function */
  def iterate[A](start: A)(f: A => A): Cofree[Function0, A]
}

import scalaz._

// Infinite stream of natural numbers
val naturals = Cofree.iterate(0)(_ + 1)

// Take first 5 values
def take[A](n: Int, cf: Cofree[Function0, A]): List[A] = {
  if (n <= 0) Nil
  else cf.head :: take(n - 1, cf.tail())
}

val first5 = take(5, naturals)  // List(0, 1, 2, 3, 4)

// Fibonacci sequence
def fib: Cofree[Function0, Int] = {
  def fibStep(a: Int, b: Int): Cofree[Function0, Int] =
    Cofree(a, () => fibStep(b, a + b))
  fibStep(0, 1)
}

val fibNumbers = take(10, fib)  // List(0, 1, 1, 2, 3, 5, 8, 13, 21, 34)

sealed abstract class Coproduct[F[_], G[_], A] {
  /** Fold using natural transformations */
  def fold[H[_]](f: F ~> H, g: G ~> H): H[A]
  
  /** Map over the value */
  def map[B](f: A => B): Coproduct[F, G, B]
  
  /** Check if this is left */
  def isLeft: Boolean
  
  /** Check if this is right */
  def isRight: Boolean
  
  /** Run natural transformation on left */
  def leftMap[H[_]](f: F ~> H): Coproduct[H, G, A]
  
  /** Run natural transformation on right */
  def rightMap[H[_]](f: G ~> H): Coproduct[F, H, A]
}

case class Coproduct[F[_], G[_], A](run: F[A] \/ G[A])

object Coproduct {
  /** Create left coproduct */
  def leftc[F[_], G[_], A](fa: F[A]): Coproduct[F, G, A]
  
  /** Create right coproduct */
  def rightc[F[_], G[_], A](ga: G[A]): Coproduct[F, G, A]
}

sealed abstract class Inject[F[_], G[_]] {
  /** Inject F into G */
  def inj[A](fa: F[A]): G[A]
  
  /** Try to project G back to F */
  def prj[A](ga: G[A]): Option[F[A]]
}

object Inject {
  /** Reflexive injection */
  implicit def reflexiveInject[F[_]]: Inject[F, F]
  
  /** Left injection into coproduct */
  implicit def leftInject[F[_], G[_]]: Inject[F, Coproduct[F, G, ?]]
  
  /** Right injection into coproduct */
  implicit def rightInject[F[_], G[_], H[_]](implicit I: Inject[F, G]): Inject[F, Coproduct[H, G, ?]]
}

import scalaz._
import scalaz.Free._

// Multiple DSL composition
sealed trait FileOp[A]
case class ReadFile(name: String) extends FileOp[String]
case class WriteFile(name: String, content: String) extends FileOp[Unit]

sealed trait ConsoleOp[A]  
case class PrintLine(msg: String) extends ConsoleOp[Unit]
case object ReadLine extends ConsoleOp[String]

// Combined DSL
type App[A] = Coproduct[FileOp, ConsoleOp, A]

// Smart constructors using injection
def readFile(name: String)(implicit I: Inject[FileOp, App]): Free[App, String] =
  liftF(I.inj(ReadFile(name)))
  
def printLine(msg: String)(implicit I: Inject[ConsoleOp, App]): Free[App, Unit] =
  liftF(I.inj(PrintLine(msg)))

// Program using both DSLs
val program = for {
  content <- readFile("input.txt")
  _       <- printLine(s"File content: $content")
} yield content

// Interpreters
val fileInterpreter = new (FileOp ~> Id) {
  def apply[A](op: FileOp[A]): A = op match {
    case ReadFile(name) => s"Contents of $name"
    case WriteFile(name, content) => println(s"Writing to $name: $content")
  }
}

val consoleInterpreter = new (ConsoleOp ~> Id) {
  def apply[A](op: ConsoleOp[A]): A = op match {
    case PrintLine(msg) => println(msg)
    case ReadLine => scala.io.StdIn.readLine()
  }
}

// Combined interpreter
val appInterpreter = new (App ~> Id) {
  def apply[A](app: App[A]): A = app.fold(fileInterpreter, consoleInterpreter)
}

// Run the program
program.foldMap(appInterpreter)

trait NaturalTransformation[F[_], G[_]] {
  /** Apply the transformation */
  def apply[A](fa: F[A]): G[A]
  
  /** Compose with another natural transformation */
  def compose[E[_]](f: E ~> F): E ~> G
  
  /** AndThen composition */
  def andThen[H[_]](f: G ~> H): F ~> H
}

type ~>[F[_], G[_]] = NaturalTransformation[F, G]
type <~[F[_], G[_]] = NaturalTransformation[G, F]

object NaturalTransformation {
  /** Identity transformation */
  def id[F[_]]: F ~> F = new (F ~> F) {
    def apply[A](fa: F[A]): F[A] = fa
  }
  
  /** Constant transformation */
  def const[F[_], G[_]](g: G[Unit]): F ~> G
}

import scalaz._

// Natural transformation from Option to List
val optionToList = new (Option ~> List) {
  def apply[A](opt: Option[A]): List[A] = opt.toList
}

// Natural transformation from List to Option (taking head)
val listToOption = new (List ~> Option) {
  def apply[A](list: List[A]): Option[A] = list.headOption
}

// Use in Free monad interpretation
val program: Free[Option, Int] = for {
  x <- Free.liftF(Some(1))
  y <- Free.liftF(Some(2))
} yield x + y

val result = program.foldMap(optionToList)  // List(3)

type Trampoline[A] = Free[Function0, A]

object Trampoline {
  /** Suspend a computation */
  def suspend[A](a: => Trampoline[A]): Trampoline[A] = 
    Free.liftF(() => a).flatMap(identity)
    
  /** Delay a computation */
  def delay[A](a: => A): Trampoline[A] = suspend(Free.pure(a))
  
  /** Done with result */
  def done[A](a: A): Trampoline[A] = Free.pure(a)
}

import scalaz._
import scalaz.Free.Trampoline

// Stack-safe factorial
def factorial(n: Int): Trampoline[BigInt] = {
  if (n <= 1) Trampoline.done(BigInt(1))
  else Trampoline.suspend(factorial(n - 1).map(_ * n))
}

// Stack-safe even/odd
def even(n: Int): Trampoline[Boolean] = 
  if (n == 0) Trampoline.done(true)
  else Trampoline.suspend(odd(n - 1))

def odd(n: Int): Trampoline[Boolean] =
  if (n == 0) Trampoline.done(false) 
  else Trampoline.suspend(even(n - 1))

// Run safely
val result1 = factorial(10000).run
val result2 = even(10000).run