λ Tony’s blog λ

// 1. Start here. Observe this trait
trait Monad[M[_]] {
  def flatMap[A, B](a: M[A], f: A => M[B]): M[B]
  def unital[A](a: A): M[A]
}
 
// A simple data type, which turns out to satisfy the above trait
case class Inter[A](f: Int => A)
 
// So does this.
case class Identity[A](a: A)
 
// Monad implementations
object Monad {
  // 2. Replace error("todo") with an implementation
  def ListMonad: Monad[List] = error("todo")
 
  // 3. Replace error("todo") with an implementation
  def OptionMonad: Monad[Option] = error("todo")
 
  // 4. Replace error("todo") with an implementation
  def InterMonad: Monad[Inter] = error("todo")
 
  // 5. Replace error("todo") with an implementation
  def IdentityMonad: Monad[Identity] = error("todo")
}
 
object MonadicFunctions {
  // 6. Replace error("todo") with an implementation
  def sequence[M[_], A](as: List[M[A]], m: Monad[M]): M[List[A]] =
    error("todo")
 
  // 7. Replace error("todo") with an implementation
  def fmap[M[_], A, B](a: M[A], f: A => B, m: Monad[M]): M[B] =
    error("todo")
 
  // 8. Replace error("todo") with an implementation
  def flatten[M[_], A](a: M[M[A]], m: Monad[M]): M[A] =
    error("todo")
 
  // 9. Replace error("todo") with an implementation
  def apply[M[_], A, B](f: M[A => B], a: M[A], m: Monad[M]): M[B] =
    error("todo")
 
  // 10. Replace error("todo") with an implementation
  def filterM[M[_], A](f: A => M[Boolean], as: List[A]
    , m: Monad[M]): M[List[A]] =
    error("todo")
 
  // 11. Replace error("todo") with an implementation
  def replicateM[M[_], A](n: Int, a: M[A], m: Monad[M]): M[List[A]] =
    error("todo: flatMap n times to produce a list")
 
  // 12. Replace error("todo") with an implementation
  def lift2[M[_], A, B, C](f: (A, B) => C, a: M[A], b: M[B]
    , m: Monad[M]): M[C] =
    error("todo")
 
  // lift3, lift4, etc. Interesting question: Can we have liftN?
}

