applicative.scala

import List.{foldLeft, reverse}

import scala.language.reflectiveCalls

sealed trait List[+A]
case object Nil extends List[Nothing]
case class Cons[+A](head: A, tail: List[A]) extends List[A]

object List {
  def apply[A](as: A*): List[A] =
    if (as.isEmpty) Nil
    else Cons(as.head, apply(as.tail: _*))

  def reverse[A](list: List[A]): List[A] = {
    foldLeft(list, Nil: List[A])((h, t) => Cons(t, h))
  }

  @annotation.tailrec
  def foldLeft[A,B](as: List[A], z: B)(f: (B, A) => B): B =
    as match {
      case Nil => z
      case Cons(x, xs) => foldLeft(xs, f(z, x))(f)
    }

  def foldRight[A,B](as: List[A], z: B)(f: (A, B) => B): B =
    foldLeft(reverse(as), z)((a, b) => f(b, a))

  def concat[A](a: List[A], b: List[A]): List[A] =
    foldRight(a, b)(Cons.apply)

  def flatten[A](list: List[List[A]]): List[A] =
    foldLeft(list, List[A]())(concat)

  def filter[A](as: List[A])(f: A => Boolean): List[A] =
    as match {
      case Nil => Nil
      case Cons(x, xs) =>
        val rest = filter(xs)(f)
        if (f(x)) {
          Cons(x, rest)
        } else {
          rest
        }
    }

  def split[A](list: List[A]): (A, List[A]) =
    list match {
      case Nil => throw null
      case Cons(x, xs) => (x, xs)
    }

  def map[A, B](list: List[A])(f: A => B): List[B] =
    list match {
      case Nil => Nil
      case Cons(x, xs) => Cons(f(x), map(xs)(f))
    }

  def flatMap[A,B](as: List[A])(f: A => List[B]): List[B] =
    flatten(map(as)(f))

  def filter2[A](as: List[A])(f: A => Boolean): List[A] =
    flatMap(as)(x => if (f(x)) { List(x)} else {List()})

  @annotation.tailrec
  def nth[A](as: List[A], n: Int): A =
    as match {
      case Cons(x, xs) => if (n > 1) nth(xs, n - 1) else x
      case Nil => throw null // we don't know about Option yet
    }

  def zipWith2[A](xs: List[A], ys: List[A])(f: (A, A) => A): List[A] = {
    val (_, result) = foldLeft(xs, (ys, List[A]()))((pair, x) => {
      pair._1 match {
        case Cons(y, ytail) => (ytail, Cons(f(x, y), pair._2))
        case Nil => (Nil, Nil)
      }
    })
    reverse(result)
  }

  def zipWith[A, B, C](xs: List[A], ys: List[B])(f: (A, B) => C): List[C] = {
    @annotation.tailrec
    def zipWithImpl(xs: List[A], ys: List[B], result: List[C])(f: (A, B) => C): List[C] =
      (xs, ys) match {
        case (Cons(x, xtail), Cons(y, ytail)) => zipWithImpl(xtail, ytail, Cons(f(x, y), result))(f)
        case _ => result
      }
    reverse(zipWithImpl(xs, ys, Nil)(f))
  }

  @annotation.tailrec
  def hasPrefix[A](sup: List[A], sub: List[A]): Boolean =
    (sup, sub) match {
      case (Cons(x, xs), Cons(y, ys)) if x == y => hasPrefix(xs, ys)
      case (_, Nil) => true
      case _ => false
    }

  @annotation.tailrec
  def hasSubsequence[A](sup: List[A], sub: List[A]): Boolean =
    sup match {
      case Nil => sub == Nil
      case list if hasPrefix(list, sub) => true
      case Cons(_, xs) => hasSubsequence(xs, sub)
    }
}

trait Functor[F[_]] {
  def map[A,B](fa: F[A])(f: A => B): F[B]
}


trait Traverse[F[_]] {
  def traverse[G[_]:Applicative,A,B](fa: F[A])(f: A => G[B]): G[F[B]]
  def sequence[G[_]:Applicative,A](fga: F[G[A]]): G[F[A]] =
    traverse(fga)(ga => ga)

  def map[A,B](fa: F[A])(f: A => B): F[B] = {
    implicit def xxx: Applicative[Id] = Id.idMonad
    val result: Id[F[B]] = traverse(fa)(a => Id(f(a)))
    result.value
  }

  def traverseS[S,A,B](fa: F[A])(f: A => State[S, B]): State[S, F[B]] =
    traverse[State[S, ?],A,B](fa)(f)(Monad.stateMonad)

