Json_typed: inline Describe in case fields.

This commit is contained in:
Grégoire Henry 2018-05-29 14:18:05 +02:00
parent 09a039bfea
commit 49de4be9a1

View File

@ -88,9 +88,22 @@ and bounds =
maximum : float } maximum : float }
and _ field = and _ field =
| Req : { name: string ; encoding: 'a encoding } -> 'a field | Req : { name: string ;
| Opt : { name: string ; encoding: 'a encoding } -> 'a option field encoding: 'a encoding ;
| Dft : { name: string ; encoding: 'a encoding ; default: 'a } -> 'a field title: string option ;
description: string option ;
} -> 'a field
| Opt : { name: string ;
encoding: 'a encoding ;
title: string option ;
description: string option ;
} -> 'a option field
| Dft : { name: string ;
encoding: 'a encoding ;
title: string option ;
description: string option ;
default: 'a ;
} -> 'a field
and 't case = and 't case =
| Case : { encoding : 'a encoding ; | Case : { encoding : 'a encoding ;
@ -378,6 +391,13 @@ end
module Ezjsonm_encoding = Make (Json_repr.Ezjsonm) module Ezjsonm_encoding = Make (Json_repr.Ezjsonm)
let patch_description ?title ?description (elt : Json_schema.element) =
match title, description with
| None, None -> elt
| Some _, None -> { elt with title }
| None, Some _ -> { elt with description }
| Some _, Some _ -> { elt with title ; description }
let schema encoding = let schema encoding =
let open Json_schema in let open Json_schema in
let sch = ref any in let sch = ref any in
@ -392,11 +412,13 @@ let schema encoding =
| Conv (_, _, o, None) -> object_schema o | Conv (_, _, o, None) -> object_schema o
| Empty -> [ [], false ] | Empty -> [ [], false ]
| Ignore -> [ [], true ] | Ignore -> [ [], true ]
| Obj (Req { name = n ; encoding = t }) -> [ [ n, schema t, true, None ], false ] | Obj (Req { name = n ; encoding = t ; title ; description }) ->
| Obj (Opt { name = n ; encoding = t }) -> [ [ n, schema t, false, None ], false ] [ [ n, patch_description ?title ?description (schema t), true, None ], false ]
| Obj (Dft { name = n ; encoding = t ; default = d }) -> | Obj (Opt { name = n ; encoding = t ; title ; description }) ->
[ [ n, patch_description ?title ?description (schema t), false, None ], false ]
| Obj (Dft { name = n ; encoding = t ; title ; description ; default = d }) ->
let d = Json_repr.repr_to_any (module Json_repr.Ezjsonm) (Ezjsonm_encoding.construct t d) in let d = Json_repr.repr_to_any (module Json_repr.Ezjsonm) (Ezjsonm_encoding.construct t d) in
[ [ n, schema t, false, Some d], false ] [ [ n, patch_description ?title ?description (schema t), false, Some d], false ]
| Objs (o1, o2) -> | Objs (o1, o2) ->
prod (object_schema o1) (object_schema o2) prod (object_schema o1) (object_schema o2)
| Union [] -> | Union [] ->
@ -515,16 +537,12 @@ let schema encoding =
(*-- utility wrappers over the GADT ------------------------------------------*) (*-- utility wrappers over the GADT ------------------------------------------*)
let req ?title ?description n t = Req { name = n ; let req ?title ?description n t =
encoding = Req { name = n ; encoding = t ; title ; description }
Describe { title ; encoding = t ; description } } let opt ?title ?description n t =
let opt ?title ?description n t = Opt { name = n ; Opt { name = n ; encoding = t ; title ; description }
encoding = let dft ?title ?description n t d =
Describe { title ; encoding = t; description } } Dft { name = n ; encoding = t ; title ; description ; default = d }
let dft ?title ?description n t d = Dft { name = n ;
encoding =
Describe { title ; encoding = t ; description } ;
default = d }
let mu name self = Mu (name, self) let mu name self = Mu (name, self)
let null = Null let null = Null