From Tealeaves.Classes Require Import
  Categorical.Applicative
  Categorical.Monad
  Kleisli.TraversableFunctor.

Import Applicative.Notations.
Import TraversableFunctor.Notations.

#[local] Generalizable Variables ψ ϕ W F G M A B C D X Y O.

#[local] Arguments map F%function_scope {Map}
  {A B}%type_scope f%function_scope _.
#[local] Arguments pure F%function_scope {Pure}
  {A}%type_scope _.
#[local] Arguments mult F%function_scope {Mult}
  {A B}%type_scope _.

(** * The [Batch] Functor *)
(**********************************************************************)
Inductive Batch (A B C: Type): Type :=
| Done: C -> Batch A B C
| Step: Batch A B (B -> C) -> A -> Batch A B C.

#[global] Arguments Done {A B C}%type_scope _.
#[global] Arguments Step {A B C}%type_scope _ _.

#[local] Arguments Done: clear implicits.
#[local] Arguments Step: clear implicits.

#[local] Infix "⧆" :=
  (Step _ _ _) (at level 51, left associativity): tealeaves_scope.

#[global] Notation "'BATCH1' B C" :=
  (fun A => Batch A B C) (at level 0, B at level 0, C at level 0).
#[global] Notation "'BATCH2' A C" :=
  (fun B => Batch A B C) (at level 3).

(** ** Map Operations *)
(**********************************************************************)
Fixpoint map_Batch
  {A B: Type} (C1 C2: Type) (f: C1 -> C2)
  (b: Batch A B C1): Batch A B C2 :=
  match b with
  | Done _ _ _ c =>
      Done A B C2 (f c)
  | Step _ _ _ rest a =>
      Step A B C2 (@map_Batch A B (B -> C1) (B -> C2) (compose f) rest) a
  end.

#[export] Instance Map_Batch {A B: Type}:
  Map (Batch A B) := @map_Batch A B.

Fixpoint mapfst_Batch
  {B C: Type} (A1 A2: Type) (f: A1 -> A2)
  (b: Batch A1 B C): Batch A2 B C :=
  match b with
  | Done _ _ _  c => Done A2 B C c
  | Step _ _ _ rest a =>
      Step A2 B C (mapfst_Batch A1 A2 f rest) (f a)
  end.

#[export] Instance Map_Batch1 {B C: Type}:
  Map (BATCH1 B C) := @mapfst_Batch B C.

Fixpoint mapsnd_Batch
  {A: Type} (B1 B2: Type) {C: Type}
  (f: B1 -> B2) (b: Batch A B2 C): Batch A B1 C :=
  match b with
  | Done _ _ _ c => Done A B1 C c
  | Step _ _ _ rest c =>
      Step A B1 C
        (map (Batch A B1) (precompose f)
           (mapsnd_Batch B1 B2 f rest)) c
  end.

(** ** Rewriting Principles *)
(**********************************************************************)
Lemma map_Batch_rw1 {A B C1 C2: Type} `(f: C1 -> C2) (c: C1):
  map (Batch A B) f (Done A B C1 c) = Done A B C2 (f c).
A, B, C1, C2: Type
f: C1 -> C2
c: C1
map (Batch A B) f (Done A B C1 c) = Done A B C2 (f c)
Proof.
A, B, C1, C2: Type
f: C1 -> C2
c: C1
map (Batch A B) f (Done A B C1 c) = Done A B C2 (f c)
  reflexivity.
Qed.

Lemma map_Batch_rw2 {A B C1 C2: Type}
  `(f: C1 -> C2) (a: A) (rest: Batch A B (B -> C1)):
  map (Batch A B) f (rest ⧆ a) = map (Batch A B) (compose f) rest ⧆ a.
A, B, C1, C2: Type
f: C1 -> C2
a: A
rest: Batch A B (B -> C1)
map (Batch A B) f (rest ⧆ a) =
map (Batch A B) (compose f) rest ⧆ a
Proof.
A, B, C1, C2: Type
f: C1 -> C2
a: A
rest: Batch A B (B -> C1)
map (Batch A B) f (rest ⧆ a) =
map (Batch A B) (compose f) rest ⧆ a
  reflexivity.
Qed.

Lemma mapfst_Batch_rw1 {A1 A2 B C: Type} `(f: A1 -> A2) (c: C):
  mapfst_Batch A1 A2 f (Done A1 B C c) = Done A2 B C c.
A1, A2, B, C: Type
f: A1 -> A2
c: C
mapfst_Batch A1 A2 f (Done A1 B C c) = Done A2 B C c
Proof.
A1, A2, B, C: Type
f: A1 -> A2
c: C
mapfst_Batch A1 A2 f (Done A1 B C c) = Done A2 B C c
  reflexivity.
Qed.

Lemma mapfst_Batch_rw2 {A1 A2 B C: Type}
  (f: A1 -> A2) (a: A1) (b: Batch A1 B (B -> C)):
  mapfst_Batch A1 A2 f (b ⧆ a) = mapfst_Batch A1 A2 f b ⧆ f a.
A1, A2, B, C: Type
f: A1 -> A2
a: A1
b: Batch A1 B (B -> C)
mapfst_Batch A1 A2 f (b ⧆ a) =
mapfst_Batch A1 A2 f b ⧆ f a
Proof.
A1, A2, B, C: Type
f: A1 -> A2
a: A1
b: Batch A1 B (B -> C)
mapfst_Batch A1 A2 f (b ⧆ a) =
mapfst_Batch A1 A2 f b ⧆ f a
  reflexivity.
Qed.

Lemma mapsnd_Batch_rw1 {A B B' C: Type} `(f: B' -> B) (c: C):
  mapsnd_Batch B' B f (Done A B C c) = Done A B' C c.
A, B, B', C: Type
f: B' -> B
c: C
mapsnd_Batch B' B f (Done A B C c) = Done A B' C c
Proof.
A, B, B', C: Type
f: B' -> B
c: C
mapsnd_Batch B' B f (Done A B C c) = Done A B' C c
  reflexivity.
Qed.

Lemma mapsnd_Batch_rw2 {A B B' C: Type} `(f: B -> B')
  (a: A) (b: Batch A B' (B' -> C)):
  mapsnd_Batch B B' f (b ⧆ a) =
    map (Batch A B) (precompose f) (mapsnd_Batch B B' f b) ⧆ a.
A, B, B', C: Type
f: B -> B'
a: A
b: Batch A B' (B' -> C)
mapsnd_Batch B B' f (b ⧆ a) =
map (Batch A B) (precompose f) (mapsnd_Batch B B' f b)
⧆ a
Proof.
A, B, B', C: Type
f: B -> B'
a: A
b: Batch A B' (B' -> C)
mapsnd_Batch B B' f (b ⧆ a) =
map (Batch A B) (precompose f) (mapsnd_Batch B B' f b)
⧆ a
  reflexivity.
Qed.

(** ** Functor Laws *)
(**********************************************************************)
Section functoriality.

  (** *** In the <<A>> Argument *)
  (**********************************************************************)
  Lemma mapfst_id_Batch: forall (B C A: Type),
      mapfst_Batch A A (@id A) = @id (Batch A B C).
forall B C A : Type, mapfst_Batch A A id = id
  Proof.
forall B C A : Type, mapfst_Batch A A id = id
    intros.
B, C, A: Type
mapfst_Batch A A id = id ext b.
B, C, A: Type
b: Batch A B C
mapfst_Batch A A id b = id b induction b as [C c|C rest IHrest a].
B, A, C: Type
c: C
mapfst_Batch A A id (Done A B C c) = id (Done A B C c)
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapfst_Batch A A id rest = id rest
mapfst_Batch A A id (rest ⧆ a) = id (rest ⧆ a)
    -
B, A, C: Type
c: C
mapfst_Batch A A id (Done A B C c) = id (Done A B C c) reflexivity.
    -
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapfst_Batch A A id rest = id rest
mapfst_Batch A A id (rest ⧆ a) = id (rest ⧆ a) cbn.
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapfst_Batch A A id rest = id rest
mapfst_Batch A A id rest ⧆ id a = id (rest ⧆ a) rewrite IHrest.
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapfst_Batch A A id rest = id rest
id rest ⧆ id a = id (rest ⧆ a) reflexivity.
  Qed.

  Lemma mapfst_mapfst_Batch:
    forall (B C A1 A2 A3: Type) (f: A1 -> A2) (g: A2 -> A3),
      mapfst_Batch _ _ g ∘ mapfst_Batch _ _ f =
        mapfst_Batch (B := B) (C := C) _ _ (g ∘ f).
forall (B C A1 A2 A3 : Type) (f : A1 -> A2)
  (g : A2 -> A3),
mapfst_Batch A2 A3 g ∘ mapfst_Batch A1 A2 f =
mapfst_Batch A1 A3 (g ∘ f)
  Proof.
forall (B C A1 A2 A3 : Type) (f : A1 -> A2)
  (g : A2 -> A3),
mapfst_Batch A2 A3 g ∘ mapfst_Batch A1 A2 f =
mapfst_Batch A1 A3 (g ∘ f)
    intros.
B, C, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
mapfst_Batch A2 A3 g ∘ mapfst_Batch A1 A2 f =
mapfst_Batch A1 A3 (g ∘ f)
    ext b.
B, C, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
b: Batch A1 B C
(mapfst_Batch A2 A3 g ∘ mapfst_Batch A1 A2 f) b =
mapfst_Batch A1 A3 (g ∘ f) b unfold compose.
B, C, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
b: Batch A1 B C
mapfst_Batch A2 A3 g (mapfst_Batch A1 A2 f b) =
mapfst_Batch A1 A3 (g ○ f) b induction b as [C c|C rest IHrest a].
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
c: C
mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f (Done A1 B C c)) =
mapfst_Batch A1 A3 (g ○ f) (Done A1 B C c)
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
rest: Batch A1 B (B -> C)
a: A1
IHrest: mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f rest) =
mapfst_Batch A1 A3 (g ○ f) rest
mapfst_Batch A2 A3 g (mapfst_Batch A1 A2 f (rest ⧆ a)) =
mapfst_Batch A1 A3 (g ○ f) (rest ⧆ a)
    -
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
c: C
mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f (Done A1 B C c)) =
mapfst_Batch A1 A3 (g ○ f) (Done A1 B C c) reflexivity.
    -
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
rest: Batch A1 B (B -> C)
a: A1
IHrest: mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f rest) =
mapfst_Batch A1 A3 (g ○ f) rest
mapfst_Batch A2 A3 g (mapfst_Batch A1 A2 f (rest ⧆ a)) =
mapfst_Batch A1 A3 (g ○ f) (rest ⧆ a) cbn.
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
rest: Batch A1 B (B -> C)
a: A1
IHrest: mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f rest) =
mapfst_Batch A1 A3 (g ○ f) rest
mapfst_Batch A2 A3 g (mapfst_Batch A1 A2 f rest)
⧆ g (f a) = mapfst_Batch A1 A3 (g ○ f) rest ⧆ g (f a) fequal.
B, A1, A2, A3: Type
f: A1 -> A2
g: A2 -> A3
C: Type
rest: Batch A1 B (B -> C)
a: A1
IHrest: mapfst_Batch A2 A3 g
  (mapfst_Batch A1 A2 f rest) =
mapfst_Batch A1 A3 (g ○ f) rest
mapfst_Batch A2 A3 g (mapfst_Batch A1 A2 f rest) =
mapfst_Batch A1 A3 (g ○ f) rest
      apply IHrest.
  Qed.

  #[export, program] Instance Functor_Batch1 {B C: Type}:
    Functor (BATCH1 B C) :=
    {| fun_map_id := @mapfst_id_Batch B C;
       fun_map_map := @mapfst_mapfst_Batch B C;
    |}.

  (** *** In the <<C>> Argument *)
  (**********************************************************************)
  Lemma map_id_Batch: forall (A B C: Type),
      map (Batch A B) (@id C) = @id (Batch A B C).
forall A B C : Type, map (Batch A B) id = id
  Proof.
forall A B C : Type, map (Batch A B) id = id
    intros.
A, B, C: Type
map (Batch A B) id = id ext b.
A, B, C: Type
b: Batch A B C
map (Batch A B) id b = id b induction b as [C c|C rest IHrest a].
A, B, C: Type
c: C
map (Batch A B) id (Done A B C c) = id (Done A B C c)
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
map (Batch A B) id (rest ⧆ a) = id (rest ⧆ a)
    -
A, B, C: Type
c: C
map (Batch A B) id (Done A B C c) = id (Done A B C c) reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
map (Batch A B) id (rest ⧆ a) = id (rest ⧆ a) cbn.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
map (Batch A B) (compose id) rest ⧆ a = id (rest ⧆ a)
      assert (lemma: compose (@id C) = @id (B -> C)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
compose id = id
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
lemma: compose id = id
map (Batch A B) (compose id) rest ⧆ a = id (rest ⧆ a)
      {
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
compose id = id reflexivity. }
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
lemma: compose id = id
map (Batch A B) (compose id) rest ⧆ a = id (rest ⧆ a) rewrite lemma.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map (Batch A B) id rest = id rest
lemma: compose id = id
map (Batch A B) id rest ⧆ a = id (rest ⧆ a)
      now rewrite IHrest.
  Qed.

  Lemma map_map_Batch:
    forall (A B C1 C2 C3: Type) (f: C1 -> C2) (g: C2 -> C3),
      map (Batch A B) g ∘ map (Batch A B) f = map (Batch A B) (g ∘ f).
forall (A B C1 C2 C3 : Type) (f : C1 -> C2)
  (g : C2 -> C3),
map (Batch A B) g ∘ map (Batch A B) f =
map (Batch A B) (g ∘ f)
  Proof.
forall (A B C1 C2 C3 : Type) (f : C1 -> C2)
  (g : C2 -> C3),
map (Batch A B) g ∘ map (Batch A B) f =
map (Batch A B) (g ∘ f)
    intros.
A, B, C1, C2, C3: Type
f: C1 -> C2
g: C2 -> C3
map (Batch A B) g ∘ map (Batch A B) f =
map (Batch A B) (g ∘ f)
    ext b.
A, B, C1, C2, C3: Type
f: C1 -> C2
g: C2 -> C3
b: Batch A B C1
(map (Batch A B) g ∘ map (Batch A B) f) b =
map (Batch A B) (g ∘ f) b unfold compose.
A, B, C1, C2, C3: Type
f: C1 -> C2
g: C2 -> C3
b: Batch A B C1
map (Batch A B) g (map (Batch A B) f b) =
map (Batch A B) (g ○ f) b
    generalize dependent C3.
A, B, C1, C2: Type
f: C1 -> C2
b: Batch A B C1
forall (C3 : Type) (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) =
map (Batch A B) (g ○ f) b
    generalize dependent C2.
A, B, C1: Type
b: Batch A B C1
forall (C2 : Type) (f : C1 -> C2) (C3 : Type)
  (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) =
map (Batch A B) (g ○ f) b
    induction b; intros.
A, B, C: Type
c: C
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) g (map (Batch A B) f (Done A B C c)) =
map (Batch A B) (g ○ f) (Done A B C c)
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2) (C3 : Type) (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) = map (Batch A B) (g ○ f) b
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) g (map (Batch A B) f (b ⧆ a)) =
map (Batch A B) (g ○ f) (b ⧆ a)
    -
A, B, C: Type
c: C
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) g (map (Batch A B) f (Done A B C c)) =
map (Batch A B) (g ○ f) (Done A B C c) reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2) (C3 : Type) (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) = map (Batch A B) (g ○ f) b
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) g (map (Batch A B) f (b ⧆ a)) =
map (Batch A B) (g ○ f) (b ⧆ a) cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2) (C3 : Type) (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) = map (Batch A B) (g ○ f) b
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) (compose g)
  (map (Batch A B) (compose f) b) ⧆ a =
map (Batch A B) (compose (g ○ f)) b ⧆ a fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2) (C3 : Type) (g : C2 -> C3),
map (Batch A B) g (map (Batch A B) f b) = map (Batch A B) (g ○ f) b
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
map (Batch A B) (compose g)
  (map (Batch A B) (compose f) b) =
map (Batch A B) (compose (g ○ f)) b
      specialize (IHb (B -> C2) (compose f)
                    (B -> C3) (compose g)).
A, B, C: Type
b: Batch A B (B -> C)
a: A
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
IHb: map (Batch A B) (compose g) (map (Batch A B) (compose f) b) =
map (Batch A B) (compose g ○ compose f) b
map (Batch A B) (compose g)
  (map (Batch A B) (compose f) b) =
map (Batch A B) (compose (g ○ f)) b
      rewrite IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
C2: Type
f: C -> C2
C3: Type
g: C2 -> C3
IHb: map (Batch A B) (compose g) (map (Batch A B) (compose f) b) =
map (Batch A B) (compose g ○ compose f) b
map (Batch A B) (compose g ○ compose f) b =
map (Batch A B) (compose (g ○ f)) b
      reflexivity.
  Qed.

  #[export, program] Instance Functor_Batch {A B: Type}:
    Functor (Batch A B) :=
    {| fun_map_id := @map_id_Batch A B;
       fun_map_map := @map_map_Batch A B;
    |}.

  (** ** Commuting Independent <<map>>s *)
  (**********************************************************************)
  Lemma mapfst_map_Batch
    {B: Type} `(f: A1 -> A2) `(g: C1 -> C2) (b: Batch A1 B C1):
    mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
      map (Batch A2 B) g (mapfst_Batch A1 A2 f b).
B, A1, A2: Type
f: A1 -> A2
C1, C2: Type
g: C1 -> C2
b: Batch A1 B C1
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
  Proof.
B, A1, A2: Type
f: A1 -> A2
C1, C2: Type
g: C1 -> C2
b: Batch A1 B C1
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
    generalize dependent C2.
B, A1, A2: Type
f: A1 -> A2
C1: Type
b: Batch A1 B C1
forall (C2 : Type) (g : C1 -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
    generalize dependent B.
A1, A2: Type
f: A1 -> A2
C1: Type
forall (B : Type) (b : Batch A1 B C1) (C2 : Type)
  (g : C1 -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
    induction b.
A1, A2: Type
f: A1 -> A2
B, C: Type
c: C
forall (C2 : Type) (g : C -> C2),
mapfst_Batch A1 A2 f
  (map (Batch A1 B) g (Done A1 B C c)) =
map (Batch A2 B) g
  (mapfst_Batch A1 A2 f (Done A1 B C c))
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
IHb: forall (C2 : Type) (g : (B -> C) -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
forall (C2 : Type) (g : C -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g (b ⧆ a)) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f (b ⧆ a))
    -
A1, A2: Type
f: A1 -> A2
B, C: Type
c: C
forall (C2 : Type) (g : C -> C2),
mapfst_Batch A1 A2 f
  (map (Batch A1 B) g (Done A1 B C c)) =
map (Batch A2 B) g
  (mapfst_Batch A1 A2 f (Done A1 B C c)) reflexivity.
    -
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
IHb: forall (C2 : Type) (g : (B -> C) -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
forall (C2 : Type) (g : C -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g (b ⧆ a)) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f (b ⧆ a)) intros.
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
IHb: forall (C2 : Type) (g : (B -> C) -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
C2: Type
g: C -> C2
mapfst_Batch A1 A2 f (map (Batch A1 B) g (b ⧆ a)) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f (b ⧆ a))
      cbn.
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
IHb: forall (C2 : Type) (g : (B -> C) -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
C2: Type
g: C -> C2
mapfst_Batch A1 A2 f (map (Batch A1 B) (compose g) b)
⧆ f a =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
⧆ f a fequal.
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
IHb: forall (C2 : Type) (g : (B -> C) -> C2),
mapfst_Batch A1 A2 f (map (Batch A1 B) g b) =
map (Batch A2 B) g (mapfst_Batch A1 A2 f b)
C2: Type
g: C -> C2
mapfst_Batch A1 A2 f (map (Batch A1 B) (compose g) b) =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
      specialize (IHb (B -> C2) (compose g)).
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
C2: Type
g: C -> C2
IHb: mapfst_Batch A1 A2 f (map (Batch A1 B) (compose g) b) =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
mapfst_Batch A1 A2 f (map (Batch A1 B) (compose g) b) =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
      rewrite IHb.
A1, A2: Type
f: A1 -> A2
B, C: Type
b: Batch A1 B (B -> C)
a: A1
C2: Type
g: C -> C2
IHb: mapfst_Batch A1 A2 f (map (Batch A1 B) (compose g) b) =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b) =
map (Batch A2 B) (compose g) (mapfst_Batch A1 A2 f b)
      reflexivity.
  Qed.

  Lemma mapsnd_map_Batch
    {A: Type} `(f: B1 -> B2) `(g: C1 -> C2) (b: Batch A B2 C1):
    mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
      map (Batch A B1) g (mapsnd_Batch B1 B2 f b).
A, B1, B2: Type
f: B1 -> B2
C1, C2: Type
g: C1 -> C2
b: Batch A B2 C1
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
  Proof.
A, B1, B2: Type
f: B1 -> B2
C1, C2: Type
g: C1 -> C2
b: Batch A B2 C1
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
    generalize dependent C2.
A, B1, B2: Type
f: B1 -> B2
C1: Type
b: Batch A B2 C1
forall (C2 : Type) (g : C1 -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
    induction b.
A, B1, B2: Type
f: B1 -> B2
C: Type
c: C
forall (C2 : Type) (g : C -> C2),
mapsnd_Batch B1 B2 f
  (map (Batch A B2) g (Done A B2 C c)) =
map (Batch A B1) g
  (mapsnd_Batch B1 B2 f (Done A B2 C c))
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
forall (C2 : Type) (g : C -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g (b ⧆ a)) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f (b ⧆ a))
    -
A, B1, B2: Type
f: B1 -> B2
C: Type
c: C
forall (C2 : Type) (g : C -> C2),
mapsnd_Batch B1 B2 f
  (map (Batch A B2) g (Done A B2 C c)) =
map (Batch A B1) g
  (mapsnd_Batch B1 B2 f (Done A B2 C c)) reflexivity.
    -
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
forall (C2 : Type) (g : C -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g (b ⧆ a)) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f (b ⧆ a)) intros.
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
mapsnd_Batch B1 B2 f (map (Batch A B2) g (b ⧆ a)) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f (b ⧆ a)) cbn.
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) (compose g) b)) ⧆ a =
map (Batch A B1) (compose g)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f b)) ⧆ a fequal.
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) (compose g) b)) =
map (Batch A B1) (compose g)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f b))
      rewrite IHb.
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
map (Batch A B1) (precompose f)
  (map (Batch A B1) (compose g)
     (mapsnd_Batch B1 B2 f b)) =
map (Batch A B1) (compose g)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f b))
      compose near (mapsnd_Batch _ _ f b).
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
(map (Batch A B1) (precompose f)
 ∘ map (Batch A B1) (compose g))
  (mapsnd_Batch B1 B2 f b) =
(map (Batch A B1) (compose g)
 ∘ map (Batch A B1) (precompose f))
  (mapsnd_Batch B1 B2 f b)
      do 2 rewrite (fun_map_map (F := Batch A B1)).
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
map (Batch A B1) (precompose f ∘ compose g)
  (mapsnd_Batch B1 B2 f b) =
map (Batch A B1) (compose g ∘ precompose f)
  (mapsnd_Batch B1 B2 f b)
      do 2 rewrite <- IHb.
A, B1, B2: Type
f: B1 -> B2
C: Type
b: Batch A B2 (B2 -> C)
a: A
IHb: forall (C2 : Type) (g : (B2 -> C) -> C2),
mapsnd_Batch B1 B2 f (map (Batch A B2) g b) =
map (Batch A B1) g (mapsnd_Batch B1 B2 f b)
C2: Type
g: C -> C2
mapsnd_Batch B1 B2 f
  (map (Batch A B2) (precompose f ∘ compose g) b) =
mapsnd_Batch B1 B2 f
  (map (Batch A B2) (compose g ∘ precompose f) b)
      reflexivity.
  Qed.

  Lemma mapfst_mapsnd_Batch:
    forall {C: Type} `(f: A1 -> A2) `(g: B1 -> B2) (b: Batch A1 B2 C),
      mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
        mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b).
forall (C A1 A2 : Type) (f : A1 -> A2) (B1 B2 : Type)
  (g : B1 -> B2) (b : Batch A1 B2 C),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
  Proof.
forall (C A1 A2 : Type) (f : A1 -> A2) (B1 B2 : Type)
  (g : B1 -> B2) (b : Batch A1 B2 C),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
    intros.
C, A1, A2: Type
f: A1 -> A2
B1, B2: Type
g: B1 -> B2
b: Batch A1 B2 C
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
    generalize dependent f.
C, A1, A2, B1, B2: Type
g: B1 -> B2
b: Batch A1 B2 C
forall f : A1 -> A2,
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
    generalize dependent g.
C, A1, A2, B1, B2: Type
b: Batch A1 B2 C
forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
    induction b.
A1, A2, B1, B2, C: Type
c: C
forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f
  (mapsnd_Batch B1 B2 g (Done A1 B2 C c)) =
mapsnd_Batch B1 B2 g
  (mapfst_Batch A1 A2 f (Done A1 B2 C c))
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g (b ⧆ a)) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f (b ⧆ a))
    -
A1, A2, B1, B2, C: Type
c: C
forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f
  (mapsnd_Batch B1 B2 g (Done A1 B2 C c)) =
