open import Chapter2.IDesc
open import Chapter2.IDesc.Tagged
open import Chapter2.IDesc.Fixpoint
open import Chapter2.IDesc.InitialAlgebra

module Chapter3.IDesc.FreeMonad.Monad
         {I : Set}
         (D : tagDesc I)
       where

open import Function

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

open import Chapter1.Logic

open import Chapter3.IDesc.FreeMonad
open import Chapter3.IDesc.FreeMonad.IMonad

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

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

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