  def mapAccum[S,A,B](fa: F[A], s: S)(f: (A, S) => (B, S)): (F[B], S) = {
    traverseS[S,A,B](fa)((a: A) => for {
      s1 <- State.get[S]
      (b, s2) = f(a, s1)
      _ <- State.set(s2)
    } yield b).run(s)
  }

  def zipWithIndex[A](fa: F[A]): F[(A, Int)] =
    mapAccum(fa, 0)((a, s) => ((a, s), s + 1))._1

  def toList[A](fa: F[A]): List[A] =
    List.reverse(mapAccum(fa, List[A]())((a, s) => ((), Cons(a, s)))._2)

  def reverse[A](fa: F[A]): F[A] = {
    val list = mapAccum(fa, List[A]())((a, s) => ((), Cons(a, s)))._2
    mapAccum(fa, list)((_, s) => {
      val (x, xs) = List.split(s)
      (x, xs)
    })._1
  }

  def foldLeft[A,B](fa: F[A], z: B)(f: (B, A) => B): B =
    mapAccum(fa, z)((a, s) => ((), f(s, a)))._2

  def fuse[G[_],H[_],A,B](fa: F[A])(f: A => G[B], g: A => H[B])
                         (G: Applicative[G], H: Applicative[H]): (G[F[B]], H[F[B]]) = {
    implicit val applicative = new Applicative[Lambda[x => (G[x], H[x])]] {
      override def map2[A, B, C](fa: (G[A], H[A]), fb: (G[B], H[B]))(f: (A, B) => C): (G[C], H[C]) =
        (G.map2(fa._1, fb._1)(f), H.map2(fa._2, fb._2)(f))
      override def unit[A](a: => A): (G[A], H[A]) =
        (G.unit(a), H.unit(a))
    }

    traverse[Lambda[x => (G[x], H[x])], A, B](fa)(a => (f(a), g(a)))
  }
}

trait Monoid[A] {
  def op(a1: A, a2: A): A
  def zero: A

  def productMonoid[A,B](a: Monoid[A], b: Monoid[B]): Monoid[(A,B)] =
    new Monoid[(A, B)] {
      override def op(a1: (A, B), a2: (A, B)): (A, B) = (a.op(a1._1, a2._1), b.op(a1._2, a2._2))
      override def zero: (A, B) = (a.zero, b.zero)
    }
}
sealed trait WC
case class Stub(chars: String) extends WC
case class Part(lStub: String, words: Int, rStub: String) extends WC

object Monoid {
  sealed trait Ordered
  case class Range(a: Int, b: Int) extends Ordered
  case object Unordered extends Ordered
  case object Mempty extends Ordered

  def orderungMonoid: Monoid[Ordered] = new Monoid[Ordered] {
    def zero: Ordered = Mempty
    def op(a: Ordered, b: Ordered): Ordered = (a, b) match {
      case (Range(la, ha), Range(lb, hb)) if ha <= lb => Range(la, hb)
      case (Mempty, i) => i
      case (i, Mempty) => i
      case _ => Unordered
    }
  }

  def isOrdered(v: IndexedSeq[Int]): Boolean = {
    foldMapV(v, orderungMonoid)(a => Range(a, a)) match {
      case Unordered => false
      case _ => true
    }
  }

  def concatenate[A](as: List[A], m: Monoid[A]): A =
    foldMap(as, m)(a => a)

  def foldMap[A,B](as: List[A], m: Monoid[B])(f: A => B): B =
    List.foldLeft(as, m.zero)((b, a) => m.op(b, f(a)))

  def foldLeft[A, B](as: List[A], z: B)(op: (B, A) => B): B = {
    foldMap(as, Monoids.endoMonoid[B])(a => b => op(b, a))(z)
  }

  def foldMapV[A,B](v: IndexedSeq[A], m: Monoid[B])(f: A => B): B = {
    if (v.isEmpty) {
      return m.zero
    }
    if (v.length == 1) {
      return f(v.head)
    }
    val (a, b) = v.splitAt(v.length / 2)
    m.op(foldMapV(a, m)(f), foldMapV(b, m)(f))
  }

  def functionMonoid[A,B](m: Monoid[B]): Monoid[A => B] =
    new Monoid[A => B] {
      override def op(a1: A => B, a2: A => B): A => B = a => m.op(a1(a), a2(a))
      override def zero: A => B = _ => m.zero
    }

