Translate chapter 3.4 into Swift

3.4-monads-programmers-definition.md

@@ -0,0 +1,327 @@
+................
+```Haskell
+vlen = sqrt . sum . fmap (flip (^) 2)
+```
+```swift
+func vlen(_ list : List<Double>) -> Double {
+  return compose(sqrt, compose(sum, List<Double>.functor().lift({ x in pow(x, 2) }))(list)
+}
+```
+................
+```Haskell
+newtype Writer w a = Writer (a, w)
+
+instance Functor (Writer w) where
+  fmap f (Writer (a, w)) = Writer (f a, w)
+```
+```swift
+class Writer<W, A> : Kind2<ForWriter, W, A> {
+  let w : (A, W)
+
+  init(_ w : (A, W)) {
+    self.w = x
+  }
+}
+```
+................
+```Haskell
+a -> Writer w b
+```
+```swift
+(A) -> Writer<W, B>
+```
+................
+```Haskell
+class Monad m where
+  (>=>) :: (a -> m b) -> (b -> m c) -> (a -> m c)
+  return :: a -> m a
+```
+```swift
+protocol Monad {
+  associatedtype M
+
+  func andThen<A, B, C>(_ f : @escaping (A) -> Kind<M, B>, _ g : @escaping (B) -> Kind<M, C>) -> (A) -> Kind<M, C>
+  func pure<A>(_ a : A) -> Kind<M, A>
+}
+```
+................
+```Haskell
+instance Monoid w => Monad (Writer w) where
+    f >=> g = \a ->
+        let Writer (b, s)  = f a
+            Writer (c, s') = g b
+        in Writer (c, s `mappend` s')
+    return a = Writer (a, mempty)
+```
+```swift
+class WriterMonad<W, MonoidW> : Monad where MonoidW : Monoid, MonoidW.A == W {
+  typealias M = Kind<ForWriter, W>
+
+  let monoid : MonoidW
+
+  init(_ monoid : MonoidW) {
+    self.monoid = monoid
+  }
+
+  func andThen<A, B, C>(_ f : @escaping (A) -> Kind2<ForWriter, W, B>, _ g : @escaping (B) -> Kind2<ForWriter, W, C>) -> (A) -> Kind2<ForWriter, W, C> {
+    return { x in
+      let y = Writer<W, B>.fix(f(x))
+      let z = Writer<W, C>.fix(g(y.w.0))
+      return Writer<W, C>((z.w.0, monoid.mappend(y.w.1, z.w.1)))
+    }
+  }
+
+  func pure<A>(_ a : A) -> Kind2<ForWriter, W, A> {
+    return Writer<W, A>((a, monoid.mempty))
+  }
+}
+```
+................
+```Haskell
+tell :: w -> Writer w ()
+tell s = Writer ((), s)
+```
+```swift
+func tell<W>(_ s : W) -> Writer<W, ()> {
+  return Writer<W, ()>(((), s))
+}
+```
+................
+```Haskell
+(>=>) :: (a -> m b) -> (b -> m c) -> (a -> m c)
+f >=> g = \a -> ...
+```
+```swift
+func andThen<A, B, C, M>(_ f : @escaping (A) -> Kind<M, B>, _ g : @escaping (B) -> Kind<M, C>) -> (A) -> Kind<M, C> {
+  return { a in ... }
+}
+```
+................
+```Haskell
+f >=> g = \a -> let mb = f a
+                in ...
+```
+```swift
+func andThen<A, B, C, M>(_ f : @escaping (A) -> Kind<M, B>, _ g : @escaping (B) -> Kind<M, C>) -> (A) -> Kind<M, C> {
+  return { a in
+    let mb = f(a)
+    ...
+  }
+}
+```
+................
+```Haskell
+(>>=) :: m a -> (a -> m b) -> m b
+```
+```swift
+func flatmap<A, B>(_ ma : Kind<M, A>, _ f : @escaping (A) -> Kind<M, B>) -> Kind<M, B>
+```
+................
+```Haskell
+class Monad m where
+    (>>=) :: m a -> (a -> m b) -> m b
+    return :: a -> m a
+```
+```swift
+protocol Monad {
+  associatedtype M
+
+  func flatmap<A, B>(_ ma : Kind<M, A>, _ f : @escaping (A) -> Kind<M, B>) -> Kind<M, B>
+  func pure<A>(_ a : A) -> Kind<M, A>
+}
+```
+................
+```Haskell
+(Writer (a, w)) >>= f = let Writer (b, w') = f a
+                        in Writer (b, w `mappend` w')
+```
+```swift
+class WriterMonad<W, MonoidW> : Monad where MonoidW : Monoid, MonoidW.A == W {
+  typealias M = Kind<ForWriter, W>
+
+  let monoid : MonoidW
+
+  init(_ monoid : MonoidW) {
+    self.monoid = monoid
+  }
+
+  func flatmap<A, B>(_ ma : Kind2<ForWriter, W, A>, _ f : @escaping (A) -> Kind2<ForWriter, W, B>) -> Kind2<ForWriter, W, B> {
+    let fixed = Writer<W, A>.fix(ma)
+    let mb = Writer<W, B>.fix(f(fixed.w.0))
+    return Writer<W, B>((mb.w.0, monoid.mappend(ma.w.1, mb.w.1)))
+  }
+
+  func pure<A>(_ a : A) -> Kind2<ForWriter, W, A> {
+    return Writer<W, A>((a, monoid.mempty))
+  }
+}
+```
+................
+```Haskell
+join :: m (m a) -> m a
+```
+```swift
+func flatten<A>(_ mma : Kind<M, Kind<M, A>>) -> Kind<M, A>
+```
+................
+```Haskell
+ma >>= f = join (fmap f ma)
+```
+```swift
+func flatmap<A, B>(_ ma : Kind<M, A>, _ f : @escaping (A) -> Kind<M, B>) -> Kind<M, B> {
+  return flatten(map(ma, f))
+}
+```
+................
+```Haskell
+class Functor m => Monad m where
+    join :: m (m a) -> m a
+    return :: a -> m a
+```
+```swift
+protocol Monad : Functor {
+  func flatten<A>(_ ffa : Kind<F, Kind<F, A>>) -> Kind<F, A>
+  func pure<A>(_ a : A) -> Kind<F, A>
+}
+```
+................
+```Haskell
+fmap f ma = ma >>= \a -> return (f a)
+```
+```swift
+func map<A, B>(_ fa : Kind<F, A>, _ f : @escaping (A) -> B) -> Kind<F, B> {
+  return flatmap(ma){ a in pure(f(a)) }
+}
+```
+................
+```Haskell
+join :: Monoid w => Writer w (Writer w a) -> Writer w a
+join (Writer ((Writer (a, w')), w)) = Writer (a, w `mappend` w')
+```
+```swift
+func flatten<A, W, MonoidW>(_ wwa : Writer<W, Writer<W, A>>, _ monoid : MonoidW) -> Writer<W, A> where
+  MonoidW : Monoid, MonoidW.A == W {
+  let w1 = wwa.w.0
+  let w2 = wwa.w.1.w.0
+  let a = wwa.w.1.w.1
+  return Writer<W, A>((a, monoid.mappend(w1, w2)))
+}
+```
+................
+```Haskell
+upCase :: String -> Writer String String
+upCase s = Writer (map toUpper s, "upCase ")
+```
+```swift
+func upCase(_ s : String) -> Writer<String, String> {
+  return Writer(s.uppercased(), "upCase ")
+}
+```
+................
+```Haskell
+process :: String -> Writer String [String]
+process = upCase >=> toWords
+```
+```swift
+func toWord(_ s : String) -> Writer<String, [String]> {
+  return Writer((s.components(separatedBy: " "), "toWords "))
+}
+
+let process = Writer<String, Any>.monad().andThen(upCase, toWords)
+```
+................
+```Haskell
+process s = do
+    upStr <- upCase s
+    toWords upStr
+```
+```swift
+func process(_ s : String) -> Writer<String, [String]> {
+  return Writer<String, Any>.monad().binding(
+      {          upCase(s) },
+      { upStr in toWords(upStr) }
+  )
+}
+```
+................
+```Haskell
+process s =
+   upCase s >>= \ upStr ->
+       toWords upStr
+```
+```swift
+let process : (String) -> Writer<String, [String]> = { s in
+  Writer<String, Any>.monad().flatmap(upCase(s)) { upStr in toWords(upStr) }
+}
+```
+................
+```Haskell
+upStr <- upCase s
+```
+```swift
+// There is no Swift equivalent to this
+```
+................
+```Haskell
+process s = do
+    upStr <- upCase s
+    tell "toWords "
+    return (words upStr)
+```
+```swift
+func words(_ s : String) -> [String] {
+  return s.components(separatedBy: " ")
+}
+
+let process : (String) -> Writer<String, [String]> = { s in
+  Writer<String, Any>.monad().binding(
+    { upCase(s) },
+    { _ in tell("toWords") },
+    { upStr, x in map(x, { _ in words(upStr)) }
+  )
+}
+```
+................
+```Haskell
+process s =
+    upCase s >>= \upStr ->
+      tell "toWords " >>= \() ->
+        return (words upStr)
+```
+```swift
+let process : (String) -> Writer<String, [String]> = { s in
+  let monad = Writer<String, Any>.monad()
+
+  return monad.flatmap(upCase(s)) { upStr in
+    monad.flatmap(tell("toWords ")) { _ in
+      monad.pure(words(upStr))
+    }
+  }
+}
+```
+................
+```Haskell
+(>>) :: m a -> m b -> m b
+m >> k = m >>= (\_ -> k)
+```
+```
+func followedBy<A, B>(_ ma : Kind<F, A>, _ mb : Kind<F, B>) -> Kind<F, B> {
+  return self.flatmap(ma) { _ in mb }
+}
+```
+................
+```Haskell
+process s =
+    upCase s >>= \upStr ->
+      tell "toWords " >>
+        return (words upStr)
+```
+```swift
+let process : (String) -> Writer<String, [String]> = { s in
+  let monad = Writer<String, Any>.monad()
+
+  return monad.flatmap(upCase(s)) { upStr in
+    monad.followedBy(tell("toWords "), monad.pure(words(upStr)))
+  }
+}
+```