1:- module(changelog,
2 [
3 ]). 4:- use_module(library(settings)). 5:- use_module(library(process)). 6:- use_module(library(readutil)). 7:- use_module(library(http/http_dispatch)). 8:- use_module(library(http/http_parameters)). 9:- use_module(library(http/html_write)). 10:- use_module(wiki). 11
12:- setting(sources,
13 atom,
14 '~/src/swipl-devel',
15 'Sourced directory for getting changelog'). 16:- setting(branches,
17 list(any),
18 [ development = 'origin/master',
19 stable = 'stable/master'
20 ],
21 'Branches displayed'). 22:- setting(default_branch,
23 atom,
24 development,
25 'Default branch to show'). 26
27:- http_handler(root('ChangeLog'), changelog, [pool(wiki)]).
33changelog(Request) :-
34 http_parameters(Request,
35 [ from(VFrom, [optional(true)]),
36 to(VTo, [optional(true)]),
37 branch(Branch, [optional(true)])
38 ]),
39 defaults(VFrom, VTo, Branch),
40 changelog_dom(VFrom-VTo, DOM),
41 ( memberchk(h1(_, TitleParts), DOM)
42 -> atomic_list_concat(TitleParts, Title)
43 ; Title = 'SWI-Prolog ChangeLog'
44 ),
45 reply_html_page(pldoc(default),
46 title(Title),
47 [ \alt_branches(Branch), ', ',
48 \alt_versions(Branch, VFrom, VTo)
49 | DOM
50 ]).
51
52defaults(VFrom, VTo, _Branch) :-
53 nonvar(VFrom), nonvar(VTo), !.
54defaults(VFrom, VTo, Branch) :-
55 ( var(Branch)
56 -> setting(default_branch, Branch)
57 ; true
58 ),
59 branch_versions(Branch, Versions),
60 append(_, [VTo,VFrom|_], Versions), !.
61
62:- dynamic
63 changelog_cache/2,
64 changelog_seen/2. 65
66changelog_dom(Range, DOM) :-
67 changelog_cache(Range, DOM), !,
68 get_time(Now),
69 retractall(changelog_seen(Range, _)),
70 assertz(changelog_seen(Range, Now)).
71changelog_dom(Range, DOM) :-
72 changelog(Range, Codes),
73 wiki_file_codes_to_dom(Codes, -, DOM),
74 assertz(changelog_cache(Range, DOM)),
75 get_time(Now),
76 assertz(changelog_seen(Range, Now)),
77 clean_cached_changelogs(5).
78
79clean_cached_changelogs(Keep) :-
80 repeat,
81 predicate_property(changelog_cache(_,_), number_of_clauses(N)),
82 ( N > Keep
83 -> retract(changelog_seen(Range, _)),
84 retractall(changelog_cache(Range, _)),
85 fail
86 ; !
87 ).
88
89changelog(Range, Codes) :-
90 setting(sources, SourceDir0),
91 expand_file_name(SourceDir0, [SourceDir]),
92 directory_file_path(SourceDir, 'scripts/mkchangelog', Script),
93 range_arg(Range, Versions),
94 setup_call_cleanup(
95 process_create(Script, ['--wiki', Versions],
96 [ stdout(pipe(Out)),
97 cwd(SourceDir)
98 ]),
99 read_stream_to_codes(Out, Codes),
100 close(Out)).
101
102range_arg(From-To, Versions) :-
103 atomic_list_concat([From, To], '..', Versions).
104range_arg(From, From).
108alt_branches(Branch) -->
109 { setting(branches, Branches),
110 maplist(arg(1), Branches, Aliases)
111 },
112 html(b('Branch:')),
113 ( { select(Branch, Aliases, Switch) }
114 -> ( { Switch \== [] }
115 -> html([' ', Branch, ' (switch to ' | \branches(Switch)]),
116 html(')')
117 ; []
118 )
119 ; branches(Aliases)
120 ).
121
122branches([]) --> [].
123branches([H|T]) --> branch(H), branches(T).
124
125branch(B) -->
126 { http_link_to_id(changelog, [branch(B)], HREF)
127 },
128 html([' ', a(href(HREF), B)]).
129
130alt_versions(Branch, _VFrom, _VTo) -->
131 { var(Branch) }, !.
132alt_versions(Branch, VFrom, VTo) -->
133 { branch_versions(Branch, Versions),
134 http_link_to_id(changelog, [], Action)
135 },
136 html([ form([action(Action), style('display:inline')],
137 [ input([type(hidden), name(branch), value(Branch)]),
138 b('version'),' ',
139 \select(from, Versions, VFrom),
140 b(' to version '),
141 \select(to, Versions, VTo), ' ',
142 input([ type(submit),
143 value('Update')
144 ])
145 ])
146 ]).
147
148select(Name, Values, Selected) -->
149 html(select(name(Name), \values(Values, Selected))).
150
151values([], _) --> [].
152values([H|T], Selected) --> value(H, Selected), values(T, Selected).
153
154value(V, V) --> !,
155 html(option([selected], V)).
156value(V, _) -->
157 html(option(V)).
163:- dynamic
164 version_cache/3. 165
166branch_versions(Alias, Versions) :-
167 setting(branches, Map),
168 memberchk(Alias=Branch, Map),
169 versions(Alias, Branch, Versions).
170
171versions(_, Branch, Versions) :-
172 version_cache(Branch, Retrieved, Versions),
173 get_time(Now),
174 Now-Retrieved < 600, !.
175versions(Alias, Branch, Versions) :-
176 retractall(version_cache(Branch, _, _)),
177 versions_no_cache(Branch, AllVersions),
178 include(branch_version(Alias), AllVersions, Versions),
179 get_time(Now),
180 assertz(version_cache(Branch, Now, Versions)).
181
182versions_no_cache(Branch, Versions) :-
183 git_repo(Repo),
184 git_tags_on_branch(Repo, Branch, Tags),
185 tags_versions(Tags, Versions).
186
187tags_versions([], []).
188tags_versions([H|T], Versions) :-
189 atomic_list_concat(Tags, ', ', H),
190 ( Tags = [Tag]
191 -> ( atom_concat('V', Version, Tag)
192 -> Versions = [Version|VT],
193 tags_versions(T, VT)
194 ; tags_versions(T, Versions)
195 )
196 ; append(Tags, T, AllTags),
197 tags_versions(AllTags, Versions)
198 ).
199
200git_repo(Repo) :-
201 setting(sources, SourceDir0),
202 expand_file_name(SourceDir0, [Repo]).
208branch_version(stable, Version) :- !,
209 atomic_list_concat([_Major,MinorAtom,_Patch], '.', Version),
210 atom_number(MinorAtom, Minor),
211 Minor mod 2 =:= 0.
212branch_version(_, _)