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})