  def mapMergeMonoid[K,V](V: Monoid[V]): Monoid[Map[K, V]] =
    new Monoid[Map[K, V]] {
      def zero = Map[K,V]()
      def op(a: Map[K, V], b: Map[K, V]) =
        (a.keySet ++ b.keySet).foldLeft(zero) { (acc,k) =>
          acc.updated(k, V.op(a.getOrElse(k, V.zero),
            b.getOrElse(k, V.zero)))
        }
    }

  def bag[A](as: IndexedSeq[A]): Map[A, Int] = {
    val mapMonoid = mapMergeMonoid[A, Int](Monoids.intAddition)
    Monoid.foldMapV(as, mapMonoid)(x => Map((x, 1)))
  }
}

object Monoids {
  val stringMonoid: Monoid[String] = new Monoid[String] {
    override def op(a1: String, a2: String): String = a1 + a2
    val zero = ""
  }

  val andMonoid: Monoid[Boolean] = new Monoid[Boolean] {
    override def op(a1: Boolean, a2: Boolean): Boolean = a1 && a2
    val zero = true
  }

  val intAddition: Monoid[Int] = new Monoid[Int] {
    override def op(a1: Int, a2: Int): Int = a1 + a2
    val zero = 0
  }

  val intMultiplication: Monoid[Int] = new Monoid[Int] {
    override def op(a1: Int, a2: Int): Int = a1 * a2
    val zero = 1
  }

  def optionMonoid[A]: Monoid[Option[A]] =
    new Monoid[Option[A]] {
      override def op(a1: Option[A], a2: Option[A]): Option[A] = a1.orElse(a2)
      override def zero: Option[A] = None
    }

  def endoMonoid[A]: Monoid[A => A] =
    new Monoid[A => A] {
      override def op(a1: A => A, a2: A => A): A => A = a => a1(a2(a))
      override def zero: A => A = a => a
    }
}

trait Foldable[F[_]] {
  def foldMap[A,B](as: F[A])(f: A => B)(mb: Monoid[B]): B
}

object Foo {
  val optionFoldable = new Foldable[Option] {
    override def foldMap[A, B](as: Option[A])(f: A => B)(mb: Monoid[B]): B =
      as match {
        case Some(x) => mb.op(f(x), mb.zero)
        case None => mb.zero
      }
  }

  val listFoldable = new Foldable[List] {
    override def foldMap[A, B](as: List[A])(f: A => B)(mb: Monoid[B]): B =
      List.foldLeft(as, mb.zero)((b, a) => mb.op(b, f(a)))
  }
}

object Traverse {
  val optionTraversable: Traverse[Option] = new Traverse[Option] {
    override def traverse[G[_] : Applicative, A, B](fa: Option[A])(f: A => G[B]): G[Option[B]] =
      fa match {
        case Some(x) => implicitly[Applicative[G]].map(f(x))(Some(_))
        case None => implicitly[Applicative[G]].unit(None)
      }
  }

  val listTraversable: Traverse[List] = new Traverse[List] {
    override def traverse[G[_] : Applicative, A, B](fa: List[A])(f: A => G[B]): G[List[B]] =
      List.foldRight(fa, implicitly[Applicative[G]].unit(List[B]()))((a, fbs) => implicitly[Applicative[G]].map2(f(a), fbs)(Cons(_,  _)))
  }

  val treeTraversable: Traverse[Tree] = new Traverse[Tree] {
    override def traverse[G[_] : Applicative, A, B](fa: Tree[A])(f: A => G[B]): G[Tree[B]] = {
      val head = f(fa.head)
      val tail = List.map(fa.tail)(n => traverse(n)(f))
      val reverseTail = implicitly[Applicative[G]].sequence(tail)
      implicitly[Applicative[G]].map2(head, reverseTail)((h, t) => Tree(h, t))
    }
  }
}

trait Applicative[F[_]] extends Functor[F] { self =>
  // primitive combinators
  def map2[A,B,C](fa: F[A], fb: F[B])(f: (A, B) => C): F[C]
  def unit[A](a: => A): F[A]
  // derived combinators
  def map[A, B](fa: F[A])(f: A => B): F[B] =
    map2(fa, unit(()))((a, _) => f(a))
  def traverse[A,B](as: List[A])(f: A => F[B]): F[List[B]] =
    List.foldRight(as, unit(List[B]()))((a, fbs) => map2(f(a), fbs)(Cons(_,  _)))

  def sequence[A](fs: List[F[A]]): F[List[A]] =
    traverse(fs)(x => x)

