open import Chapter2.Desc
open import Chapter2.Desc.Tagged
open import Chapter2.Desc.Fixpoint
open import Chapter2.Desc.InitialAlgebra

module Chapter3.Desc.FreeMonad.Monad
         (D : tagDesc)
       where

open import Data.Unit
open import Data.Nat hiding (_*_ ; fold)
open import Data.Fin hiding (fold)
open import Data.Vec
open import Data.Product

open import Category.Monad

open import Chapter3.Desc.FreeMonad


apply : ∀{X Y}  (D : tagDesc)  
        (X  D * Y) 
         toDesc (D *D X)  (D * Y)  
        D * Y
apply (cs , ds) σ (zero , xs , tt) = σ xs
apply (cs , ds) σ (suc k , xs) = `comp (k , xs)

subst : ∀{X Y}  
        D * X  (X  D * Y)  
        D * Y
subst {X} dx σ = fold (toDesc (D *D X)) (apply D σ) dx 

monad : RawMonad (_*_ D)
monad = record
  { return = `v
  ; _>>=_  = subst 
  }