mapsnd_Batch B1 B2 g
  (mapfst_Batch A1 A2 f (Done A1 B2 C c)) reflexivity.
    -
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g (b ⧆ a)) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f (b ⧆ a)) intros.
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
g: B1 -> B2
f: A1 -> A2
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g (b ⧆ a)) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f (b ⧆ a)) cbn.
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
g: B1 -> B2
f: A1 -> A2
mapfst_Batch A1 A2 f
  (map (Batch A1 B1) (precompose g)
     (mapsnd_Batch B1 B2 g b)) ⧆ f a =
map (Batch A2 B1) (precompose g)
  (mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b))
⧆ f a fequal.
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
g: B1 -> B2
f: A1 -> A2
mapfst_Batch A1 A2 f
  (map (Batch A1 B1) (precompose g)
     (mapsnd_Batch B1 B2 g b)) =
map (Batch A2 B1) (precompose g)
  (mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)) rewrite mapfst_map_Batch.
A1, A2, B1, B2, C: Type
b: Batch A1 B2 (B2 -> C)
a: A1
IHb: forall (g : B1 -> B2) (f : A1 -> A2),
mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b) =
mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b)
g: B1 -> B2
f: A1 -> A2
map (Batch A2 B1) (precompose g)
  (mapfst_Batch A1 A2 f (mapsnd_Batch B1 B2 g b)) =
map (Batch A2 B1) (precompose g)
  (mapsnd_Batch B1 B2 g (mapfst_Batch A1 A2 f b))
      now rewrite IHb.
  Qed.

  (** ** Functoriality In the <<B>> Argument *)
  (**********************************************************************)
  Lemma mapsnd_id_Batch: forall (A C B: Type),
      mapsnd_Batch B B (@id B) = @id (Batch A B C).
forall A C B : Type, mapsnd_Batch B B id = id
  Proof.
forall A C B : Type, mapsnd_Batch B B id = id
    intros.
A, C, B: Type
mapsnd_Batch B B id = id ext b.
A, C, B: Type
b: Batch A B C
mapsnd_Batch B B id b = id b induction b as [C c|C rest IHrest a].
A, B, C: Type
c: C
mapsnd_Batch B B id (Done A B C c) = id (Done A B C c)
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
mapsnd_Batch B B id (rest ⧆ a) = id (rest ⧆ a)
    -
A, B, C: Type
c: C
mapsnd_Batch B B id (Done A B C c) = id (Done A B C c) reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
mapsnd_Batch B B id (rest ⧆ a) = id (rest ⧆ a) cbn.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
map (Batch A B) (precompose id)
  (mapsnd_Batch B B id rest) ⧆ a = id (rest ⧆ a) rewrite IHrest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
map (Batch A B) (precompose id) (id rest) ⧆ a =
id (rest ⧆ a)
      change (@precompose B B C (@id B)) with (@id (B -> C)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
map (Batch A B) id (id rest) ⧆ a = id (rest ⧆ a)
      unfold id.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
map (Batch A B) (fun x : B -> C => x) rest ⧆ a =
rest ⧆ a
      rewrite fun_map_id.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: mapsnd_Batch B B id rest = id rest
id rest ⧆ a = rest ⧆ a
      reflexivity.
  Qed.

  Lemma mapsnd_mapsnd_Batch:
    forall (A C B1 B2 B3: Type) (f: B1 -> B2) (g: B2 -> B3),
      mapsnd_Batch _ _ f ∘ mapsnd_Batch _ _ g =
        mapsnd_Batch (A := A) (C := C) _ _ (g ∘ f).
forall (A C B1 B2 B3 : Type) (f : B1 -> B2)
  (g : B2 -> B3),
mapsnd_Batch B1 B2 f ∘ mapsnd_Batch B2 B3 g =
mapsnd_Batch B1 B3 (g ∘ f)
  Proof.
forall (A C B1 B2 B3 : Type) (f : B1 -> B2)
  (g : B2 -> B3),
mapsnd_Batch B1 B2 f ∘ mapsnd_Batch B2 B3 g =
mapsnd_Batch B1 B3 (g ∘ f)
    intros.
A, C, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
mapsnd_Batch B1 B2 f ∘ mapsnd_Batch B2 B3 g =
mapsnd_Batch B1 B3 (g ∘ f)
    ext b.
A, C, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
b: Batch A B3 C
(mapsnd_Batch B1 B2 f ∘ mapsnd_Batch B2 B3 g) b =
mapsnd_Batch B1 B3 (g ∘ f) b unfold compose.
A, C, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
b: Batch A B3 C
mapsnd_Batch B1 B2 f (mapsnd_Batch B2 B3 g b) =
mapsnd_Batch B1 B3 (g ○ f) b induction b as [C c|C rest IHrest a].
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
c: C
mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g (Done A B3 C c)) =
mapsnd_Batch B1 B3 (g ○ f) (Done A B3 C c)
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
mapsnd_Batch B1 B2 f (mapsnd_Batch B2 B3 g (rest ⧆ a)) =
mapsnd_Batch B1 B3 (g ○ f) (rest ⧆ a)
    -
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
c: C
mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g (Done A B3 C c)) =
mapsnd_Batch B1 B3 (g ○ f) (Done A B3 C c) reflexivity.
    -
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
mapsnd_Batch B1 B2 f (mapsnd_Batch B2 B3 g (rest ⧆ a)) =
mapsnd_Batch B1 B3 (g ○ f) (rest ⧆ a) cbn.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) (precompose g)
        (mapsnd_Batch B2 B3 g rest))) ⧆ a =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest) ⧆ a fequal.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) (precompose g)
        (mapsnd_Batch B2 B3 g rest))) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      rewrite mapsnd_map_Batch.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose f)
  (map (Batch A B1) (precompose g)
     (mapsnd_Batch B1 B2 f (mapsnd_Batch B2 B3 g rest))) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      rewrite IHrest.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose f)
  (map (Batch A B1) (precompose g)
     (mapsnd_Batch B1 B3 (g ○ f) rest)) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      compose near (mapsnd_Batch B1 B3 (g ○ f) rest) on left.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
(map (Batch A B1) (precompose f)
 ∘ map (Batch A B1) (precompose g))
  (mapsnd_Batch B1 B3 (g ○ f) rest) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      rewrite map_map_Batch.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose f ∘ precompose g)
  (mapsnd_Batch B1 B3 (g ○ f) rest) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      rewrite precompose_precompose.
A, B1, B2, B3: Type
f: B1 -> B2
g: B2 -> B3
C: Type
rest: Batch A B3 (B3 -> C)
a: A
IHrest: mapsnd_Batch B1 B2 f
  (mapsnd_Batch B2 B3 g rest) =
mapsnd_Batch B1 B3 (g ○ f) rest
map (Batch A B1) (precompose (g ∘ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest) =
map (Batch A B1) (precompose (g ○ f))
  (mapsnd_Batch B1 B3 (g ○ f) rest)
      reflexivity.
  Qed.

  (* There is no contravariant functor typeclass to instantiate *)

End functoriality.

(** * Applicative Functor Instance *)
(**********************************************************************)
Section Applicative_Batch.

  Context
    {A B: Type}.

  (** ** Operations *)
  (********************************************************************)
  #[export] Instance Pure_Batch: Pure (@Batch A B) :=
    fun (C: Type) (c: C) => Done A B C c.

  Fixpoint mult_Batch `(b1: Batch A B C) `(b2: Batch A B D):
    @Batch A B (C * D) :=
    match b2 with
    | Done _ _ _ d => map (Batch A B) (fun (c: C) => (c, d)) b1
    | Step _ _ _ rest a =>
        Step A B (C * D)
          (map (Batch A B) strength_arrow (mult_Batch b1 rest)) a
    end.

  #[export] Instance Mult_Batch: Mult (@Batch A B) :=
    fun C D '(b1, b2) => mult_Batch b1 b2.

  (** *** Examples of operations *)
  (********************************************************************)
  (*
    Section demo.
    Context
    (A B C D: Type)
    (a1 a2 a3: A)
    (c1 c2 c3: C)
    (d1 d2 d3: D)
    (mk1: B -> C)
    (mk1': B -> D)
    (mk2: B -> B -> C).

    Compute Done A B C c1 ⊗ Done A B D d1.
    Compute Done A B C c1 ⊗ (Done A B (B -> D) mk1' ⧆ a1).
    Compute (Done A B _ mk1 ⧆ a1) ⊗ Done A B D d2.
    Compute (Done A B _ mk1 ⧆ a1) ⊗ (Done A B _ mk1' ⧆ a2).
    Compute (Done A B _ mk2 ⧆ a1 ⧆ a2) ⊗ (Done A B _ mk1' ⧆ a3).
    End demo.
   *)

  (** ** Rewriting Principles *)
  (********************************************************************)
  Lemma mult_Batch_rw1:
    forall `(c: C) `(d: D),
      Done A B C c ⊗ Done A B D d = Done A B (C * D) (c, d).
A, B: Type
forall (C : Type) (c : C) (D : Type) (d : D),
Done A B C c ⊗ Done A B D d = Done A B (C * D) (c, d)
  Proof.
A, B: Type
forall (C : Type) (c : C) (D : Type) (d : D),
Done A B C c ⊗ Done A B D d = Done A B (C * D) (c, d)
    reflexivity.
  Qed.

  Lemma mult_Batch_rw2:
    forall `(d: D) `(b1: Batch A B C),
      b1 ⊗ Done A B D d = map (Batch A B) (pair_right d) b1.
A, B: Type
forall (D : Type) (d : D) (C : Type)
  (b1 : Batch A B C),
b1 ⊗ Done A B D d = map (Batch A B) (pair_right d) b1
  Proof.
A, B: Type
forall (D : Type) (d : D) (C : Type)
  (b1 : Batch A B C),
b1 ⊗ Done A B D d = map (Batch A B) (pair_right d) b1
    intros.
A, B, D: Type
d: D
C: Type
b1: Batch A B C
b1 ⊗ Done A B D d = map (Batch A B) (pair_right d) b1 induction b1; easy.
  Qed.

  Lemma mult_Batch_rw3:
    forall (D: Type) (b2: Batch A B (B -> D)) (a: A) `(b1: Batch A B C),
      b1 ⊗ (b2 ⧆ a) =
        map (Batch A B) strength_arrow (b1 ⊗ b2) ⧆ a.
A, B: Type
forall (D : Type) (b2 : Batch A B (B -> D)) (a : A)
  (C : Type) (b1 : Batch A B C),
b1 ⊗ (b2 ⧆ a) =
map (Batch A B) strength_arrow (b1 ⊗ b2) ⧆ a
  Proof.
A, B: Type
forall (D : Type) (b2 : Batch A B (B -> D)) (a : A)
  (C : Type) (b1 : Batch A B C),
b1 ⊗ (b2 ⧆ a) =
map (Batch A B) strength_arrow (b1 ⊗ b2) ⧆ a
    reflexivity.
  Qed.


  Lemma mult_Batch_rw4:
    forall `(b2: Batch A B D) `(c: C),
      Done A B C c ⊗ b2 = map (Batch A B) (pair c) b2.
A, B: Type
forall (D : Type) (b2 : Batch A B D) (C : Type)
  (c : C),
Done A B C c ⊗ b2 = map (Batch A B) (pair c) b2
  Proof.
A, B: Type
forall (D : Type) (b2 : Batch A B D) (C : Type)
  (c : C),
Done A B C c ⊗ b2 = map (Batch A B) (pair c) b2
    induction b2.
A, B, C: Type
c: C
forall (C0 : Type) (c0 : C0),
Done A B C0 c0 ⊗ Done A B C c =
map (Batch A B) (pair c0) (Done A B C c)
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ (b2 ⧆ a) =
map (Batch A B) (pair c) (b2 ⧆ a)
    -
A, B, C: Type
c: C
forall (C0 : Type) (c0 : C0),
Done A B C0 c0 ⊗ Done A B C c =
map (Batch A B) (pair c0) (Done A B C c) reflexivity.
    -
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ (b2 ⧆ a) =
map (Batch A B) (pair c) (b2 ⧆ a) intros.
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
C0: Type
c: C0
Done A B C0 c ⊗ (b2 ⧆ a) =
map (Batch A B) (pair c) (b2 ⧆ a) cbn; change (mult_Batch ?x ?y) with (x ⊗ y).
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
C0: Type
c: C0
map (Batch A B) strength_arrow (Done A B C0 c ⊗ b2)
⧆ a = map (Batch A B) (compose (pair c)) b2 ⧆ a
      fequal.
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
C0: Type
c: C0
map (Batch A B) strength_arrow (Done A B C0 c ⊗ b2) =
map (Batch A B) (compose (pair c)) b2 rewrite IHb2.
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
C0: Type
c: C0
map (Batch A B) strength_arrow
  (map (Batch A B) (pair c) b2) =
map (Batch A B) (compose (pair c)) b2
      compose near b2 on left.
A, B, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C0 : Type) (c : C0),
Done A B C0 c ⊗ b2 =
map (Batch A B) (pair c) b2
C0: Type
c: C0
(map (Batch A B) strength_arrow
 ∘ map (Batch A B) (pair c)) b2 =
map (Batch A B) (compose (pair c)) b2
      now rewrite (fun_map_map (F := Batch A B)).
  Qed.

  Lemma mult_Batch_rw5:
    forall (a: A) `(b1: @Batch A B (B -> C)) `(d: D),
      (b1 ⧆ a) ⊗ Done A B D d =
        map (Batch A B) (costrength_arrow ∘ pair_right d) b1 ⧆ a.
A, B: Type
forall (a : A) (C : Type) (b1 : Batch A B (B -> C))
  (D : Type) (d : D),
(b1 ⧆ a) ⊗ Done A B D d =
map (Batch A B) (costrength_arrow ∘ pair_right d) b1
⧆ a
  Proof.
A, B: Type
forall (a : A) (C : Type) (b1 : Batch A B (B -> C))
  (D : Type) (d : D),
(b1 ⧆ a) ⊗ Done A B D d =
map (Batch A B) (costrength_arrow ∘ pair_right d) b1
⧆ a
    reflexivity.
  Qed.

  Lemma mult_Batch_rw6:
    forall `(b2: @Batch A B (B -> D)) `(c: C) (a: A),
      Done A B C c ⊗ (b2 ⧆ a) =
        map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a.
A, B: Type
forall (D : Type) (b2 : Batch A B (B -> D)) (C : Type)
  (c : C) (a : A),
Done A B C c ⊗ (b2 ⧆ a) =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
  Proof.
A, B: Type
forall (D : Type) (b2 : Batch A B (B -> D)) (C : Type)
  (c : C) (a : A),
Done A B C c ⊗ (b2 ⧆ a) =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
    intros.
A, B, D: Type
b2: Batch A B (B -> D)
C: Type
c: C
a: A
Done A B C c ⊗ (b2 ⧆ a) =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
    rewrite mult_Batch_rw3.
A, B, D: Type
b2: Batch A B (B -> D)
C: Type
c: C
a: A
map (Batch A B) strength_arrow (Done A B C c ⊗ b2) ⧆ a =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
    rewrite mult_Batch_rw4.
A, B, D: Type
b2: Batch A B (B -> D)
C: Type
c: C
a: A
map (Batch A B) strength_arrow
  (map (Batch A B) (pair c) b2) ⧆ a =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
    compose near b2 on left.
A, B, D: Type
b2: Batch A B (B -> D)
C: Type
c: C
a: A
(map (Batch A B) strength_arrow
 ∘ map (Batch A B) (pair c)) b2 ⧆ a =
map (Batch A B) (strength_arrow ∘ pair c) b2 ⧆ a
    now rewrite (fun_map_map (F := Batch A B)).
  Qed.

  Lemma mult_Batch_rw7:
    forall (a1 a2: A) `(b1: Batch A B (B -> C))
      `(b2: Batch A B (B -> D)),
      (b1 ⧆ a1) ⊗ (b2 ⧆ a2) =
        (map (Batch A B) strength_arrow ((b1 ⧆ a1) ⊗ b2)) ⧆ a2.
A, B: Type
forall (a1 a2 : A) (C : Type)
  (b1 : Batch A B (B -> C)) (D : Type)
  (b2 : Batch A B (B -> D)),
(b1 ⧆ a1) ⊗ (b2 ⧆ a2) =
map (Batch A B) strength_arrow ((b1 ⧆ a1) ⊗ b2) ⧆ a2
  Proof.
A, B: Type
forall (a1 a2 : A) (C : Type)
  (b1 : Batch A B (B -> C)) (D : Type)
  (b2 : Batch A B (B -> D)),
(b1 ⧆ a1) ⊗ (b2 ⧆ a2) =
map (Batch A B) strength_arrow ((b1 ⧆ a1) ⊗ b2) ⧆ a2
    reflexivity.
  Qed.

  (** ** Applicative Laws *)
  (********************************************************************)
  Lemma app_pure_natural_Batch:
    forall `(f: C1 -> C2) (c: C1),
      map (Batch A B) f (pure (Batch A B) c) =
        pure (Batch A B) (f c).
A, B: Type
forall (C1 C2 : Type) (f : C1 -> C2) (c : C1),
map (Batch A B) f (pure (Batch A B) c) =
pure (Batch A B) (f c)
  Proof.
A, B: Type
forall (C1 C2 : Type) (f : C1 -> C2) (c : C1),
map (Batch A B) f (pure (Batch A B) c) =
pure (Batch A B) (f c)
    reflexivity.
  Qed.

  Lemma app_mult_natural_Batch1:
    forall (C1 C2 D: Type) (f: C1 -> C2)
      (b1: Batch A B C1) (b2: Batch A B D),
      map (Batch A B) f b1 ⊗ b2 = map (Batch A B) (map_fst f) (b1 ⊗ b2).
A, B: Type
forall (C1 C2 D : Type) (f : C1 -> C2)
  (b1 : Batch A B C1) (b2 : Batch A B D),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
  Proof.
A, B: Type
forall (C1 C2 D : Type) (f : C1 -> C2)
  (b1 : Batch A B C1) (b2 : Batch A B D),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
    intros.
A, B, C1, C2, D: Type
f: C1 -> C2
b1: Batch A B C1
b2: Batch A B D
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2) generalize dependent C1.
A, B, C2, D: Type
b2: Batch A B D
forall (C1 : Type) (f : C1 -> C2) (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2) induction b2.
A, B, C2, C: Type
c: C
forall (C1 : Type) (f : C1 -> C2) (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ Done A B C c =
map (Batch A B) (map_fst f) (b1 ⊗ Done A B C c)
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
forall (C1 : Type) (f : C1 -> C2) (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ (b2 ⧆ a) =
map (Batch A B) (map_fst f) (b1 ⊗ (b2 ⧆ a))
    -
A, B, C2, C: Type
c: C
forall (C1 : Type) (f : C1 -> C2) (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ Done A B C c =
map (Batch A B) (map_fst f) (b1 ⊗ Done A B C c) intros; cbn.
A, B, C2, C: Type
c: C
C1: Type
f: C1 -> C2
b1: Batch A B C1
map (Batch A B) (fun c0 : C2 => (c0, c))
  (map (Batch A B) f b1) =
map (Batch A B) (map_fst f)
  (map (Batch A B) (fun c0 : C1 => (c0, c)) b1) compose near b1.
A, B, C2, C: Type
c: C
C1: Type
f: C1 -> C2
b1: Batch A B C1
(map (Batch A B) (fun c0 : C2 => (c0, c))
 ∘ map (Batch A B) f) b1 =
(map (Batch A B) (map_fst f)
 ∘ map (Batch A B) (fun c0 : C1 => (c0, c))) b1
      now do 2 rewrite (fun_map_map (F := Batch A B)).
    -
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
forall (C1 : Type) (f : C1 -> C2) (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ (b2 ⧆ a) =
map (Batch A B) (map_fst f) (b1 ⊗ (b2 ⧆ a)) intros; cbn.
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
map (Batch A B) strength_arrow
  (mult_Batch (map (Batch A B) f b1) b2) ⧆ a =
map (Batch A B) (compose (map_fst f))
  (map (Batch A B) strength_arrow (mult_Batch b1 b2))
⧆ a
      change (mult_Batch ?x ?y) with (x ⊗ y) in *.
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
map (Batch A B) strength_arrow
  (map (Batch A B) f b1 ⊗ b2) ⧆ a =
map (Batch A B) (compose (map_fst f))
  (map (Batch A B) strength_arrow (b1 ⊗ b2)) ⧆ a
      rewrite IHb2.
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
map (Batch A B) strength_arrow
  (map (Batch A B) (map_fst f) (b1 ⊗ b2)) ⧆ a =
map (Batch A B) (compose (map_fst f))
  (map (Batch A B) strength_arrow (b1 ⊗ b2)) ⧆ a compose near (b1 ⊗ b2).
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
(map (Batch A B) strength_arrow
 ∘ map (Batch A B) (map_fst f)) (b1 ⊗ b2) ⧆ a =
(map (Batch A B) (compose (map_fst f))
 ∘ map (Batch A B) strength_arrow) (b1 ⊗ b2) ⧆ a
      do 2 rewrite (fun_map_map (F := Batch A B)).
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
map (Batch A B) (strength_arrow ∘ map_fst f) (b1 ⊗ b2)
⧆ a =
map (Batch A B) (compose (map_fst f) ∘ strength_arrow)
  (b1 ⊗ b2) ⧆ a
      do 2 fequal.
A, B, C2, C: Type
b2: Batch A B (B -> C)
a: A
IHb2: forall (C1 : Type) (f : C1 -> C2)
  (b1 : Batch A B C1),
map (Batch A B) f b1 ⊗ b2 =
map (Batch A B) (map_fst f) (b1 ⊗ b2)
C1: Type
f: C1 -> C2
b1: Batch A B C1
strength_arrow ∘ map_fst f =
compose (map_fst f) ∘ strength_arrow
      now ext [? ?].
  Qed.

  Lemma app_mult_natural_Batch2:
    forall (C D1 D2: Type) (g: D1 -> D2)
      (b1: Batch A B C) (b2: Batch A B D1),
      b1 ⊗ map (Batch A B) g b2 =
        map (Batch A B) (map_snd g) (b1 ⊗ b2).
A, B: Type
forall (C D1 D2 : Type) (g : D1 -> D2)
  (b1 : Batch A B C) (b2 : Batch A B D1),
b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_snd g) (b1 ⊗ b2)
  Proof.
A, B: Type
forall (C D1 D2 : Type) (g : D1 -> D2)
  (b1 : Batch A B C) (b2 : Batch A B D1),
b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_snd g) (b1 ⊗ b2)
    intros.
A, B, C, D1, D2: Type
g: D1 -> D2
b1: Batch A B C
b2: Batch A B D1
b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_snd g) (b1 ⊗ b2) generalize dependent D2.
A, B, C, D1: Type
b1: Batch A B C
b2: Batch A B D1
forall (D2 : Type) (g : D1 -> D2),
b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_snd g) (b1 ⊗ b2)
    induction b2 as [ANY any | ANY rest IH x'].
A, B, C: Type
b1: Batch A B C
ANY: Type
any: ANY
forall (D2 : Type) (g : ANY -> D2),
b1 ⊗ map (Batch A B) g (Done A B ANY any) =
map (Batch A B) (map_snd g) (b1 ⊗ Done A B ANY any)
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
forall (D2 : Type) (g : ANY -> D2),
b1 ⊗ map (Batch A B) g (rest ⧆ x') =
map (Batch A B) (map_snd g) (b1 ⊗ (rest ⧆ x'))
    -
A, B, C: Type
b1: Batch A B C
ANY: Type
any: ANY
forall (D2 : Type) (g : ANY -> D2),
b1 ⊗ map (Batch A B) g (Done A B ANY any) =
map (Batch A B) (map_snd g) (b1 ⊗ Done A B ANY any) intros; cbn.
A, B, C: Type
b1: Batch A B C
ANY: Type
any: ANY
D2: Type
g: ANY -> D2
map (Batch A B) (fun c : C => (c, g any)) b1 =
map (Batch A B) (map_snd g)
  (map (Batch A B) (fun c : C => (c, any)) b1) compose near b1 on right.
A, B, C: Type
b1: Batch A B C
ANY: Type
any: ANY
D2: Type
g: ANY -> D2
map (Batch A B) (fun c : C => (c, g any)) b1 =
(map (Batch A B) (map_snd g)
 ∘ map (Batch A B) (fun c : C => (c, any))) b1
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
b1: Batch A B C
ANY: Type
any: ANY
D2: Type
g: ANY -> D2
map (Batch A B) (fun c : C => (c, g any)) b1 =
map (Batch A B) (map_snd g ∘ (fun c : C => (c, any)))
  b1
      reflexivity.
    -
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
forall (D2 : Type) (g : ANY -> D2),
b1 ⊗ map (Batch A B) g (rest ⧆ x') =
map (Batch A B) (map_snd g) (b1 ⊗ (rest ⧆ x')) intros; cbn.
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
D2: Type
g: ANY -> D2
map (Batch A B) strength_arrow
  (mult_Batch b1 (map (Batch A B) (compose g) rest))
⧆ x' =
map (Batch A B) (compose (map_snd g))
  (map (Batch A B) strength_arrow (mult_Batch b1 rest))
⧆ x' fequal.
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
D2: Type
g: ANY -> D2
map (Batch A B) strength_arrow
  (mult_Batch b1 (map (Batch A B) (compose g) rest)) =
map (Batch A B) (compose (map_snd g))
  (map (Batch A B) strength_arrow (mult_Batch b1 rest))
      change (mult_Batch ?x ?y) with (x ⊗ y).
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
D2: Type
g: ANY -> D2
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) (compose g) rest) =
map (Batch A B) (compose (map_snd g))
  (map (Batch A B) strength_arrow (b1 ⊗ rest))
      compose near (b1 ⊗ rest).
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
D2: Type
g: ANY -> D2
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) (compose g) rest) =
(map (Batch A B) (compose (map_snd g))
 ∘ map (Batch A B) strength_arrow) (b1 ⊗ rest)
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall (D2 : Type) (g : (B -> ANY) -> D2),
b1 ⊗ map (Batch A B) g rest =
map (Batch A B) (map_snd g) (b1 ⊗ rest)
D2: Type
g: ANY -> D2
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) (compose g) rest) =
map (Batch A B) (compose (map_snd g) ∘ strength_arrow)
  (b1 ⊗ rest)
      specialize (IH (B -> D2) (compose g)).
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
D2: Type
g: ANY -> D2
IH: b1 ⊗ map (Batch A B) (compose g) rest =
map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) (compose g) rest) =
map (Batch A B) (compose (map_snd g) ∘ strength_arrow)
  (b1 ⊗ rest)
      rewrite IH.
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
D2: Type
g: ANY -> D2
IH: b1 ⊗ map (Batch A B) (compose g) rest =
map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)
map (Batch A B) strength_arrow
  (map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)) =
map (Batch A B) (compose (map_snd g) ∘ strength_arrow)
  (b1 ⊗ rest)
      compose near (b1 ⊗ rest) on left.
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
D2: Type
g: ANY -> D2
IH: b1 ⊗ map (Batch A B) (compose g) rest =
map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)
(map (Batch A B) strength_arrow
 ∘ map (Batch A B) (map_snd (compose g))) (b1 ⊗ rest) =