  def sequenceMap[K,V](ofa: Map[K,F[V]]): F[Map[K,V]] =
    traverseMap(ofa)(x => x)

  def traverseMap[K,V, V2](ofa: Map[K,V])(f: V => F[V2]): F[Map[K,V2]] =
    ofa.foldRight(unit(Map[K, V2]()))((pair, fbs) =>
      map2(f(pair._2), fbs)((p, fbs) => fbs + ((pair._1, p))))

  def replicateM[A](n: Int, ma: F[A]): F[List[A]] = {
    val list: List[F[A]] = List.apply(Range(0, n).map(_ => ma): _*)
    sequence(list)
  }

  def product[A,B](ma: F[A], mb: F[B]): F[(A, B)] = map2(ma, mb)((_, _))

  def apply[A,B](fab: F[A => B])(fa: F[A]): F[B] =
    map2(fab, fa)((f, x) => f(x))

  def product[G[_]](G: Applicative[G]): Applicative[Lambda[x => (F[x], G[x])]] = new Applicative[Lambda[x => (F[x], G[x])]] {
    override def map2[A, B, C](fa: (F[A], G[A]), fb: (F[B], G[B]))(f: (A, B) => C): (F[C], G[C]) =
      (self.map2(fa._1, fb._1)(f), G.map2(fa._2, fb._2)(f))
    override def unit[A](a: => A): (F[A], G[A]) =
      (self.unit(a), G.unit(a))
  }

  def compose[G[_]](G: Applicative[G]): Applicative[Lambda[x => F[G[x]]]] = new Applicative[Lambda[x => F[G[x]]]] {
    override def map2[A, B, C](fa: F[G[A]], fb: F[G[B]])(f: (A, B) => C): F[G[C]] =
      self.map2(fa, fb)((ga: G[A], gb: G[B]) => G.map2(ga, gb)(f))
    override def unit[A](a: => A): F[G[A]] =
      self.unit(G.unit(a))
  }

}

trait Applicative2[F[_]] extends Functor[F] {
  def apply[A,B](fab: F[A => B])(fa: F[A]): F[B]
  def unit[A](a: => A): F[A]

  def map2[A,B,C](fa: F[A], fb: F[B])(f: (A, B) => C): F[C] =
    apply(apply(unit(f.curried))(fa))(fb)

  def map[A,B](fa: F[A])(f: A => B): F[B] =
    apply(unit(f))(fa)

  def map3[A,B,C,D](fa: F[A],
                    fb: F[B],
                    fc: F[C])(f: (A, B, C) => D): F[D] =
    apply(apply(apply(unit(f.curried))(fa))(fb))(fc)

  def map4[A,B,C,D,E](fa: F[A],
                      fb: F[B],
                      fc: F[C],
                      fd: F[D])(f: (A, B, C, D) => E): F[E] =
    apply(apply(apply(apply(unit(f.curried))(fa))(fb))(fc))(fd)
}

object Applicative {
  val streamApplicative: Applicative[Stream] = new Applicative[Stream] {
    def unit[A](a: => A): Stream[A] =
      Stream.continually(a)
    def map2[A,B,C](a: Stream[A], b: Stream[B])(
      f: (A,B) => C): Stream[C] =
      a zip b map f.tupled
  }

  def validationApplicative[E]: Applicative[Validation[E, ?]] = new Applicative[Validation[E, ?]] {
    override def unit[A](a: => A): Validation[E, A] = Success(a)
    override def map2[A, B, C](fa: Validation[E, A], fb: Validation[E, B])(f: (A, B) => C): Validation[E, C] = (fa, fb) match {
      case (Success(a), Success(b)) => Success(f(a, b))
      case (Success(_), Failure(e, tail)) => Failure(e, tail)
      case (Failure(e, tail), Success(_)) => Failure(e, tail)
      case (Failure(ae, atail), Failure(be, btail)) => Failure(ae, (be +: atail) ++ btail)
    }
  }

  val listApplicative: Applicative[List] = new Applicative[List] {
    override def map2[A, B, C](fa: List[A], fb: List[B])(f: (A, B) => C): List[C] = List.zipWith(fa, fb)(f)
    override def unit[A](a: => A): List[A] = List(a)
  }
}

trait Monad[F[_]] extends Applicative[F] { self =>
  // primitive combinators
  def unit[A](a: => A): F[A]
  def flatMap[A,B](ma: F[A])(f: A => F[B]): F[B]

