Commit 8d394a0c authored by Loïc Correnson's avatar Loïc Correnson
Browse files

[server] added Jtag for light enums

parent 75b7205a
......@@ -74,6 +74,7 @@ let makeJtype ?self ~names =
| Jnumber -> Format.pp_print_string fmt "number"
| Jboolean -> Format.pp_print_string fmt "boolean"
| Jstring | Jalpha -> Format.pp_print_string fmt "string"
| Jtag a -> Format.fprintf fmt "\"%s\"" a
| Jkey kd -> Format.fprintf fmt "Json.key<'#%s'>" kd
| Jindex kd -> Format.fprintf fmt "Json.index<'#%s'>" kd
| Jdict(kd,js) -> Format.fprintf fmt "Json.Dict<'#%s',%a>" kd pp js
......@@ -166,6 +167,7 @@ let rec makeDecoder ~safe ?self ~names fmt js =
| Jboolean -> jsafe ~safe "Boolean" jprim fmt "jBoolean"
| Jnumber -> jsafe ~safe "Number" jprim fmt "jNumber"
| Jstring | Jalpha -> jsafe ~safe "String" jprim fmt "jString"
| Jtag a -> Format.fprintf fmt "jTag(\"%s\")" a
| Jkey kd -> jsafe ~safe ("#" ^ kd) jkey fmt kd
| Jindex kd -> jsafe ~safe ("#" ^ kd) jindex fmt kd
| Jdata id -> jcall names fmt (Pkg.Derived.decode ~safe id)
......@@ -223,8 +225,6 @@ let makeOrder ~self ~names fmt js =
| Jdata id -> jcall names fmt (Pkg.Derived.order id)
| Joption js ->
Format.fprintf fmt "@[<hov 2>Compare.defined(@,%a)@]" pp js
| Jany | Junion _ -> (* Can not find a better solution *)
Format.fprintf fmt "Compare.structural"
| Jenum id ->
Format.fprintf fmt "@[<hov 2>Compare.byEnum(@,%a)@]" (jcall names) id
| Jlist js | Jarray js ->
......@@ -250,6 +250,8 @@ let makeOrder ~self ~names fmt js =
Format.fprintf fmt
"@[<hov 2>Compare.dictionary<@,Json.dict<'#%s'@,%a>>(@,%a)@]"
kd jtype js pp js
| Jany | Junion _ | Jtag _ ->
Format.fprintf fmt "Compare.structural"
in pp fmt js
(* -------------------------------------------------------------------------- *)
......
......@@ -118,6 +118,15 @@ export const jString: Loose<string> = (js: json) => (
typeof js === 'string' ? js : undefined
);
/** JSON constant.
Capture the tag or returns `undefined`.
Can be used with [[jUnion]], although [[jEnum]]
might be more efficient.
*/
export function jTag<A>(tg: A): Loose<A> {
return (js: json) => Object.is(js, tg) ? tg : undefined;
}
/**
Lookup tags in a dictionary.
Can be used directly for enum types, eg. `jEnum(myEnumType)`.
......
......@@ -166,6 +166,7 @@ type jtype =
| Jnumber
| Jstring
| Jalpha (* string primarily compared without case *)
| Jtag of string (* single constant string *)
| Jkey of string (* kind of a string used for indexing *)
| Jindex of string (* kind of an integer used for indexing *)
| Joption of jtype
......@@ -289,14 +290,14 @@ let rec isRecursive = function
| Jself -> true
| Jdata _ | Jenum _
| Jany | Jnull | Jboolean | Jnumber
| Jstring | Jalpha | Jkey _ | Jindex _ -> false
| Jstring | Jalpha | Jkey _ | Jindex _ | Jtag _ -> false
| Joption js | Jdict(_,js) | Jarray js | Jlist js -> isRecursive js
| Jtuple js | Junion js -> List.exists isRecursive js
| Jrecord fjs -> List.exists (fun (_,js) -> isRecursive js) fjs
let rec visit_jtype fn = function
| Jany | Jself | Jnull | Jboolean | Jnumber
| Jstring | Jalpha | Jkey _ | Jindex _ -> ()
| Jstring | Jalpha | Jkey _ | Jindex _ | Jtag _ -> ()
| Joption js | Jdict(_,js) | Jarray js | Jlist js -> visit_jtype fn js
| Jtuple js | Junion js -> List.iter (visit_jtype fn) js
| Jrecord fjs -> List.iter (fun (_,js) -> visit_jtype fn js) fjs
......@@ -447,7 +448,7 @@ let iter f =
let key kd = Md.plain (Printf.sprintf "`#%s`" kd)
let index kd = Md.plain (Printf.sprintf "`#0%s`" kd)
let escaped tag = Md.plain (Printf.sprintf "`\"%s\"`" @@ String.escaped tag)
let litteral tag = Md.plain (Printf.sprintf "`\"%s\"`" tag)
type pp = {
self: Md.text ;
......@@ -461,6 +462,7 @@ let rec md_jtype pp = function
| Jnumber -> Md.emph "number"
| Jboolean -> Md.emph "boolean"
| Jstring | Jalpha -> Md.emph "string"
| Jtag a -> litteral a
| Jkey kd -> key kd
| Jindex kd -> index kd
| Jdata id | Jenum id -> pp.ident id
......@@ -478,7 +480,7 @@ and md_jlist pp sep js =
and fields pp fjs =
Md.glue ~sep:(Md.plain ",") @@
List.map (fun (fd,js) ->
escaped fd @
litteral fd @
match js with
| Joption js -> Md.code ":?" @ md_jtype pp js
| _ -> Md.code ":" @ md_jtype pp js
......@@ -501,7 +503,7 @@ let md_tags ?(title="Tags") (tags : tagInfo list) =
] in
let row tg = [
tg.tg_label ;
escaped tg.tg_name ;
litteral tg.tg_name ;
tg.tg_descr ;
] in
Md.{ caption = None ; header ; content = List.map row tags }
......@@ -515,12 +517,12 @@ let md_fields ?(title="Field") pp (fields : fieldInfo list) =
let row f =
match f.fd_type with
| Joption js -> [
escaped (f.fd_name ^ "?") ;
litteral f.fd_name @ Md.plain "(opt.)" ;
md_jtype pp js ;
f.fd_descr ;
]
| _ -> [
escaped f.fd_name ;
litteral f.fd_name ;
md_jtype pp f.fd_type ;
f.fd_descr ;
]
......
......@@ -34,6 +34,7 @@ type jtype =
| Jnumber
| Jstring
| Jalpha (** string primarily compared without case *)
| Jtag of string (** single constant string *)
| Jkey of string (** kind of a string used for indexing *)
| Jindex of string (** kind of an integer used for indexing *)
| Joption of jtype
......@@ -222,7 +223,8 @@ type pp = {
ident: ident -> Markdown.text ;
}
val escaped : string -> Markdown.text
(** Quoted string *)
val litteral : string -> Markdown.text
val md_jtype : pp -> jtype -> Markdown.text
val md_tags : ?title:string -> tagInfo list -> Markdown.table
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment