35
36:- module(json_convert,
37 [ prolog_to_json/2, 38 json_to_prolog/2, 39 (json_object)/1, 40 op(1150, fx, (json_object))
41 ]). 42:- use_module(library(error)). 43:- use_module(library(pairs)). 44:- use_module(library(apply)). 45:- use_module(json). 46
47:- meta_predicate
48 prolog_to_json(:, -),
49 json_to_prolog(+, :). 50
51:- public
52 clear_cache/0,
53 prolog_list_to_json/3, 54 prolog_to_json/3, 55 prolog_bool_to_json/2. 56
129
137
138:- multifile
139 json_object_to_pairs/3, 140 current_json_object/3. 141
167
168json_object(Declaration) :-
169 throw(error(context_error(nodirective, json_object(Declaration)), _)).
170
171
182
183compile_json_objects(Spec, Clauses) :-
184 phrase(compile_objects(Spec), Clauses).
185
186compile_objects(A) -->
187 { var(A),
188 !,
189 instantiation_error(A)
190 }.
191compile_objects((A,B)) -->
192 !,
193 compile_objects(A),
194 compile_objects(B).
195compile_objects(Term) -->
196 compile_object(Term).
197
198compile_object(ObjectDef) -->
199 { prolog_load_context(module, CM),
200 strip_module(CM:ObjectDef, M, Def),
201 extra_defs(Def, Term, ExtraFields),
202 Term =.. [Constructor|Args],
203 defaults(Args, Defs, TypedArgs),
204 types(TypedArgs, Names, Types)
205 },
206 record_to_json_clause(Constructor, M, Types, Names, ExtraFields),
207 current_clause(Constructor, M, Types, Defs, Names, ExtraFields),
208 [ (:- json_convert:clear_cache) ].
209
(Term+Extra0, Term, Extra) :-
211 !,
212 must_be(list, Extra0),
213 maplist(canonical_pair, Extra0, Extra).
214extra_defs(Term, Term, []).
215
216
217canonical_pair(Var, _) :-
218 var(Var),
219 !,
220 instantiation_error(Var).
221canonical_pair(Name=Value, Name=Value) :-
222 !,
223 must_be(atom, Name).
224canonical_pair(Name-Value, Name=Value) :-
225 !,
226 must_be(atom, Name).
227canonical_pair(NameValue, Name=Value) :-
228 NameValue =.. [Name,Value],
229 !.
230canonical_pair(Pair, _) :-
231 type_error(pair, Pair).
232
233
238
239record_to_json_clause(Constructor, Module, Types, Names, Extra) -->
240 { type_checks(Types, VarsHead, VarsBody, Body0, Module),
241 clean_body(Body0, Body),
242 Term =.. [Constructor|VarsHead],
243 make_pairs(Names, VarsBody, Pairs, Extra),
244 Head =.. [json_object_to_pairs,Term,Module,json(Pairs)]
245 },
246 [ (json_convert:(Head :- Body)) ].
247
248
258
259type_checks([], [], [], true, _).
260type_checks([Type|T], [IV|IVars], [OV|OVars], (Goal, Body), M) :-
261 !,
262 type_check(Type, IV, OV, M, Goal),
263 type_checks(T, IVars, OVars, Body, M).
264
265type_check(any, IV, OV, M, prolog_to_json(IV, OV, M)) :- !.
266type_check(Name/Arity, IV, OV, M, prolog_to_json(IV, OV, M)) :-
267 !,
268 functor(IV, Name, Arity).
269type_check(boolean, IV, OV, _, prolog_bool_to_json(IV, OV)) :- !.
270type_check(list, IV, OV, M, prolog_list_to_json(IV, OV, M)) :- !.
271type_check(list(any), IV, OV, M, prolog_list_to_json(IV, OV, M)) :- !.
272type_check(list(_Type), IV, OV, M, prolog_list_to_json(IV, OV, M)) :- !.
273type_check(Type, V, V, _, Goal) :-
274 type_goal(Type, V, Goal).
275
276
284
285prolog_bool_to_json(Var, _) :-
286 var(Var),
287 instantiation_error(Var).
288prolog_bool_to_json(true, @(true)).
289prolog_bool_to_json(false, @(false)).
290prolog_bool_to_json(fail, @(false)).
291prolog_bool_to_json(0, @(false)).
292prolog_bool_to_json(on, @(true)).
293prolog_bool_to_json(off, @(false)).
294prolog_bool_to_json(1, @(false)).
295prolog_bool_to_json(@(True), True) :-
296 prolog_bool_to_json(True, True).
297
298
302
303type_goal(Type, Var, Body) :-
304 current_type(Type, Var, Body0),
305 primitive(Body0, Body),
306 !.
307type_goal(Type, Var, is_of_type(Type, Var)).
308
309primitive((A0,B0), (A,B)) :-
310 !,
311 primitive(A0, A),
312 primitive(B0, B).
313primitive((A0;B0), (A,B)) :-
314 !,
315 primitive(A0, A),
316 primitive(B0, B).
317primitive((A0->B0), (A,B)) :-
318 !,
319 primitive(A0, A),
320 primitive(B0, B).
321primitive(_:G, G) :-
322 !,
323 predicate_property(system:G, built_in).
324primitive(G, G) :-
325 predicate_property(system:G, built_in).
326
327non_json_type(Type) :-
328 current_type(Type, _, _),
329 !.
330
331
337
338clean_body(Var, Var) :-
339 var(Var),
340 !.
341clean_body((A0,B0), G) :-
342 !,
343 clean_body(A0, A),
344 clean_body(B0, B),
345 conj(A, B, G).
346clean_body(ground(X), true) :- 347 ground(X),
348 !.
349clean_body(memberchk(V, Values), true) :- 350 ground(V), ground(Values),
351 memberchk(V, Values),
352 !.
353clean_body((integer(Low) -> If ; Then), Goal) :- 354 number(Low),
355 !,
356 ( integer(Low)
357 -> Goal = If
358 ; Goal = Then
359 ).
360clean_body((A->true;fail), A) :- !. 361clean_body((fail->_;A), A) :- !.
362clean_body(A, A).
363
364conj(T, A, A) :- T == true, !.
365conj(A, T, A) :- T == true, !.
366conj(A, B, (A,B)).
367
368make_pairs([], [], L, L).
369make_pairs([N|TN], [V|TV], [N=V|T], Tail) :-
370 make_pairs(TN, TV, T, Tail).
371
375
376current_clause(Constructor, Module, Types, Defs, Names, Extra) -->
377 { length(Types, Arity),
378 functor(Term, Constructor, Arity),
379 extra_fields(Extra, EF),
380 Term =.. [_|Vars],
381 mk_fields(Names, Types, Defs, Vars, Fields0, EF),
382 sort(Fields0, Fields),
383 Head =.. [current_json_object, Term, Module, Fields]
384 },
385 [ json_convert:Head ].
386
([], []).
388extra_fields([Name=Value|T0], [f(Name, oneof([Value]), _, Value)|T]) :-
389 extra_fields(T0, T).
390
391mk_fields([], [], [], [], Fields, Fields).
392mk_fields([Name|TN], [Type|TT], [Def|DT], [Var|VT],
393 [f(Name, Type, Def, Var)|T], Tail) :-
394 mk_fields(TN, TT, DT, VT, T, Tail).
395
396
398
402
403defaults([], [], []).
404defaults([Arg=Default|T0], [Default|TD], [Arg|TA]) :-
405 !,
406 defaults(T0, TD, TA).
407defaults([Arg|T0], [NoDefault|TD], [Arg|TA]) :-
408 no_default(NoDefault),
409 defaults(T0, TD, TA).
410
411no_default('$no-default$').
412
416
417types([], [], []).
418types([Name:Type|T0], [Name|TN], [Type|TT]) :-
419 !,
420 must_be(atom, Name),
421 types(T0, TN, TT).
422types([Name|T0], [Name|TN], [any|TT]) :-
423 must_be(atom, Name),
424 types(T0, TN, TT).
425
426
427 430
442
443prolog_to_json(Module:Term, JSON) :-
444 prolog_to_json(Term, JSON, Module).
445
446prolog_to_json(Var, _, _) :-
447 var(Var),
448 !,
449 instantiation_error(Var).
450prolog_to_json(Atomic, Atomic, _) :-
451 atomic(Atomic),
452 !.
453prolog_to_json(List, JSON, Module) :-
454 is_list(List),
455 !,
456 prolog_list_to_json(List, JSON, Module).
457prolog_to_json(Record, JSON, Module) :-
458 record_to_pairs(Record, JSON, Module),
459 !.
460prolog_to_json(Term, Term, _) :-
461 is_json_term(Term),
462 !.
463prolog_to_json(Term, _, _) :-
464 type_error(json_term, Term).
465
466record_to_pairs(T, _, _) :-
467 var(T),
468 !,
469 instantiation_error(T).
470record_to_pairs(T, JSON, M) :-
471 object_module(M, Module),
472 json_object_to_pairs(T, Module, JSON),
473 !.
474
475object_module(user, user) :- !.
476object_module(M, M).
477object_module(_, user).
478
479prolog_list_to_json([], [], _).
480prolog_list_to_json([H0|T0], [H|T], M) :-
481 prolog_to_json(H0, H, M),
482 prolog_list_to_json(T0, T, M).
483
484
485 488
489:- dynamic
490 json_to_prolog_rule/3, 491 created_rules_for_pairs/2. 492
493clear_cache :-
494 retractall(json_to_prolog_rule(_,_,_)),
495 retractall(created_rules_for_pairs(_,_)).
496
497:- clear_cache. 498
511
512json_to_prolog(JSON, Module:Term) :-
513 json_to_prolog(JSON, Term, Module).
514
515json_to_prolog(json(Pairs), Term, Module) :-
516 !,
517 ( pairs_to_term(Pairs, Term, Module)
518 -> true
519 ; json_pairs_to_prolog(Pairs, Prolog, Module),
520 Term = json(Prolog)
521 ).
522json_to_prolog(List, Prolog, Module) :-
523 is_list(List),
524 !,
525 json_list_to_prolog(List, Prolog, Module).
526json_to_prolog(@(Special), @(Special), _) :- !.
527json_to_prolog(Atomic, Atomic, _).
528
529json_pairs_to_prolog([], [], _).
530json_pairs_to_prolog([Name=JSONValue|T0], [Name=PrologValue|T], Module) :-
531 json_to_prolog(JSONValue, PrologValue, Module),
532 json_pairs_to_prolog(T0, T, Module).
533
534json_list_to_prolog([], [], _).
535json_list_to_prolog([JSONValue|T0], [PrologValue|T], Module) :-
536 json_to_prolog(JSONValue, PrologValue, Module),
537 json_list_to_prolog(T0, T, Module).
538
539
547
548pairs_to_term(Pairs, Term, Module) :-
549 object_module(Module, M),
550 ( json_to_prolog_rule(M, Pairs, Term)
551 -> !
552 ; created_rules_for_pairs(M, Pairs)
553 -> !, fail
554 ; pairs_args(Pairs, PairArgs),
555 sort(PairArgs, SortedPairArgs),
556 findall(Q-Rule,
557 ( create_rule(SortedPairArgs, Module, M, Term0, Body, Q),
558 Rule = (json_to_prolog_rule(M, PairArgs, Term0) :- Body)
559 ),
560 RulePairs),
561 keysort(RulePairs, ByQuality),
562 pairs_values(ByQuality, Rules),
563 maplist(asserta, Rules),
564 asserta(created_rules_for_pairs(M, PairArgs)),
565 json_to_prolog_rule(M, Pairs, Term), !
566 ).
567
568pairs_args([], []).
569pairs_args([Name=_Value|T0], [Name=_|T]) :-
570 pairs_args(T0, T).
571
594
595create_rule(PairArgs, Module, M, Term, Body, Quality) :-
596 current_json_object(Term, M, Fields),
597 match_fields(PairArgs, Fields, Body0, Module, 0, Quality),
598 clean_body(Body0, Body).
599
600match_fields(Ignored, [], true, _, Q0, Q) :-
601 !,
602 length(Ignored, Len),
603 Q is Q0-2*Len.
604match_fields([Name=JSON|TP], [f(Name, Type, _, Prolog)|TF], (Goal,Body),
605 M, Q0, Q) :-
606 !,
607 match_field(Type, JSON, Prolog, M, Goal),
608 match_fields(TP, TF, Body, M, Q0, Q).
609match_fields([Name=JSON|TP], [f(OptName, Type, Def, Prolog)|TF], Body,
610 M, Q0, Q) :-
611 OptName @< Name,
612 !,
613 ( nullable(Type)
614 -> true
615 ; no_default(NoDef),
616 Def \== NoDef
617 -> Prolog = Def
618 ),
619 Q1 is Q0-1,
620 match_fields([Name=JSON|TP], TF, Body, M, Q1, Q).
621match_fields([], [f(_OptName, Type, Def, Prolog)|TF], Body,
622 M, Q0, Q) :-
623 !,
624 ( nullable(Type)
625 -> true
626 ; no_default(NoDef),
627 Def \== NoDef
628 -> Prolog = Def
629 ),
630 Q1 is Q0-1,
631 match_fields([], TF, Body, M, Q1, Q).
632match_fields([Name=_|TP], [F|TF], Body, M, Q0, Q) :-
633 arg(1, F, Next),
634 Name @< Next,
635 Q1 is Q0-2,
636 match_fields(TP, [F|TF], Body, M, Q1, Q).
637
638nullable(null).
639nullable((A|B)) :- ( nullable(A) -> true ; nullable(B) ).
640
641match_field((A|B), JSON, Prolog, M, (BodyA->true;BodyB)) :-
642 !,
643 match_field(A, JSON, Prolog, M, BodyA),
644 match_field(B, JSON, Prolog, M, BodyB).
645match_field(null, _, _, _, fail) :- !.
646match_field(any, JSON, Prolog, M, json_to_prolog(JSON,Prolog,M)) :- !.
647match_field(F/A, JSON, Prolog, M, json_to_prolog(JSON,Prolog,M)) :-
648 !,
649 functor(Prolog, F, A).
650match_field(boolean, JSON, Prolog, _, json_bool_to_prolog(JSON, Prolog)) :- !.
651match_field(list(Type), JSON, Prolog, M, json_list_to_prolog(JSON, Prolog, M)) :-
652 !,
653 ( Type = _Funcor/_Arity
654 -> true
655 ; non_json_type(Type)
656 -> true
657 ; current_json_object(Term, M, _Fields),
658 functor(Term, Type, _)
659 ).
660match_field(list, JSON, Prolog, M, Goal) :-
661 !,
662 match_field(list(any), JSON, Prolog, M, Goal).
663match_field(Type, Var, Var, _, Goal) :-
664 type_goal(Type, Var, Goal).
665
666:- public json_bool_to_prolog/2. 667
668json_bool_to_prolog(@(True), True).
669
670
671 674
675:- multifile
676 system:term_expansion/2. 677:- dynamic
678 system:term_expansion/2. 679
680system:term_expansion((:- json_object(Spec)), Clauses) :-
681 compile_json_objects(Spec, Clauses)