map (Batch A B) (compose (map_snd g) ∘ strength_arrow)
  (b1 ⊗ rest)
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
D2: Type
g: ANY -> D2
IH: b1 ⊗ map (Batch A B) (compose g) rest =
map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)
map (Batch A B) (strength_arrow ∘ map_snd (compose g))
  (b1 ⊗ rest) =
map (Batch A B) (compose (map_snd g) ∘ strength_arrow)
  (b1 ⊗ rest)
      fequal.
A, B, C: Type
b1: Batch A B C
ANY: Type
rest: Batch A B (B -> ANY)
x': A
D2: Type
g: ANY -> D2
IH: b1 ⊗ map (Batch A B) (compose g) rest =
map (Batch A B) (map_snd (compose g)) (b1 ⊗ rest)
strength_arrow ∘ map_snd (compose g) =
compose (map_snd g) ∘ strength_arrow
      now ext [c mk].
  Qed.

  Lemma app_mult_natural_Batch:
    forall (C1 C2 D1 D2: Type) (f: C1 -> C2) (g: D1 -> D2)
      (b1: Batch A B C1) (b2: Batch A B D1),
      map (Batch A B) f b1 ⊗ map (Batch A B) g b2 =
        map (Batch A B) (map_tensor f g) (b1 ⊗ b2).
A, B: Type
forall (C1 C2 D1 D2 : Type) (f : C1 -> C2)
  (g : D1 -> D2) (b1 : Batch A B C1)
  (b2 : Batch A B D1),
map (Batch A B) f b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
  Proof.
A, B: Type
forall (C1 C2 D1 D2 : Type) (f : C1 -> C2)
  (g : D1 -> D2) (b1 : Batch A B C1)
  (b2 : Batch A B D1),
map (Batch A B) f b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    intros.
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
map (Batch A B) f b1 ⊗ map (Batch A B) g b2 =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    rewrite app_mult_natural_Batch1.
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
map (Batch A B) (map_fst f)
  (b1 ⊗ map (Batch A B) g b2) =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    rewrite app_mult_natural_Batch2.
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
map (Batch A B) (map_fst f)
  (map (Batch A B) (map_snd g) (b1 ⊗ b2)) =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    compose near (b1 ⊗ b2) on left.
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
(map (Batch A B) (map_fst f)
 ∘ map (Batch A B) (map_snd g)) (b1 ⊗ b2) =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    rewrite (fun_map_map (F := Batch A B)).
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
map (Batch A B) (map_fst f ∘ map_snd g) (b1 ⊗ b2) =
map (Batch A B) (map_tensor f g) (b1 ⊗ b2)
    fequal.
A, B, C1, C2, D1, D2: Type
f: C1 -> C2
g: D1 -> D2
b1: Batch A B C1
b2: Batch A B D1
map_fst f ∘ map_snd g = map_tensor f g
    now ext [c1 d1].
  Qed.

  Lemma app_assoc_Batch:
    forall (C D E: Type)
      (b1: Batch A B C) (b2: Batch A B D) (b3: Batch A B E),
      map (Batch A B) associator ((b1 ⊗ b2) ⊗ b3) = b1 ⊗ (b2 ⊗ b3).
A, B: Type
forall (C D E : Type) (b1 : Batch A B C)
  (b2 : Batch A B D) (b3 : Batch A B E),
map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
  Proof.
A, B: Type
forall (C D E : Type) (b1 : Batch A B C)
  (b2 : Batch A B D) (b3 : Batch A B E),
map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
    intros.
A, B, C, D, E: Type
b1: Batch A B C
b2: Batch A B D
b3: Batch A B E
map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3) induction b3.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
c: C0
map (Batch A B) associator (b1 ⊗ b2 ⊗ Done A B C0 c) =
b1 ⊗ (b2 ⊗ Done A B C0 c)
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) associator (b1 ⊗ b2 ⊗ (b3 ⧆ a)) =
b1 ⊗ (b2 ⊗ (b3 ⧆ a))
    -
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
c: C0
map (Batch A B) associator (b1 ⊗ b2 ⊗ Done A B C0 c) =
b1 ⊗ (b2 ⊗ Done A B C0 c) do 2 rewrite mult_Batch_rw2.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
c: C0
map (Batch A B) associator
  (map (Batch A B) (pair_right c) (b1 ⊗ b2)) =
b1 ⊗ map (Batch A B) (pair_right c) b2
      rewrite app_mult_natural_Batch2.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
c: C0
map (Batch A B) associator
  (map (Batch A B) (pair_right c) (b1 ⊗ b2)) =
map (Batch A B) (map_snd (pair_right c)) (b1 ⊗ b2)
      compose near (b1 ⊗ b2) on left.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
c: C0
(map (Batch A B) associator
 ∘ map (Batch A B) (pair_right c)) (b1 ⊗ b2) =
map (Batch A B) (map_snd (pair_right c)) (b1 ⊗ b2)
      now rewrite (fun_map_map (F := Batch A B)).
    -
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) associator (b1 ⊗ b2 ⊗ (b3 ⧆ a)) =
b1 ⊗ (b2 ⊗ (b3 ⧆ a)) cbn.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator)
  (map (Batch A B) strength_arrow
     (mult_Batch (mult_Batch b1 b2) b3)) ⧆ a =
map (Batch A B) strength_arrow
  (mult_Batch b1
     (map (Batch A B) strength_arrow
        (mult_Batch b2 b3))) ⧆ a repeat change (mult_Batch ?x ?y) with (x ⊗ y).
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator)
  (map (Batch A B) strength_arrow (b1 ⊗ b2 ⊗ b3)) ⧆ a =
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) strength_arrow (b2 ⊗ b3)) ⧆ a
      fequal.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator)
  (map (Batch A B) strength_arrow (b1 ⊗ b2 ⊗ b3)) =
map (Batch A B) strength_arrow
  (b1 ⊗ map (Batch A B) strength_arrow (b2 ⊗ b3))
      rewrite app_mult_natural_Batch2.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator)
  (map (Batch A B) strength_arrow (b1 ⊗ b2 ⊗ b3)) =
map (Batch A B) strength_arrow
  (map (Batch A B) (map_snd strength_arrow)
     (b1 ⊗ (b2 ⊗ b3)))
      rewrite <- IHb3.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator)
  (map (Batch A B) strength_arrow (b1 ⊗ b2 ⊗ b3)) =
map (Batch A B) strength_arrow
  (map (Batch A B) (map_snd strength_arrow)
     (map (Batch A B) associator (b1 ⊗ b2 ⊗ b3)))
      compose near (b1 ⊗ b2 ⊗ b3).
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
(map (Batch A B) (compose associator)
 ∘ map (Batch A B) strength_arrow) (b1 ⊗ b2 ⊗ b3) =
map (Batch A B) strength_arrow
  ((map (Batch A B) (map_snd strength_arrow)
    ∘ map (Batch A B) associator) (b1 ⊗ b2 ⊗ b3))
      do 2 rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator ∘ strength_arrow)
  (b1 ⊗ b2 ⊗ b3) =
map (Batch A B) strength_arrow
  (map (Batch A B)
     (map_snd strength_arrow ∘ associator)
     (b1 ⊗ b2 ⊗ b3))
      compose near (b1 ⊗ b2 ⊗ b3) on right.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator ∘ strength_arrow)
  (b1 ⊗ b2 ⊗ b3) =
(map (Batch A B) strength_arrow
 ∘ map (Batch A B)
     (map_snd strength_arrow ∘ associator))
  (b1 ⊗ b2 ⊗ b3)
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
map (Batch A B) (compose associator ∘ strength_arrow)
  (b1 ⊗ b2 ⊗ b3) =
map (Batch A B)
  (strength_arrow
   ∘ (map_snd strength_arrow ∘ associator))
  (b1 ⊗ b2 ⊗ b3)
      fequal.
A, B, C, D: Type
b1: Batch A B C
b2: Batch A B D
C0: Type
b3: Batch A B (B -> C0)
a: A
IHb3: map (Batch A B) associator (b1 ⊗ b2 ⊗ b3) =
b1 ⊗ (b2 ⊗ b3)
compose associator ∘ strength_arrow =
strength_arrow ∘ (map_snd strength_arrow ∘ associator)
      now ext [[c d] mk].
  Qed.

  Lemma app_unital_l_Batch:
    forall (C: Type) (b: Batch A B C),
      map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b.
A, B: Type
forall (C : Type) (b : Batch A B C),
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) =
b
  Proof.
A, B: Type
forall (C : Type) (b : Batch A B C),
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) =
b
    intros.
A, B, C: Type
b: Batch A B C
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) =
b induction b.
A, B, C: Type
c: C
map (Batch A B) left_unitor
  (pure (Batch A B) tt ⊗ Done A B C c) = Done A B C c
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) left_unitor
  (pure (Batch A B) tt ⊗ (b ⧆ a)) = b ⧆ a
    -
A, B, C: Type
c: C
map (Batch A B) left_unitor
  (pure (Batch A B) tt ⊗ Done A B C c) = Done A B C c reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) left_unitor
  (pure (Batch A B) tt ⊗ (b ⧆ a)) = b ⧆ a cbn.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) (compose left_unitor)
  (map (Batch A B) strength_arrow
     (mult_Batch (pure (Batch A B) tt) b)) ⧆ a = b ⧆ a change (mult_Batch ?x ?y) with (x ⊗ y).
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) (compose left_unitor)
  (map (Batch A B) strength_arrow
     (pure (Batch A B) tt ⊗ b)) ⧆ a = b ⧆ a
      fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) (compose left_unitor)
  (map (Batch A B) strength_arrow
     (pure (Batch A B) tt ⊗ b)) = b compose near (pure (Batch A B) tt ⊗ b).
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
(map (Batch A B) (compose left_unitor)
 ∘ map (Batch A B) strength_arrow)
  (pure (Batch A B) tt ⊗ b) = b
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) (compose left_unitor ∘ strength_arrow)
  (pure (Batch A B) tt ⊗ b) = b
      rewrite <- IHb.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) (compose left_unitor ∘ strength_arrow)
  (pure (Batch A B) tt
   ⊗ map (Batch A B) left_unitor
       (pure (Batch A B) tt ⊗ b)) =
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b)
      do 3 fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) = b
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ b) =
b
      assumption.
  Qed.

  Lemma app_unital_r_Batch:
    forall (C: Type) (b: Batch A B C),
      map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) = b.
A, B: Type
forall (C : Type) (b : Batch A B C),
map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) =
b
  Proof.
A, B: Type
forall (C : Type) (b : Batch A B C),
map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) =
b
    intros.
A, B, C: Type
b: Batch A B C
map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) =
b induction b.
A, B, C: Type
c: C
map (Batch A B) right_unitor
  (Done A B C c ⊗ pure (Batch A B) tt) = Done A B C c
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) = b
map (Batch A B) right_unitor
  ((b ⧆ a) ⊗ pure (Batch A B) tt) = b ⧆ a
    -
A, B, C: Type
c: C
map (Batch A B) right_unitor
  (Done A B C c ⊗ pure (Batch A B) tt) = Done A B C c reflexivity.
    -
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (b ⊗ pure (Batch A B) tt) = b
map (Batch A B) right_unitor
  ((b ⧆ a) ⊗ pure (Batch A B) tt) = b ⧆ a cbn in *.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (map (Batch A B) (fun c : B -> C => (c, tt)) b) =
b
map (Batch A B) (compose right_unitor)
  (map (Batch A B) (compose (fun c : C => (c, tt))) b)
⧆ a = b ⧆ a fequal.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (map (Batch A B) (fun c : B -> C => (c, tt)) b) =
b
map (Batch A B) (compose right_unitor)
  (map (Batch A B) (compose (fun c : C => (c, tt))) b) =
b rewrite <- IHb at 2.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (map (Batch A B) (fun c : B -> C => (c, tt)) b) =
b
map (Batch A B) (compose right_unitor)
  (map (Batch A B) (compose (fun c : C => (c, tt))) b) =
map (Batch A B) right_unitor
  (map (Batch A B) (fun c : B -> C => (c, tt)) b)
      compose near b.
A, B, C: Type
b: Batch A B (B -> C)
a: A
IHb: map (Batch A B) right_unitor (map (Batch A B) (fun c : B -> C => (c, tt)) b) =
b
(map (Batch A B) (compose right_unitor)
 ∘ map (Batch A B) (compose (fun c : C => (c, tt)))) b =
(map (Batch A B) right_unitor
 ∘ map (Batch A B) (fun c : B -> C => (c, tt))) b
      now do 2 rewrite (fun_map_map (F := Batch A B)).
  Qed.

  Lemma app_mult_pure_Batch:
    forall (C D: Type) (c: C) (d: D),
      pure (Batch A B) c ⊗ pure (Batch A B) d =
        pure (Batch A B) (c, d).
A, B: Type
forall (C D : Type) (c : C) (d : D),
pure (Batch A B) c ⊗ pure (Batch A B) d =
pure (Batch A B) (c, d)
  Proof.
A, B: Type
forall (C D : Type) (c : C) (d : D),
pure (Batch A B) c ⊗ pure (Batch A B) d =
pure (Batch A B) (c, d)
    intros.
A, B, C, D: Type
c: C
d: D
pure (Batch A B) c ⊗ pure (Batch A B) d =
pure (Batch A B) (c, d) reflexivity.
  Qed.

  (** ** Typeclass Instance *)
  (********************************************************************)
  #[export] Instance Applicative_Batch: Applicative (Batch A B).
A, B: Type
Applicative (Batch A B)
  Proof.
A, B: Type
Applicative (Batch A B)
    constructor; intros.
A, B: Type
Functor (Batch A B)
A, B, A0, B0: Type
f: A0 -> B0
x: A0
map (Batch A B) f (pure (Batch A B) x) =
pure (Batch A B) (f x)
A, B, A0, B0, C, D: Type
f: A0 -> C
g: B0 -> D
x: Batch A B A0
y: Batch A B B0
map (Batch A B) f x ⊗ map (Batch A B) g y =
map (Batch A B) (map_tensor f g) (x ⊗ y)
A, B, A0, B0, C: Type
x: Batch A B A0
y: Batch A B B0
z: Batch A B C
map (Batch A B) associator (x ⊗ y ⊗ z) = x ⊗ (y ⊗ z)
A, B, A0: Type
x: Batch A B A0
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ x) =
x
A, B, A0: Type
x: Batch A B A0
map (Batch A B) right_unitor (x ⊗ pure (Batch A B) tt) =
x
A, B, A0, B0: Type
a: A0
b: B0
pure (Batch A B) a ⊗ pure (Batch A B) b =
pure (Batch A B) (a, b)
    -
A, B: Type
Functor (Batch A B) typeclasses eauto.
    -
A, B, A0, B0: Type
f: A0 -> B0
x: A0
map (Batch A B) f (pure (Batch A B) x) =
pure (Batch A B) (f x) reflexivity.
    -
A, B, A0, B0, C, D: Type
f: A0 -> C
g: B0 -> D
x: Batch A B A0
y: Batch A B B0
map (Batch A B) f x ⊗ map (Batch A B) g y =
map (Batch A B) (map_tensor f g) (x ⊗ y) apply app_mult_natural_Batch.
    -
A, B, A0, B0, C: Type
x: Batch A B A0
y: Batch A B B0
z: Batch A B C
map (Batch A B) associator (x ⊗ y ⊗ z) = x ⊗ (y ⊗ z) apply app_assoc_Batch.
    -
A, B, A0: Type
x: Batch A B A0
map (Batch A B) left_unitor (pure (Batch A B) tt ⊗ x) =
x apply app_unital_l_Batch.
    -
A, B, A0: Type
x: Batch A B A0
map (Batch A B) right_unitor (x ⊗ pure (Batch A B) tt) =
x apply app_unital_r_Batch.
    -
A, B, A0, B0: Type
a: A0
b: B0
pure (Batch A B) a ⊗ pure (Batch A B) b =
pure (Batch A B) (a, b) reflexivity.
  Qed.

End Applicative_Batch.

(** ** <<mapfst>> and <<mapsnd>> as Applicative Homomorphisms *)
(**********************************************************************)
Lemma mapfst_Batch1 {B C D: Type} `(f: A1 -> A2)
  (b1: Batch A1 B C) (b2: Batch A1 B D):
  mapfst_Batch A1 A2 f (b1 ⊗ b2) =
    mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B C
b2: Batch A1 B D
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2
Proof.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B C
b2: Batch A1 B D
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2
  generalize dependent b1.
B, C, D, A1, A2: Type
f: A1 -> A2
b2: Batch A1 B D
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2 induction b2.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
c: C0
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ Done A1 B C0 c) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f (Done A1 B C0 c)
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ (b2 ⧆ a)) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f (b2 ⧆ a)
  -
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
c: C0
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ Done A1 B C0 c) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f (Done A1 B C0 c) intros.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
c: C0
b1: Batch A1 B C
mapfst_Batch A1 A2 f (b1 ⊗ Done A1 B C0 c) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f (Done A1 B C0 c) cbn.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
c: C0
b1: Batch A1 B C
mapfst_Batch A1 A2 f
  (map (Batch A1 B) (fun c0 : C => (c0, c)) b1) =
map (Batch A2 B) (fun c0 : C => (c0, c))
  (mapfst_Batch A1 A2 f b1) now rewrite mapfst_map_Batch.
  -
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ (b2 ⧆ a)) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f (b2 ⧆ a) cbn.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f
  (map (Batch A1 B) strength_arrow (mult_Batch b1 b2))
⧆ f a =
map (Batch A2 B) strength_arrow
  (mult_Batch (mapfst_Batch A1 A2 f b1)
     (mapfst_Batch A1 A2 f b2)) ⧆ f a fequal.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f
  (map (Batch A1 B) strength_arrow (mult_Batch b1 b2))
⧆ f a =
map (Batch A2 B) strength_arrow
  (mult_Batch (mapfst_Batch A1 A2 f b1)
     (mapfst_Batch A1 A2 f b2)) ⧆ f a
    change (mult_Batch ?x ?y) with (x ⊗ y) in *; intros.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
b1: Batch A1 B C
mapfst_Batch A1 A2 f
  (map (Batch A1 B) strength_arrow (b1 ⊗ b2)) ⧆ f a =
map (Batch A2 B) strength_arrow
  (mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2)
⧆ f a
    rewrite <- IHb2.
B, C, A1, A2: Type
f: A1 -> A2
C0: Type
b2: Batch A1 B (B -> C0)
a: A1
IHb2: forall b1 : Batch A1 B C,
mapfst_Batch A1 A2 f (b1 ⊗ b2) =
mapfst_Batch A1 A2 f b1
⊗ mapfst_Batch A1 A2 f b2
b1: Batch A1 B C
mapfst_Batch A1 A2 f
  (map (Batch A1 B) strength_arrow (b1 ⊗ b2)) ⧆ f a =
map (Batch A2 B) strength_arrow
  (mapfst_Batch A1 A2 f (b1 ⊗ b2)) ⧆ f a
    now rewrite mapfst_map_Batch.
Qed.

Lemma mapfst_Batch2 {B C D: Type} `(f: A1 -> A2)
  (b1: Batch A1 B (C -> D)) (b2: Batch A1 B C):
  mapfst_Batch A1 A2 f (b1 <⋆> b2) =
    mapfst_Batch A1 A2 f b1 <⋆> mapfst_Batch A1 A2 f b2.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B (C -> D)
b2: Batch A1 B C
mapfst_Batch A1 A2 f (b1 <⋆> b2) =
mapfst_Batch A1 A2 f b1 <⋆> mapfst_Batch A1 A2 f b2
Proof.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B (C -> D)
b2: Batch A1 B C
mapfst_Batch A1 A2 f (b1 <⋆> b2) =
mapfst_Batch A1 A2 f b1 <⋆> mapfst_Batch A1 A2 f b2
  unfold ap.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B (C -> D)
b2: Batch A1 B C
mapfst_Batch A1 A2 f
  (map (Batch A1 B) (fun '(f, a) => f a) (b1 ⊗ b2)) =
map (Batch A2 B) (fun '(f, a) => f a)
  (mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2) rewrite mapfst_map_Batch.
B, C, D, A1, A2: Type
f: A1 -> A2
b1: Batch A1 B (C -> D)
b2: Batch A1 B C
map (Batch A2 B) (fun '(f, a) => f a)
  (mapfst_Batch A1 A2 f (b1 ⊗ b2)) =
map (Batch A2 B) (fun '(f, a) => f a)
  (mapfst_Batch A1 A2 f b1 ⊗ mapfst_Batch A1 A2 f b2)
  now rewrite mapfst_Batch1.
Qed.

#[export] Instance ApplicativeMorphism_mapfst_Batch
  {B: Type} `(f: A1 -> A2):
  ApplicativeMorphism (Batch A1 B) (Batch A2 B)
    (fun C => mapfst_Batch _ _ f).
B, A1, A2: Type
f: A1 -> A2
ApplicativeMorphism (Batch A1 B) (Batch A2 B)
  (fun C : Type => mapfst_Batch A1 A2 f)
Proof.
B, A1, A2: Type
f: A1 -> A2
ApplicativeMorphism (Batch A1 B) (Batch A2 B)
  (fun C : Type => mapfst_Batch A1 A2 f)
  intros.
B, A1, A2: Type
f: A1 -> A2
ApplicativeMorphism (Batch A1 B) (Batch A2 B)
  (fun C : Type => mapfst_Batch A1 A2 f)
  constructor; try typeclasses eauto.
B, A1, A2: Type
f: A1 -> A2
forall (A B0 : Type) (f0 : A -> B0) (x : Batch A1 B A),
mapfst_Batch A1 A2 f (map (Batch A1 B) f0 x) =
map (Batch A2 B) f0 (mapfst_Batch A1 A2 f x)
B, A1, A2: Type
f: A1 -> A2
forall (A : Type) (a : A),
mapfst_Batch A1 A2 f (pure (Batch A1 B) a) =
pure (Batch A2 B) a
B, A1, A2: Type
f: A1 -> A2
forall (A B0 : Type) (x : Batch A1 B A)
  (y : Batch A1 B B0),
mapfst_Batch A1 A2 f (x ⊗ y) =
mapfst_Batch A1 A2 f x ⊗ mapfst_Batch A1 A2 f y
  -
B, A1, A2: Type
f: A1 -> A2
forall (A B0 : Type) (f0 : A -> B0) (x : Batch A1 B A),
mapfst_Batch A1 A2 f (map (Batch A1 B) f0 x) =
map (Batch A2 B) f0 (mapfst_Batch A1 A2 f x) intros.
B, A1, A2: Type
f: A1 -> A2
A, B0: Type
f0: A -> B0
x: Batch A1 B A
mapfst_Batch A1 A2 f (map (Batch A1 B) f0 x) =
map (Batch A2 B) f0 (mapfst_Batch A1 A2 f x) now rewrite mapfst_map_Batch.
  -
B, A1, A2: Type
f: A1 -> A2
forall (A : Type) (a : A),
mapfst_Batch A1 A2 f (pure (Batch A1 B) a) =
pure (Batch A2 B) a intros.
B, A1, A2: Type
f: A1 -> A2
A: Type
a: A
mapfst_Batch A1 A2 f (pure (Batch A1 B) a) =
pure (Batch A2 B) a reflexivity.
  -
B, A1, A2: Type
f: A1 -> A2
forall (A B0 : Type) (x : Batch A1 B A)
  (y : Batch A1 B B0),
mapfst_Batch A1 A2 f (x ⊗ y) =
mapfst_Batch A1 A2 f x ⊗ mapfst_Batch A1 A2 f y intros.
B, A1, A2: Type
f: A1 -> A2
A, B0: Type
x: Batch A1 B A
y: Batch A1 B B0
mapfst_Batch A1 A2 f (x ⊗ y) =
mapfst_Batch A1 A2 f x ⊗ mapfst_Batch A1 A2 f y apply mapfst_Batch1.
Qed.

Lemma mapsnd_Batch1 {A C D: Type} `(f: B1 -> B2)
  (b1: Batch A B2 C) (b2: Batch A B2 D):
  mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
    mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 C
b2: Batch A B2 D
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2
Proof.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 C
b2: Batch A B2 D
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2
  generalize dependent b1.
A, C, D, B1, B2: Type
f: B1 -> B2
b2: Batch A B2 D
forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2 induction b2.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
c: C0
forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ Done A B2 C0 c) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f (Done A B2 C0 c)
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ (b2 ⧆ a)) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f (b2 ⧆ a)
  -
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
c: C0
forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ Done A B2 C0 c) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f (Done A B2 C0 c) intros.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
c: C0
b1: Batch A B2 C
mapsnd_Batch B1 B2 f (b1 ⊗ Done A B2 C0 c) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f (Done A B2 C0 c) cbn.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
c: C0
b1: Batch A B2 C
mapsnd_Batch B1 B2 f
  (map (Batch A B2) (fun c0 : C => (c0, c)) b1) =
map (Batch A B1) (fun c0 : C => (c0, c))
  (mapsnd_Batch B1 B2 f b1) now rewrite mapsnd_map_Batch.
  -
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ (b2 ⧆ a)) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f (b2 ⧆ a) cbn.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
forall b1 : Batch A B2 C,
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) strength_arrow
        (mult_Batch b1 b2))) ⧆ a =
