-- | Notes taken by Jonas Grybė
--
-- Lambda Calculus Foundations:
-- People wanted to formalize computations - what are computations, how do they work?
-- Lambda calculus emerged as a very primitive language that still allows calculation.
-- It's amazing because it detaches computations from physical things.

-- This lesson shows how monadic do-notation gets mechanically transformed
-- into continuation-passing style through 14 refactoring steps.

{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DeriveFunctor #-}
module Lessons.Lesson13 where

import Control.Monad.Free (Free (..))
import Control.Monad.Trans.State.Strict (State, get, put, runState)

import Lessons.Lesson11 (Expr(..), eval)

import Lessons.Lesson12 (MyDomain, MyDomainAlgebra(..), calculte, restore, store)

e :: Expr
e :: Expr
e = Expr -> Expr
Neg (Expr -> Expr -> Expr
Add (Integer -> Expr
Lit Integer
5) (Expr -> Expr -> Expr
Add (Integer -> Expr
Lit Integer
4) (Integer -> Expr
Lit Integer
6)))

-- | Original program in do-notation.
-- Calls restore, bind, bind with argument v, then store, bind (ignoring result), then return.
myProgram :: MyDomain Integer
myProgram :: MyDomain Integer
myProgram = do
  Integer
r <- Expr -> MyDomain Integer
calculte Expr
e
  Integer
v <- MyDomain Integer
restore
  Integer -> MyDomain ()
store Integer
r
  Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return  Integer
v

-- | Step 0: Desugar do-notation into explicit bind (>>=) operators.
-- Shows the structure hidden by do-notation syntax.
myProgram0 :: MyDomain Integer
myProgram0 :: MyDomain Integer
myProgram0 = Expr -> MyDomain Integer
calculte Expr
e MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
r ->
  MyDomain Integer
restore MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
    Integer -> MyDomain ()
store Integer
r MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
      Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
      ))
  )

-- | Step 1: Replace method names (calculte, restore, store) with their actual implementations.
-- Now we see the Free constructors (Calculate, Restore, Store) explicitly.
myProgram1 :: MyDomain Integer
myProgram1 :: MyDomain Integer
myProgram1 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
r ->
  MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
    MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
      Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
      ))
  )

-- | Step 2: Apply the Monad instance rule: Free m >>= f = Free (fmap (>>= f) m)
-- The first bind gets transformed, revealing the fmap.
myProgram2 :: MyDomain Integer
myProgram2 :: MyDomain Integer
myProgram2 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  (MyDomain Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall a b. (a -> b) -> MyDomainAlgebra a -> MyDomainAlgebra b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
r ->
      MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )
        )
      ))
    (Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure)
  )

-- | Step 3: Replace fmap with its realization from the Functor instance.
-- fmap f (Calculate e next) = Calculate e (\a -> f (next a))
myProgram3 :: MyDomain Integer
myProgram3 :: MyDomain Integer
myProgram3 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
a ->
    (MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
r ->
      MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )
        )
      )) (Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure Integer
a)
    )
  )

-- | Step 4: Move Pure a from the end to the front as the first argument of bind.
-- Prepares for applying the Pure >>= f = f a rule.
myProgram4 :: MyDomain Integer
myProgram4 :: MyDomain Integer
myProgram4 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
a ->
    (Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure Integer
a) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
r ->
      MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )
        )
      )
    )
  )

-- | Step 5: Apply Pure >>= f = f a rule from Monad instance.
-- The 'a' from Calculate goes to Pure, becomes 'r', so we remove Pure and just use 'r'.
myProgram5 :: MyDomain Integer
myProgram5 :: MyDomain Integer
myProgram5 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
      MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
        Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
        )
      )
    )
  )

-- | Step 6: Deal with the second bind. Apply Free m >>= f = Free (fmap (>>= f) m).
-- We have Free (Restore Pure) and a function on the right.
myProgram6 :: MyDomain Integer
myProgram6 :: MyDomain Integer
myProgram6 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
a -> (MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
        ))
      ) (Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure Integer
a))
    )
  ))


-- | Step 7: Replace fmap with the Restore realization.
-- fmap f (Restore next) = Restore (\a -> f (next a))
myProgram7 :: MyDomain Integer
myProgram7 :: MyDomain Integer
myProgram7 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
a -> (Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure Integer
a MyDomain Integer
-> (Integer -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
        ))
      ))
    )
  ))

-- | Step 8: Apply Pure a >>= f = f a again.
-- The function already had name 'v', so we simplify by removing brackets.
myProgram8 :: MyDomain Integer
myProgram8 :: MyDomain Integer
myProgram8 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain ()) -> MyDomain ()
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure) MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
        )
      )
    )
  ))

