Merge pull request #15 from typelift/dev-ops

Explore Ops Typeclasses

Author: CodaFi

Basis/Applicative.swift

@@ -60,7 +60,23 @@ public protocol Alternative : Applicative {
 	///
 	/// The least solution to the equation:
 	///
-	///		some(v) <|> FLA.pure([])
+	///		some(v) <|> pure([])
 	func many(Self) -> FLA
 }
 
+/// Additional functions to be implemented by those types conforming to the Applicative protocol.
+public protocol ApplicativeOps : Applicative {
+	typealias C
+	typealias FC = K1<C>
+	typealias D
+	typealias FD = K1<D>
+
+	/// Lift a function to a Functorial action.
+	class func liftA(f : A -> B) -> Self -> FB
+
+	/// Lift a binary function to a Functorial action.
+	class func liftA2(f : A -> B -> C) -> Self -> FB -> FC
+
+	/// Lift a ternary function to a Functorial action.
+	class func liftA3(f : A -> B -> C -> D) -> Self -> FB -> FC -> FD
+}

Basis/Either.swift

@@ -134,8 +134,7 @@ public func !=<A : Equatable, B : Equatable>(lhs: Either<A, B>, rhs: Either<A, B
 extension Either : Functor {
 	typealias A = R
 	typealias B = Any
-	typealias C = Any
-	typealias FB = Either<L, C>
+	typealias FB = Either<L, B>
 
 	public static func fmap<C>(f : R -> C) -> Either<L, R> -> Either<L, C> {
 		return { 
@@ -150,7 +149,7 @@ extension Either : Functor {
 
 }
 
-public func <%><A, B, C>(f: B -> C, either : Either<A, B>) -> Either<A, C> {
+public func <%><A, B, C>(f : B -> C, either : Either<A, B>) -> Either<A, C> {
 	return Either.fmap(f)(either)
 }
 
@@ -191,17 +190,37 @@ public func <*<A, B, C>(a : Either<A, B>, b : Either<A, C>) -> Either<A, B> {
 	return const <%> a <*> b
 }
 
+extension Either : ApplicativeOps {
+	typealias C = Any
+	typealias FC = Either<L, C>
+	typealias D = Any
+	typealias FD = Either<L, D>
+
+	public static func liftA<B>(f : A -> B) -> Either<L, A> -> Either<L, B> {
+		return { a in Either<L, A -> B>.pure(f) <*> a }
+	}
+
+	public static func liftA2<B, C>(f : A -> B -> C) -> Either<L, A> -> Either<L, B> -> Either<L, C> {
+		return { a in { b in f <%> a <*> b  } }
+	}
+
+	public static func liftA3<B, C, D>(f : A -> B -> C -> D) -> Either<L, A> -> Either<L, B> -> Either<L, C> -> Either<L, D> {
+		return { a in { b in { c in f <%> a <*> b <*> c } } }
+	}
+}
+
 extension Either : Monad {
-	public func bind<C>(f : R -> Either<L, C>) -> Either<L, C> {
+	public func bind<B>(f : A -> Either<L, B>) -> Either<L, B> {
 		switch self.destruct() {
 			case .Left(let l):
-				return Either<L, C>.left(l)
+				return Either<L, B>.left(l)
 			case .Right(let r):
 				return f(r.unBox())
 		}
 	}
 }
-public func >>-<A, B, C>(xs : Either<A, B>, f : Either<A, B>.A -> Either<A, C>) -> Either<A, C> {
+
+public func >>-<L, A, B>(xs : Either<L, A>, f : A -> Either<L, B>) -> Either<L, B> {
 	return xs.bind(f)
 }
 
@@ -211,6 +230,48 @@ public func >><A, B, C>(x : Either<A, B>, y : Either<A, C>) -> Either<A, C> {
 	}
 }
 
+extension Either : MonadOps {
+	typealias MLA = Either<L, [A]>
+	typealias MLB = Either<L, [B]>
+	typealias MU = Either<L, ()>
+
+	public static func mapM<B>(f : A -> Either<L, B>) -> [A] -> Either<L, [B]> {
+		return { xs in Either<L, B>.sequence(map(f)(xs)) }
+	}
+
+	public static func mapM_<B>(f : A -> Either<L, B>) -> [A] -> Either<L, ()> {
+		return { xs in Either<L, B>.sequence_(map(f)(xs)) }
+	}
+
+	public static func forM<B>(xs : [A]) -> (A -> Either<L, B>) -> Either<L, [B]> {
+		return flip(Either.mapM)(xs)
+	}
+
+	public static func forM_<B>(xs : [A]) -> (A -> Either<L, B>) -> Either<L, ()> {
+		return flip(Either.mapM_)(xs)
+	}
+
+	public static func sequence(ls : [Either<L, A>]) -> Either<L, [A]> {
+		return foldr({ m, m2 in m >>- { x in m2 >>- { xs in Either<L, [A]>.pure(cons(x)(xs)) } } })(Either<L, [A]>.pure([]))(ls)
+	}
+
+	public static func sequence_(ls : [Either<L, A>]) -> Either<L, ()> {
+		return foldr(>>)(Either<L, ()>.pure(()))(ls)
+	}
+}
+
+public func -<<<L, A, B>(f : A -> Either<L, B>, xs : Either<L, A>) -> Either<L, B> {
+	return xs.bind(f)
+}
+
+public func >-><L, A, B, C>(f : A -> Either<L, B>, g : B -> Either<L, C>) -> A -> Either<L, C> {
+	return { x in f(x) >>- g }
+}
+
+public func <-<<L, A, B, C>(g : B -> Either<L, C>, f : A -> Either<L, B>) -> A -> Either<L, C> {
+	return { x in f(x) >>- g }
+}
+
 extension Either : MonadFix {
 	public static func mfix(f : R -> Either<L, R>) -> Either<L, R> {
 		func fromRight(e : Either<L, R>) -> R {

Basis/IO.swift

@@ -25,6 +25,37 @@ public struct IO<A> {
 	}
 }
 
+/// Wraps up a closure in a lazy IO action.
+///
+/// Do-notation is a special syntax taken from Haskell.  In Haskell, one uses do-notation as a
+/// shorthand for chains of Monadic operators, and for more "imperative-looking" code.  While Swift
+/// does not allow us to define a DSL that specific, we can use the implicit sequencing of its
+/// imperative statements and call execution of those statements our "desugaring".
+///
+/// Generally, do-notation in the Basis is used around side-effecting code.  Do-blocks in Swift are
+/// therefore more useful as a means of delimiting pure and side-effecting code from one another,
+/// while also retaining the benefits of the lazy IO monad.
+///
+/// It is important to note that IO actions returned are lazy.  This means the provided block will
+/// not be executed until the values inside are requested, either with an extract (`<-`) or a call
+/// to `unsafePerformIO()`
+public func do_<A>(fn: () -> IO<A>) -> IO<A> {
+	return IO<A>({ rw in (rw, !fn()) })
+}
+
+/// Wraps up a closure returning a value in a lazy IO action.
+///
+/// This variant of do-blocks allows one to write more natural looking code.  The return keyword
+/// becomes monadic return.
+public func do_<A>(fn: () -> A) -> IO<A> {
+	return IO<A>({ rw in (rw, fn()) })
+}
+
+/// An more convenient form of unsafePerformIO.
+public prefix func !<A>(m: IO<A>) -> A {
+	return m.unsafePerformIO()
+}
+
 /// Writes a character to standard output.
 public func putChar(c : Character) -> IO<Void> {
 	return IO.pure(print(c))
@@ -126,6 +157,25 @@ public func <* <A, B>(a : IO<A>, b : IO<B>) -> IO<A> {
 	return const <%> a <*> b
 }
 
+extension IO : ApplicativeOps {
+	typealias C = Any
+	typealias FC = IO<C>
+	typealias D = Any
+	typealias FD = IO<D>
+
+	public static func liftA<B>(f : A -> B) -> IO<A> -> IO<B> {
+		return { a in IO<A -> B>.pure(f) <*> a }
+	}
+
+	public static func liftA2<B, C>(f : A -> B -> C) -> IO<A> -> IO<B> -> IO<C> {
+		return { a in { b in f <%> a <*> b  } }
+	}
+
+	public static func liftA3<B, C, D>(f : A -> B -> C -> D) -> IO<A> -> IO<B> -> IO<C> -> IO<D> {
+		return { a in { b in { c in f <%> a <*> b <*> c } } }
+	}
+}
+
 extension IO : Monad {
 	public func bind<B>(f: A -> IO<B>) -> IO<B> {
 		return IO<B>({ rw in
@@ -145,73 +195,46 @@ public func >><A, B>(x: IO<A>, y: IO<B>) -> IO<B> {
 	})
 }
 
-public prefix func !<A>(m: IO<A>) -> A {
-	return m.unsafePerformIO()
-}
+extension IO : MonadOps {
+	typealias MLA = IO<[A]>
+	typealias MLB = IO<[B]>
+	typealias MU = IO<()>
 
-/// Wraps up a closure in a lazy IO action.
-///
-/// Do-notation is a special syntax taken from Haskell.  In Haskell, one uses do-notation as a 
-/// shorthand for chains of Monadic operators, and for more "imperative-looking" code.  While Swift
-/// does not allow us to define a DSL that specific, we can use the implicit sequencing of its 
-/// imperative statements and call execution of those statements our "desugaring".
-///
-/// Generally, do-notation in the Basis is used around side-effecting code.  Do-blocks in Swift are
-/// therefore more useful as a means of delimiting pure and side-effecting code from one another, 
-/// while also retaining the benefits of the lazy IO monad.
-///
-/// It is important to note that IO actions returned are lazy.  This means the provided block will
-/// not be executed until the values inside are requested, either with an extract (`<-`) or a call
-/// to `unsafePerformIO()`
-public func do_<A>(fn: () -> IO<A>) -> IO<A> {
-	return IO<A>({ rw in (rw, !fn()) })
-}
+	public static func mapM<B>(f : A -> IO<B>) -> [A] -> IO<[B]> {
+		return { xs in IO<B>.sequence(map(f)(xs)) }
+	}
 
-/// Wraps up a closure returning a value in a lazy IO action.
-///
-/// This variant of do-blocks allows one to write more natural looking code.  The return keyword
-/// becomes monadic return.
-public func do_<A>(fn: () -> A) -> IO<A> {
-	return IO<A>({ rw in (rw, fn()) })
-}
+	public static func mapM_<B>(f : A -> IO<B>) -> [A] -> IO<()> {
+		return { xs in IO<B>.sequence_(map(f)(xs)) }
+	}
 
-/// Executes a list of IO actions sequentially, accumulating their results in a list in another IO
-/// action
-public func sequence<A>(ms : [IO<A>]) -> IO<[A]> {
-	return foldr({ m in { n in
-		do_ { () -> [A] in
-			let x : A = !m
-			let xs : [A] = !n
-			return [x] + xs
-		}
-	}})(IO.pure([]))(ms)
-}
+	public static func forM<B>(xs : [A]) -> (A -> IO<B>) -> IO<[B]> {
+		return flip(IO.mapM)(xs)
+	}
 
-/// Executes a list of IO actions sequentially, discarding the result of each along the way.
-public func sequence_<A>(ms : [IO<A>]) -> IO<Void> {
-	return foldr({ x, y in x.bind({ _ in y }) })(IO<Void>.pure(Void()))(ms)
-}
+	public static func forM_<B>(xs : [A]) -> (A -> IO<B>) -> IO<()> {
+		return flip(IO.mapM_)(xs)
+	}
+
+	public static func sequence(ls : [IO<A>]) -> IO<[A]> {
+		return foldr({ m, m2 in m >>- { x in m2 >>- { xs in IO<[A]>.pure(cons(x)(xs)) } } })(IO<[A]>.pure([]))(ls)
+	}
 
-/// Maps a function over a list, then sequences the resulting IO actions together, accumulating 
-/// their results in a list in another IO action.
-public func mapM<A, B>(f : A -> IO<B>) -> [A] -> IO<[B]> {
-	return { ms in sequence(ms.map(f)) }
+	public static func sequence_(ls : [IO<A>]) -> IO<()> {
+		return foldr(>>)(IO<()>.pure(()))(ls)
+	}
 }
 
-/// Maps a function over a list, then sequences the resulting IO actions together, discarding the
-/// result of each along the way.
-public func mapM_<A, B>(f : A -> IO<B>) -> [A] -> IO<Void> {
-	return { ms in sequence_(ms.map(f)) }
+public func -<<<A, B>(f : A -> IO<B>, xs : IO<A>) -> IO<B> {
+	return xs.bind(f)
 }
 
-/// mapM with its arguments flipped around.
-public func forM<A, B>(l: [A])(f : A -> IO<B>) -> IO<[B]> {
-	return mapM(f)(l)
+public func >-><A, B, C>(f : A -> IO<B>, g : B -> IO<C>) -> A -> IO<C> {
+	return { x in f(x) >>- g }
 }
 
-/// mapM_ with its arguments flipped around.
-public func forM_<A, B>(l: [A])(f : A -> IO<B>) -> IO<Void> {
-	return mapM_(f)(l)
+public func <-<<A, B, C>(g : B -> IO<C>, f : A -> IO<B>) -> A -> IO<C> {
+	return { x in f(x) >>- g }
 }
 
 extension IO : MonadFix {

Basis/Lazy.swift

@@ -88,7 +88,6 @@ extension Lazy : Applicative {
 	}
 }
 
-
 public func <*><A, B>(stfn: Lazy<A -> B>, st: Lazy<A>) -> Lazy<B> {
 	return Lazy<A>.ap(stfn)(st)
 }
@@ -101,6 +100,25 @@ public func <*<A, B>(a : Lazy<A>, b : Lazy<B>) -> Lazy<A> {
 	return const <%> a <*> b
 }
 
+extension Lazy : ApplicativeOps {
+	typealias C = Any
+	typealias FC = Lazy<C>
+	typealias D = Any
+	typealias FD = Lazy<D>
+
+	public static func liftA<B>(f : A -> B) -> Lazy<A> -> Lazy<B> {
+		return { a in Lazy<A -> B>.pure(f) <*> a }
+	}
+
+	public static func liftA2<B, C>(f : A -> B -> C) -> Lazy<A> -> Lazy<B> -> Lazy<C> {
+		return { a in { b in f <%> a <*> b  } }
+	}
+
+	public static func liftA3<B, C, D>(f : A -> B -> C -> D) -> Lazy<A> -> Lazy<B> -> Lazy<C> -> Lazy<D> {
+		return { a in { b in { c in f <%> a <*> b <*> c } } }
+	}
+}
+
 extension Lazy : Monad {
 	public func bind<B>(f: A -> Lazy<B>) -> Lazy<B> {
 		return f(force(self))
@@ -116,3 +134,45 @@ public func >><A, B>(x : Lazy<A>, y : Lazy<B>) -> Lazy<B> {
 		return y
 	})
 }
+
+extension Lazy : MonadOps {
+	typealias MLA = Lazy<[A]>
+	typealias MLB = Lazy<[B]>
+	typealias MU = Lazy<()>
+
+	public static func mapM<B>(f : A -> Lazy<B>) -> [A] -> Lazy<[B]> {
+		return { xs in Lazy<B>.sequence(map(f)(xs)) }
+	}
+
+	public static func mapM_<B>(f : A -> Lazy<B>) -> [A] -> Lazy<()> {
+		return { xs in Lazy<B>.sequence_(map(f)(xs)) }
+	}
+
+	public static func forM<B>(xs : [A]) -> (A -> Lazy<B>) -> Lazy<[B]> {
+		return flip(Lazy.mapM)(xs)
+	}
+
+	public static func forM_<B>(xs : [A]) -> (A -> Lazy<B>) -> Lazy<()> {
+		return flip(Lazy.mapM_)(xs)
+	}
+
+	public static func sequence(ls : [Lazy<A>]) -> Lazy<[A]> {
+		return foldr({ m, m2 in m >>- { x in m2 >>- { xs in Lazy<[A]>.pure(cons(x)(xs)) } } })(Lazy<[A]>.pure([]))(ls)
+	}
+
+	public static func sequence_(ls : [Lazy<A>]) -> Lazy<()> {
+		return foldr(>>)(Lazy<()>.pure(()))(ls)
+	}
+}
+
+public func -<<<A, B>(f : A -> Lazy<B>, xs : Lazy<A>) -> Lazy<B> {
+	return xs.bind(f)
+}
+
+public func >-><A, B, C>(f : A -> Lazy<B>, g : B -> Lazy<C>) -> A -> Lazy<C> {
+	return { x in f(x) >>- g }
+}
+
+public func <-<<A, B, C>(g : B -> Lazy<C>, f : A -> Lazy<B>) -> A -> Lazy<C> {
+	return { x in f(x) >>- g }
+}