35
36:- module(term_html,
37 [ term//2 38 ]). 39:- use_module(library(http/html_write)). 40:- use_module(library(option)). 41:- use_module(library(error)). 42:- use_module(library(debug)). 43:- use_module(library(http/json)). 44
45:- multifile
46 blob_rendering//3, 47 portray//2, 48 layout/3.
76term(Term, Options) -->
77 { must_be(acyclic, Term),
78 merge_options(Options,
79 [ priority(1200),
80 max_depth(1 000 000 000),
81 depth(0)
82 ],
83 Options1),
84 dict_options(Dict, Options1)
85 },
86 any(Term, Dict),
87 finalize_term(Term, Dict).
88
89:- html_meta
90 embrace(html,?,?). 91
92any(_, Options) -->
93 { Options.depth >= Options.max_depth },
94 !,
95 html(span(class('pl-ellipsis'), ...)).
96any(Term, Options) -->
97 ( { nonvar(Term)
98 ; attvar(Term)
99 }
100 -> portray(Term, Options)
101 ),
102 !.
103any(Term, Options) -->
104 { primitive(Term, Class0),
105 !,
106 quote_atomic(Term, S, Options),
107 primitive_class(Class0, Term, S, Class)
108 },
109 html(span([class(Class)], S)).
110any(Term, Options) -->
111 { blob(Term,Type), Term \== [] },
112 !,
113 ( blob_rendering(Type,Term,Options)
114 -> []
115 ; html(span(class('pl-blob'),['<',Type,'>']))
116 ).
117any(Term, Options) -->
118 { is_dict(Term), !
119 },
120 dict(Term, Options).
121any(Term, Options) -->
122 { assertion((compound(Term);Term==[]))
123 },
124 compound(Term, Options).
130compound('$VAR'(Var), Options) -->
131 { Options.get(numbervars) == true,
132 !,
133 format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
134 ( S == "_"
135 -> Class = 'pl-anon'
136 ; Class = 'pl-var'
137 )
138 },
139 html(span([class(Class)], S)).
140compound(List, Options) -->
141 { ( List == []
142 ; List = [_|_] 143 ),
144 !,
145 arg_options(Options, _{priority:999}, ArgOptions)
146 },
147 list(List, ArgOptions).
148compound({X}, Options) -->
149 !,
150 { arg_options(Options, _{priority:1200}, ArgOptions) },
151 html(span(class('pl-curl'), [ '{', \any(X, ArgOptions), '}' ])).
152compound(OpTerm, Options) -->
153 { compound_name_arity(OpTerm, Name, 1),
154 is_op1(Name, Type, Pri, ArgPri, Options),
155 \+ Options.get(ignore_ops) == true
156 },
157 !,
158 op1(Type, Pri, OpTerm, ArgPri, Options).
159compound(OpTerm, Options) -->
160 { compound_name_arity(OpTerm, Name, 2),
161 is_op2(Name, Type, LeftPri, Pri, RightPri, Options),
162 \+ Options.get(ignore_ops) == true
163 },
164 !,
165 op2(Pri, OpTerm, Type, LeftPri, RightPri, Options).
166compound(Compound, Options) -->
167 { compound_name_arity(Compound, Name, Arity),
168 quote_atomic(Name, S, Options.put(embrace, never)),
169 arg_options(Options, _{priority:999}, ArgOptions),
170 extra_classes(Compound, Classes, Attrs, Options)
171 },
172 html(span([ class(['pl-compound','pl-adaptive'|Classes]),
173 'data-arity'(Arity),
174 'data-name'(Name)
175 | Attrs
176 ],
177 [ span(class(['pl-functor', 'pl-trigger']),
178 [ S, \punct('(') ]),
179 span(class('pl-compound-args'),
180 [ \args(0, Arity, Compound, ArgOptions)
181 ])
182 ])).
183
(Term, Classes, OAttrs, Options) :-
185 findall(A, extra_attr(Term, A, Options), Attrs),
186 partition(is_class_attr, Attrs, CAttrs, OAttrs),
187 maplist(arg(1), CAttrs, Classes).
188
189is_class_attr(class(_)).
190
(_, class('pl-level-0'), Options) :-
192 Options.depth == 0.
193extra_attr(Term, 'data-layout'(Data), Options) :-
194 layout(Term, Layout, Options),
195 ( is_dict(Layout)
196 -> atom_json_dict(Data, Layout, [])
197 ; Data = Layout
198 ).
206arg_options(Options, Options.put(depth, NewDepth)) :-
207 NewDepth is Options.depth+1.
208arg_options(Options, Extra, Options.put(depth, NewDepth).put(Extra)) :-
209 NewDepth is Options.depth+1.
215args(Arity, Arity, _, _) --> !.
216args(I, Arity, Compound, ArgOptions) -->
217 { NI is I + 1,
218 arg(NI, Compound, Arg)
219 },
220 ( {NI == Arity}
221 -> html([ span(class('pl-compound-arg'), \any(Arg, ArgOptions)),
222 span(class(['pl-compound-close', 'pl-punct']), ')')
223 ])
224 ; html(span(class('pl-compound-arg'),
225 [ \any(Arg, ArgOptions), \punct(',') ])),
226 args(NI, Arity, Compound, ArgOptions)
227 ).
228
229punct(Punct) -->
230 html(span(class('pl-punct'), Punct)).
236list(List, Options) -->
237 { '$skip_list'(Length, List, Tail),
238 ( Tail == []
239 -> Attr = ['data-length'(Length)]
240 ; Attr = ['data-length'(Length), 'data-partial'(true)]
241 )
242 },
243 html(span([ class(['pl-list','pl-adaptive'])
244 | Attr
245 ],
246 [ span(class(['pl-list-open', 'pl-trigger', 'pl-punct']), '['),
247 \list_content(List, Options),
248 span(class(['pl-list-close', 'pl-punct']), ']')
249 ])).
250
251list_content([], _Options) -->
252 !,
253 [].
254list_content([H|T], Options) -->
255 !,
256 { arg_options(Options, ArgOptions),
257 ( T == []
258 -> Sep = [],
259 Next = end
260 ; Options.depth + 1 >= Options.max_depth
261 -> Sep = [span(class('pl-punct'), '|')],
262 Next = depth_limit
263 ; (var(T) ; \+ T = [_|_])
264 -> Sep = [span(class('pl-punct'), '|')],
265 Next = tail
266 ; Sep = [span(class('pl-punct'), [',', ' '])],
267 Next = list
268 )
269 },
270 html(span(class('pl-list-el'),
271 [ \any(H, Options) | Sep ])),
272 list_next(Next, T, ArgOptions).
273
274list_next(end, _, _) --> !.
275list_next(depth_limit, _, _) -->
276 !,
277 html(span(class('pl-ellipsis'), ...)).
278list_next(tail, Value, Options) -->
279 { var(Value)
280 -> Class = 'pl-var-tail'
281 ; Class = 'pl-nonvar-tail'
282 },
283 html(span(class(Class), \any(Value, Options))).
284list_next(list, Tail, Options) -->
285 list_content(Tail, Options).
291is_op1(Name, Type, Pri, ArgPri, Options) :-
292 operator_module(Module, Options),
293 current_op(Pri, OpType, Module:Name),
294 argpri(OpType, Type, Pri, ArgPri),
295 !.
296
297argpri(fx, prefix, Pri0, Pri) :- Pri is Pri0 - 1.
298argpri(fy, prefix, Pri, Pri).
299argpri(xf, postfix, Pri0, Pri) :- Pri is Pri0 - 1.
300argpri(yf, postfix, Pri, Pri).
301
305
306is_op2(Name, Type, LeftPri, Pri, RightPri, Options) :-
307 operator_module(Module, Options),
308 current_op(Pri, Type, Module:Name),
309 infix_argpri(Type, LeftPri, Pri, RightPri),
310 !.
311
312infix_argpri(xfx, ArgPri, Pri, ArgPri) :- ArgPri is Pri - 1.
313infix_argpri(yfx, Pri, Pri, ArgPri) :- ArgPri is Pri - 1.
314infix_argpri(xfy, ArgPri, Pri, Pri) :- ArgPri is Pri - 1.
320operator_module(Module, Options) :-
321 Module = Options.get(module),
322 !.
323operator_module(TypeIn, _) :-
324 '$module'(TypeIn, TypeIn).
328op1(Type, Pri, Term, ArgPri, Options) -->
329 { Pri > Options.priority },
330 !,
331 embrace(\op1(Type, Term, ArgPri, Options)).
332op1(Type, _, Term, ArgPri, Options) -->
333 op1(Type, Term, ArgPri, Options).
334
335op1(prefix, Term, ArgPri, Options) -->
336 { Term =.. [Functor,Arg],
337 arg_options(Options, DepthOptions),
338 FuncOptions = DepthOptions.put(embrace, never),
339 ArgOptions = DepthOptions.put(priority, ArgPri),
340 quote_atomic(Functor, S, FuncOptions),
341 extra_classes(Term, Classes, Attrs, Options.put(op, prefix))
342 },
343 html(span([ class(['pl-compound', 'pl-op', 'pl-prefix-op'|Classes]),
344 'data-arity'(1),
345 'data-name'(Functor)
346 | Attrs
347 ],
348 [ span(class('pl-functor'), S),
349 \space(Functor, Arg, o, a, FuncOptions, ArgOptions),
350 \op_arg(Arg, ArgOptions)
351 ])).
352op1(postfix, Term, ArgPri, Options) -->
353 { Term =.. [Functor,Arg],
354 arg_options(Options, DepthOptions),
355 ArgOptions = DepthOptions.put(priority, ArgPri),
356 FuncOptions = DepthOptions.put(embrace, never),
357 quote_atomic(Functor, S, FuncOptions),
358 extra_classes(Term, Classes, Attrs, Options.put(op, postfix))
359 },
360 html(span([ class(['pl-compound', 'pl-op', 'pl-postfix-op'|Classes]),
361 'data-arity'(1),
362 'data-name'(Functor)
363 | Attrs
364 ],
365 [ \op_arg(Arg, ArgOptions),
366 \space(Arg, Functor, a, o, ArgOptions, FuncOptions),
367 span(class('pl-functor'), S)
368 ])).
372op2(Pri, Term, Type, LeftPri, RightPri, Options) -->
373 { Pri > Options.priority },
374 !,
375 embrace(\op2(Term, Type, LeftPri, RightPri, Options)).
376op2(_, Term, Type, LeftPri, RightPri, Options) -->
377 op2(Term, Type, LeftPri, RightPri, Options).
378
379op2(Term, xfy, LeftPri, RightPri, Options) -->
380 { functor(Term, Functor, 2),
381 quote_op(Functor, S, Options),
382 xfy_list(Term, Functor, List),
383 List \== [],
384 !,
385 arg_options(Options, DepthOptions),
386 ArgOptions = DepthOptions.put(#{priority:LeftPri, quoted_op:S}),
387 extra_classes(Term, Classes, Attrs, Options.put(op, infix))
388 },
389 html(span([ class(['pl-op-seq', 'pl-adaptive'|Classes])
390 | Attrs
391 ],
392 \op_seq(List, Functor, RightPri, ArgOptions))).
393op2(Term, _Type, LeftPri, RightPri, Options) -->
394 { Term =.. [Functor,Left,Right],
395 arg_options(Options, DepthOptions),
396 LeftOptions = DepthOptions.put(priority, LeftPri),
397 FuncOptions = DepthOptions.put(embrace, never),
398 RightOptions = DepthOptions.put(priority, RightPri),
399 ( ( need_space(Left, Functor, a, o, LeftOptions, FuncOptions)
400 ; need_space(Functor, Right, o, a, FuncOptions, RightOptions)
401 )
402 -> Space = ' '
403 ; Space = ''
404 ),
405 quote_op(Functor, S, Options),
406 extra_classes(Term, Classes, Attrs, Options.put(op, infix))
407 },
408 html(span([ class(['pl-compound', 'pl-op', 'pl-infix-op'|Classes]),
409 'data-arity'(2),
410 'data-name'(Functor)
411 | Attrs
412 ],
413 [ \op_arg(Left, LeftOptions),
414 Space,
415 span(class('pl-functor'), S),
416 Space,
417 \op_arg(Right, RightOptions)
418 ])).
422op_arg(Atom, Options) -->
423 { atom(Atom),
424 operator_module(Module, Options),
425 current_op(_,_,Module:Atom)
426 }, !,
427 embrace(\any(Atom, Options.put(embrace, never))).
428op_arg(Any, Options) -->
429 any(Any, Options).
430
431op_seq([Last], _Functor, LastPri, Options) -->
432 !,
433 { LastOptions = Options.put(priority, LastPri)
434 },
435 html(span(class('pl-op-seq-el'), \op_arg(Last, LastOptions))).
436op_seq([H|T], Functor, LastPri, Options) -->
437 html(span(class('pl-op-seq-el'),
438 [ \op_arg(H, Options),
439 \left_space(H, Functor, Options),
440 span(class('pl-infix'), Options.quoted_op)
441 ])),
442 op_seq(T, Functor, LastPri, Options).
443
444left_space(Left, Functor, Options) -->
445 { need_space(Left, Functor, a, o, Options, Options.put(embrace, never))
446 },
447 !,
448 html(' ').
449left_space(_,_,_) -->
450 [].
451
452xfy_list(Term, Name, List),
453 compound(Term),
454 compound_name_arguments(Term, Name, [A,B]) =>
455 List = [A|T],
456 xfy_list(B, Name, T).
457xfy_list(Term, _, List) =>
458 List = [Term].
465embrace(HTML) -->
466 html(span(class('pl-embrace'),
467 [ span(class('pl-parenthesis'), '('),
468 span(class('pl-embraced'),\html(HTML)),
469 span(class('pl-parenthesis'), ')')
470 ])).
477space(T1, T2, C1, C2, LeftOptions, RightOptions) -->
478 { need_space(T1, T2, C1, C2, LeftOptions, RightOptions) },
479 html(' ').
480space(_, _, _, _, _, _) -->
481 [].
482
483need_space(T1, T2, _, _, _, _) :-
484 ( is_solo(T1)
485 ; is_solo(T2)
486 ),
487 !,
488 fail.
489need_space(T1, T2, C1, C2, LeftOptions, RightOptions) :-
490 end_code_type(T1, C1, TypeR, LeftOptions.put(side, right)),
491 end_code_type(T2, C2, TypeL, RightOptions.put(side, left)),
492 \+ no_space(TypeR, TypeL).
493
494no_space(punct, _).
495no_space(_, punct).
496no_space(quote(R), quote(L)) :-
497 !,
498 R \== L.
499no_space(alnum, symbol).
500no_space(symbol, alnum).
507end_code_type(Atom, a, Type, Options) :-
508 atom(Atom),
509 operator_module(Module, Options),
510 current_op(_,_,Module:Atom),
511 !,
512 Type = punct.
513end_code_type(Atom, _, Type, Options) :-
514 end_code_type(Atom, Type, Options).
515
516end_code_type(_, Type, Options) :-
517 Options.depth >= Options.max_depth,
518 !,
519 Type = symbol.
520end_code_type(Term, Type, Options) :-
521 primitive(Term, _),
522 !,
523 quote_atomic(Term, S, Options),
524 end_type(S, Type, Options).
525end_code_type(Dict, Type, Options) :-
526 is_dict(Dict, Tag),
527 !,
528 ( Options.side == left
529 -> end_code_type(Tag, Type, Options)
530 ; Type = punct
531 ).
532end_code_type('$VAR'(Var), Type, Options) :-
533 Options.get(numbervars) == true,
534 !,
535 format(string(S), '~W', ['$VAR'(Var), [numbervars(true)]]),
536 end_type(S, Type, Options).
537end_code_type(List, Type, _) :-
538 ( List == []
539 ; List = [_|_]
540 ),
541 !,
542 Type = punct.
543end_code_type(OpTerm, Type, Options) :-
544 compound_name_arity(OpTerm, Name, 1),
545 is_op1(Name, OpType, Pri, ArgPri, Options),
546 \+ Options.get(ignore_ops) == true,
547 !,
548 ( Pri > Options.priority
549 -> Type = punct
550 ; ( OpType == prefix, Options.side == left
551 -> end_code_type(Name, Type, Options)
552 ; OpType == postfix, Options.side == right
553 -> end_code_type(Name, Type, Options)
554 ; arg(1, OpTerm, Arg),
555 arg_options(Options, ArgOptions),
556 op_end_code_type(Arg, Type, ArgOptions.put(priority, ArgPri))
557 )
558 ).
559end_code_type(OpTerm, Type, Options) :-
560 compound_name_arity(OpTerm, Name, 2),
561 is_op2(Name, _Type, LeftPri, Pri, RightPri, Options),
562 \+ Options.get(ignore_ops) == true,
563 !,
564 ( Pri > Options.priority
565 -> Type = punct
566 ; Options.side == left
567 -> arg(1, OpTerm, Arg),
568 arg_options(Options, ArgOptions),
569 op_end_code_type(Arg, Type, ArgOptions.put(priority, LeftPri))
570 ; Options.side == right
571 -> arg(2, OpTerm, Arg),
572 arg_options(Options, ArgOptions),
573 op_end_code_type(Arg, Type, ArgOptions.put(priority, RightPri))
574 ).
575end_code_type(Compound, Type, Options) :-
576 compound_name_arity(Compound, Name, _),
577 end_code_type(Name, Type, Options).
578
579op_end_code_type(Atom, Type, Options) :-
580 end_code_type(Atom, a, Type, Options).
581
582end_type(S, Type, Options) :-
583 number(S),
584 !,
585 ( (S < 0 ; S == -0.0),
586 Options.side == left
587 -> Type = symbol
588 ; Type = alnum
589 ).
590end_type(S, Type, Options) :-
591 Options.side == left,
592 !,
593 sub_string(S, 0, 1, _, Start),
594 syntax_type(Start, Type).
595end_type(S, Type, _) :-
596 sub_string(S, _, 1, 0, End),
597 syntax_type(End, Type).
598
599syntax_type("\"", quote(double)) :- !.
600syntax_type("\'", quote(single)) :- !.
601syntax_type("\`", quote(back)) :- !.
602syntax_type(S, Type) :-
603 string_code(1, S, C),
604 ( code_type(C, prolog_identifier_continue)
605 -> Type = alnum
606 ; code_type(C, prolog_symbol)
607 -> Type = symbol
608 ; code_type(C, space)
609 -> Type = layout
610 ; Type = punct
611 ).
616dict(Term, Options) -->
617 { dict_pairs(Term, Tag, Pairs),
618 quote_atomic(Tag, S, Options.put(embrace, never)),
619 arg_options(Options, ArgOptions)
620 },
621 html(span(class(['pl-dict', 'pl-adaptive']),
622 [ span(class(['pl-tag', 'pl-trigger']), S),
623 span(class(['pl-dict-open', 'pl-punct']), '{'),
624 span(class('pl-dict-body'),
625 [ span(class('pl-dict-kvs'),
626 \dict_kvs(Pairs, ArgOptions)),
627 span(class(['pl-dict-close', 'pl-punct']), '}')
628 ])
629 ])).
630
631dict_kvs([], _) --> [].
632dict_kvs(_, Options) -->
633 { Options.depth >= Options.max_depth },
634 !,
635 html(span(class('pl-ellipsis'), ...)).
636dict_kvs(KVs, Options) -->
637 dict_kvs2(KVs, Options).
638
639dict_kvs2([], _) -->
640 [].
641dict_kvs2([K-V|T], Options) -->
642 { quote_atomic(K, S, Options),
643 end_code_type(V, VType, Options.put(side, left)),
644 ( VType == symbol
645 -> VSpace = ' '
646 ; VSpace = ''
647 ),
648 arg_options(Options, ArgOptions),
649 ( T == []
650 -> Sep = []
651 ; Sep = [\punct(','), ' ']
652 )
653 },
654 html(span(class('pl-dict-kv'),
655 [ span(class('pl-key'), [S, \punct(:)]),
656 VSpace,
657 span(class('pl-dict-value'),
658 [ \any(V, ArgOptions)
659 | Sep
660 ])
661 ])),
662 dict_kvs2(T, Options).
663
664quote_atomic(Float, String, Options) :-
665 float(Float),
666 Format = Options.get(float_format),
667 !,
668 format(string(String), Format, [Float]).
669quote_atomic(Plain, String, Options) :-
670 atomic(Plain),
671 Format = Options.get(format),
672 !,
673 format(string(String), Format, [Plain]).
674quote_atomic(Plain, String, Options) :-
675 rational(Plain),
676 \+ integer(Plain),
677 !,
678 operator_module(Module, Options),
679 format(string(String), '~W', [Plain, [module(Module)]]).
680quote_atomic(Plain, Plain, _) :-
681 number(Plain),
682 !.
683quote_atomic(Plain, String, Options) :-
684 Options.get(quoted) == true,
685 !,
686 ( Options.get(embrace) == never
687 -> format(string(String), '~q', [Plain])
688 ; format(string(String), '~W', [Plain, Options])
689 ).
690quote_atomic(Var, String, Options) :-
691 var(Var),
692 !,
693 format(string(String), '~W', [Var, Options]).
694quote_atomic(Plain, Plain, _).
695
696quote_op(Op, S, _Options) :-
697 is_solo(Op),
698 !,
699 S = Op.
700quote_op(Op, S, Options) :-
701 quote_atomic(Op, S, Options.put(embrace,never)).
702
703is_solo(Var) :-
704 var(Var), !, fail.
705is_solo(',').
706is_solo(';').
707is_solo('!').
714primitive(Term, Type) :- var(Term), !, Type = 'pl-avar'.
715primitive(Term, Type) :- atom(Term), !, Type = 'pl-atom'.
716primitive(Term, Type) :- string(Term), !, Type = 'pl-string'.
717primitive(Term, Type) :- integer(Term), !, Type = 'pl-int'.
718primitive(Term, Type) :- rational(Term), !, Type = 'pl-rational'.
719primitive(Term, Type) :- float(Term), !, Type = 'pl-float'.
726primitive_class('pl-atom', Atom, String, Class) :-
727 \+ atom_string(Atom, String),
728 !,
729 Class = 'pl-quoted-atom'.
730primitive_class(Class, _, _, Class).
736finalize_term(Term, Dict) -->
737 ( { true == Dict.get(full_stop) }
738 -> space(Term, '.', o, o, Dict, Dict),
739 ( { true == Dict.get(nl) }
740 -> html(['.', br([])])
741 ; html('. ')
742 )
743 ; ( { true == Dict.get(nl) }
744 -> html(br([]))
745 ; []
746 )
747 ).
748
749
750
Represent Prolog terms as HTML
This file is primarily designed to support running Prolog applications over the web. It provides a replacement for write_term/2 which renders terms as structured HTML. */