map (Batch A B1) strength_arrow
  (mult_Batch (mapsnd_Batch B1 B2 f b1)
     (map (Batch A B1) (precompose f)
        (mapsnd_Batch B1 B2 f b2))) ⧆ a fequal.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
forall b1 : Batch A B2 C,
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) strength_arrow
        (mult_Batch b1 b2))) ⧆ a =
map (Batch A B1) strength_arrow
  (mult_Batch (mapsnd_Batch B1 B2 f b1)
     (map (Batch A B1) (precompose f)
        (mapsnd_Batch B1 B2 f b2))) ⧆ a
    change (mult_Batch ?x ?y) with (x ⊗ y) in *; intros.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f)
  (mapsnd_Batch B1 B2 f
     (map (Batch A B2) strength_arrow (b1 ⊗ b2))) ⧆ a =
map (Batch A B1) strength_arrow
  (mapsnd_Batch B1 B2 f b1
   ⊗ map (Batch A B1) (precompose f)
       (mapsnd_Batch B1 B2 f b2)) ⧆ a
    rewrite mapsnd_map_Batch.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f)
  (map (Batch A B1) strength_arrow
     (mapsnd_Batch B1 B2 f (b1 ⊗ b2))) ⧆ a =
map (Batch A B1) strength_arrow
  (mapsnd_Batch B1 B2 f b1
   ⊗ map (Batch A B1) (precompose f)
       (mapsnd_Batch B1 B2 f b2)) ⧆ a
    compose near (mapsnd_Batch B1 B2 f (b1 ⊗ b2)).
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
(map (Batch A B1) (precompose f)
 ∘ map (Batch A B1) strength_arrow)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) ⧆ a =
map (Batch A B1) strength_arrow
  (mapsnd_Batch B1 B2 f b1
   ⊗ map (Batch A B1) (precompose f)
       (mapsnd_Batch B1 B2 f b2)) ⧆ a
    rewrite (fun_map_map (F := Batch A B1)).
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f ∘ strength_arrow)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) ⧆ a =
map (Batch A B1) strength_arrow
  (mapsnd_Batch B1 B2 f b1
   ⊗ map (Batch A B1) (precompose f)
       (mapsnd_Batch B1 B2 f b2)) ⧆ a
    rewrite app_mult_natural_Batch2.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f ∘ strength_arrow)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) ⧆ a =
map (Batch A B1) strength_arrow
  (map (Batch A B1) (map_snd (precompose f))
     (mapsnd_Batch B1 B2 f b1
      ⊗ mapsnd_Batch B1 B2 f b2)) ⧆ a
    compose near (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2).
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f ∘ strength_arrow)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) ⧆ a =
(map (Batch A B1) strength_arrow
 ∘ map (Batch A B1) (map_snd (precompose f)))
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2)
⧆ a
    rewrite (fun_map_map (F := Batch A B1)).
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f ∘ strength_arrow)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) ⧆ a =
map (Batch A B1)
  (strength_arrow ∘ map_snd (precompose f))
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2)
⧆ a
    rewrite IHb2.
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
map (Batch A B1) (precompose f ∘ strength_arrow)
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2)
⧆ a =
map (Batch A B1)
  (strength_arrow ∘ map_snd (precompose f))
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2)
⧆ a do 2 fequal; ext [c rest].
A, C, B1, B2: Type
f: B1 -> B2
C0: Type
b2: Batch A B2 (B2 -> C0)
a: A
IHb2: forall b1 : Batch A B2 C,
mapsnd_Batch B1 B2 f (b1 ⊗ b2) =
mapsnd_Batch B1 B2 f b1
⊗ mapsnd_Batch B1 B2 f b2
b1: Batch A B2 C
c: C
rest: B2 -> C0
(precompose f ∘ strength_arrow) (c, rest) =
(strength_arrow ∘ map_snd (precompose f)) (c, rest)
    reflexivity.
Qed.

Lemma mapsnd_Batch2 {A C D: Type} `(f: B1 -> B2)
  (b1: Batch A B2 (C -> D)) (b2: Batch A B2 C):
  mapsnd_Batch B1 B2 f (b1 <⋆> b2) =
    mapsnd_Batch B1 B2 f b1 <⋆> mapsnd_Batch B1 B2 f b2.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 (C -> D)
b2: Batch A B2 C
mapsnd_Batch B1 B2 f (b1 <⋆> b2) =
mapsnd_Batch B1 B2 f b1 <⋆> mapsnd_Batch B1 B2 f b2
Proof.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 (C -> D)
b2: Batch A B2 C
mapsnd_Batch B1 B2 f (b1 <⋆> b2) =
mapsnd_Batch B1 B2 f b1 <⋆> mapsnd_Batch B1 B2 f b2
  unfold ap.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 (C -> D)
b2: Batch A B2 C
mapsnd_Batch B1 B2 f
  (map (Batch A B2) (fun '(f, a) => f a) (b1 ⊗ b2)) =
map (Batch A B1) (fun '(f, a) => f a)
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2) rewrite mapsnd_map_Batch.
A, C, D, B1, B2: Type
f: B1 -> B2
b1: Batch A B2 (C -> D)
b2: Batch A B2 C
map (Batch A B1) (fun '(f, a) => f a)
  (mapsnd_Batch B1 B2 f (b1 ⊗ b2)) =
map (Batch A B1) (fun '(f, a) => f a)
  (mapsnd_Batch B1 B2 f b1 ⊗ mapsnd_Batch B1 B2 f b2)
  now rewrite mapsnd_Batch1.
Qed.

#[export] Instance ApplicativeMorphism_mapsnd_Batch
  {A B1 B2: Type} `(f: B1 -> B2):
  ApplicativeMorphism (Batch A B2) (Batch A B1)
    (fun C => mapsnd_Batch B1 B2 f).
A, B1, B2: Type
f: B1 -> B2
ApplicativeMorphism (Batch A B2) (Batch A B1)
  (fun C : Type => mapsnd_Batch B1 B2 f)
Proof.
A, B1, B2: Type
f: B1 -> B2
ApplicativeMorphism (Batch A B2) (Batch A B1)
  (fun C : Type => mapsnd_Batch B1 B2 f)
  intros.
A, B1, B2: Type
f: B1 -> B2
ApplicativeMorphism (Batch A B2) (Batch A B1)
  (fun C : Type => mapsnd_Batch B1 B2 f)
  constructor; try typeclasses eauto.
A, B1, B2: Type
f: B1 -> B2
forall (A0 B : Type) (f0 : A0 -> B)
  (x : Batch A B2 A0),
mapsnd_Batch B1 B2 f (map (Batch A B2) f0 x) =
map (Batch A B1) f0 (mapsnd_Batch B1 B2 f x)
A, B1, B2: Type
f: B1 -> B2
forall (A0 : Type) (a : A0),
mapsnd_Batch B1 B2 f (pure (Batch A B2) a) =
pure (Batch A B1) a
A, B1, B2: Type
f: B1 -> B2
forall (A0 B : Type) (x : Batch A B2 A0)
  (y : Batch A B2 B),
mapsnd_Batch B1 B2 f (x ⊗ y) =
mapsnd_Batch B1 B2 f x ⊗ mapsnd_Batch B1 B2 f y
  -
A, B1, B2: Type
f: B1 -> B2
forall (A0 B : Type) (f0 : A0 -> B)
  (x : Batch A B2 A0),
mapsnd_Batch B1 B2 f (map (Batch A B2) f0 x) =
map (Batch A B1) f0 (mapsnd_Batch B1 B2 f x) intros.
A, B1, B2: Type
f: B1 -> B2
A0, B: Type
f0: A0 -> B
x: Batch A B2 A0
mapsnd_Batch B1 B2 f (map (Batch A B2) f0 x) =
map (Batch A B1) f0 (mapsnd_Batch B1 B2 f x) now rewrite mapsnd_map_Batch.
  -
A, B1, B2: Type
f: B1 -> B2
forall (A0 : Type) (a : A0),
mapsnd_Batch B1 B2 f (pure (Batch A B2) a) =
pure (Batch A B1) a intros.
A, B1, B2: Type
f: B1 -> B2
A0: Type
a: A0
mapsnd_Batch B1 B2 f (pure (Batch A B2) a) =
pure (Batch A B1) a reflexivity.
  -
A, B1, B2: Type
f: B1 -> B2
forall (A0 B : Type) (x : Batch A B2 A0)
  (y : Batch A B2 B),
mapsnd_Batch B1 B2 f (x ⊗ y) =
mapsnd_Batch B1 B2 f x ⊗ mapsnd_Batch B1 B2 f y intros.
A, B1, B2: Type
f: B1 -> B2
A0, B: Type
x: Batch A B2 A0
y: Batch A B2 B
mapsnd_Batch B1 B2 f (x ⊗ y) =
mapsnd_Batch B1 B2 f x ⊗ mapsnd_Batch B1 B2 f y apply mapsnd_Batch1.
Qed.

(** * The <<runBatch>> Operation *)
(**********************************************************************)
Fixpoint runBatch {A B: Type}
  (F: Type -> Type) `{Map F} `{Mult F} `{Pure F}
  (ϕ: A -> F B) (C: Type) (b: Batch A B C): F C :=
  match b with
  | Done _ _ _ c => pure F c
  | Step _ _ _ rest a => runBatch F ϕ (B -> C) rest <⋆> ϕ a
  end.

(** ** Rewriting Principles *)
(**********************************************************************)
Lemma runBatch_rw1 `{Applicative F} `(ϕ: A -> F B) (C: Type) (c: C):
  runBatch F ϕ C (Done A B C c) = pure F c.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
c: C
runBatch F ϕ C (Done A B C c) = pure F c
Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
c: C
runBatch F ϕ C (Done A B C c) = pure F c
  reflexivity.
Qed.

Lemma runBatch_rw2 `{Applicative F} `(ϕ: A -> F B)
  (a: A) (C: Type) (rest: Batch A B (B -> C)):
  runBatch F ϕ C (rest ⧆ a) = runBatch F ϕ (B -> C) rest <⋆> ϕ a.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
a: A
C: Type
rest: Batch A B (B -> C)
runBatch F ϕ C (rest ⧆ a) =
runBatch F ϕ (B -> C) rest <⋆> ϕ a
Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
a: A
C: Type
rest: Batch A B (B -> C)
runBatch F ϕ C (rest ⧆ a) =
runBatch F ϕ (B -> C) rest <⋆> ϕ a
  reflexivity.
Qed.

(** ** Naturality of <<runBatch>> *)
(**********************************************************************)
Section runBatch_naturality.

  Context
    `{Applicative F}.

  Lemma natural_runBatch
    {A B C1 C2: Type} (ϕ: A -> F B) (f: C1 -> C2) (b: Batch A B C1):
    map F f (runBatch F ϕ C1 b) = runBatch F ϕ C2 (map (Batch A B) f b).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B, C1, C2: Type
ϕ: A -> F B
f: C1 -> C2
b: Batch A B C1
map F f (runBatch F ϕ C1 b) =
runBatch F ϕ C2 (map (Batch A B) f b)
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B, C1, C2: Type
ϕ: A -> F B
f: C1 -> C2
b: Batch A B C1
map F f (runBatch F ϕ C1 b) =
runBatch F ϕ C2 (map (Batch A B) f b)
    generalize dependent C2.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B, C1: Type
ϕ: A -> F B
b: Batch A B C1
forall (C2 : Type) (f : C1 -> C2),
map F f (runBatch F ϕ C1 b) =
runBatch F ϕ C2 (map (Batch A B) f b)
    induction b; intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
c: C
C2: Type
f: C -> C2
map F f (runBatch F ϕ C (Done A B C c)) =
runBatch F ϕ C2 (map (Batch A B) f (Done A B C c))
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2),
map F f (runBatch F ϕ (B -> C) b) =
runBatch F ϕ C2 (map (Batch A B) f b)
C2: Type
f: C -> C2
map F f (runBatch F ϕ C (b ⧆ a)) =
runBatch F ϕ C2 (map (Batch A B) f (b ⧆ a))
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
c: C
C2: Type
f: C -> C2
map F f (runBatch F ϕ C (Done A B C c)) =
runBatch F ϕ C2 (map (Batch A B) f (Done A B C c)) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
c: C
C2: Type
f: C -> C2
map F f (pure F c) = pure F (f c) now rewrite app_pure_natural.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2),
map F f (runBatch F ϕ (B -> C) b) =
runBatch F ϕ C2 (map (Batch A B) f b)
C2: Type
f: C -> C2
map F f (runBatch F ϕ C (b ⧆ a)) =
runBatch F ϕ C2 (map (Batch A B) f (b ⧆ a)) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2),
map F f (runBatch F ϕ (B -> C) b) =
runBatch F ϕ C2 (map (Batch A B) f b)
C2: Type
f: C -> C2
map F f (runBatch F ϕ (B -> C) b <⋆> ϕ a) =
runBatch F ϕ (B -> C2) (map (Batch A B) (compose f) b) <⋆>
ϕ a rewrite map_ap.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2),
map F f (runBatch F ϕ (B -> C) b) =
runBatch F ϕ C2 (map (Batch A B) f b)
C2: Type
f: C -> C2
map F (compose f) (runBatch F ϕ (B -> C) b) <⋆> ϕ a =
runBatch F ϕ (B -> C2) (map (Batch A B) (compose f) b) <⋆>
ϕ a fequal.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: forall (C2 : Type) (f : (B -> C) -> C2),
map F f (runBatch F ϕ (B -> C) b) =
runBatch F ϕ C2 (map (Batch A B) f b)
C2: Type
f: C -> C2
map F (compose f) (runBatch F ϕ (B -> C) b) =
runBatch F ϕ (B -> C2) (map (Batch A B) (compose f) b) now rewrite IHb.
  Qed.

  #[export] Instance Natural_runBatch `(ϕ: A -> F B):
    Natural (runBatch F ϕ).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
Natural (runBatch F ϕ)
  constructor; try typeclasses eauto.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 B0 : Type) (f : A0 -> B0),
map F f ∘ runBatch F ϕ A0 =
runBatch F ϕ B0 ∘ map (Batch A B) f
  intros C D f.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
f: C -> D
map F f ∘ runBatch F ϕ C =
runBatch F ϕ D ∘ map (Batch A B) f ext b.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
f: C -> D
b: Batch A B C
(map F f ∘ runBatch F ϕ C) b =
(runBatch F ϕ D ∘ map (Batch A B) f) b unfold compose.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
f: C -> D
b: Batch A B C
map F f (runBatch F ϕ C b) =
runBatch F ϕ D (map (Batch A B) f b)
  rewrite natural_runBatch.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
f: C -> D
b: Batch A B C
runBatch F ϕ D (map (Batch A B) f b) =
runBatch F ϕ D (map (Batch A B) f b)
  reflexivity.
  Qed.

  Lemma runBatch_mapfst:
    forall `(s: Batch A1 B C) `(ϕ: A2 -> F B) (f: A1 -> A2),
      runBatch F (ϕ ∘ f) C s = runBatch F ϕ C (mapfst_Batch A1 A2 f s).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A1 B C : Type) (s : Batch A1 B C) (A2 : Type)
  (ϕ : A2 -> F B) (f : A1 -> A2),
runBatch F (ϕ ∘ f) C s =
runBatch F ϕ C (mapfst_Batch A1 A2 f s)
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A1 B C : Type) (s : Batch A1 B C) (A2 : Type)
  (ϕ : A2 -> F B) (f : A1 -> A2),
runBatch F (ϕ ∘ f) C s =
runBatch F ϕ C (mapfst_Batch A1 A2 f s)
    intros; induction s.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, B, C: Type
c: C
A2: Type
ϕ: A2 -> F B
f: A1 -> A2
runBatch F (ϕ ∘ f) C (Done A1 B C c) =
runBatch F ϕ C (mapfst_Batch A1 A2 f (Done A1 B C c))
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, B, C: Type
s: Batch A1 B (B -> C)
a: A1
A2: Type
ϕ: A2 -> F B
f: A1 -> A2
IHs: runBatch F (ϕ ∘ f) (B -> C) s =
runBatch F ϕ (B -> C) (mapfst_Batch A1 A2 f s)
runBatch F (ϕ ∘ f) C (s ⧆ a) =
runBatch F ϕ C (mapfst_Batch A1 A2 f (s ⧆ a))
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, B, C: Type
c: C
A2: Type
ϕ: A2 -> F B
f: A1 -> A2
runBatch F (ϕ ∘ f) C (Done A1 B C c) =
runBatch F ϕ C (mapfst_Batch A1 A2 f (Done A1 B C c)) easy.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, B, C: Type
s: Batch A1 B (B -> C)
a: A1
A2: Type
ϕ: A2 -> F B
f: A1 -> A2
IHs: runBatch F (ϕ ∘ f) (B -> C) s =
runBatch F ϕ (B -> C) (mapfst_Batch A1 A2 f s)
runBatch F (ϕ ∘ f) C (s ⧆ a) =
runBatch F ϕ C (mapfst_Batch A1 A2 f (s ⧆ a)) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A1, B, C: Type
s: Batch A1 B (B -> C)
a: A1
A2: Type
ϕ: A2 -> F B
f: A1 -> A2
IHs: runBatch F (ϕ ∘ f) (B -> C) s =
runBatch F ϕ (B -> C) (mapfst_Batch A1 A2 f s)
runBatch F (ϕ ∘ f) (B -> C) s <⋆> (ϕ ∘ f) a =
runBatch F ϕ (B -> C) (mapfst_Batch A1 A2 f s) <⋆>
ϕ (f a) now rewrite IHs.
  Qed.

  Lemma runBatch_mapfst':
    forall `(ϕ: A2 -> F B) `(f: A1 -> A2) C,
      runBatch F (ϕ ∘ f) C = runBatch F ϕ C ∘ mapfst_Batch A1 A2 f.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A2 B : Type) (ϕ : A2 -> F B) (A1 : Type)
  (f : A1 -> A2) (C : Type),
runBatch F (ϕ ∘ f) C =
runBatch F ϕ C ∘ mapfst_Batch A1 A2 f
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A2 B : Type) (ϕ : A2 -> F B) (A1 : Type)
  (f : A1 -> A2) (C : Type),
runBatch F (ϕ ∘ f) C =
runBatch F ϕ C ∘ mapfst_Batch A1 A2 f
    intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A2, B: Type
ϕ: A2 -> F B
A1: Type
f: A1 -> A2
C: Type
runBatch F (ϕ ∘ f) C =
runBatch F ϕ C ∘ mapfst_Batch A1 A2 f ext s.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A2, B: Type
ϕ: A2 -> F B
A1: Type
f: A1 -> A2
C: Type
s: Batch A1 B C
runBatch F (ϕ ∘ f) C s =
(runBatch F ϕ C ∘ mapfst_Batch A1 A2 f) s
    apply runBatch_mapfst.
  Qed.

  Lemma runBatch_mapsnd:
    forall `(s: @Batch A B2 C) `(ϕ: A -> F B1) (f: B1 -> B2),
      runBatch F (map F f ∘ ϕ) C s =
        runBatch F ϕ C (mapsnd_Batch B1 B2 f s).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A B2 C : Type) (s : Batch A B2 C) (B1 : Type)
  (ϕ : A -> F B1) (f : B1 -> B2),
runBatch F (map F f ∘ ϕ) C s =
runBatch F ϕ C (mapsnd_Batch B1 B2 f s)
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
forall (A B2 C : Type) (s : Batch A B2 C) (B1 : Type)
  (ϕ : A -> F B1) (f : B1 -> B2),
runBatch F (map F f ∘ ϕ) C s =
runBatch F ϕ C (mapsnd_Batch B1 B2 f s)
    intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 C
B1: Type
ϕ: A -> F B1
f: B1 -> B2
runBatch F (map F f ∘ ϕ) C s =
runBatch F ϕ C (mapsnd_Batch B1 B2 f s) induction s.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
c: C
B1: Type
ϕ: A -> F B1
f: B1 -> B2
runBatch F (map F f ∘ ϕ) C (Done A B2 C c) =
runBatch F ϕ C (mapsnd_Batch B1 B2 f (Done A B2 C c))
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
runBatch F (map F f ∘ ϕ) C (s ⧆ a) =
runBatch F ϕ C (mapsnd_Batch B1 B2 f (s ⧆ a))
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
c: C
B1: Type
ϕ: A -> F B1
f: B1 -> B2
runBatch F (map F f ∘ ϕ) C (Done A B2 C c) =
runBatch F ϕ C (mapsnd_Batch B1 B2 f (Done A B2 C c)) easy.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
runBatch F (map F f ∘ ϕ) C (s ⧆ a) =
runBatch F ϕ C (mapsnd_Batch B1 B2 f (s ⧆ a)) intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
runBatch F (map F f ∘ ϕ) C (s ⧆ a) =
runBatch F ϕ C (mapsnd_Batch B1 B2 f (s ⧆ a)) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
runBatch F (map F f ∘ ϕ) (B2 -> C) s <⋆>
(map F f ∘ ϕ) a =
runBatch F ϕ (B1 -> C)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f s)) <⋆> ϕ a unfold compose at 2.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
runBatch F (map F f ∘ ϕ) (B2 -> C) s <⋆> map F f (ϕ a) =
runBatch F ϕ (B1 -> C)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f s)) <⋆> ϕ a
      rewrite <- ap_map.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
map F (precompose f)
  (runBatch F (map F f ∘ ϕ) (B2 -> C) s) <⋆> ϕ a =
runBatch F ϕ (B1 -> C)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f s)) <⋆> ϕ a fequal.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
map F (precompose f)
  (runBatch F (map F f ∘ ϕ) (B2 -> C) s) =
runBatch F ϕ (B1 -> C)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f s))
      rewrite IHs.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B2, C: Type
s: Batch A B2 (B2 -> C)
a: A
B1: Type
ϕ: A -> F B1
f: B1 -> B2
IHs: runBatch F (map F f ∘ ϕ) (B2 -> C) s =
runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)
map F (precompose f)
  (runBatch F ϕ (B2 -> C) (mapsnd_Batch B1 B2 f s)) =
runBatch F ϕ (B1 -> C)
  (map (Batch A B1) (precompose f)
     (mapsnd_Batch B1 B2 f s))
      now rewrite natural_runBatch.
  Qed.

  Context
    `{homomorphism: ApplicativeMorphism F G ψ}.

  Lemma runBatch_morphism `(ϕ: A -> F B) `(b: Batch A B C):
    ψ C (runBatch F ϕ C b) = runBatch G (ψ B ∘ ϕ) C b.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B C
ψ C (runBatch F ϕ C b) = runBatch G (ψ B ∘ ϕ) C b
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B C
ψ C (runBatch F ϕ C b) = runBatch G (ψ B ∘ ϕ) C b
    induction b.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
c: C
ψ C (runBatch F ϕ C (Done A B C c)) =
runBatch G (ψ B ∘ ϕ) C (Done A B C c)
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: ψ (B -> C) (runBatch F ϕ (B -> C) b) =
runBatch G (ψ B ∘ ϕ) (B -> C) b
ψ C (runBatch F ϕ C (b ⧆ a)) =
runBatch G (ψ B ∘ ϕ) C (b ⧆ a)
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
c: C
ψ C (runBatch F ϕ C (Done A B C c)) =
runBatch G (ψ B ∘ ϕ) C (Done A B C c) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
c: C
ψ C (pure F c) = pure G c now rewrite appmor_pure.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: ψ (B -> C) (runBatch F ϕ (B -> C) b) =
runBatch G (ψ B ∘ ϕ) (B -> C) b
ψ C (runBatch F ϕ C (b ⧆ a)) =
runBatch G (ψ B ∘ ϕ) C (b ⧆ a) cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: ψ (B -> C) (runBatch F ϕ (B -> C) b) =
runBatch G (ψ B ∘ ϕ) (B -> C) b
ψ C (runBatch F ϕ (B -> C) b <⋆> ϕ a) =
runBatch G (ψ B ∘ ϕ) (B -> C) b <⋆> (ψ B ∘ ϕ) a rewrite ap_morphism_1.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B (B -> C)
a: A
IHb: ψ (B -> C) (runBatch F ϕ (B -> C) b) =
runBatch G (ψ B ∘ ϕ) (B -> C) b
ψ (B -> C) (runBatch F ϕ (B -> C) b) <⋆> ψ B (ϕ a) =
runBatch G (ψ B ∘ ϕ) (B -> C) b <⋆> (ψ B ∘ ϕ) a
      now rewrite IHb.
  Qed.

  Lemma runBatch_morphism' `(ϕ: A -> F B):
    forall C, ψ C ∘ runBatch F ϕ C = runBatch G (ψ B ∘ ϕ) C.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
