### RWS

``````readWriteState = do
a <- get
let res = a + e
put res
tell [res]
return res
-- (3 3 [3])
``````

``````newtype ReaderT e m a = ReaderT { runReaderT :: e -> m a }
``````

``````newtype Reader e a = Reader { runReader :: (e -> a) }
``````

``````instance (Monad m) => Monad (ReaderT e m) where
return   = lift . return
r >>= k  = ReaderT \$ \ e -> do
``````

``````instance MonadTrans (ReaderT e) where
lift m = ReaderT (const m)
``````

``````type Reader r a= ReaderT r Identity a
``````

``````ReaderT { runReaderT :: r -> Identity a }
-- Identity a is a
``````

### Alternative

``````class Applicative f => Alternative f where
empty :: f a
(<|>) :: f a -> f a -> f a
``````

``````Just 1 <|> Just 2 -- Just 1
Just 1 <|> Nothing -- Just 1
Nothing <|> Just 1 -- Just 1
Nothing <|> Nothing -- Nothing
``````

``````class (Alternative m, Monad m) => MonadPlus m where
mzero :: m a
mzero = empty
mplus :: m a -> m a -> m a
mplus = (<|>)
``````

ST Monad 跟 State Monad 的功能有些像, 不过更厉害的是, 他不是 immutable 的, 而是 "immutable" 的在原地做修改. 改完之后 runST 又然他回到了 immutable 的 Haskell 世界.

``````sumST :: Num a => [a] -> a
sumST xs = runST \$ do           -- do 后面的事情会是不错的内存操作, runST 可以把它拉会纯的世界
n <- newSTRef 0             -- 在内存中创建一块并指到 STRef
forM_ xs \$ \x -> do         -- 这跟命令式的for循环改写变量是一毛一样的
modifySTRef n (+x)
readSTRef n                 -- 返回改完之后的 n 的值
``````

#### Free

``````data Free f a = Roll (f (Free f a)) | Return a
``````
``````seal trait Free[F[_], A]
case class Roll[S[_], A](a: S[Free[S,A]]) extends Free[S, A]
case class Return[F[_], A](a: A) extends Free[S, A]
``````

``````instance Functor f => Monad (Free f) where
return a        = Return a
Return a >>= fn = fn a
Roll ffa >>= fn = Roll \$ fmap (>>= fn) ffa
``````
``````implicit def monadForFree[S[_]](implicit F:Functor[S]): Monad[Free[S, ?]] =
def pure[A](a: A): Free[S, A] = Return(a)
def map[A, B](fa: Free[S, A])(f: A => B): Free[S, B] = fa.flatMap(a=>Return(f(a)))
def flatMap[A, B](a: Free[S, A])(f: A => Free[S, B]): Free[S, B] = a match {
case Return(a) => f(a)
case Roll(a) => Roll(F.map(a)(_.flatMap(f)))
}
}
``````

``````data Eff a = Eff1 a | Eff2 a | Eff3 a
program = do
a <- liftF \$ Eff1 1
b <- liftF \$ Eff2 2
c <- liftF \$ Eff3 3
return a + b + c
``````
``````sealed trait Eff[A] {
def eff1[A](a: A): Eff[A] = Free.liftF[Eff, A](Eff1(a))
def eff2[A](a: A): Eff[A] = Free.liftF[Eff, A](Eff2(a))
def eff3[A](a: A): Eff[A] = Free.liftF[Eff, A](Eff3(a))
}
case class Eff1[A](a: A) extends Eff[A]
case class Eff2[A](a: A) extends Eff[A]
case class Eff3[A](a: A) extends Eff[A]

val program = for {
a <- eff1(1)
b <- eff2(2)
c <- eff3(3)
} yield a + b + c
``````

``````liftF \$ Eff1 1
``````

``````Roll (Eff1 (Return 1))
``````

``````program = Roll (Eff1 (Return 1)) >>= \a -> do
b <- liftF \$ Eff2 2
c <- liftF \$ Eff3 3
return a + b + c
``````
``````val program = Roll(Eff1(Return(1))).flatMap(a=>
for {
b <- eff2(2)
c <- eff3(3)
} yield a + b + c
)
``````