-- | Step 9: We have Free and bind again, apply the transformation rule.
-- Free m >>= f = Free (fmap (>>= f) m)
myProgram9 :: MyDomain Integer
myProgram9 :: MyDomain Integer
myProgram9 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free ((MyDomain () -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain ())
-> MyDomainAlgebra (MyDomain Integer)
forall a b. (a -> b) -> MyDomainAlgebra a -> MyDomainAlgebra b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
          Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
        )) (Integer -> (() -> MyDomain ()) -> MyDomainAlgebra (MyDomain ())
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r () -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure)) 
      )
    )
  ))

-- | Step 10: Replace fmap with Store realization.
-- fmap f (Store i next) = Store i (\a -> f (next a))
myProgram10 :: MyDomain Integer
myProgram10 :: MyDomain Integer
myProgram10 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
          Integer
-> (() -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r (\()
a -> (MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
            Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )) (() -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure ()
a))
      )
    )
  )))

-- | Step 11: Move Pure a to the front of bind again.
-- Take the argument from the end and put it in front.
myProgram11 :: MyDomain Integer
myProgram11 :: MyDomain Integer
myProgram11 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
          Integer
-> (() -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r (\()
a -> (() -> MyDomain ()
forall (f :: * -> *) a. a -> Free f a
Pure ()
a MyDomain () -> (() -> MyDomain Integer) -> MyDomain Integer
forall a b.
Free MyDomainAlgebra a
-> (a -> Free MyDomainAlgebra b) -> Free MyDomainAlgebra b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\()
_ ->
            Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )))
      )
    )
  ))
  )

-- | Step 12: Apply Pure a >>= f = f a using the Monad rule.
-- Simplifies the bind with Pure.
myProgram12 :: MyDomain Integer
myProgram12 :: MyDomain Integer
myProgram12 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
          Integer
-> (() -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r (\()
a -> ((\()
_ ->
            Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          ) ()
a ))
      )
    )
  ))
  )

-- | Step 13: The 'a' comes as an argument, but we ignore it (use _) and return v.
-- Simplify to a function with no 'a'.
myProgram13 :: MyDomain Integer
myProgram13 :: MyDomain Integer
myProgram13 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
          Integer
-> (() -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r (\()
_ ->
            Integer -> MyDomain Integer
forall a. a -> Free MyDomainAlgebra a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
v
          )
      )
    )
  ))
  )

-- | Step 14: Replace 'return' with 'Pure' (return = pure = Pure in our Monad).
-- Final form in continuation-passing style!
-- We calculate e, get result r, call Free with Restore, which gives us v,
-- pass to Store, ignore result, and end with Pure v signaling completion.
myProgram14 :: MyDomain Integer
myProgram14 :: MyDomain Integer
myProgram14 = MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
  Expr
-> (Integer -> MyDomain Integer)
-> MyDomainAlgebra (MyDomain Integer)
forall next. Expr -> (Integer -> next) -> MyDomainAlgebra next
Calculate Expr
e (\Integer
r ->
    MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
      (Integer -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. (Integer -> next) -> MyDomainAlgebra next
Restore (\Integer
v ->
        MyDomainAlgebra (MyDomain Integer) -> MyDomain Integer
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (
          Integer
-> (() -> MyDomain Integer) -> MyDomainAlgebra (MyDomain Integer)
forall next. Integer -> (() -> next) -> MyDomainAlgebra next
Store Integer
r (\()
_ ->
            Integer -> MyDomain Integer
forall (f :: * -> *) a. a -> Free f a
Pure Integer
v
          )
      )
    )
  ))
  )

-- | The Free monad structure and its instances (for reference):
-- data Free f a = Pure a | Free (f (Free f a))
--
-- Pure signals there's nowhere to go further.
-- Free says "here we go next" - contains the next step.
--
-- The result is nested as needed, passing arguments as far as needed.
-- When we run the interpreter: if it's Free, it contains the next step;
-- if it's Pure, it's the final result.
--
-- Performance note: This transformation reveals why Free monad programs aren't very fast.
-- We had only 3 expressions but performed 14 steps - the complexity is roughly quadratic
-- (n expressions → n² steps). Control.Monad.Free has various interpreters to solve
-- the speed issue. Sometimes computation isn't quadratic if the tree only needs to be
-- constructed once, making it more linear.
-- The rollout of this procedure is a huge and known problem that is actively being solved.


-- | Functor and Monad instance rules used throughout the transformations above.
-- fmap f (Calculate e next) = Calculate e (\a -> f (next a))
-- fmap f (Store i next) = Store i (\a -> f (next a))
-- fmap f (Restore next) = Restore (\a -> f (next a))

-- instance Functor f => Monad (Free f) where
--   Pure a >>= f = f a
--   Free m >>= f = Free (fmap (>>= f) m)