forall C : Type,
ψ C ∘ runBatch F ϕ C = runBatch G (ψ B ∘ ϕ) C
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
forall C : Type,
ψ C ∘ runBatch F ϕ C = runBatch G (ψ B ∘ ϕ) C
    intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
ψ C ∘ runBatch F ϕ C = runBatch G (ψ B ∘ ϕ) C ext b.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B C
(ψ C ∘ runBatch F ϕ C) b = runBatch G (ψ B ∘ ϕ) C b unfold compose.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B C
ψ C (runBatch F ϕ C b) = runBatch G (ψ B ○ ϕ) C b rewrite runBatch_morphism.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
G: Type -> Type
H0: Map F
H1: Mult F
H2: Pure F
H3: Map G
H4: Mult G
H5: Pure G
ψ: forall A : Type, F A -> G A
homomorphism: ApplicativeMorphism F G ψ
A, B: Type
ϕ: A -> F B
C: Type
b: Batch A B C
runBatch G (ψ B ∘ ϕ) C b = runBatch G (ψ B ○ ϕ) C b
    reflexivity.
  Qed.

End runBatch_naturality.

(** ** <<runBatch>> as an Applicative Homomorphism **)
(**********************************************************************)
Section runBatch_morphism.

  Context
    `{Applicative F}
    `{ϕ: A -> F B}.

  Lemma appmor_pure_runBatch: forall (a: A),
      runBatch F ϕ A (pure (Batch A B) a) = pure F a.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall a : A,
runBatch F ϕ A (pure (Batch A B) a) = pure F a
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall a : A,
runBatch F ϕ A (pure (Batch A B) a) = pure F a
    easy.
  Qed.

  Lemma appmor_mult_runBatch:
    forall {C D} (x: Batch A B C) (y: Batch A B D),
      runBatch F ϕ (C * D) (x ⊗ y) =
        runBatch F ϕ C x ⊗ runBatch F ϕ D y.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (C D : Type) (x : Batch A B C)
  (y : Batch A B D),
runBatch F ϕ (C * D) (x ⊗ y) =
runBatch F ϕ C x ⊗ runBatch F ϕ D y
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (C D : Type) (x : Batch A B C)
  (y : Batch A B D),
runBatch F ϕ (C * D) (x ⊗ y) =
runBatch F ϕ C x ⊗ runBatch F ϕ D y
    intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
