ITree.EqmR.Monads.Error

EqmR-related laws for the error monad.



Definition error (exn A : Type) : Type :=
  sum exn A.

Section Error.
  Variable exn : Type.

  Global Instance Monad_error : Monad (error exn) :=
    {|
      ret := fun (t : Type) (X : t) => inr X;
      bind :=
        fun (t u : Type) (X : error exn t) (X0 : t -> error exn u) =>
        match X with
        | inl e => inl e
        | inr t0 => X0 t0
        end
    |}.

  Global Instance EqmR_error : EqmR (error exn) :=
    {| eqmR :=
         fun A B R x y => match x, y with
                   | inl _, inl _ => True
                   | inr r1, inr r2 => R r1 r2
                   | _, _ => False
                   end |}.

  Global Instance eqmR_transport_PER_error : TransportPER (error exn).
  Proof.
    intros A R PER_R. split.
    - intros PA PB. repeat intro. destruct PA, PB; try inv H.
      all : red; auto.
      red in H. symmetry; auto.
    - intros PA PB PC. repeat intro. destruct PA, PB, PC; try inv H; auto.
      red in H, H0. cbn. etransitivity; eauto.
  Qed.

  Global Instance eqmR_transport_Equiv_error : TransportEquiv (error exn).
  Proof.
    split. 2, 3 : apply eqmR_transport_PER_error; typeclasses eauto.
    repeat intro. repeat red. destruct x. eauto. reflexivity.
  Qed.

  Global Instance eqmR_rel_comp_error : RelComp (error exn).
  Proof.
    repeat intro. destruct ma, mb, mc; try inv H; try inv H0; cbn; auto.
    econstructor; constructor; eauto.
  Qed.

  Global Instance eqmR_prod_fst_inv_error : FmapFst (error exn).
  Proof.
    repeat intro. destruct m1, m2; try inv H; auto. cbn. auto.
  Qed.

  Global Instance eqmR_prod_snd_inv_error : FmapSnd (error exn).
  Proof.
    repeat intro. destruct m1, m2; try inv H; auto. cbn. auto.
  Qed.

  Global Instance eqmR_prod_rel_error : RelProd (error exn).
  Proof.
    repeat intro. destruct m1, m2; try inv H; try inv H0; auto; cbn; auto.
    destruct p, p0. cbn in *. constructor; auto.
  Qed.

  Global Instance eqmR_sum_inl_error : FmapInl (error exn).
  Proof.
    repeat intro. destruct m1, m2; try inv H; try inv H0; auto; cbn; auto.
  Qed.

  Global Instance eqmR_sum_inr_error : FmapInr (error exn).
  Proof.
    repeat intro. destruct m1, m2; try inv H; try inv H0; auto; cbn; auto.
  Qed.

  Global Instance eqmR_sum_rel_error : RelSum (error exn).
  Proof.
    repeat intro. split; intros; destruct m1, m2; cbn in *; eauto.
    4 : destruct s, s0; cbn in *; eauto; eapply H; repeat intro ;eauto.
    destruct s, s0; inv H; eauto.
    1, 2 :specialize (H (A1 + B1)%type (A2 + B2)%type inl inl inr inr (RA RB));
      eapply H; repeat intro; eauto.
  Qed.

  Global Instance eqmR_conj_error : RelConj (error exn).
  Proof.
    repeat intro. destruct ma, mb; eauto. constructor; eauto.
  Qed.

  Global Instance eqmR_lift_transpose_error : LiftTranspose (error exn).
  Proof.
    repeat intro. split; repeat intro; destruct x, y; cbn in *; eauto.
  Qed.

  Global Instance eqmR_Proper_error : forall A B : Type, Proper ((@eq_rel A B) ==> eq_rel) eqmR.
  Proof.
    repeat intro. destruct H. split; repeat intro; destruct x0, y0; cbn in *; eauto.
  Qed.

  Global Instance eqmR_Proper_mono :
    forall A B : Type, Proper (subrelationH (A:=A)(B:=B) ==> subrelationH (B:=error exn B)) eqmR.
  Proof.
    repeat intro. destruct x0, y0; cbn in *; eauto.
  Qed.

  Instance transport_refl : TransportReflexive (error exn).
  Proof.
    repeat intro; repeat red; destruct x; eauto.
  Qed.

  Instance transport_symm : TransportSymmetric (error exn).
  Proof.
    repeat intro; repeat red; destruct x, y; eauto.
  Qed.

  Instance transport_trans : TransportTransitive (error exn).
  Proof.
    repeat intro; repeat red; destruct x, y, z; eauto. destruct H0.
  Qed.

  Global Instance EqmR_OK_error : EqmR_OK (error exn).
  Proof.
    constructor; try typeclasses eauto.
  Qed.

  Lemma PER_bot : forall A, PER (A := A) (fun _ _ => False).
  Proof.
    split; repeat intro; try contradiction.
  Qed.

  Lemma mayRet_error :
    forall A (a :A) (ma : error exn A), a ma -> ma = inr a.
  Proof.
    intros. destruct ma.
    - specialize (H _ (PER_bot _) I). inv H.
    - f_equiv. repeat red in H.
      specialize (H (singletonR a0)).
      cbn in *. destruct H; eauto.
      split. apply singletonR_SymmetricH. apply singletonR_TransitiveH.
      constructor; auto.
  Qed.

  Lemma mayRet_ret_error :
    forall A (a :A), a ret a.
  Proof.
    intros. repeat intro. apply EQR.
  Qed.

  Ltac errtac :=
    match goal with
    | [H : ?a ?ma |- _] => apply mayRet_error in H; subst
    end.

  Global Instance eqmR_mayRet_l_error : MayRetL (error exn).
  Proof.
    repeat intro.
    errtac.
    destruct ma2; cbn in *. inv EQH. esplit; split; eauto.
    apply mayRet_ret_error.
  Qed.

  Global Instance eqmR_mayRet_r_error : MayRetR (error exn).
  Proof.
    repeat intro.
    errtac.
    destruct ma1; cbn in *. inv EQH. esplit; split; eauto.
    apply mayRet_ret_error.
  Qed.

  Global Instance eqmR_ret_error : RetFinal (error exn).
  Proof.
    repeat intro. apply H.
  Qed.

  Global Instance eqmR_bind_ProperH_error : ProperBind (error exn).
  Proof.
    repeat intro. destruct ma1, ma2; try inv H. cbn; auto.
    cbn. cbn in H. specialize (H0 _ _ H).
    eauto.
  Qed.

  Global Instance eqmR_bind_ret_l_error : BindRetL (error exn).
  Proof.
    repeat intro. cbn. destruct (f a); eauto.
  Qed.

  Global Instance eqmR_bind_ret_r_error : BindRetR (error exn).
  Proof.
    repeat intro. cbn. destruct (ma); eauto.
  Qed.

  Global Instance eqmR_bind_bind_error : BindBind (error exn).
  Proof.
    repeat intro. cbn. destruct (ma); eauto.
    destruct (f a); eauto. destruct (g b); eauto.
  Qed.

  Global Instance EqmRMonad_error : EqmRMonadLaws (error exn).
  Proof.
    constructor; try typeclasses eauto.
    repeat intro. cbn. destruct ma; eauto.
    repeat intro. apply EQR.
  Qed.

  Global Instance eqmR_ret_inv_error : RetInv (error exn).
  Proof.
    repeat intro. apply H.
  Qed.

  Global Instance mayRet_bind_inv_error : MayRetBindInv (error exn).
  Proof.
    repeat intro. errtac. cbn in *. destruct ma. inv H. exists a.
    split; try rewrite H; apply mayRet_ret_error.
  Qed.

  Global Instance fmap_inv_mayRet_error : FmapInvRet (error exn).
  Proof.
    repeat intro. errtac. cbn in *. auto.
  Qed.

  Global Instance fmap_inv_error : FmapInv_mayRet (error exn).
  Proof.
    repeat intro. cbn in *. destruct ma1, ma2; cbn in *; eauto.
    split; eauto. red. split; apply mayRet_ret_error.
  Qed.

  Global Instance eqmR_inv_error : EqmRInv (error exn).
  repeat intro. cbn in *. apply mayRet_error in H0. subst. auto.
  Qed.

  Global Instance EqmRMonadInverses_error : EqmRInversionProperties (error exn).
  Proof.
    constructor; try typeclasses eauto.
  Qed.

End Error.