module Chapter11.Lift.Examples.Lookup 
         {A : Set}
       where

open import Level
  renaming ( zero to zeroL 
           ; suc to sucL )

open import Data.Unit
open import Data.Product
open import Data.Fin hiding (_<_ ; fold ; lift)

open import Chapter2.Logic

open import Chapter6.IDesc.Fixpoint
open import Chapter6.IDesc.Induction
open import Chapter6.IDesc.Examples.Nat
open import Chapter6.IDesc.Examples.Bool

open import Chapter10.Ornament.Identity
open import Chapter10.Ornament.Examples.List
open import Chapter10.Ornament.Examples.Maybe

open import Chapter10.Reornament.Examples.List
open import Chapter10.Reornament.Examples.Maybe

open import Chapter11.Functions.Examples.Le
open import Chapter11.FunOrnament.Examples.Lookup
open import Chapter11.Patch.Examples.Lookup

open import Chapter11.Functions
open import Chapter11.FunOrnament
open import Chapter11.Patch
open import Chapter11.Lift.Induction
open import Chapter11.Lift.Constructor


βL : (n : Nat)  A 
     Patch {T = μ NatD [ tt ]→ μ BoolD [ tt  `⊤} 
           (induction NatD  _  Nat  Bool × Lift )  {i}{xs}  α {i}{xs}) n)
           (μ⁺ (idO NatD) [ inv tt ]→ μ⁺ MaybeO A [ inv tt  `⊤) 
     DAlgLift (idO NatD) 
               {i}{xs}  β
                (induction NatD _  {i}{xs}  α {i}{xs}) n)
                {i}{xs}) 
              (μ⁺ MaybeO A [ inv tt  `⊤)
βL n a ih {tt ,  zero , lift tt } {lift tt , lift tt} (lift tt) = 
        liftConstructor (MaybeO A) (a , lift tt) (lift tt) (lift tt)
βL n a ih {tt ,  suc zero , m , lift tt } 
          {(lift tt , lift tt) , m' , lift tt} 
          ((_ , lift tt) , lift tt) = ih m m'
βL n a ih {tt ,  suc (suc ()) , _ } {_ , _} _ 


αL : DAlgLift (ListO A)  {i}{xs}  α {i}{xs}) 
              (μ⁺ (idO NatD) [ inv tt ]→ μ⁺ MaybeO A [ inv tt  `⊤)
αL {tt ,  zero , lift tt } {lift tt , lift tt} (lift tt) = 
        λ x xs  liftConstructor (MaybeO A) (lift tt) (lift tt) (lift tt)
αL {tt ,  suc zero , n , lift tt } {(a , lift tt , lift tt) , m , lift tt} (ih , lift tt) = 
       liftInd (idO NatD) 
               {T = μ BoolD [ tt  `⊤} 
               {T⁺ = μ⁺ MaybeO A [ inv tt  `⊤}
                {i}{xs}  β (induction NatD _  {i}{xs}  α {i}{xs}) n) {i}{xs}) 
                {i}{xs}  βL n a ih {i}{xs})
αL {tt ,  suc (suc ()) , _ } {_ , _} _


vlookup : Patch _<_ (typeLookup A)
vlookup m m' n vs = liftInd (ListO A) {i = tt}{i⁺ = inv tt} 
                           {T = μ NatD [ tt ]→ μ BoolD [ tt  `⊤}
                           {T⁺ = μ⁺ (idO NatD) [ inv tt ]→ 
                                 μ⁺ MaybeO A [ inv tt  `⊤} 
                            {i}{xs}  α {i}{xs})
                           (λ{i}{xs}  αL {i}{xs}) n vs m m'

open import Chapter11.Patch.Apply

lookup :  typeLookup A ⟧FunctionOrn
lookup = patch (typeLookup A) _<_ vlookup