``````program = Roll \$ Eff1 (Return 1 >>= fn1)) where
fn1 = \a -> do
b <- liftF \$ Eff2 2
c <- liftF \$ Eff3 3
return a + b + c
``````
``````val fn1 = (a: Int) =>
for {
b <- eff2(2)
c <- eff3(3)
} yield a + b + c

val program = Roll(Eff1(Return(1).flatMap(fn1)))
``````

`Return 1 >>= fn1` 我们都知道怎么展开:

``````program = Roll \$ Eff1 (fn1 1) where
fn1 = \a -> do
b <- liftF \$ Eff2 2
c <- liftF \$ Eff3 3
return a + b + c
``````
``````val fn1 = (a: Int) =>
for {
b <- eff2(2)
c <- eff3(3)
} yield a + b + c

val program = Roll(Eff1(fn1(1)))
``````

``````program = Roll \$ Eff1 do
b <- liftF \$ Eff2 2
c <- liftF \$ Eff3 3
return 1 + b + c
``````
``````val program = Roll(Eff1(for {
b <- eff2(2)
c <- eff3(3)
} yield 1 + b + c))
``````

``````program = Roll \$ Eff1 \$ Roll \$ Eff2 do
c <- liftF \$ Eff3 3
return 1 + 2 + c
``````
``````val program = Roll(Eff1(Roll(Eff2(for {
c <- eff3(3)
} yield 1 + 2 + c))))
``````

``````program = Roll \$ Eff1 \$ Roll \$ Eff2 \$ Roll \$ Eff3 do
return 1 + 2 + 3
``````
``````val program = Roll(Eff1(Roll(Eff2(Roll(Eff3(Return(1 + 2 + 3)))))))
``````

``````program = Roll \$ Eff1 \$ Roll \$ Eff2 \$ Roll \$ Eff3 \$ Return 1 + 2 + 3
``````

#### Coyoneda

``````data CoYoneda f a = forall b. CoYoneda (b -> a) (f b)
``````
``````trait CoYoneda[F[_], A] {
type P
val fi: F[P]
val ks: P => A
}
object CoYoneda{
type Aux[F[_], A, B] = CoYoneda[F, A] { type P = B }
def apply[F[_], A, B](f: B => A)(fa: F[B]): Aux[F, A, B] = new CoYoneda[F, A] {
type P = B
val fi = fa
val ks = f
}
}
``````

``````phi :: f a -> CoYoneda f a
phi fa = CoYoneda id fa
``````
``````def phi[F[_], A](fa: F[A]): Aux[F, A, A] = apply(identity)(fa)
``````

`f``Functor` 时, 又可以把 `CoYoneda` 变成 `f`

``````psi :: Functor f => CoYoneda f a -> f a
psi (CoYoneda g fa) = fmap g fa
``````
``````def psi[F[_]:Functor, A](fa: CoYoneda[F, A]): F[A] = Functor[F].map(fa.fi)(fa.ki)
``````

``````instance Functor (Coyoneda f) where
fmap f (Coyoneda g fb) = Coyoneda (f . g) fb
``````
``````implicit def freeFunctorForCoyoneda[F[_]]: Functor[CoYoneda[F, _]] =
new Functor[CoYoneda[F, _]] {
def map[A, B, C](cfa: Aux[F, A, C])(f: A => B): Aux[F, B, C] = new CoYoneda[F, B] {
type P = C
val fi: F[C] = cfa.fi
val ki: C => B = f compose cfa.ki
}
}
``````

#### Free Functor

``````data Eff a = Eff1 a | Eff2 a | Eff3 a
program = Roll (phi (Eff1 (Roll (phi (Eff2 (Return Int))))))
``````
``````val program = Roll(phi(Eff1(Roll((phi(Eff2(Roll(phi(Eff3(Return(1 + 2 + 3)))))))))))
``````

#### Interpreter

``````foldMap :: Monad m => (forall x . f x -> m x) -> Free f a -> m a
foldMap _ (Return a)  = return a
foldMap f (Roll a) = f a >>= foldMap f
``````
``````def foldMap[F[_], M[_]: Monad, A](free: Free[F, A])(fk: F ~> M): M[A] = free match {
case Roll(a) => fk(a).flatMap(foldMap(_)(fk))
}
``````