module Chapter6.Lift.Examples.Head 
         (A : Set)
       where

open import Data.Unit
open import Data.Fin hiding (fold)
open import Data.Product

open import Chapter1.Logic

open import Chapter2.IDesc
open import Chapter2.IDesc.Fixpoint
open import Chapter2.IDesc.InitialAlgebra
open import Chapter2.IDesc.Examples.Bool
open import Chapter2.IDesc.Examples.Nat 

open import Chapter5.Ornament
open import Chapter5.Ornament.Examples.List
open import Chapter5.Ornament.Examples.Maybe

open import Chapter6.Functions
open import Chapter6.FunOrnament
open import Chapter6.Patch
open import Chapter6.Lift.Fold
open import Chapter6.Lift.Constructor

typeIsSuc : Type
typeIsSuc = μ NatD [ tt ]→ μ BoolD [ tt  `⊤

α : Alg NatD  _  Bool × )
α {tt} (zero , tt) = false , tt
α {tt} (suc zero , _) = true , tt
α {tt} (suc (suc ()) , _)

isSuc :  typeIsSuc ⟧Type
isSuc = fold NatD α
  

typeHead : FunctionOrn typeIsSuc
typeHead = μ⁺ ListO A [ inv tt ]→ 
             μ⁺ MaybeO A [ inv tt  `⊤

αL : AlgLift (ListO A) α (μ⁺ MaybeO A [ inv tt  `⊤)
αL {tt ,  zero , tt } xs = liftConstructor (MaybeO A) tt tt tt
αL {tt ,  suc zero , n } ((a , _) , xs) = liftConstructor ((MaybeO A)) (a , tt) tt tt
αL {tt ,  suc (suc ()) , _ } _

head : Patch isSuc typeHead
head = liftAlg (ListO A)  {T⁺ = μ⁺ MaybeO A [ inv tt  `⊤} α  {i}  αL {i})