  // derived combinators
  def map2[A,B,C](ma: F[A], mb: F[B])(f: (A, B) => C): F[C] =
    flatMap(ma)(a => flatMap(mb)(b => unit(f(a, b))))

  def filterM[A](ms: List[A])(f: A => F[Boolean]): F[List[A]] = {
    val lists = traverse(ms)(a => map(f(a))(b => if (b) List(a) else List()))
    map(lists)(l => List.flatten(l))
  }

  def compose[A,B,C](f: A => F[B], g: B => F[C]): A => F[C] =
    a => flatMap(f(a))(g)

  def flatMap2[A,B](ma: F[A])(f: A => F[B]): F[B] =
    compose[F[A], A, B](identity, f)(ma)

  def join[A](mma: F[F[A]]): F[A] =
    flatMap(mma)(identity)
}

object Monad {
  val optionMonad: Monad[Option] = new Monad[Option] {
    def unit[A](a: => A): Option[A] = Some(a)
    def flatMap[A,B](ma: Option[A])(f: A => Option[B]): Option[B] =
      ma flatMap f
  }

  val listMonad: Monad[List] = new Monad[List] {
    def unit[A](a: => A): List[A] = List(a)
    def flatMap[A,B](ma: List[A])(f: A => List[B]): List[B] =
      List.flatMap(ma)(f)
  }

  def readerMonad[R]: Monad[Reader[R, ?]] = new Monad[Reader[R, ?]] {
    def unit[A](a: => A): Reader[R,A] = Reader(_ => a)
    def flatMap[A,B](st: Reader[R,A])(f: A => Reader[R,B]): Reader[R,B] = Reader[R,B](
      r => {
        val a = st.run(r)
        f(a).run(r)
      }
    )
  }

  def stateMonad[S]: Monad[State[S, ?]] = new Monad[State[S, ?]] {
    override def unit[A](a: => A): State[S, A] = State(s => (a, s))
    override def flatMap[A, B](f: State[S, A])(g: A => State[S, B]): State[S, B] =
      State[S, B](
        s1 => {
          val (a, s2) = f.run(s1)
          g(a).run(s2)
        }
      )
  }

  def eitherMonad[E]: Monad[Either[E, ?]] = new Monad[Either[E, ?]] {
    override def unit[A](a: => A): Either[E, A] = Right(a)
    override def flatMap[A, B](ma: Either[E, A])(f: A => Either[E, B]): Either[E, B] = ma.flatMap(f)
  }
}

case class State[S,+A](run: S => (A,S)) { self =>
  def flatMap[B](g: A => State[S, B]): State[S, B] = Monad.stateMonad.flatMap(self)(g)
  def map[B](f: A => B): State[S, B] = Monad.stateMonad.map(self)(f)
}

object State {
  def get[S]: State[S, S] = State(s => (s, s))
  def set[S](s: S): State[S, Unit] = State(_ => ((), s))
  def unit[S, A](a: A): State[S, A] = Monad.stateMonad.unit(a)
}

case class Id[T](value: T);

object Id {
  val idMonad: Monad[Id] = new Monad[Id] {
    override def unit[A](a: => A): Id[A] = Id(a)
    override def flatMap[A, B](ma: Id[A])(f: A => Id[B]): Id[B] = f(ma.value)
  }
}

case class Reader[R, A](run: R => A)

sealed trait Validation[+E, +A]
case class Failure[E](head: E, tail: Vector[E] = Vector())
  extends Validation[E, Nothing]
case class Success[A](a: A) extends Validation[Nothing, A]

case class Tree[+A](head: A, tail: List[Tree[A]]) extends Functor[Tree] {
  def unit[A](a: => A): Tree[A] = Tree(a, List())
  override def map[A, B](fa: Tree[A])(f: A => B): Tree[B] = Tree(f(fa.head), List.map(fa.tail)(t => map(t)(f)))
}

object Tree {
  def foldLeft[A,B](as: Tree[A], z: B)(f: (B, A) => B): B = {
    val bhead = f(z, as.head)
    List.foldLeft(as.tail, bhead)((b, a) => Tree.foldLeft(a, b)(f))
  }
}

object Main extends App {
  println(Traverse.listTraversable.zipWithIndex(List('a', 'b', 'c')))
  println(Traverse.listTraversable.toList(List('a', 'b', 'c')))
  println(Traverse.listTraversable.reverse(List('a', 'b', 'c')))
  println(Traverse.listTraversable.foldLeft(List(1,2,3), 1)(_ * _))
}