Section Traversable.
Variable t : Type -> Type.
Variable traverse : KleeneCoalg (fun x => x) t.
Definition size a (x:t a) : nat := dim (traverse a a x).
Definition iso1 a (x: t a) : {x : t unit & Vector.t a (size x)} :=
let s := coalg traverse unit x in
existT (fun x : t unit => Vector.t a (size x)) (peek (k:=s) (Vector.const tt _))
(eq_rect _ (Vector.t a) (pos s) _ (eq_sym (dim_preservation _ _ _))).
Definition iso2 a (y : {x : t unit & Vector.t a (size x)}) : t a :=
let (t,s) := y in
peek (k:=coalg traverse a t) (eq_rect _ (Vector.t a) s _ (eq_sym (free_b_dim _ _ _ _))).
End Traversable.
(******************************************************************************)
Record Applicative := applicative
{ carrier :> Type -> Type
; pure : forall a, a -> carrier a
; ap : forall a b, carrier (a -> b) -> carrier a -> carrier b
; map := fun a b (f : a -> b) x => ap (pure f) x
; _ : forall (a : Type) x, map (fun (y : a) => y) x = x
; _ : forall a b c x y z,
ap (ap (map (fun (f : b -> c) (g : a -> b) (w:a) => f (g w)) x) y) z =
ap x (ap y z)
; _ : forall a b (f : a -> b) x, map f (pure x) = pure (f x)
; _ : forall a b (f : carrier (a -> b)) x,
ap f (pure x) = map (fun g => g x) f
}.
Fixpoint sequenceVector n a (F:Applicative) (v: Vector.t (F a) n) : F (Vector.t a n) :=
match v in Vector.t _ n return F (Vector.t a n) with
| Vector.nil => pure _ (Vector.nil _)
| Vector.cons h m t =>
ap (map (fun x => Vector.cons _ x m) h) (sequenceVector t)
end.
Definition traverseVector n a b (F:Applicative) (f : a -> F b) (v : Vector.t a n) : F (Vector.t b n) :=
sequenceVector (Vector.map f v).

Lemma homomorphism_law (F : Applicative) a b (f : a -> b) x :
ap (pure F f) (pure F x) = pure F (f x).