Module tag.
Inductive t :=
| Null : t
| Bool : bool -> t
| Num : nat -> t
| Str : String.string -> t
| Arr : t
| Obj : t.
(* tag serializer *)
Definition tag_serialize (t : t) : IOStreamWriter.t :=
match t with
| Null => serialize x00
| Bool b => IOStreamWriter.append (fun _ => serialize x01)
(fun _ => serialize b)
| Num n => IOStreamWriter.append (fun _ => serialize x02)
(fun _ => serialize n)
| Str s => IOStreamWriter.append (fun _ => serialize x03)
(fun _ => serialize s)
| Arr => serialize x04
| Obj => serialize x05
end.
Definition tag_deserialize : ByteListReader.t t :=
tag <- deserialize ;;
match tag with
| x00 => ByteListReader.ret Null
| x01 => Bool <$> deserialize
| x02 => Num <$> deserialize
| x03 => Str <$> deserialize
| x04 => ByteListReader.ret Arr
| x05 => ByteListReader.ret Obj
| _ => ByteListReader.error
end.
Proof using.
intros.
destruct a;
unfold tag_serialize, tag_deserialize;
cheerios_crush;
unfold app;
cheerios_crush.
Qed.
Instance tag_Serializer : Serializer t.
(* json <-> tree tag conversion *)
Fixpoint json_treeify (j : json.t) : tree tag.t :=
let fix obj_list_to_tree_list (l : list (String.string * json.t)) :=
match l with
| [] => []
| (s, j) :: l => atom (tag.Str s)
:: json_treeify j
:: obj_list_to_tree_list l
end
in
match j with
| json.Null => atom tag.Null
| json.Bool b => atom (tag.Bool b)
| json.Num n => atom (tag.Num n)
| json.String s => atom (tag.Str s)
| json.Arr l => node (atom tag.Arr :: List.map json_treeify l)
| json.Obj l => node (atom tag.Obj :: obj_list_to_tree_list l)
end.
Definition obj_list_to_tree_list :=
fix obj_list_to_tree_list (l : list (String.string * json.t)) :
list (tree tag.t) :=
match l with
| [] => []
| (s, j) :: l => atom (tag.Str s) :: json_treeify j :: obj_list_to_tree_list l
end.
Fixpoint json_untreeify (t : tree tag.t) : option json.t :=
let fix untreeify_list (l : list (tree tag.t)) : option (list json.t) :=
match l with
| [] => Some []
| x :: l => match json_untreeify x with
| None => None
| Some y => match untreeify_list l with
| None => None
| Some l => Some (y :: l)
end
end
end in
let fix untreeify_obj_list (l : list (tree tag.t)) :
option (list (String.string * json.t)) :=
match l with
| [] => Some []
| atom (tag.Str s) :: t :: l =>
match json_untreeify t with
| None => None
| Some j => match untreeify_obj_list l with
| None => None
| Some l => Some ((s, j) :: l)
end
end
| _ => None
end in
match t with
| atom (tag.Num n) => Some (json.Num n)
| atom (tag.Bool b) => Some (json.Bool b)
| atom (tag.Str s) => Some (json.String s)
| node (atom tag.Arr :: l) => match untreeify_list l with
| None => None
| Some l => Some (json.Arr l)
end
| atom (tag.Null) => Some (json.Null)
| node (atom tag.Obj :: l) => match untreeify_obj_list l with
| None => None
| Some l => Some (json.Obj l)
end
| _ => None
end.
Definition untreeify_obj_list :=
fix untreeify_obj_list (l : list (tree tag.t)) :
option (list (String.string * json.t)) :=
match l with
| [] => Some []
| atom (tag.Str s) :: t :: l =>
match json_untreeify t with
| None => None
| Some j => match untreeify_obj_list l with
| None => None
| Some l => Some ((s, j) :: l)
end
end
| _ => None
end.
Definition untreeify_list :=
fix untreeify_list l : option (list json.t) :=
match l with
| [] => Some []
| x :: l => match json_untreeify x with
| None => None
| Some y => match untreeify_list l with
| None => None
| Some l => Some (y :: l)
end
end
end.
Definition treeify_untreeify_aux (j : json.t) :=
json_untreeify (json_treeify j) = Some j.
Proof using.
induction j using json.json_rect with
(P_list := fun l => untreeify_list (List.map json_treeify l) = Some l)
(P_list' := fun l => untreeify_obj_list (obj_list_to_tree_list l) = Some l);
unfold treeify_untreeify_aux;
auto;
simpl;
try (fold untreeify_list);
try (fold untreeify_obj_list);
try (fold obj_list_to_tree_list);
try (rewrite IHj);
try (rewrite IHj0);
auto.
Qed.
Definition json_serialize (j : json.t) : IOStreamWriter.t :=
serialize (json_treeify j).
Definition json_deserialize : ByteListReader.t json.t :=
j <- deserialize;;
match json_untreeify j with
| Some j => ByteListReader.ret j
| None => ByteListReader.error
end.
Proof using.
intros.
unfold json_serialize, json_deserialize.
cheerios_crush.
rewrite treeify_untreeify_id.
cheerios_crush.
Qed.
Instance json_Serializer : Serializer json.t.
End tag.
Definition string_eqb s s' :=
if (String.string_dec s s') then true else false.
Proof using.
intros.
unfold string_eqb in H.
destruct (String.string_dec s s').
+ assumption.
+ congruence.
Qed.
Proof using.
intros.
unfold string_eqb.
destruct (String.string_dec s s); congruence.
Qed.
Fixpoint json_eqb (j j' : json.t) : bool :=
let fix loop_arr (l l': list json.t) : bool :=
match (l, l') with
| ([], []) => true
| (j :: l, j' :: l') => andb (json_eqb j j') (loop_arr l l')
| (_, _) => false
end in
let fix loop_obj (l l' : list (String.string * json.t)) : bool :=
match (l, l') with
| ([], []) => true
| ((s, j) :: l, (s', j') :: l') => andb (string_eqb s s')
(andb (json_eqb j j')
(loop_obj l l'))
| (_, _) => false
end in
match (j, j') with
| (json.Null, json.Null) => true
| (json.Bool b, json.Bool b') => Bool.eqb b b'
| (json.Num n, json.Num n') => Nat.eqb n n'
| (json.String s, json.String s') => string_eqb s s'
| (json.Arr l, json.Arr l') => loop_arr l l'
| (json.Obj l, json.Obj l') => loop_obj l l'
| _ => false
end.
Definition loop_arr :=
fix loop_arr (l l': list json.t) : bool :=
match (l, l') with
| ([], []) => true
| (j :: l, j' :: l') => andb (json_eqb j j') (loop_arr l l')
| (_, _) => false
end.
Definition loop_obj :=
fix loop_obj (l l' : list (String.string * json.t)) : bool :=
match (l, l') with
| ([], []) => true
| ((s, j) :: l, (s', j') :: l') => andb (string_eqb s s')
(andb (json_eqb j j') (loop_obj l l'))
| (_, _) => false
end.
Proof using.
induction j using json.json_rect with (P_list := fun l =>
forall l', loop_arr l l' = true -> l = l')
(P_list' := fun l =>
forall l', loop_obj l l' = true -> l = l');
unfold json_eqb.
- intros.
destruct l'.
+ reflexivity.
+ simpl in H. congruence.
- intros.
destruct l'.
+ simpl in H. congruence.
+ simpl in H.
apply Bool.andb_true_iff in H.
assert (j = t).
* apply IHj. apply H.
* assert (l = l').
-- apply IHj0. apply H.
-- now rewrite H0, H1.
- intros.
destruct l'.
* reflexivity.
* simpl in H. congruence.
- intros.
destruct l'; simpl in H.
+ congruence.
+ destruct p.
apply Bool.andb_true_iff in H. destruct H.
apply Bool.andb_true_iff in H0. destruct H0.
assert (s = s0). now apply string_eqb_true in H.
assert (j = t). apply (IHj t H0).
assert (l = l'). apply (IHj0 _ H1).
now rewrite H2, H3, H4.
- destruct j'; try congruence.
- destruct j'; try congruence.
intros.
apply Bool.eqb_prop in H.
now rewrite H.
- destruct j'; try congruence.
intros.
apply EqNat.beq_nat_true in H.
now rewrite H.
- destruct j'; try congruence.
intros.
apply string_eqb_true in H.
now rewrite H.
- fold json_eqb.
fold loop_arr.
destruct j'; try congruence.
intros.
apply IHj in H.
now rewrite H.
- fold json_eqb.
fold loop_obj.
destruct j'; try congruence.
intros.
apply IHj in H.
now rewrite H.
Qed.
Proof using.
induction j using json.json_rect with (P_list := fun l => loop_arr l l = true)
(P_list' := fun l => loop_obj l l = true).
- reflexivity.
- simpl.
specialize IHj with j.
rewrite IHj0.
rewrite IHj; reflexivity.
- reflexivity.
- simpl.
rewrite string_eqb_refl, IHj0.
rewrite IHj; auto.
- intros. now rewrite <- H.
- intros. rewrite <- H. simpl.
apply Bool.eqb_reflx.
- intros. rewrite <- H. simpl.
symmetry.
apply EqNat.beq_nat_refl.
- intros.
rewrite <- H.
simpl.
apply string_eqb_refl.
- intros.
rewrite <- H.
simpl.
assumption.
- intros.
rewrite <- H.
simpl.
assumption.
Qed.

Lemma json_eq_dec : forall j j' : json.t, {j = j'} + {j <> j'}.