{-# LANGUAGE RankNTypes #-}
 
-- 1. Start here. Observe this data type
data Monad' m = Monad' {
  unital :: forall a. a -> m a,
  flatMap :: forall a b. m a -> (a -> m b) -> m b
}
 
-- A simple data type, which turns out to satisfy the above trait
newtype Inter a = Inter { f :: Int -> a }
 
-- So does this.
newtype Identity a = Identity { a :: a }
  deriving Show
 
-- *** Monad implementations ***
 
-- 2. Replace error "todo" with an implementation
listMonad :: Monad' []
listMonad = error "todo"
 
-- 3. Replace error "todo" with an implementation
maybeMonad :: Monad' Maybe
maybeMonad = error "todo"
 
-- 4. Replace error "todo" with an implementation
interMonad :: Monad' Inter
interMonad = error "todo"
 
-- 5. Replace error "todo" with an implementation
identityMonad :: Monad' Identity
identityMonad = error "todo"
 
-- *** Monadic functions ***
 
-- 6. Replace error "todo" with an implementation
sequence' :: [m a] -> Monad' m -> m [a]
sequence' = error "todo"
 
-- 7. Replace error "todo" with an implementation
fmap' :: m a -> (a -> b) -> Monad' m -> m b
fmap' = error "todo"
 
-- 8. Replace error "todo" with an implementation
flatten :: m (m a) -> Monad' m -> m a
flatten = error "todo"
 
-- 9. Replace error "todo" with an implementation
apply :: m (a -> b) -> m a -> Monad' m -> m b
apply = error "todo"
 
-- 10. Replace error "todo" with an implementation
filterM' :: (a -> m Bool) -> [a] -> Monad' m -> m [a]
filterM' = error "todo"
 
-- 11. Replace error "todo" with an implementation
replicateM' :: Int -> m a -> Monad' m -> m [a]
replicateM' = error "todo: flatMap n times to produce a list"
 
-- 12. Replace error "todo" with an implementation
lift2 :: (a -> b -> c) -> m a -> m b -> Monad' m -> m c
lift2 = error "todo"
 
-- lift3, lift4, etc. Interesting question: Can we have liftN?

method(s1.charAt(i), s2.charAt(j));

sequence :: [m a] -> m [a]
sequence* :: [t -> a] -> t -> [a]

// A constructor accepting a Swizzle
SwizzleManager m = new SwizzleManager(t);
// One of the following usually follow:
//   A list constructed by the results of executing several methods on 'm'
List<R> = { m.a(x), m.b(y), m.c(z) }
//   A loop over a list of the results of executing several methods on 'm'
for(R r : { m.a(x), m.b(y), m.c(z) }) {
  use(r);
}
//   A list of effects to execute using 'm'
m.a(x);
m.b(y);
m.c(z);

public static <A> Semigroup<LinkedList<A>> LinkedListSemigroup() {
  return new Semigroup<LinkedList<A>>() {
    public LinkedList<A> append(final LinkedList<A> a1,
                                final LinkedList<A> a2) {
      final LinkedList<A> r = new LinkedList<A>(a1);
      r.addAll(a2);
      return r;
    }
  };
}

// int wrapper between 0 and 130
class Age {
  private final int i;
  private Age(final int i) { this.i = i; }
  public int value() { return i; }
  public static Age age(final int i) {
    if(i <= 0 || i >= 130)
      throw new Error("out of range");
    else
      return new Age(i);
  }
}

// String wrapper starts with upper-case
class Name {
  private final String s;
  private Name(final String s) { this.s = s; }
  public String value() { return s; }
  public static Name name(final String s) {
    if(s.isEmpty() || !Character.isUpperCase(s.charAt(0)))
      throw new java.lang.Error();
    else
      return new Name(s);
  }
}

F<String, F<String, <Validation<LinkedList<String>, Person>>>>

F<A, F<B, Validation<E, V>>

data Validation e a = Fail e | Success a deriving (Eq, Show)
 
-- Associative, binary operation (Monoid without identity)
class Semigroup a where
  append :: a -> a -> a
 
(<+>) :: Validation e a -> (a -> b) -> Validation e b
Fail e <+> _ = Fail e
Success a <+> f = Success (f a)
 
(<*>) :: (Semigroup e) => Validation e a
    -> Validation e (a -> b)
    -> Validation e b
Fail e1 <*> Fail e2 = Fail (e1 `append` e2)
Fail e1 <*> Success _ = Fail e1
Success _ <*> Fail e2 = Fail e2
Success a <*> Success f = Success (f a)

sealed trait Validation[E, A] {
  def <+>[B](f: A => B): Validation[E, B] = this match {
    case Fail(e) => Fail(e)
    case Success(a) => Success(f(a))
  }
 
  def <*>[B](f: Validation[E, A => B])(implicit s: Semigroup[E])
    : Validation[E, B] = this match {
    case Fail(e1) => f match {
      case Fail(e2) => Fail(s append (e1, e2))
      case Success(_) => Fail(e1)
    }
    case Success(a) => f match {
      case Fail(e2) => Fail(e2)
      case Success(f) => Success(f(a))
    }
  }
}
case class Fail[E, A](e: E) extends Validation[E, A]
case class Success[E, A](a: A) extends Validation[E, A]
 
// Associative binary operation (Monoid without identity)
case class Semigroup[A](append: (A, A) => A)

// Java pre-amble, sigh.
interface F<X, Y> {
  Y apply(X x);
}
 
// Associative binary operation (Monoid without identity)
interface Semigroup<A> {
  A append(A a1, A a2);
}
 
abstract class Validation<E, A> {
  // No algebraic data types in Java. Use a Church encoding (catamorphism).
  public abstract <X> X fold(F<E, X> fail, F<A, X> success);
 
  // Construction for fail
  public static <E, A> Validation<E, A> fail(final E e) {
    return new Validation<E, A>() {
      public <X> X fold(final F<E, X> fail, final F<A, X> success) {
        return fail.apply(e);
      }
    };
  }
 
  // Construction for success
  public static <E, A> Validation<E, A> success(final A a) {
    return new Validation<E, A>() {
      public <X> X fold(final F<E, X> fail, final F<A, X> success) {
        return success.apply(a);
      }
    };
  }
 
  // <+>
  public <B> Validation<E, B> map(final F<A, B> f) {
    return new Validation<E, B>() {
      public <X> X fold(final F<E, X> fail, final F<B, X> success) {
        return Validation.this.fold(fail, new F<A, X>() {
          public X apply(final A a) {
            return success.apply(f.apply(a));
          }
        });
      }
    };
  }
 
  // <*>
  public <B> Validation<E, B> applicativate(
      final Validation<E, F<A, B>> f,
      final Semigroup<E> s /* no implicits or type-classes in Java */) {
    return Validation.this.fold(new F<E, Validation<E, B>>() {
      public Validation<E, B> apply(final E e1) {
        return f.fold(new F<E, Validation<E, B>>() {
          public Validation<E, B> apply(final E e2) {
            // case (Fail(e1), Fail(e2))
            return Validation.fail(s.append(e1, e2)); 
          }
        }, new F<F<A, B>, Validation<E, B>>() {
          public Validation<E, B> apply(final F<A, B> f) {
            // case (Fail(e1), Success(f))
            return Validation.fail(e1); 
          }
        });
      }
    }, new F<A, Validation<E, B>>() {
      public Validation<E, B> apply(final A a) {
        return f.fold(new F<E, Validation<E, B>>() {
          public Validation<E, B> apply(final E e2) {
            // case (Success(a), Fail(e2))
            return Validation.fail(e2); 
          }
        }, new F<F<A, B>, Validation<E, B>>() {
          public Validation<E, B> apply(final F<A, B> f) {
            // case (Success(a), Success(f))
            return Validation.success(f.apply(a)); 
          }
        });
      }
    });
  }
}