x: Batch A B C
y: Batch A B D
runBatch F ϕ (C * D) (x ⊗ y) =
runBatch F ϕ C x ⊗ runBatch F ϕ D y generalize dependent x.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, D: Type
y: Batch A B D
forall x : Batch A B C,
runBatch F ϕ (C * D) (x ⊗ y) =
runBatch F ϕ C x ⊗ runBatch F ϕ D y
    induction y as [ANY any | ANY rest IH x'].
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
forall x : Batch A B C,
runBatch F ϕ (C * ANY) (x ⊗ Done A B ANY any) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (Done A B ANY any)
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
forall x : Batch A B C,
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (rest ⧆ x')
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
forall x : Batch A B C,
runBatch F ϕ (C * ANY) (x ⊗ Done A B ANY any) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (Done A B ANY any) intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ Done A B ANY any) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (Done A B ANY any) rewrite mult_Batch_rw2.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
x: Batch A B C
runBatch F ϕ (C * ANY)
  (map (Batch A B) (pair_right any) x) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (Done A B ANY any)
      rewrite runBatch_rw1.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
x: Batch A B C
runBatch F ϕ (C * ANY)
  (map (Batch A B) (pair_right any) x) =
runBatch F ϕ C x ⊗ pure F any rewrite triangle_4.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
any: ANY
x: Batch A B C
runBatch F ϕ (C * ANY)
  (map (Batch A B) (pair_right any) x) =
map F (fun b : C => (b, any)) (runBatch F ϕ C x)
      now rewrite natural_runBatch.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
forall x : Batch A B C,
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (rest ⧆ x') intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
runBatch F ϕ C x ⊗ runBatch F ϕ ANY (rest ⧆ x')  rewrite runBatch_rw2.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
runBatch F ϕ C x
⊗ (runBatch F ϕ (B -> ANY) rest <⋆> ϕ x')
      unfold ap.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
runBatch F ϕ C x
⊗ map F (fun '(f, a) => f a)
    (runBatch F ϕ (B -> ANY) rest ⊗ ϕ x') rewrite (app_mult_natural_r F).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
map F (map_snd (fun '(f, a) => f a))
  (runBatch F ϕ C x
   ⊗ (runBatch F ϕ (B -> ANY) rest ⊗ ϕ x'))
      rewrite <- app_assoc.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
map F (map_snd (fun '(f, a) => f a))
  (map F associator
     (runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
      ⊗ ϕ x'))
      rewrite <- IH.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
IH: forall x : Batch A B C,
runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) =
runBatch F ϕ C x ⊗ runBatch F ϕ (B -> ANY) rest
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
map F (map_snd (fun '(f, a) => f a))
  (map F associator
     (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')) clear IH.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
map F (map_snd (fun '(f, a) => f a))
  (map F associator
     (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x'))
      compose near (runBatch F ϕ _ (x ⊗ rest) ⊗ ϕ x').
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
(map F (map_snd (fun '(f, a) => f a))
 ∘ map F associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')
      rewrite fun_map_map.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
runBatch F ϕ (C * ANY) (x ⊗ (rest ⧆ x')) =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')
      cbn.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
runBatch F ϕ (B -> C * ANY)
  (map (Batch A B) strength_arrow (mult_Batch x rest)) <⋆>
ϕ x' =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (mult_Batch x rest)
   ⊗ ϕ x') unfold ap.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
map F (fun '(f, a) => f a)
  (runBatch F ϕ (B -> C * ANY)
     (map (Batch A B) strength_arrow
        (mult_Batch x rest)) ⊗ ϕ x') =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (mult_Batch x rest)
   ⊗ ϕ x') change (mult_Batch ?jx ?jy) with (jx ⊗ jy).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
map F (fun '(f, a) => f a)
  (runBatch F ϕ (B -> C * ANY)
     (map (Batch A B) strength_arrow (x ⊗ rest))
   ⊗ ϕ x') =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')
      rewrite <- natural_runBatch.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
map F (fun '(f, a) => f a)
  (map F strength_arrow
     (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest)) ⊗ 
   ϕ x') =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x') rewrite (app_mult_natural_l F).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
map F (fun '(f, a) => f a)
  (map F (map_fst strength_arrow)
     (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')) =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')
      compose near (runBatch F ϕ _ (x ⊗ rest) ⊗ ϕ x') on left.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
(map F (fun '(f, a) => f a)
 ∘ map F (map_fst strength_arrow))
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x') =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x')
      rewrite fun_map_map.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
map F ((fun '(f, a) => f a) ∘ map_fst strength_arrow)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x') =
map F (map_snd (fun '(f, a) => f a) ∘ associator)
  (runBatch F ϕ (C * (B -> ANY)) (x ⊗ rest) ⊗ ϕ x') fequal.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
C, ANY: Type
rest: Batch A B (B -> ANY)
x': A
x: Batch A B C
(fun '(f, a) => f a) ∘ map_fst strength_arrow =
map_snd (fun '(f, a) => f a) ∘ associator now ext [[? ?] ?].
  Qed.

  #[export] Instance ApplicativeMorphism_runBatch:
    ApplicativeMorphism (Batch A B) F (runBatch F ϕ).
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
ApplicativeMorphism (Batch A B) F (runBatch F ϕ)
  Proof.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
ApplicativeMorphism (Batch A B) F (runBatch F ϕ)
    constructor; try typeclasses eauto.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 B0 : Type) (f : A0 -> B0)
  (x : Batch A B A0),
runBatch F ϕ B0 (map (Batch A B) f x) =
map F f (runBatch F ϕ A0 x)
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 : Type) (a : A0),
runBatch F ϕ A0 (pure (Batch A B) a) = pure F a
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 B0 : Type) (x : Batch A B A0)
  (y : Batch A B B0),
runBatch F ϕ (A0 * B0) (x ⊗ y) =
runBatch F ϕ A0 x ⊗ runBatch F ϕ B0 y
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 B0 : Type) (f : A0 -> B0)
  (x : Batch A B A0),
runBatch F ϕ B0 (map (Batch A B) f x) =
map F f (runBatch F ϕ A0 x) intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
A0, B0: Type
f: A0 -> B0
x: Batch A B A0
runBatch F ϕ B0 (map (Batch A B) f x) =
map F f (runBatch F ϕ A0 x) now rewrite natural_runBatch.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 : Type) (a : A0),
runBatch F ϕ A0 (pure (Batch A B) a) = pure F a intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
A0: Type
a: A0
runBatch F ϕ A0 (pure (Batch A B) a) = pure F a easy.
    -
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
forall (A0 B0 : Type) (x : Batch A B A0)
  (y : Batch A B B0),
runBatch F ϕ (A0 * B0) (x ⊗ y) =
runBatch F ϕ A0 x ⊗ runBatch F ϕ B0 y intros.
F: Type -> Type
Map_G: Map F
Pure_G: Pure F
Mult_G: Mult F
H: Applicative F
A, B: Type
ϕ: A -> F B
A0, B0: Type
x: Batch A B A0
y: Batch A B B0
runBatch F ϕ (A0 * B0) (x ⊗ y) =
runBatch F ϕ A0 x ⊗ runBatch F ϕ B0 y apply appmor_mult_runBatch.
  Qed.

End runBatch_morphism.

(** * <<Batch>> as a Parameterized Monad *)
(**********************************************************************)
Section parameterised_monad.

  (** ** Operations <<batch>> and <<join_Batch>> *)
  (********************************************************************)
  Definition batch (A B: Type): A -> Batch A B B :=
    Step A B B (Done A B (B -> B) (@id B)).

  Fixpoint join_Batch {A B C D: Type}
    (b: Batch (Batch A B C) C D): Batch A B D :=
    match b with
    | Done _ _ _ d => Done _ _ _ d
    | Step _ _ _ rest a =>
        ap (Batch A B) (@join_Batch A B C (C -> D) rest) a
    end.

  Lemma join_Batch_rw1 {A B C D: Type}:
    forall (rest: Batch (Batch A B C) C (C -> D)) (b: Batch A B C),
      join_Batch (rest ⧆ b) = join_Batch rest <⋆> b.
A, B, C, D: Type
forall (rest : Batch (Batch A B C) C (C -> D))
  (b : Batch A B C),
join_Batch (rest ⧆ b) = join_Batch rest <⋆> b
  Proof.
A, B, C, D: Type
forall (rest : Batch (Batch A B C) C (C -> D))
  (b : Batch A B C),
join_Batch (rest ⧆ b) = join_Batch rest <⋆> b
    reflexivity.
  Qed.

  (** ** <<join_Batch>> as <<runBatch (Batch A B) id>> *)
  (********************************************************************)
  Lemma join_Batch_to_runBatch: forall (A B C: Type),
      @join_Batch A B C = runBatch (Batch A B) (@id (Batch A B C)).
forall A B C : Type,
@join_Batch A B C = runBatch (Batch A B) id
  Proof.
forall A B C : Type,
@join_Batch A B C = runBatch (Batch A B) id
    intros.
A, B, C: Type
@join_Batch A B C = runBatch (Batch A B) id ext D b.
A, B, C, D: Type
b: Batch (Batch A B C) C D
join_Batch b = runBatch (Batch A B) id D b
    induction b as [D d | D rest IHrest a].
A, B, C, D: Type
d: D
join_Batch (Done (Batch A B C) C D d) =
runBatch (Batch A B) id D (Done (Batch A B C) C D d)
A, B, C, D: Type
rest: Batch (Batch A B C) C (C -> D)
a: Batch A B C
IHrest: join_Batch rest =
runBatch (Batch A B) id (C -> D) rest
join_Batch (rest ⧆ a) =
runBatch (Batch A B) id D (rest ⧆ a)
    -
A, B, C, D: Type
d: D
join_Batch (Done (Batch A B C) C D d) =
runBatch (Batch A B) id D (Done (Batch A B C) C D d) reflexivity.
    -
A, B, C, D: Type
rest: Batch (Batch A B C) C (C -> D)
a: Batch A B C
IHrest: join_Batch rest =
runBatch (Batch A B) id (C -> D) rest
join_Batch (rest ⧆ a) =
runBatch (Batch A B) id D (rest ⧆ a) rewrite join_Batch_rw1.
A, B, C, D: Type
rest: Batch (Batch A B C) C (C -> D)
a: Batch A B C
IHrest: join_Batch rest =
runBatch (Batch A B) id (C -> D) rest
join_Batch rest <⋆> a =
runBatch (Batch A B) id D (rest ⧆ a)
      rewrite IHrest.
A, B, C, D: Type
rest: Batch (Batch A B C) C (C -> D)
a: Batch A B C
IHrest: join_Batch rest =
runBatch (Batch A B) id (C -> D) rest
runBatch (Batch A B) id (C -> D) rest <⋆> a =
runBatch (Batch A B) id D (rest ⧆ a)
      reflexivity.
  Qed.

  (** ** Naturality *)
  (********************************************************************)
  Lemma ret_natural (A1 A2 B: Type) (f: A1 -> A2):
    mapfst_Batch A1 A2 f ∘ batch A1 B = batch A2 B ∘ f.
A1, A2, B: Type
f: A1 -> A2
mapfst_Batch A1 A2 f ∘ batch A1 B = batch A2 B ∘ f
  Proof.
A1, A2, B: Type
f: A1 -> A2
mapfst_Batch A1 A2 f ∘ batch A1 B = batch A2 B ∘ f
    reflexivity.
  Qed.

  Lemma ret_dinatural (A B1 B2: Type) (f: B1 -> B2):
    mapsnd_Batch B1 B2 f ∘ batch A B2 = map (Batch A B1) f ∘ batch A B1.
A, B1, B2: Type
f: B1 -> B2
mapsnd_Batch B1 B2 f ∘ batch A B2 =
map (Batch A B1) f ∘ batch A B1
  Proof.
A, B1, B2: Type
f: B1 -> B2
mapsnd_Batch B1 B2 f ∘ batch A B2 =
map (Batch A B1) f ∘ batch A B1
    reflexivity.
  Qed.

  (** ** <<join>> as an Applicative Homomorphism *)
  (********************************************************************)
  #[export] Instance ApplicativeMorphism_join_Batch:
    forall (A B C: Type),
      ApplicativeMorphism (Batch (Batch A B C) C) (Batch A B)
        (@join_Batch A B C).
forall A B C : Type,
ApplicativeMorphism (Batch (Batch A B C) C)
  (Batch A B) (@join_Batch A B C)
  Proof.
forall A B C : Type,
ApplicativeMorphism (Batch (Batch A B C) C)
  (Batch A B) (@join_Batch A B C)
    intros.
A, B, C: Type
ApplicativeMorphism (Batch (Batch A B C) C)
  (Batch A B) (@join_Batch A B C)
    rewrite (@join_Batch_to_runBatch A B C).
A, B, C: Type
ApplicativeMorphism (Batch (Batch A B C) C)
  (Batch A B) (runBatch (Batch A B) id)
    apply ApplicativeMorphism_runBatch.
  Qed.

  (** ** Other Laws *)
  (********************************************************************)
  Lemma runBatch_batch:
    forall (G: Type -> Type) `{Applicative G} (A B: Type) (f: A -> G B),
      runBatch G f B ∘ batch A B = f.
forall (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B),
runBatch G f B ∘ batch A B = f
  Proof.
forall (G : Type -> Type) (Map_G : Map G)
  (Pure_G : Pure G) (Mult_G : Mult G),
Applicative G ->
forall (A B : Type) (f : A -> G B),
runBatch G f B ∘ batch A B = f
    intros.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
runBatch G f B ∘ batch A B = f ext a.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
a: A
(runBatch G f B ∘ batch A B) a = f a cbn.
G: Type -> Type
Map_G: Map G
Pure_G: Pure G
Mult_G: Mult G
H: Applicative G
A, B: Type
f: A -> G B
a: A
pure G id <⋆> f a = f a
    now rewrite ap1.
  Qed.

  Lemma runBatch_batch_id: forall (A B: Type),
      runBatch (Batch A B) (batch A B) B =
        @id (Batch A B B).
forall A B : Type,
runBatch (Batch A B) (batch A B) B = id
  Proof.
forall A B : Type,
runBatch (Batch A B) (batch A B) B = id
    intros.
A, B: Type
runBatch (Batch A B) (batch A B) B = id ext b.
A, B: Type
b: Batch A B B
runBatch (Batch A B) (batch A B) B b = id b
    induction b as [C c | C rest IHrest a].
A, B, C: Type
c: C
runBatch (Batch A B) (batch A B) C (Done A B C c) =
id (Done A B C c)
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = id rest
runBatch (Batch A B) (batch A B) C (rest ⧆ a) =
id (rest ⧆ a)
    -
A, B, C: Type
c: C
runBatch (Batch A B) (batch A B) C (Done A B C c) =
id (Done A B C c) reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = id rest
runBatch (Batch A B) (batch A B) C (rest ⧆ a) =
id (rest ⧆ a) cbn.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = id rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B) (fun c : B -> C => (c, id))
        (runBatch (Batch A B) (batch A B) (B -> C)
           rest))) ⧆ a = id (rest ⧆ a) unfold id in *.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B)
        (fun c : B -> C => (c, fun x : B => x))
        (runBatch (Batch A B) (batch A B) (B -> C)
           rest))) ⧆ a = rest ⧆ a
      fequal.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B)
        (fun c : B -> C => (c, fun x : B => x))
        (runBatch (Batch A B) (batch A B) (B -> C)
           rest))) = rest rewrite IHrest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B)
        (fun c : B -> C => (c, fun x : B => x)) rest)) =
rest
      compose near rest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  ((map (Batch A B) strength_arrow
    ∘ map (Batch A B)
        (fun c : B -> C => (c, fun x : B => x))) rest) =
rest
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B)
     (strength_arrow
      ∘ (fun c : B -> C => (c, fun x : B => x))) rest) =
rest
      compose near rest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
(map (Batch A B) (compose (fun '(f, a) => f a))
 ∘ map (Batch A B)
     (strength_arrow
      ∘ (fun c : B -> C => (c, fun x : B => x)))) rest =
rest
      rewrite (fun_map_map (F := Batch A B)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B)
  (compose (fun '(f, a) => f a)
   ∘ (strength_arrow
      ∘ (fun c : B -> C => (c, fun x : B => x)))) rest =
rest
      unfold compose, strength_arrow.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B)
  (fun a : B -> C =>
   fst (a, fun x : B => x) ○ snd (a, fun x : B => x))
  rest = rest
      change rest with (id rest) at 2.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B)
  (fun a : B -> C =>
   fst (a, fun x : B => x) ○ snd (a, fun x : B => x))
  rest = id rest
      rewrite <- (fun_map_id (F := Batch A B)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch (Batch A B) (batch A B) 
  (B -> C) rest = rest
map (Batch A B)
  (fun a : B -> C =>
   fst (a, fun x : B => x) ○ snd (a, fun x : B => x))
  rest = map (Batch A B) id rest
      fequal.
  Qed.

  (** ** Monad Laws *)
  (********************************************************************)
  Lemma ret_join: forall (A B C: Type),
      (@join_Batch A B C C) ∘ batch (Batch A B C) C = @id (Batch A B C).
forall A B C : Type,
join_Batch ∘ batch (Batch A B C) C = id
  Proof.
forall A B C : Type,
join_Batch ∘ batch (Batch A B C) C = id
    intros.
A, B, C: Type
join_Batch ∘ batch (Batch A B C) C = id ext b.
A, B, C: Type
b: Batch A B C
(join_Batch ∘ batch (Batch A B C) C) b = id b unfold compose, id.
A, B, C: Type
b: Batch A B C
join_Batch (batch (Batch A B C) C b) = b
    induction b as [C c | C rest IHrest a].
A, B, C: Type
c: C
join_Batch (batch (Batch A B C) C (Done A B C c)) =
Done A B C c
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
join_Batch (batch (Batch A B C) C (rest ⧆ a)) =
rest ⧆ a
    -
A, B, C: Type
c: C
join_Batch (batch (Batch A B C) C (Done A B C c)) =
Done A B C c reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
join_Batch (batch (Batch A B C) C (rest ⧆ a)) =
rest ⧆ a unfold batch.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
join_Batch
  (Done (Batch A B C) C (C -> C) id ⧆ (rest ⧆ a)) =
rest ⧆ a
      unfold join_Batch.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
Done A B (C -> C) id <⋆> (rest ⧆ a) = rest ⧆ a
      change (Done A B (C -> C) id) with (pure (Batch A B) (@id C)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
pure (Batch A B) id <⋆> (rest ⧆ a) = rest ⧆ a
      rewrite ap1.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (batch (Batch A B (B -> C)) (B -> C) rest) =
rest
rest ⧆ a = rest ⧆ a
      reflexivity.
  Qed.

  Lemma join_map_ret: forall (A B C: Type),
      (@join_Batch A B B C) ∘ mapfst_Batch A (Batch A B B) (batch A B) =
        @id (Batch A B C).
forall A B C : Type,
join_Batch ∘ mapfst_Batch A (Batch A B B) (batch A B) =
id
  Proof.
forall A B C : Type,
join_Batch ∘ mapfst_Batch A (Batch A B B) (batch A B) =
id
    intros.
A, B, C: Type
join_Batch ∘ mapfst_Batch A (Batch A B B) (batch A B) =
id ext b.
A, B, C: Type
b: Batch A B C
(join_Batch ∘ mapfst_Batch A (Batch A B B) (batch A B))
  b = id b unfold compose, id.
A, B, C: Type
b: Batch A B C
join_Batch
  (mapfst_Batch A (Batch A B B) (batch A B) b) = b
    induction b as [C c | C rest IHrest a].
A, B, C: Type
c: C
join_Batch
  (mapfst_Batch A (Batch A B B) (batch A B)
     (Done A B C c)) = Done A B C c
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
join_Batch
  (mapfst_Batch A (Batch A B B) (batch A B) (rest ⧆ a)) =
rest ⧆ a
    -
A, B, C: Type
c: C
join_Batch
  (mapfst_Batch A (Batch A B B) (batch A B)
     (Done A B C c)) = Done A B C c reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
join_Batch
  (mapfst_Batch A (Batch A B B) (batch A B) (rest ⧆ a)) =
rest ⧆ a cbn.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B) (fun c : B -> C => (c, id))
        (join_Batch
           (mapfst_Batch A (Batch A B B) (batch A B)
              rest)))) ⧆ a = rest ⧆ a rewrite IHrest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B) (fun c : B -> C => (c, id)) rest))
⧆ a = rest ⧆ a fequal.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (map (Batch A B) (fun c : B -> C => (c, id)) rest)) =
rest
      compose near rest on left.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  ((map (Batch A B) strength_arrow
    ∘ map (Batch A B) (fun c : B -> C => (c, id)))
     rest) = rest
      rewrite (fun_map_map).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B)
     (strength_arrow ∘ (fun c : B -> C => (c, id)))
     rest) = rest
      compose near rest on left.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
(map (Batch A B) (compose (fun '(f, a) => f a))
 ∘ map (Batch A B)
     (strength_arrow ∘ (fun c : B -> C => (c, id))))
  rest = rest
      rewrite (fun_map_map).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B)
  (compose (fun '(f, a) => f a)
   ∘ (strength_arrow ∘ (fun c : B -> C => (c, id))))
  rest = rest
      replace (compose (fun '(f, a0) => f a0)
                 ∘ (strength_arrow ∘ (fun c: B -> C => (c, id))))
        with (@id (B -> C)).
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) id rest = rest
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
id =
compose (fun '(f, a0) => f a0)
∘ (strength_arrow ∘ (fun c : B -> C => (c, id)))
      2:{
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
id =
compose (fun '(f, a0) => f a0)
∘ (strength_arrow ∘ (fun c : B -> C => (c, id))) symmetry.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
compose (fun '(f, a0) => f a0)
∘ (strength_arrow ∘ (fun c : B -> C => (c, id))) = id
          ext f b.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
f: B -> C
b: B
(compose (fun '(f, a0) => f a0)
 ∘ (strength_arrow ∘ (fun c : B -> C => (c, id)))) f b =
id f b
          unfold compose, strength_arrow, id.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
f: B -> C
b: B
fst (f, fun x : B => x) (snd (f, fun x : B => x) b) =
f b
          reflexivity. }
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
map (Batch A B) id rest = rest
      rewrite fun_map_id.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: join_Batch
  (mapfst_Batch A (Batch A B B) 
     (batch A B) rest) = rest
id rest = rest
      reflexivity.
  Qed.

  #[local] Instance Map_Batch_Fst (B: Type):
    Map (fun A => Batch A B B) :=
    fun A B f => mapfst_Batch _ _ f.

  #[local] Instance Return_Batch (B: Type):
    Return (fun A => Batch A B B) :=
    (fun A => batch A B).

  #[local] Instance Join_Batch (B: Type):
    Join (fun A => Batch A B B) :=
    fun A => @join_Batch A B B B.

  Goal forall B, Categorical.Monad.Monad (fun A => Batch A B B).
forall B : Type, Monad BATCH1 B B
  Proof.
forall B : Type, Monad BATCH1 B B
    intros.
B: Type
Monad BATCH1 B B constructor.
B: Type
Functor BATCH1 B B
B: Type
Natural (@ret BATCH1 B B (Return_Batch B))
B: Type
Natural (@join BATCH1 B B (Join_Batch B))
B: Type
forall A : Type, join ∘ ret = id
B: Type
forall A : Type, join ∘ map BATCH1 B B ret = id
B: Type
forall A : Type,
join ∘ join = join ∘ map BATCH1 B B join
    -
B: Type
Functor BATCH1 B B typeclasses eauto.
    -
B: Type
Natural (@ret BATCH1 B B (Return_Batch B)) constructor.
B: Type
Functor (fun A : Type => A)
B: Type
Functor BATCH1 B B
B: Type
forall (A B0 : Type) (f : A -> B0),
map BATCH1 B B f ∘ ret =
ret ∘ map (fun A0 : Type => A0) f
      +
B: Type
Functor (fun A : Type => A) typeclasses eauto.
      +
B: Type
Functor BATCH1 B B typeclasses eauto.
      +
B: Type
forall (A B0 : Type) (f : A -> B0),
map BATCH1 B B f ∘ ret =
ret ∘ map (fun A0 : Type => A0) f unfold_ops @Map_Batch_Fst.
B: Type
forall (A B0 : Type) (f : A -> B0),
mapfst_Batch A B0 f ∘ ret =
ret ∘ map (fun A0 : Type => A0) f
        unfold_ops @Return_Batch.
B: Type
forall (A B0 : Type) (f : A -> B0),
mapfst_Batch A B0 f ∘ batch A B =
batch B0 B ∘ map (fun A0 : Type => A0) f
        unfold_ops @Map_I.
B: Type
forall (A B0 : Type) (f : A -> B0),
mapfst_Batch A B0 f ∘ batch A B = batch B0 B ∘ f
        reflexivity.
    -
B: Type
Natural (@join BATCH1 B B (Join_Batch B)) admit.
    -
B: Type
forall A : Type, join ∘ ret = id unfold_ops @Join_Batch Return_Batch.
B: Type
forall A : Type,
join_Batch ∘ batch (Batch A B B) B = id
      intros A.
B, A: Type
join_Batch ∘ batch (Batch A B B) B = id ext b.
B, A: Type
b: Batch A B B
(join_Batch ∘ batch (Batch A B B) B) b = id b
      induction b.
B, A, C: Type
c: C
(join_Batch ∘ batch (Batch A B C) C) (Done A B C c) =
id (Done A B C c)
B, A, C: Type
b: Batch A B (B -> C)
a: A
IHb: (join_Batch ∘ batch (Batch A B (B -> C)) (B -> C)) b = id b
(join_Batch ∘ batch (Batch A B C) C) (b ⧆ a) =
id (b ⧆ a)
      +
B, A, C: Type
c: C
(join_Batch ∘ batch (Batch A B C) C) (Done A B C c) =
id (Done A B C c) reflexivity.
      +
B, A, C: Type
b: Batch A B (B -> C)
a: A
IHb: (join_Batch ∘ batch (Batch A B (B -> C)) (B -> C)) b = id b
(join_Batch ∘ batch (Batch A B C) C) (b ⧆ a) =
id (b ⧆ a) cbn.
B, A, C: Type
b: Batch A B (B -> C)
a: A
IHb: (join_Batch ∘ batch (Batch A B (B -> C)) (B -> C)) b = id b
map (Batch A B) (compose (fun '(f, a) => f a))
  (map (Batch A B) strength_arrow
     (mult_Batch (Done A B (C -> C) id) b)) ⧆ a =
id (b ⧆ a)
  Abort.

End parameterised_monad.

(** * <<Batch>> as a Parameterized Comonad *)
(**********************************************************************)
Section parameterized.

  #[local] Unset Implicit Arguments.

  (** ** Operations <<extract_Batch>> and <<cojoin_Batch>> *)
  (********************************************************************)
  Fixpoint extract_Batch {A B: Type} (b: Batch A A B): B :=
    match b with
    | Done _ _ _ b => b
    | Step _ _ _ rest a => extract_Batch rest a
    end.

  Fixpoint cojoin_Batch {A B C D: Type} (b: Batch A C D):
    Batch A B (Batch B C D) :=
    match b with
    | Done _ _ _ d => Done A B (Batch B C D) (Done B C D d)
    | Step _ _ _ rest a =>
        Step A B (Batch B C D)
          (map (Batch A B) (Step B C D) (cojoin_Batch rest)) a
    end.

  (** ** Rewriting Principles *)
  (********************************************************************)
  Lemma extract_Batch_rw0:
    forall (A C: Type) (c: C),
      extract_Batch (Done A A C c) = c.
forall (A C : Type) (c : C),
extract_Batch (Done A A C c) = c
  Proof.
forall (A C : Type) (c : C),
extract_Batch (Done A A C c) = c
    reflexivity.
  Qed.

  Lemma extract_Batch_rw1:
    forall (A B: Type) (rest: Batch A A (A -> B)) (a: A),
      extract_Batch (rest ⧆ a) = extract_Batch rest a.
forall (A B : Type) (rest : Batch A A (A -> B))
  (a : A),
extract_Batch (rest ⧆ a) = extract_Batch rest a
  Proof.
forall (A B : Type) (rest : Batch A A (A -> B))
  (a : A),
extract_Batch (rest ⧆ a) = extract_Batch rest a
    reflexivity.
  Qed.

  Lemma cojoin_Batch_rw0:
    forall (A B C D: Type) (d: D),
      @cojoin_Batch A B C D (Done A C D d) =
        Done A B (Batch B C D) (Done B C D d).
forall (A B C D : Type) (d : D),
cojoin_Batch (Done A C D d) =
Done A B (Batch B C D) (Done B C D d)
  Proof.
forall (A B C D : Type) (d : D),
cojoin_Batch (Done A C D d) =
Done A B (Batch B C D) (Done B C D d)
    reflexivity.
  Qed.

  Lemma cojoin_Batch_rw1:
    forall (A B C D: Type) (rest: Batch A C (C -> D)) (a: A),
      @cojoin_Batch A B C D (rest ⧆ a) =
        map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a.
forall (A B C D : Type) (rest : Batch A C (C -> D))
  (a : A),
cojoin_Batch (rest ⧆ a) =
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a
  Proof.
forall (A B C D : Type) (rest : Batch A C (C -> D))
  (a : A),
cojoin_Batch (rest ⧆ a) =
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a
    reflexivity.
  Qed.

  (** ** <<extract_Batch>> as <<runBatch (fun A => A) id>> *)
  (********************************************************************)
  Lemma extract_Batch_to_runBatch: forall (A: Type),
      @extract_Batch A = runBatch (fun A => A) (@id A).
forall A : Type,
@extract_Batch A = runBatch (fun A0 : Type => A0) id
  Proof.
forall A : Type,
@extract_Batch A = runBatch (fun A0 : Type => A0) id
    intros.
A: Type
@extract_Batch A = runBatch (fun A : Type => A) id ext B b.
A, B: Type
b: Batch A A B
extract_Batch b = runBatch (fun A : Type => A) id B b
    induction b.
A, C: Type
c: C
extract_Batch (Done A A C c) =
runBatch (fun A : Type => A) id C (Done A A C c)
A, C: Type
b: Batch A A (A -> C)
a: A
IHb: extract_Batch b = runBatch (fun A : Type => A) id (A -> C) b
extract_Batch (b ⧆ a) =
runBatch (fun A : Type => A) id C (b ⧆ a)
    -
A, C: Type
c: C
extract_Batch (Done A A C c) =
runBatch (fun A : Type => A) id C (Done A A C c) reflexivity.
    -
A, C: Type
b: Batch A A (A -> C)
a: A
IHb: extract_Batch b = runBatch (fun A : Type => A) id (A -> C) b
extract_Batch (b ⧆ a) =
runBatch (fun A : Type => A) id C (b ⧆ a) cbn.
A, C: Type
b: Batch A A (A -> C)
a: A
IHb: extract_Batch b = runBatch (fun A : Type => A) id (A -> C) b
extract_Batch b a =
runBatch (fun A : Type => A) id (A -> C) b (id a) rewrite IHb.
A, C: Type
b: Batch A A (A -> C)
a: A
IHb: extract_Batch b = runBatch (fun A : Type => A) id (A -> C) b
runBatch (fun A : Type => A) id (A -> C) b a =
runBatch (fun A : Type => A) id (A -> C) b (id a)
      reflexivity.
  Qed.

  (** ** <<cojoin_Batch>> as <<runBatch double_batch>> *)
  (********************************************************************)
  Definition double_batch {A B C: Type}:
    A -> Batch A B (Batch B C C) :=
    map (Batch A B) (batch B C) ∘ (batch A B).

  Lemma double_batch_rw {A B C: Type} (a: A):
    double_batch (B := B) (C := C) a =
      Done A B (B -> Batch B C C) (batch B C) ⧆ a.
A, B, C: Type
a: A
double_batch a =
Done A B (B -> Batch B C C) (batch B C) ⧆ a
  Proof.
A, B, C: Type
a: A
double_batch a =
Done A B (B -> Batch B C C) (batch B C) ⧆ a
    reflexivity.
  Qed.

  Lemma double_batch_spec: forall (A B C: Type),
      double_batch = batch B C ⋆2 batch A B.
forall A B C : Type,
double_batch = batch B C ⋆2 batch A B
  Proof.
forall A B C : Type,
double_batch = batch B C ⋆2 batch A B
    reflexivity.
  Qed.
  Lemma cojoin_Batch_to_runBatch: forall (A B C: Type),
      @cojoin_Batch A B C =
        runBatch (Batch A B ∘ Batch B C) double_batch.
forall A B C : Type,
@cojoin_Batch A B C =
runBatch (Batch A B ∘ Batch B C) double_batch
  Proof.
forall A B C : Type,
@cojoin_Batch A B C =
runBatch (Batch A B ∘ Batch B C) double_batch
    intros.
A, B, C: Type
@cojoin_Batch A B C =
runBatch (Batch A B ∘ Batch B C) double_batch ext D.
A, B, C, D: Type
cojoin_Batch =
runBatch (Batch A B ∘ Batch B C) double_batch D
    ext b.
A, B, C, D: Type
b: Batch A C D
cojoin_Batch b =
runBatch (Batch A B ∘ Batch B C) double_batch D b
    induction b as [D d | D rest IHrest a].
A, B, C, D: Type
d: D
cojoin_Batch (Done A C D d) =
runBatch (Batch A B ∘ Batch B C) double_batch D
  (Done A C D d)
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
cojoin_Batch (rest ⧆ a) =
runBatch (Batch A B ∘ Batch B C) double_batch D
  (rest ⧆ a)
    -
A, B, C, D: Type
d: D
cojoin_Batch (Done A C D d) =
runBatch (Batch A B ∘ Batch B C) double_batch D
  (Done A C D d) reflexivity.
    -
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
cojoin_Batch (rest ⧆ a) =
runBatch (Batch A B ∘ Batch B C) double_batch D
  (rest ⧆ a) cbn.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a)))
  (map (Batch A B) (compose (mult (Batch B C)))
     (map (Batch A B) strength_arrow
        (map (Batch A B)
           (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id))
           (runBatch (Batch A B ∘ Batch B C)
              double_batch (C -> D) rest)))) ⧆ a
      compose near (runBatch (Batch A B ∘ Batch B C) double_batch (C -> D) rest).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a)))
  (map (Batch A B) (compose (mult (Batch B C)))
     ((map (Batch A B) strength_arrow
       ∘ map (Batch A B)
           (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))
        (runBatch (Batch A B ∘ Batch B C) double_batch
           (C -> D) rest))) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a)))
  (map (Batch A B) (compose (mult (Batch B C)))
     (map (Batch A B)
        (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))
        (runBatch (Batch A B ∘ Batch B C) double_batch
           (C -> D) rest))) ⧆ a
      compose near (runBatch (Batch A B ∘ Batch B C) double_batch (C -> D) rest).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a)))
  ((map (Batch A B) (compose (mult (Batch B C)))
    ∘ map (Batch A B)
        (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id))))
     (runBatch (Batch A B ∘ Batch B C) double_batch
        (C -> D) rest)) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a)))
  (map (Batch A B)
     (compose (mult (Batch B C))
      ∘ (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id))))
     (runBatch (Batch A B ∘ Batch B C) double_batch
        (C -> D) rest)) ⧆ a
      compose near (runBatch (Batch A B ∘ Batch B C) double_batch (C -> D) rest).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
(map (Batch A B)
   (compose (map (Batch B C) (fun '(f, a) => f a)))
 ∘ map (Batch A B)
     (compose (mult (Batch B C))
      ∘ (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))))
  (runBatch (Batch A B ∘ Batch B C) double_batch
     (C -> D) rest) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a))
   ∘ (compose (mult (Batch B C))
      ∘ (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))))
  (runBatch (Batch A B ∘ Batch B C) double_batch
     (C -> D) rest) ⧆ a
      rewrite <- IHrest.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a))
   ∘ (compose (mult (Batch B C))
      ∘ (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))))
  (cojoin_Batch rest) ⧆ a
      fequal.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
map (Batch A B) (Step B C D) (cojoin_Batch rest) =
map (Batch A B)
  (compose (map (Batch B C) (fun '(f, a) => f a))
   ∘ (compose (mult (Batch B C))
      ∘ (strength_arrow
         ∘ (fun c : Batch B C (C -> D) =>
            (c, batch B C ∘ id)))))
  (cojoin_Batch rest)
      fequal.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch rest =
runBatch (Batch A B ∘ Batch B C) double_batch
  (C -> D) rest
Step B C D =
compose (map (Batch B C) (fun '(f, a) => f a))
∘ (compose (mult (Batch B C))
   ∘ (strength_arrow
      ∘ (fun c : Batch B C (C -> D) =>
         (c, batch B C ∘ id))))
      clear.
B, C, D: Type
Step B C D =
compose (map (Batch B C) (fun '(f, a) => f a))
∘ (compose (mult (Batch B C))
   ∘ (strength_arrow
      ∘ (fun c : Batch B C (C -> D) =>
         (c, batch B C ∘ id))))
      ext rest b.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest ⧆ b =
(compose (map (Batch B C) (fun '(f, a) => f a))
 ∘ (compose (mult (Batch B C))
    ∘ (strength_arrow
       ∘ (fun c : Batch B C (C -> D) =>
          (c, batch B C ∘ id))))) rest b cbn.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest ⧆ b =
map (Batch B C) (compose (fun '(f, a) => f a))
  (map (Batch B C) strength_arrow
     (map (Batch B C) (fun c : C -> D => (c, id)) rest))
⧆ id b
      unfold compose, id.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest ⧆ b =
map (Batch B C)
  (fun (f : C -> (C -> D) * C) (a : C) =>
   let '(f0, a0) := f a in f0 a0)
  (map (Batch B C) strength_arrow
     (map (Batch B C)
        (fun c : C -> D => (c, fun x : C => x)) rest))
⧆ b
      fequal.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest =
map (Batch B C)
  (fun (f : C -> (C -> D) * C) (a : C) =>
   let '(f0, a0) := f a in f0 a0)
  (map (Batch B C) strength_arrow
     (map (Batch B C)
        (fun c : C -> D => (c, fun x : C => x)) rest))
      compose near rest.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest =
map (Batch B C)
  (fun (f : C -> (C -> D) * C) (a : C) =>
   let '(f0, a0) := f a in f0 a0)
  ((map (Batch B C) strength_arrow
    ∘ map (Batch B C)
        (fun c : C -> D => (c, fun x : C => x))) rest)
      rewrite fun_map_map.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest =
map (Batch B C)
  (fun (f : C -> (C -> D) * C) (a : C) =>
   let '(f0, a0) := f a in f0 a0)
  (map (Batch B C)
     (strength_arrow
      ∘ (fun c : C -> D => (c, fun x : C => x))) rest)
      compose near rest.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest =
(map (Batch B C)
   (fun (f : C -> (C -> D) * C) (a : C) =>
    let '(f0, a0) := f a in f0 a0)
 ∘ map (Batch B C)
     (strength_arrow
      ∘ (fun c : C -> D => (c, fun x : C => x)))) rest
      rewrite fun_map_map.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest =
map (Batch B C)
  ((fun (f : C -> (C -> D) * C) (a : C) =>
    let '(f0, a0) := f a in f0 a0)
   ∘ (strength_arrow
      ∘ (fun c : C -> D => (c, fun x : C => x)))) rest
      rewrite fun_map_id.
B, C, D: Type
rest: Batch B C (C -> D)
b: B
rest = id rest
      reflexivity.
  Qed.

  (** ** <<extract_Batch>> and <<cojoin_Batch>> as Applicative Homomorphisms *)
  (********************************************************************)
  #[export] Instance ApplicativeMorphism_extract_Batch:
    forall (A: Type),
      ApplicativeMorphism (Batch A A) (fun A => A) (@extract_Batch A).
forall A : Type,
ApplicativeMorphism (Batch A A) (fun A0 : Type => A0)
  (@extract_Batch A)
  Proof.
forall A : Type,
ApplicativeMorphism (Batch A A) (fun A0 : Type => A0)
  (@extract_Batch A)
    intros.
A: Type
ApplicativeMorphism (Batch A A) (fun A : Type => A)
  (@extract_Batch A)
    rewrite extract_Batch_to_runBatch.
A: Type
ApplicativeMorphism (Batch A A) (fun A : Type => A)
  (runBatch (fun A : Type => A) id)
    apply ApplicativeMorphism_runBatch.
  Qed.

  #[export] Instance ApplicativeMorphism_cojoin_Batch:
    forall (A B C: Type),
      ApplicativeMorphism (Batch A C) (Batch A B ∘ Batch B C)
        (@cojoin_Batch A B C).
forall A B C : Type,
ApplicativeMorphism (Batch A C)
  (Batch A B ∘ Batch B C) (@cojoin_Batch A B C)
  Proof.
forall A B C : Type,
ApplicativeMorphism (Batch A C)
  (Batch A B ∘ Batch B C) (@cojoin_Batch A B C)
    intros.
A, B, C: Type
ApplicativeMorphism (Batch A C)
  (Batch A B ∘ Batch B C) (@cojoin_Batch A B C)
    rewrite cojoin_Batch_to_runBatch.
A, B, C: Type
ApplicativeMorphism (Batch A C)
  (Batch A B ∘ Batch B C)
  (runBatch (Batch A B ∘ Batch B C) double_batch)
    apply ApplicativeMorphism_runBatch.
  Qed.

  (** ** Composition with <<ret>>/<<batch>> *)
  (********************************************************************)
  Lemma extract_Batch_batch: forall (A: Type),
      extract_Batch ∘ batch A A = @id A.
forall A : Type, extract_Batch ∘ batch A A = id
  Proof.
forall A : Type, extract_Batch ∘ batch A A = id
    reflexivity.
  Qed.

  Lemma cojoin_Batch_batch: forall (A B C: Type),
      @cojoin_Batch A B C C ∘ batch A C =
        double_batch.
forall A B C : Type,
cojoin_Batch ∘ batch A C = double_batch
  Proof.
forall A B C : Type,
cojoin_Batch ∘ batch A C = double_batch
    intros.
A, B, C: Type
cojoin_Batch ∘ batch A C = double_batch
    rewrite cojoin_Batch_to_runBatch.
A, B, C: Type
runBatch (Batch A B ∘ Batch B C) double_batch C
∘ batch A C = double_batch
    rewrite (runBatch_batch (Batch A B ∘ Batch B C) A C).
A, B, C: Type
double_batch = double_batch
    reflexivity.
  Qed.

  (** ** Naturality *)
  (********************************************************************)
  Lemma extract_natural (A C D: Type) (f: C -> D):
    forall (b: Batch A A C),
      @extract_Batch A D (map (Batch A A) f b) =
        f (@extract_Batch A C b).
A, C, D: Type
f: C -> D
forall b : Batch A A C,
extract_Batch (map (Batch A A) f b) =
f (extract_Batch b)
  Proof.
A, C, D: Type
f: C -> D
forall b : Batch A A C,
extract_Batch (map (Batch A A) f b) =
f (extract_Batch b)
    intros.
A, C, D: Type
f: C -> D
b: Batch A A C
extract_Batch (map (Batch A A) f b) =
f (extract_Batch b)
    generalize dependent D.
A, C: Type
b: Batch A A C
forall (D : Type) (f : C -> D),
extract_Batch (map (Batch A A) f b) =
f (extract_Batch b)
    induction b as [C c | C rest IHrest a]; intros D f.
A, C: Type
c: C
D: Type
f: C -> D
extract_Batch (map (Batch A A) f (Done A A C c)) =
f (extract_Batch (Done A A C c))
A, C: Type
rest: Batch A A (A -> C)
a: A
IHrest: forall (D : Type) (f : (A -> C) -> D),
extract_Batch (map (Batch A A) f rest) =
f (extract_Batch rest)
D: Type
f: C -> D
extract_Batch (map (Batch A A) f (rest ⧆ a)) =
f (extract_Batch (rest ⧆ a))
    -
A, C: Type
c: C
D: Type
f: C -> D
extract_Batch (map (Batch A A) f (Done A A C c)) =
f (extract_Batch (Done A A C c)) reflexivity.
    -
A, C: Type
rest: Batch A A (A -> C)
a: A
IHrest: forall (D : Type) (f : (A -> C) -> D),
extract_Batch (map (Batch A A) f rest) =
f (extract_Batch rest)
D: Type
f: C -> D
extract_Batch (map (Batch A A) f (rest ⧆ a)) =
f (extract_Batch (rest ⧆ a)) cbn.
A, C: Type
rest: Batch A A (A -> C)
a: A
IHrest: forall (D : Type) (f : (A -> C) -> D),
extract_Batch (map (Batch A A) f rest) =
f (extract_Batch rest)
D: Type
f: C -> D
extract_Batch (map (Batch A A) (compose f) rest) a =
f (extract_Batch rest a)
      now rewrite IHrest.
  Qed.

  Lemma extract_dinatural (A B C: Type) (f: A -> B):
    forall (b: Batch A B C),
      @extract_Batch B C (mapfst_Batch A B f b) =
        @extract_Batch A C (mapsnd_Batch A B f b).
A, B, C: Type
f: A -> B
forall b : Batch A B C,
extract_Batch (mapfst_Batch A B f b) =
extract_Batch (mapsnd_Batch A B f b)
  Proof.
A, B, C: Type
f: A -> B
forall b : Batch A B C,
extract_Batch (mapfst_Batch A B f b) =
extract_Batch (mapsnd_Batch A B f b)
    intros.
A, B, C: Type
f: A -> B
b: Batch A B C
extract_Batch (mapfst_Batch A B f b) =
extract_Batch (mapsnd_Batch A B f b)
    induction b as [C c | C rest IHrest a].
A, B: Type
f: A -> B
C: Type
c: C
extract_Batch (mapfst_Batch A B f (Done A B C c)) =
extract_Batch (mapsnd_Batch A B f (Done A B C c))
A, B: Type
f: A -> B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (mapfst_Batch A B f rest) =
extract_Batch (mapsnd_Batch A B f rest)
extract_Batch (mapfst_Batch A B f (rest ⧆ a)) =
extract_Batch (mapsnd_Batch A B f (rest ⧆ a))
    -
A, B: Type
f: A -> B
C: Type
c: C
extract_Batch (mapfst_Batch A B f (Done A B C c)) =
extract_Batch (mapsnd_Batch A B f (Done A B C c)) reflexivity.
    -
A, B: Type
f: A -> B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (mapfst_Batch A B f rest) =
extract_Batch (mapsnd_Batch A B f rest)
extract_Batch (mapfst_Batch A B f (rest ⧆ a)) =
extract_Batch (mapsnd_Batch A B f (rest ⧆ a)) cbn.
A, B: Type
f: A -> B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (mapfst_Batch A B f rest) =
extract_Batch (mapsnd_Batch A B f rest)
extract_Batch (mapfst_Batch A B f rest) (f a) =
extract_Batch
  (map (Batch A A) (precompose f)
     (mapsnd_Batch A B f rest)) a
      rewrite IHrest.
A, B: Type
f: A -> B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (mapfst_Batch A B f rest) =
extract_Batch (mapsnd_Batch A B f rest)
extract_Batch (mapsnd_Batch A B f rest) (f a) =
extract_Batch
  (map (Batch A A) (precompose f)
     (mapsnd_Batch A B f rest)) a
      rewrite extract_natural.
A, B: Type
f: A -> B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (mapfst_Batch A B f rest) =
extract_Batch (mapsnd_Batch A B f rest)
extract_Batch (mapsnd_Batch A B f rest) (f a) =
precompose f (extract_Batch (mapsnd_Batch A B f rest))
  a
      reflexivity.
  Qed.

  Lemma cojoin_natural (A B C D E: Type) (f: D -> E):
    forall (b: Batch A C D),
      @cojoin_Batch A B C E (map (Batch A C) f b) =
        map (Batch A B) (map (Batch B C) f) (@cojoin_Batch A B C D b).
A, B, C, D, E: Type
f: D -> E
forall b : Batch A C D,
cojoin_Batch (map (Batch A C) f b) =
map (Batch A B) (map (Batch B C) f) (cojoin_Batch b)
  Proof.
A, B, C, D, E: Type
f: D -> E
forall b : Batch A C D,
cojoin_Batch (map (Batch A C) f b) =
map (Batch A B) (map (Batch B C) f) (cojoin_Batch b)
    intros.
A, B, C, D, E: Type
f: D -> E
b: Batch A C D
cojoin_Batch (map (Batch A C) f b) =
map (Batch A B) (map (Batch B C) f) (cojoin_Batch b)
    generalize dependent E.
A, B, C, D: Type
b: Batch A C D
forall (E : Type) (f : D -> E),
cojoin_Batch (map (Batch A C) f b) =
map (Batch A B) (map (Batch B C) f) (cojoin_Batch b)
    induction b as [D d | D rest IHrest a]; intros E f.
A, B, C, D: Type
d: D
E: Type
f: D -> E
cojoin_Batch (map (Batch A C) f (Done A C D d)) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch (Done A C D d))
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
cojoin_Batch (map (Batch A C) f (rest ⧆ a)) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch (rest ⧆ a))
    -
A, B, C, D: Type
d: D
E: Type
f: D -> E
cojoin_Batch (map (Batch A C) f (Done A C D d)) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch (Done A C D d)) reflexivity.
    -
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
cojoin_Batch (map (Batch A C) f (rest ⧆ a)) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch (rest ⧆ a)) cbn.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
map (Batch A B) (Step B C E)
  (cojoin_Batch (map (Batch A C) (compose f) rest))
⧆ a =
map (Batch A B) (compose (map (Batch B C) f))
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ a
      rewrite IHrest.
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
map (Batch A B) (Step B C E)
  (map (Batch A B) (map (Batch B C) (compose f))
     (cojoin_Batch rest)) ⧆ a =
map (Batch A B) (compose (map (Batch B C) f))
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ a
      compose near (cojoin_Batch (B := B) rest).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
(map (Batch A B) (Step B C E)
 ∘ map (Batch A B) (map (Batch B C) (compose f)))
  (cojoin_Batch rest) ⧆ a =
(map (Batch A B) (compose (map (Batch B C) f))
 ∘ map (Batch A B) (Step B C D)) (cojoin_Batch rest)
⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
map (Batch A B)
  (Step B C E ∘ map (Batch B C) (compose f))
  (cojoin_Batch rest) ⧆ a =
(map (Batch A B) (compose (map (Batch B C) f))
 ∘ map (Batch A B) (Step B C D)) (cojoin_Batch rest)
⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C, D: Type
rest: Batch A C (C -> D)
a: A
IHrest: forall (E : Type) (f : (C -> D) -> E),
cojoin_Batch (map (Batch A C) f rest) =
map (Batch A B) (map (Batch B C) f)
  (cojoin_Batch rest)
E: Type
f: D -> E
map (Batch A B)
  (Step B C E ∘ map (Batch B C) (compose f))
  (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (map (Batch B C) f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a
      reflexivity.
  Qed.

  Lemma cojoin_natural1 (A A' B C D: Type) (f: A -> A'):
    forall (b: Batch A C D),
      @cojoin_Batch A' B C D (mapfst_Batch _ _ f b) =
        mapfst_Batch _ _ f (@cojoin_Batch A B C D b).
A, A', B, C, D: Type
f: A -> A'
forall b : Batch A C D,
cojoin_Batch (mapfst_Batch A A' f b) =
mapfst_Batch A A' f (cojoin_Batch b)
  Proof.
A, A', B, C, D: Type
f: A -> A'
forall b : Batch A C D,
cojoin_Batch (mapfst_Batch A A' f b) =
mapfst_Batch A A' f (cojoin_Batch b)
    intros.
A, A', B, C, D: Type
f: A -> A'
b: Batch A C D
cojoin_Batch (mapfst_Batch A A' f b) =
mapfst_Batch A A' f (cojoin_Batch b)
    induction b as [D d | D rest IHrest a].
A, A', B, C: Type
f: A -> A'
D: Type
d: D
cojoin_Batch (mapfst_Batch A A' f (Done A C D d)) =
mapfst_Batch A A' f (cojoin_Batch (Done A C D d))
A, A', B, C: Type
f: A -> A'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch (mapfst_Batch A A' f rest) =
mapfst_Batch A A' f (cojoin_Batch rest)
cojoin_Batch (mapfst_Batch A A' f (rest ⧆ a)) =
mapfst_Batch A A' f (cojoin_Batch (rest ⧆ a))
    -
A, A', B, C: Type
f: A -> A'
D: Type
d: D
cojoin_Batch (mapfst_Batch A A' f (Done A C D d)) =
mapfst_Batch A A' f (cojoin_Batch (Done A C D d)) reflexivity.
    -
A, A', B, C: Type
f: A -> A'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch (mapfst_Batch A A' f rest) =
mapfst_Batch A A' f (cojoin_Batch rest)
cojoin_Batch (mapfst_Batch A A' f (rest ⧆ a)) =
mapfst_Batch A A' f (cojoin_Batch (rest ⧆ a)) cbn.
A, A', B, C: Type
f: A -> A'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch (mapfst_Batch A A' f rest) =
mapfst_Batch A A' f (cojoin_Batch rest)
map (Batch A' B) (Step B C D)
  (cojoin_Batch (mapfst_Batch A A' f rest)) ⧆ f a =
mapfst_Batch A A' f
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ f a
      rewrite IHrest.
A, A', B, C: Type
f: A -> A'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch (mapfst_Batch A A' f rest) =
mapfst_Batch A A' f (cojoin_Batch rest)
map (Batch A' B) (Step B C D)
  (mapfst_Batch A A' f (cojoin_Batch rest)) ⧆ f a =
mapfst_Batch A A' f
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ f a
      rewrite <- mapfst_map_Batch.
A, A', B, C: Type
f: A -> A'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: cojoin_Batch (mapfst_Batch A A' f rest) =
mapfst_Batch A A' f (cojoin_Batch rest)
mapfst_Batch A A' f
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ f a =
mapfst_Batch A A' f
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ f a
      reflexivity.
  Qed.

  Lemma cojoin_natural2 (A B C C' D: Type) (f: C -> C'):
    forall (b: Batch A C' D),
      @cojoin_Batch A B C D (mapsnd_Batch _ _ f b) =
        map (Batch A B) (mapsnd_Batch _ _ f) (@cojoin_Batch A B C' D b).
A, B, C, C', D: Type
f: C -> C'
forall b : Batch A C' D,
cojoin_Batch (mapsnd_Batch C C' f b) =
map (Batch A B) (mapsnd_Batch C C' f) (cojoin_Batch b)
  Proof.
A, B, C, C', D: Type
f: C -> C'
forall b : Batch A C' D,
cojoin_Batch (mapsnd_Batch C C' f b) =
map (Batch A B) (mapsnd_Batch C C' f) (cojoin_Batch b)
    intros.
A, B, C, C', D: Type
f: C -> C'
b: Batch A C' D
cojoin_Batch (mapsnd_Batch C C' f b) =
map (Batch A B) (mapsnd_Batch C C' f) (cojoin_Batch b)
    generalize dependent C.
A, B, C', D: Type
b: Batch A C' D
forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f b) =
map (Batch A B) (mapsnd_Batch C C' f) (cojoin_Batch b)
    induction b as [D d | D rest IHrest a]; intros C f.
A, B, C', D: Type
d: D
C: Type
f: C -> C'
cojoin_Batch (mapsnd_Batch C C' f (Done A C' D d)) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch (Done A C' D d))
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
cojoin_Batch (mapsnd_Batch C C' f (rest ⧆ a)) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch (rest ⧆ a))
    -
A, B, C', D: Type
d: D
C: Type
f: C -> C'
cojoin_Batch (mapsnd_Batch C C' f (Done A C' D d)) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch (Done A C' D d)) reflexivity.
    -
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
cojoin_Batch (mapsnd_Batch C C' f (rest ⧆ a)) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch (rest ⧆ a)) cbn.
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B) (Step B C D)
  (cojoin_Batch
     (map (Batch A C) (precompose f)
        (mapsnd_Batch C C' f rest))) ⧆ a =
map (Batch A B) (compose (mapsnd_Batch C C' f))
  (map (Batch A B) (Step B C' D) (cojoin_Batch rest))
⧆ a
      rewrite cojoin_natural.
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B) (Step B C D)
  (map (Batch A B) (map (Batch B C) (precompose f))
     (cojoin_Batch (mapsnd_Batch C C' f rest))) ⧆ a =
map (Batch A B) (compose (mapsnd_Batch C C' f))
  (map (Batch A B) (Step B C' D) (cojoin_Batch rest))
⧆ a
      change (map (Batch A B) ?g (map (Batch A B) ?f ?b))
        with ((map (Batch A B) g ∘ map (Batch A B) f) b).
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
(map (Batch A B) (Step B C D)
 ∘ map (Batch A B) (map (Batch B C) (precompose f)))
  (cojoin_Batch (mapsnd_Batch C C' f rest)) ⧆ a =
(map (Batch A B) (compose (mapsnd_Batch C C' f))
 ∘ map (Batch A B) (Step B C' D)) (cojoin_Batch rest)
⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B)
  (Step B C D ∘ map (Batch B C) (precompose f))
  (cojoin_Batch (mapsnd_Batch C C' f rest)) ⧆ a =
(map (Batch A B) (compose (mapsnd_Batch C C' f))
 ∘ map (Batch A B) (Step B C' D)) (cojoin_Batch rest)
⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B)
  (Step B C D ∘ map (Batch B C) (precompose f))
  (cojoin_Batch (mapsnd_Batch C C' f rest)) ⧆ a =
map (Batch A B)
  (compose (mapsnd_Batch C C' f) ∘ Step B C' D)
  (cojoin_Batch rest) ⧆ a
      rewrite IHrest.
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B)
  (Step B C D ∘ map (Batch B C) (precompose f))
  (map (Batch A B) (mapsnd_Batch C C' f)
     (cojoin_Batch rest)) ⧆ a =
map (Batch A B)
  (compose (mapsnd_Batch C C' f) ∘ Step B C' D)
  (cojoin_Batch rest) ⧆ a
      change (map (Batch A B) ?g (map (Batch A B) ?f ?b))
        with ((map (Batch A B) g ∘ map (Batch A B) f) b).
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
(map (Batch A B)
   (Step B C D ∘ map (Batch B C) (precompose f))
 ∘ map (Batch A B) (mapsnd_Batch C C' f))
  (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (mapsnd_Batch C C' f) ∘ Step B C' D)
  (cojoin_Batch rest) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, C', D: Type
rest: Batch A C' (C' -> D)
a: A
IHrest: forall (C : Type) (f : C -> C'),
cojoin_Batch (mapsnd_Batch C C' f rest) =
map (Batch A B) (mapsnd_Batch C C' f)
  (cojoin_Batch rest)
C: Type
f: C -> C'
map (Batch A B)
  (Step B C D ∘ map (Batch B C) (precompose f)
   ∘ mapsnd_Batch C C' f) (cojoin_Batch rest) ⧆ a =
map (Batch A B)
  (compose (mapsnd_Batch C C' f) ∘ Step B C' D)
  (cojoin_Batch rest) ⧆ a
      reflexivity.
  Qed.

  Lemma cojoin_dinatural (A B B' C D: Type) (f: B -> B'):
    forall (b: Batch A C D),
      map (Batch A B) (mapfst_Batch _ _ f) (@cojoin_Batch A B C D b) =
        (mapsnd_Batch _ _ f) (@cojoin_Batch A B' C D b).
A, B, B', C, D: Type
f: B -> B'
forall b : Batch A C D,
map (Batch A B) (mapfst_Batch B B' f) (cojoin_Batch b) =
mapsnd_Batch B B' f (cojoin_Batch b)
  Proof.
A, B, B', C, D: Type
f: B -> B'
forall b : Batch A C D,
map (Batch A B) (mapfst_Batch B B' f) (cojoin_Batch b) =
mapsnd_Batch B B' f (cojoin_Batch b)
    intros.
A, B, B', C, D: Type
f: B -> B'
b: Batch A C D
map (Batch A B) (mapfst_Batch B B' f) (cojoin_Batch b) =
mapsnd_Batch B B' f (cojoin_Batch b)
    induction b as [D d | D rest IHrest a].
A, B, B', C: Type
f: B -> B'
D: Type
d: D
map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch (Done A C D d)) =
mapsnd_Batch B B' f (cojoin_Batch (Done A C D d))
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch (rest ⧆ a)) =
mapsnd_Batch B B' f (cojoin_Batch (rest ⧆ a))
    -
A, B, B', C: Type
f: B -> B'
D: Type
d: D
map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch (Done A C D d)) =
mapsnd_Batch B B' f (cojoin_Batch (Done A C D d)) reflexivity.
    -
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch (rest ⧆ a)) =
mapsnd_Batch B B' f (cojoin_Batch (rest ⧆ a)) cbn.
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B) (compose (mapfst_Batch B B' f))
  (map (Batch A B) (Step B C D) (cojoin_Batch rest))
⧆ a =
map (Batch A B) (precompose f)
  (mapsnd_Batch B B' f
     (map (Batch A B') (Step B' C D)
        (cojoin_Batch rest))) ⧆ a
      compose near (cojoin_Batch (B := B) rest).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
(map (Batch A B) (compose (mapfst_Batch B B' f))
 ∘ map (Batch A B) (Step B C D)) (cojoin_Batch rest)
⧆ a =
map (Batch A B) (precompose f)
  (mapsnd_Batch B B' f
     (map (Batch A B') (Step B' C D)
        (cojoin_Batch rest))) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B)
  (compose (mapfst_Batch B B' f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a =
map (Batch A B) (precompose f)
  (mapsnd_Batch B B' f
     (map (Batch A B') (Step B' C D)
        (cojoin_Batch rest))) ⧆ a
      rewrite mapsnd_map_Batch.
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B)
  (compose (mapfst_Batch B B' f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a =
map (Batch A B) (precompose f)
  (map (Batch A B) (Step B' C D)
     (mapsnd_Batch B B' f (cojoin_Batch rest))) ⧆ a
      compose near (mapsnd_Batch B B' f (cojoin_Batch (B := B') rest)).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B)
  (compose (mapfst_Batch B B' f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a =
(map (Batch A B) (precompose f)
 ∘ map (Batch A B) (Step B' C D))
  (mapsnd_Batch B B' f (cojoin_Batch rest)) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B)
  (compose (mapfst_Batch B B' f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a =
map (Batch A B) (precompose f ∘ Step B' C D)
  (mapsnd_Batch B B' f (cojoin_Batch rest)) ⧆ a
      rewrite <- IHrest.
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
map (Batch A B)
  (compose (mapfst_Batch B B' f) ∘ Step B C D)
  (cojoin_Batch rest) ⧆ a =
map (Batch A B) (precompose f ∘ Step B' C D)
  (map (Batch A B) (mapfst_Batch B B' f)
     (cojoin_Batch rest)) ⧆ a
      compose near (cojoin_Batch (B := B) rest).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
(Step A B (Batch B' C D)
 ∘ map (Batch A B)
     (compose (mapfst_Batch B B' f) ∘ Step B C D))
  (cojoin_Batch rest) a =
(map (Batch A B) (precompose f ∘ Step B' C D)
 ∘ map (Batch A B) (mapfst_Batch B B' f))
  (cojoin_Batch rest) ⧆ a
      rewrite (fun_map_map (F := Batch A B)).
A, B, B', C: Type
f: B -> B'
D: Type
rest: Batch A C (C -> D)
a: A
IHrest: map (Batch A B) (mapfst_Batch B B' f)
  (cojoin_Batch rest) =
mapsnd_Batch B B' f (cojoin_Batch rest)
(Step A B (Batch B' C D)
 ∘ map (Batch A B)
     (compose (mapfst_Batch B B' f) ∘ Step B C D))
  (cojoin_Batch rest) a =
map (Batch A B)
  (precompose f ∘ Step B' C D ∘ mapfst_Batch B B' f)
  (cojoin_Batch rest) ⧆ a
      reflexivity.
  Qed.

  (** ** Comonad Laws *)
  (********************************************************************)
  Lemma extr_cojoin_Batch:
    `(extract_Batch ∘ cojoin_Batch = @id (Batch A B C)).
forall A B C : Type, extract_Batch ∘ cojoin_Batch = id
  Proof.
forall A B C : Type, extract_Batch ∘ cojoin_Batch = id
    intros.
A, B, C: Type
extract_Batch ∘ cojoin_Batch = id ext b.
A, B, C: Type
b: Batch A B C
(extract_Batch ∘ cojoin_Batch) b = id b unfold id.
A, B, C: Type
b: Batch A B C
(extract_Batch ∘ cojoin_Batch) b = b
    induction b as [C c | C rest IHrest a].
A, B, C: Type
c: C
(extract_Batch ∘ cojoin_Batch) (Done A B C c) =
Done A B C c
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (extract_Batch ∘ cojoin_Batch) rest = rest
(extract_Batch ∘ cojoin_Batch) (rest ⧆ a) = rest ⧆ a
    -
A, B, C: Type
c: C
(extract_Batch ∘ cojoin_Batch) (Done A B C c) =
Done A B C c unfold compose.
A, B, C: Type
c: C
extract_Batch (cojoin_Batch (Done A B C c)) =
Done A B C c cbn.
A, B, C: Type
c: C
Done A B C c = Done A B C c reflexivity.
    -
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (extract_Batch ∘ cojoin_Batch) rest = rest
(extract_Batch ∘ cojoin_Batch) (rest ⧆ a) = rest ⧆ a unfold compose in *.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (cojoin_Batch rest) = rest
extract_Batch (cojoin_Batch (rest ⧆ a)) = rest ⧆ a
      cbn.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (cojoin_Batch rest) = rest
extract_Batch
  (map (Batch A A) (Step A B C) (cojoin_Batch rest)) a =
rest ⧆ a
      rewrite extract_natural.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (cojoin_Batch rest) = rest
extract_Batch (cojoin_Batch rest) ⧆ a = rest ⧆ a
      rewrite IHrest.
A, B, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: extract_Batch (cojoin_Batch rest) = rest
rest ⧆ a = rest ⧆ a
      reflexivity.
  Qed.

  (* TODO Finish rest of the parameterized comonad structure. *)

End parameterized.

(** * <<Batch>> is Traversable in the First Argument *)
(**********************************************************************)
Fixpoint traverse_Batch (B C: Type) (G: Type -> Type)
  `{Map G} `{Pure G} `{Mult G} (A A': Type) (f: A -> G A')
  (b: Batch A B C): G (Batch A' B C) :=
  match b with
  | Done _ _ _ c => pure G (Done A' B C c)
  | Step _ _ _ rest a =>
      pure G (Step A' B C) <⋆>
        traverse_Batch B (B -> C) G A A' f rest <⋆>
        f a
  end.

#[export] Instance Traverse_Batch1:
  forall (B C: Type), Traverse (BATCH1 B C) := traverse_Batch.

(** ** Rewriting Principles *)
(**********************************************************************)
Lemma traverse_Batch_rw1:
  forall (B C: Type)
    (G: Type -> Type)
    `{Map G} `{Pure G} `{Mult G}
    (A A': Type) (f: A -> G A') (c: C),
    traverse f (Done A B C c) = pure G (Done A' B C c).
forall (B C : Type) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A A' : Type)
  (f : A -> G A') (c : C),
traverse f (Done A B C c) = pure G (Done A' B C c)
Proof.
forall (B C : Type) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A A' : Type)
  (f : A -> G A') (c : C),
traverse f (Done A B C c) = pure G (Done A' B C c)
  reflexivity.
Qed.

Lemma traverse_Batch_rw1':
  forall (B C: Type)
    (G: Type -> Type)
    `{Map G} `{Pure G} `{Mult G}
    (A A': Type) (f: A -> G A'),
    (traverse f ∘ pure (Batch A B)) =
      pure (G ∘ Batch A' B) (A := C).
forall (B C : Type) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A A' : Type)
  (f : A -> G A'),
traverse f ∘ pure (Batch A B) = pure (G ∘ Batch A' B)
Proof.
forall (B C : Type) (G : Type -> Type) (H : Map G)
  (H0 : Pure G) (H1 : Mult G) (A A' : Type)
  (f : A -> G A'),
traverse f ∘ pure (Batch A B) = pure (G ∘ Batch A' B)
  intros.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
traverse f ∘ pure (Batch A B) = pure (G ∘ Batch A' B)
  unfold_ops @Pure_Batch.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
traverse f ∘ (fun c : C => Done A B C c) =
pure (G ∘ Batch A' B)
  unfold_ops @Pure_compose.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
traverse f ∘ (fun c : C => Done A B C c) =
pure G ○ pure (Batch A' B)
  unfold pure at 2.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
traverse f ∘ (fun c : C => Done A B C c) =
pure G ○ Done A' B C
  unfold compose at 1; ext c.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
c: C
traverse f (Done A B C c) = pure G (Done A' B C c)
  rewrite traverse_Batch_rw1.
B, C: Type
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
A, A': Type
f: A -> G A'
c: C
pure G (Done A' B C c) = pure G (Done A' B C c)
  reflexivity.
Qed.

Lemma traverse_Batch_rw2:
  forall`{Map G} `{Pure G} `{Mult G}
   `{! Applicative G}
   (B C: Type)
   (A A': Type) (f: A -> G A')
   (k: Batch A B (B -> C)) (a: A),
    traverse f (k ⧆ a) =
      map G (Step A' B C) (traverse (G := G) f k) <⋆> f a.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall (B C A A' : Type) (f : A -> G A')
  (k : Batch A B (B -> C)) (a : A),
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a
Proof.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall (B C A A' : Type) (f : A -> G A')
  (k : Batch A B (B -> C)) (a : A),
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a
  intros.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
k: Batch A B (B -> C)
a: A
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a cbn.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
k: Batch A B (B -> C)
a: A
pure G (Step A' B C) <⋆>
Traverse_Batch1 B (B -> C) G H H0 H1 A A' f k <⋆> 
f a = map G (Step A' B C) (traverse f k) <⋆> f a
  rewrite <- map_to_ap.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
k: Batch A B (B -> C)
a: A
map G (Step A' B C)
  (Traverse_Batch1 B (B -> C) G H H0 H1 A A' f k) <⋆>
f a = map G (Step A' B C) (traverse f k) <⋆> f a
  reflexivity.
Qed.

Lemma traverse_Batch_rw2':
  forall `{Map G} `{Pure G} `{Mult G}
    `{! Applicative G}
    (B C: Type)
    (A A': Type) (f: A -> G A')
    (k: Batch A B (B -> C)) (a: A),
    traverse f (k ⧆ a) =
      map G (Step A' B C) (traverse (G := G) f k) <⋆> f a.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall (B C A A' : Type) (f : A -> G A')
  (k : Batch A B (B -> C)) (a : A),
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a
Proof.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall (B C A A' : Type) (f : A -> G A')
  (k : Batch A B (B -> C)) (a : A),
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a
  intros.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
k: Batch A B (B -> C)
a: A
traverse f (k ⧆ a) =
map G (Step A' B C) (traverse f k) <⋆> f a
  rewrite traverse_Batch_rw2.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
k: Batch A B (B -> C)
a: A
map G (Step A' B C) (traverse f k) <⋆> f a =
map G (Step A' B C) (traverse f k) <⋆> f a
  reflexivity.
Qed.

Lemma traverse_Batch_ap_rw2:
  forall`{Map G} `{Pure G} `{Mult G}
   `{! Applicative G}
   (B C: Type)
   (A A': Type) (f: A -> G A')
   {X Y: Type}
   (lhs: Batch A B (X -> Y))
   (rhs: Batch A B X),
    traverse (T := BATCH1 B Y) f (lhs <⋆> rhs) =
      pure G (ap (Batch A' B) (A := X) (B := Y))
        <⋆> traverse (T := BATCH1 B (X -> Y)) f lhs
        <⋆> traverse (T := BATCH1 B X) f rhs.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall B : Type,
Type ->
forall (A A' : Type) (f : A -> G A') (X Y : Type)
  (lhs : Batch A B (X -> Y)) (rhs : Batch A B X),
traverse f (lhs <⋆> rhs) =
pure G (ap (Batch A' B)) <⋆> traverse f lhs <⋆>
traverse f rhs
Proof.
forall (G : Type -> Type) (H : Map G) (H0 : Pure G)
  (H1 : Mult G),
Applicative G ->
forall B : Type,
Type ->
forall (A A' : Type) (f : A -> G A') (X Y : Type)
  (lhs : Batch A B (X -> Y)) (rhs : Batch A B X),
traverse f (lhs <⋆> rhs) =
pure G (ap (Batch A' B)) <⋆> traverse f lhs <⋆>
traverse f rhs
  intros.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
X, Y: Type
lhs: Batch A B (X -> Y)
rhs: Batch A B X
traverse f (lhs <⋆> rhs) =
pure G (ap (Batch A' B)) <⋆> traverse f lhs <⋆>
traverse f rhs
  destruct lhs.
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
X, Y: Type
y: X -> Y
rhs: Batch A B X
traverse f (Done A B (X -> Y) y <⋆> rhs) =
pure G (ap (Batch A' B)) <⋆>
traverse f (Done A B (X -> Y) y) <⋆> traverse f rhs
G: Type -> Type
H: Map G
H0: Pure G
H1: Mult G
Applicative0: Applicative G
B, C, A, A': Type
f: A -> G A'
X, Y: Type
lhs: Batch A B (B -> X -> Y)
a: A
rhs: Batch A B X
traverse f ((lhs ⧆ a) <⋆> rhs) =
pure G (ap (Batch A' B)) <⋆> traverse f (lhs ⧆ a) <⋆>
traverse f rhs
Abort.

(** ** Traversable Functor Laws *)
(**********************************************************************)
Lemma trf_traverse_id_Batch:
  forall (B C A: Type),
    traverse (T := BATCH1 B C) (G := fun X: Type => X) (@id A) = id.
forall B C A : Type, traverse id = id
Proof.
forall B C A : Type, traverse id = id
  intros.
B, C, A: Type
traverse id = id ext b.
B, C, A: Type
b: Batch A B C
traverse id b = id b
  unfold id.
B, C, A: Type
b: Batch A B C
traverse (fun x : A => x) b = b
  induction b as [C c | C rest IHrest].
B, A, C: Type
c: C
traverse (fun x : A => x) (Done A B C c) =
Done A B C c
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse (fun x : A => x) rest = rest
traverse (fun x : A => x) (rest ⧆ a) = rest ⧆ a
  -
B, A, C: Type
c: C
traverse (fun x : A => x) (Done A B C c) =
Done A B C c cbn.
B, A, C: Type
c: C
pure (fun X : Type => X) (Done A B C c) = Done A B C c reflexivity.
  -
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse (fun x : A => x) rest = rest
traverse (fun x : A => x) (rest ⧆ a) = rest ⧆ a cbn.
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse (fun x : A => x) rest = rest
pure (fun X : Type => X) (Step A B C)
  (Traverse_Batch1 B (B -> C) (fun X : Type => X)
     Map_I Pure_I Mult_I A A (fun x : A => x) rest) a =
rest ⧆ a
    change (Traverse_Batch1 B (B -> C)) with
      (@traverse (BATCH1 B (B -> C)) _).
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse (fun x : A => x) rest = rest
pure (fun X : Type => X) (Step A B C)
  (traverse (fun x : A => x) rest) a = rest ⧆ a
    rewrite IHrest.
B, A, C: Type
rest: Batch A B (B -> C)
a: A
IHrest: traverse (fun x : A => x) rest = rest
pure (fun X : Type => X) (Step A B C) rest a =
rest ⧆ a
    reflexivity.
Qed.

Lemma trf_traverse_traverse_Batch (B C: Type):
  forall `(H0: Map G1) (H1: Pure G1) (H2: Mult G1),
    Applicative G1 ->
    forall `(H4: Map G2) (H5: Pure G2) (H6: Mult G2),
      Applicative G2 ->
      forall (A A' A'': Type) (g: A' -> G2 A'') (f: A -> G1 A'),
        map G1 (traverse (T := BATCH1 B C) g) ∘
          traverse (T := BATCH1 B C) f =
          traverse (T := BATCH1 B C) (G := G1 ∘ G2) (g ⋆2 f).
B, C: Type
forall (G1 : Type -> Type) (H0 : Map G1)
  (H1 : Pure G1) (H2 : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (H4 : Map G2)
  (H5 : Pure G2) (H6 : Mult G2),
Applicative G2 ->
forall (A A' A'' : Type) (g : A' -> G2 A'')
  (f : A -> G1 A'),
map G1 (traverse g) ∘ traverse f = traverse (g ⋆2 f)
Proof.
B, C: Type
forall (G1 : Type -> Type) (H0 : Map G1)
  (H1 : Pure G1) (H2 : Mult G1),
Applicative G1 ->
forall (G2 : Type -> Type) (H4 : Map G2)
  (H5 : Pure G2) (H6 : Mult G2),
Applicative G2 ->
forall (A A' A'' : Type) (g : A' -> G2 A'')
  (f : A -> G1 A'),
map G1 (traverse g) ∘ traverse f = traverse (g ⋆2 f)
  intros.
B, C: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
map G1 (traverse g) ∘ traverse f = traverse (g ⋆2 f) ext b.
B, C: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
b: Batch A B C
(map G1 (traverse g) ∘ traverse f) b =
traverse (g ⋆2 f) b
  unfold id.
B, C: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
b: Batch A B C
(map G1 (traverse g) ∘ traverse f) b =
traverse (g ⋆2 f) b
  induction b as [C c | C rest IHrest].
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
(map G1 (traverse g) ∘ traverse f) (Done A B C c) =
traverse (g ⋆2 f) (Done A B C c)
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
traverse (g ⋆2 f) (rest ⧆ a)
  -
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
(map G1 (traverse g) ∘ traverse f) (Done A B C c) =
traverse (g ⋆2 f) (Done A B C c) cbn.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
(map G1 (traverse g) ∘ traverse f) (Done A B C c) =
pure (G1 ∘ G2) (Done A'' B C c) unfold compose.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
map G1 (traverse g) (traverse f (Done A B C c)) =
pure (G1 ○ G2) (Done A'' B C c)
    cbn.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
map G1 (traverse g) (pure G1 (Done A' B C c)) =
pure (G1 ○ G2) (Done A'' B C c) rewrite app_pure_natural.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
c: C
pure G1 (traverse g (Done A' B C c)) =
pure (G1 ○ G2) (Done A'' B C c)
    reflexivity.
  -
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
traverse (g ⋆2 f) (rest ⧆ a) cbn.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure (G1 ∘ G2) (Step A'' B C) <⋆>
Traverse_Batch1 B (B -> C) (G1 ∘ G2)
  (Map_compose G1 G2) (Pure_compose G1 G2)
  (Mult_compose G1 G2) A A'' (g ⋆2 f) rest <⋆>
(g ⋆2 f) a
    (* RHS *)
    change (Traverse_Batch1 B (B -> C))
      with (@traverse (BATCH1 B (B -> C)) _).
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure (G1 ∘ G2) (Step A'' B C) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    (* cleanup *)
    rewrite (ap_compose1 G2 G1).
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1 (ap G2) <⋆>
(pure (G1 ∘ G2) (Step A'' B C) <⋆>
 traverse (g ⋆2 f) rest) <⋆> (g ⋆2 f) a
    rewrite (ap_compose1 G2 G1).
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1 (ap G2) <⋆>
(pure G1 (ap G2) <⋆> pure (G1 ∘ G2) (Step A'' B C) <⋆>
 traverse (g ⋆2 f) rest) <⋆> (g ⋆2 f) a
    rewrite <- map_to_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (ap G2)
  (pure G1 (ap G2) <⋆> pure (G1 ∘ G2) (Step A'' B C) <⋆>
   traverse (g ⋆2 f) rest) <⋆> (g ⋆2 f) a
    rewrite map_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (compose (ap G2))
  (pure G1 (ap G2) <⋆> pure (G1 ∘ G2) (Step A'' B C)) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    rewrite map_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (compose (compose (ap G2))) (pure G1 (ap G2)) <⋆>
pure (G1 ∘ G2) (Step A'' B C) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    rewrite app_pure_natural.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1 (compose (ap G2) ∘ ap G2) <⋆>
pure (G1 ∘ G2) (Step A'' B C) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    (* <<unfold_ops Pure_compose>> prevents << rewrite <- IHrest>> *)
    unfold pure at 2; unfold Pure_compose at 1.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1 (compose (ap G2) ∘ ap G2) <⋆>
pure G1 (pure G2 (Step A'' B C)) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    rewrite ap2.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  ((compose (ap G2) ∘ ap G2) (pure G2 (Step A'' B C))) <⋆>
traverse (g ⋆2 f) rest <⋆> (g ⋆2 f) a
    (* deal with <<rest>> *)
    rewrite <- IHrest.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  ((compose (ap G2) ∘ ap G2) (pure G2 (Step A'' B C))) <⋆>
(map G1 (traverse g) ∘ traverse f) rest <⋆> (g ⋆2 f) a
    unfold compose at 4.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  ((compose (ap G2) ∘ ap G2) (pure G2 (Step A'' B C))) <⋆>
map G1 (traverse g) (traverse f rest) <⋆> (g ⋆2 f) a
    rewrite <- ap_map.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (precompose (traverse g))
  (pure G1
     ((compose (ap G2) ∘ ap G2)
        (pure G2 (Step A'' B C)))) <⋆> traverse f rest <⋆>
(g ⋆2 f) a
    rewrite app_pure_natural.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  (precompose (traverse g)
     ((compose (ap G2) ∘ ap G2)
        (pure G2 (Step A'' B C)))) <⋆> traverse f rest <⋆>
(g ⋆2 f) a
    unfold kc2.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  (precompose (traverse g)
     ((compose (ap G2) ∘ ap G2)
        (pure G2 (Step A'' B C)))) <⋆> traverse f rest <⋆>
(map G1 g ∘ f) a
    unfold compose at 4.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  (precompose (traverse g)
     ((compose (ap G2) ∘ ap G2)
        (pure G2 (Step A'' B C)))) <⋆> traverse f rest <⋆>
map G1 g (f a)
    rewrite <- ap_map.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (precompose g)
  (pure G1
     (precompose (traverse g)
        ((compose (ap G2) ∘ ap G2)
           (pure G2 (Step A'' B C)))) <⋆>
   traverse f rest) <⋆> f a
    rewrite map_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
map G1 (compose (precompose g))
  (pure G1
     (precompose (traverse g)
        ((compose (ap G2) ∘ ap G2)
           (pure G2 (Step A'' B C))))) <⋆>
traverse f rest <⋆> f a
    rewrite app_pure_natural.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
(map G1 (traverse g) ∘ traverse f) (rest ⧆ a) =
pure G1
  (precompose g
   ∘ precompose (traverse g)
       ((compose (ap G2) ∘ ap G2)
          (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    (* LHS *)
    unfold compose; cbn.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
map G1 (traverse g)
  (pure G1 (Step A' B C) <⋆>
   Traverse_Batch1 B (B -> C) G1 H0 H1 H2 A A' f rest <⋆>
   f a) =
pure G1
  (precompose g
   ○ precompose (traverse g)
       (ap G2 ○ ap G2 (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    fold (@traverse (BATCH1 B (B -> C)) _).
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
map G1 (traverse g)
  (pure G1 (Step A' B C) <⋆> traverse f rest <⋆> f a) =
pure G1
  (precompose g
   ○ precompose (traverse g)
       (ap G2 ○ ap G2 (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    rewrite map_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
map G1 (compose (traverse g))
  (pure G1 (Step A' B C) <⋆> traverse f rest) <⋆> 
f a =
pure G1
  (precompose g
   ○ precompose (traverse g)
       (ap G2 ○ ap G2 (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    rewrite map_ap.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
map G1 (compose (compose (traverse g)))
  (pure G1 (Step A' B C)) <⋆> traverse f rest <⋆> 
f a =
pure G1
  (precompose g
   ○ precompose (traverse g)
       (ap G2 ○ ap G2 (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    rewrite app_pure_natural.
B: Type
G1: Type -> Type
H0: Map G1
H1: Pure G1
H2: Mult G1
H: Applicative G1
G2: Type -> Type
H4: Map G2
H5: Pure G2
H6: Mult G2
H3: Applicative G2
A, A', A'': Type
g: A' -> G2 A''
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (map G1 (traverse g) ∘ traverse f) rest =
traverse (g ⋆2 f) rest
pure G1 (compose (traverse g) ∘ Step A' B C) <⋆>
traverse f rest <⋆> f a =
pure G1
  (precompose g
   ○ precompose (traverse g)
       (ap G2 ○ ap G2 (pure G2 (Step A'' B C)))) <⋆>
traverse f rest <⋆> f a
    reflexivity.
Qed.

Lemma trf_traverse_morphism_Batch:
  forall (B C: Type) (G1 G2: Type -> Type)
    `{ApplicativeMorphism G1 G2 ϕ},
  forall (A A': Type) (f: A -> G1 A'),
    ϕ (BATCH1 B C A') ∘ traverse (T := BATCH1 B C) (G := G1) f =
      traverse (T := BATCH1 B C) (G := G2) (ϕ A' ∘ f).
forall (B C : Type) (G1 G2 : Type -> Type)
  (H : Map G1) (H0 : Mult G1) (H1 : Pure G1)
  (H2 : Map G2) (H3 : Mult G2) (H4 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A A' : Type) (f : A -> G1 A'),
ϕ (BATCH1 B C A') ∘ traverse f = traverse (ϕ A' ∘ f)
Proof.
forall (B C : Type) (G1 G2 : Type -> Type)
  (H : Map G1) (H0 : Mult G1) (H1 : Pure G1)
  (H2 : Map G2) (H3 : Mult G2) (H4 : Pure G2)
  (ϕ : forall A : Type, G1 A -> G2 A),
ApplicativeMorphism G1 G2 ϕ ->
forall (A A' : Type) (f : A -> G1 A'),
ϕ (BATCH1 B C A') ∘ traverse f = traverse (ϕ A' ∘ f)
  intros.
B, C: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
ϕ (BATCH1 B C A') ∘ traverse f = traverse (ϕ A' ∘ f) ext b.
B, C: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
b: Batch A B C
(ϕ (Batch A' B C) ∘ traverse f) b =
traverse (ϕ A' ∘ f) b
  induction b as [C c | C rest IHrest].
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
c: C
(ϕ (Batch A' B C) ∘ traverse f) (Done A B C c) =
traverse (ϕ A' ∘ f) (Done A B C c)
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
(ϕ (Batch A' B C) ∘ traverse f) (rest ⧆ a) =
traverse (ϕ A' ∘ f) (rest ⧆ a)
  -
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
c: C
(ϕ (Batch A' B C) ∘ traverse f) (Done A B C c) =
traverse (ϕ A' ∘ f) (Done A B C c) unfold compose; cbn.
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
c: C
ϕ (Batch A' B C) (pure G1 (Done A' B C c)) =
pure G2 (Done A' B C c)
    now rewrite appmor_pure.
  -
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
(ϕ (Batch A' B C) ∘ traverse f) (rest ⧆ a) =
traverse (ϕ A' ∘ f) (rest ⧆ a) cbn.
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
(ϕ (Batch A' B C) ∘ traverse f) (rest ⧆ a) =
pure G2 (Step A' B C) <⋆>
Traverse_Batch1 B (B -> C) G2 H2 H4 H3 A A' (ϕ A' ∘ f)
  rest <⋆> (ϕ A' ∘ f) a
    unfold compose at 1.
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B C) (traverse f (rest ⧆ a)) =
pure G2 (Step A' B C) <⋆>
Traverse_Batch1 B (B -> C) G2 H2 H4 H3 A A' (ϕ A' ∘ f)
  rest <⋆> (ϕ A' ∘ f) a cbn.
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B C)
  (pure G1 (Step A' B C) <⋆>
   Traverse_Batch1 B (B -> C) G1 H H1 H0 A A' f rest <⋆>
   f a) =
pure G2 (Step A' B C) <⋆>
Traverse_Batch1 B (B -> C) G2 H2 H4 H3 A A' (ϕ A' ∘ f)
  rest <⋆> (ϕ A' ∘ f) a
    change (Traverse_Batch1 B (B -> C))
      with (@traverse (BATCH1 B (B -> C)) _).
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B C)
  (pure G1 (Step A' B C) <⋆> traverse f rest <⋆> f a) =
pure G2 (Step A' B C) <⋆> traverse (ϕ A' ∘ f) rest <⋆>
(ϕ A' ∘ f) a
    rewrite <- IHrest.
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B C)
  (pure G1 (Step A' B C) <⋆> traverse f rest <⋆> f a) =
pure G2 (Step A' B C) <⋆>
(ϕ (Batch A' B (B -> C)) ∘ traverse f) rest <⋆>
(ϕ A' ∘ f) a
    rewrite <- (appmor_pure (F := G1) (G := G2)).
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B C)
  (pure G1 (Step A' B C) <⋆> traverse f rest <⋆> f a) =
ϕ (Batch A' B (B -> C) -> A' -> Batch A' B C)
  (pure G1 (Step A' B C)) <⋆>
(ϕ (Batch A' B (B -> C)) ∘ traverse f) rest <⋆>
(ϕ A' ∘ f) a
    rewrite (ap_morphism_1 (ϕ := ϕ)).
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (A' -> Batch A' B C)
  (pure G1 (Step A' B C) <⋆> traverse f rest) <⋆>
ϕ A' (f a) =
ϕ (Batch A' B (B -> C) -> A' -> Batch A' B C)
  (pure G1 (Step A' B C)) <⋆>
(ϕ (Batch A' B (B -> C)) ∘ traverse f) rest <⋆>
(ϕ A' ∘ f) a
    rewrite (ap_morphism_1 (ϕ := ϕ)).
B: Type
G1, G2: Type -> Type
H: Map G1
H0: Mult G1
H1: Pure G1
H2: Map G2
H3: Mult G2
H4: Pure G2
ϕ: forall A : Type, G1 A -> G2 A
H5: ApplicativeMorphism G1 G2 ϕ
A, A': Type
f: A -> G1 A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: (ϕ (Batch A' B (B -> C)) ∘ traverse f) rest =
traverse (ϕ A' ∘ f) rest
ϕ (Batch A' B (B -> C) -> A' -> Batch A' B C)
  (pure G1 (Step A' B C)) <⋆>
ϕ (Batch A' B (B -> C)) (traverse f rest) <⋆>
ϕ A' (f a) =
ϕ (Batch A' B (B -> C) -> A' -> Batch A' B C)
  (pure G1 (Step A' B C)) <⋆>
(ϕ (Batch A' B (B -> C)) ∘ traverse f) rest <⋆>
(ϕ A' ∘ f) a
    reflexivity.
Qed.

(** *** Typeclass Instance *)
(**********************************************************************)
#[export] Instance TraversableFunctor_Batch: forall (B C: Type),
    TraversableFunctor (BATCH1 B C) :=
  fun B C =>
    {| trf_traverse_id := trf_traverse_id_Batch B C;
       trf_traverse_traverse := @trf_traverse_traverse_Batch B C;
       trf_traverse_morphism := @trf_traverse_morphism_Batch B C;
    |}.

(** *** Compatibility with <<map>> *)
(**********************************************************************)
Lemma map_compat_traverse_Batch1: forall (B C: Type),
    @map (BATCH1 B C) _ =
      @traverse (BATCH1 B C) _ (fun A => A) Map_I Pure_I Mult_I.
forall B C : Type,
@map BATCH1 B C Map_Batch1 =
@traverse BATCH1 B C (Traverse_Batch1 B C)
  (fun A : Type => A) Map_I Pure_I Mult_I
Proof.
forall B C : Type,
@map BATCH1 B C Map_Batch1 =
@traverse BATCH1 B C (Traverse_Batch1 B C)
  (fun A : Type => A) Map_I Pure_I Mult_I
  intros.
B, C: Type
@map BATCH1 B C Map_Batch1 =
@traverse BATCH1 B C (Traverse_Batch1 B C)
  (fun A : Type => A) Map_I Pure_I Mult_I
  ext A A' f b.
B, C, A, A': Type
f: A -> A'
b: Batch A B C
map BATCH1 B C f b = traverse f b
  induction b as [C c | C rest IHrest a].
B, A, A': Type
f: A -> A'
C: Type
c: C
map BATCH1 B C f (Done A B C c) =
traverse f (Done A B C c)
B, A, A': Type
f: A -> A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map BATCH1 B (B -> C) f rest =
traverse f rest
map BATCH1 B C f (rest ⧆ a) = traverse f (rest ⧆ a)
  -
B, A, A': Type
f: A -> A'
C: Type
c: C
map BATCH1 B C f (Done A B C c) =
traverse f (Done A B C c) reflexivity.
  -
B, A, A': Type
f: A -> A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map BATCH1 B (B -> C) f rest =
traverse f rest
map BATCH1 B C f (rest ⧆ a) = traverse f (rest ⧆ a) cbn.
B, A, A': Type
f: A -> A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map BATCH1 B (B -> C) f rest =
traverse f rest
mapfst_Batch A A' f rest ⧆ f a =
pure (fun A : Type => A) (Step A' B C)
  (Traverse_Batch1 B (B -> C) (fun A : Type => A)
     Map_I Pure_I Mult_I A A' f rest) (f a)
    change (Traverse_Batch1 B (B -> C)) with
      (@traverse (BATCH1 B (B -> C)) _).
B, A, A': Type
f: A -> A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map BATCH1 B (B -> C) f rest =
traverse f rest
mapfst_Batch A A' f rest ⧆ f a =
pure (fun A : Type => A) (Step A' B C)
  (traverse f rest) (f a)
    rewrite <- IHrest.
B, A, A': Type
f: A -> A'
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: map BATCH1 B (B -> C) f rest =
traverse f rest
mapfst_Batch A A' f rest ⧆ f a =
pure (fun A : Type => A) (Step A' B C)
  (map BATCH1 B (B -> C) f rest) (f a)
    reflexivity.
Qed.

#[export] Instance Compat_Map_Traverse_Batch1:
  forall B C, @Compat_Map_Traverse (BATCH1 B C) _ _.
forall B C : Type, Compat_Map_Traverse BATCH1 B C
Proof.
forall B C : Type, Compat_Map_Traverse BATCH1 B C
  intros.
B, C: Type
Compat_Map_Traverse BATCH1 B C hnf.
B, C: Type
Map_Batch1 = DerivedOperations.Map_Traverse BATCH1 B C
  ext X Y f.
B, C, X, Y: Type
f: X -> Y
Map_Batch1 X Y f =
DerivedOperations.Map_Traverse BATCH1 B C X Y f
  change_left (map (BATCH1 B C) f).
B, C, X, Y: Type
f: X -> Y
map BATCH1 B C f =
DerivedOperations.Map_Traverse BATCH1 B C X Y f
  rewrite map_compat_traverse_Batch1.
B, C, X, Y: Type
f: X -> Y
traverse f =
DerivedOperations.Map_Traverse BATCH1 B C X Y f
  reflexivity.
Qed.

(** ** <<runBatch>> Characterized by <<traverse>> *)
(**********************************************************************)
Lemma runBatch_via_traverse {A B: Type}
  {F: Type -> Type}
  `{Map F} `{Mult F} `{Pure F} `{! Applicative F}
  (ϕ: A -> F B) (C: Type):
  runBatch F ϕ C =
    map F extract_Batch ∘ traverse (G := F) (T := BATCH1 B C) ϕ.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
runBatch F ϕ C = map F extract_Batch ∘ traverse ϕ
Proof.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
runBatch F ϕ C = map F extract_Batch ∘ traverse ϕ
  intros.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
runBatch F ϕ C = map F extract_Batch ∘ traverse ϕ ext b.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
b: Batch A B C
runBatch F ϕ C b =
(map F extract_Batch ∘ traverse ϕ) b
  induction b as [C c | C rest IHrest].
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
c: C
runBatch F ϕ C (Done A B C c) =
(map F extract_Batch ∘ traverse ϕ) (Done A B C c)
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
runBatch F ϕ C (rest ⧆ a) =
(map F extract_Batch ∘ traverse ϕ) (rest ⧆ a)
  -
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
c: C
runBatch F ϕ C (Done A B C c) =
(map F extract_Batch ∘ traverse ϕ) (Done A B C c) unfold compose; cbn.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
c: C
pure F c = map F extract_Batch (pure F (Done B B C c))
    rewrite app_pure_natural.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
c: C
pure F c = pure F (extract_Batch (Done B B C c))
    reflexivity.
  -
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
runBatch F ϕ C (rest ⧆ a) =
(map F extract_Batch ∘ traverse ϕ) (rest ⧆ a) cbn.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
runBatch F ϕ (B -> C) rest <⋆> ϕ a =
(map F extract_Batch ∘ traverse ϕ) (rest ⧆ a)
    rewrite IHrest.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
(map F extract_Batch ∘ traverse ϕ) rest <⋆> ϕ a =
(map F extract_Batch ∘ traverse ϕ) (rest ⧆ a)
    unfold compose; cbn.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
map F extract_Batch (traverse ϕ rest) <⋆> ϕ a =
map F extract_Batch
  (pure F (Step B B C) <⋆>
   Traverse_Batch1 B (B -> C) F H H1 H0 A B ϕ rest <⋆>
   ϕ a)
    fold (@traverse (BATCH1 B (B -> C)) _).
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
map F extract_Batch (traverse ϕ rest) <⋆> ϕ a =
map F extract_Batch
  (pure F (Step B B C) <⋆> traverse ϕ rest <⋆> ϕ a)
    rewrite map_ap.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
map F extract_Batch (traverse ϕ rest) <⋆> ϕ a =
map F (compose extract_Batch)
  (pure F (Step B B C) <⋆> traverse ϕ rest) <⋆> ϕ a
    rewrite map_ap.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
map F extract_Batch (traverse ϕ rest) <⋆> ϕ a =
map F (compose (compose extract_Batch))
  (pure F (Step B B C)) <⋆> traverse ϕ rest <⋆> ϕ a
    rewrite app_pure_natural.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
map F extract_Batch (traverse ϕ rest) <⋆> ϕ a =
pure F (compose extract_Batch ∘ Step B B C) <⋆>
traverse ϕ rest <⋆> ϕ a
    rewrite map_to_ap.
A, B: Type
F: Type -> Type
H: Map F
H0: Mult F
H1: Pure F
Applicative0: Applicative F
ϕ: A -> F B
C: Type
rest: Batch A B (B -> C)
a: A
IHrest: runBatch F ϕ (B -> C) rest =
(map F extract_Batch ∘ traverse ϕ) rest
pure F extract_Batch <⋆> traverse ϕ rest <⋆> ϕ a =
pure F (compose extract_Batch ∘ Step B B C) <⋆>
traverse ϕ rest <⋆> ϕ a
    reflexivity.
Qed.

(** * Notations *)
(**********************************************************************)
Module Notations.
  Infix "⧆" :=
    (Step _ _ _) (at level 51, left associativity): tealeaves_scope.
End Notations.

(** * Arguments *)
(**********************************************************************)
#[global] Arguments runBatch {A B}%type_scope {G}%function_scope
  {H H0 H1} f%function_scope {C}%type_scope b: rename.
#[global] Arguments mapfst_Batch {B C A1 A2}%type_scope
  f%function_scope b.
#[global] Arguments mapsnd_Batch {A B1 B2 C}%type_scope
  f%function_scope b.