1:- module(uri_qq, [uri/4]). 2:- use_module(library(apply), [maplist/3]). 3:- use_module(library(quasi_quotations)). 4:- use_module(library(readutil), [read_stream_to_codes/2]). 5:- use_module(library(record)). 6:- use_module(library(uri), [uri_components/2, uri_data/3]). 7
8
9% We parse the quasiquotation content into a URI term, replace $-escaped
10% variables with their values, then convert the URI term back into an
11% atom. The round trip makes sure that all necessary escaping
12% and normalization is done properly.
13%
14% I wanted to use library(uri) directly, but it leaves too many of the
15% URI's components hidden inside opaque atoms (authority, path segments,
16% query name-value pairs). The uriqq record splits everything down to
17% the smallest structural level.
18
19% represents a URI with more structure than library(uri) provides
20:- record uriqq( scheme
21 , user
22 , password
23 , host
24 , port
25 , path
26 , search
27 , fragment
28 ).
29
34atom_uri(Atom, UriQQ) :-
35 var(Atom),
36 uri_uriqq(Uri, UriQQ),
37 uri_components(Atom, Uri).
38atom_uri(Atom, UriQQ) :-
39 atom(Atom),
40 uri_components(Atom, Uri),
41 uri_uriqq(Uri, UriQQ).
42
43
45uri_uriqq(Uri, UriQQ) :-
46 scheme(Uri, UriQQ),
47 authority(Uri, UriQQ),
48 path(Uri, UriQQ),
49 search(Uri, UriQQ),
50 fragment(Uri, UriQQ).
51
52scheme(Uri, UriQQ) :-
53 uri_data(scheme, Uri, Scheme),
54 uriqq_data(scheme, UriQQ, Scheme).
55
56authority(Uri, UriQQ) :-
57 uri_data(authority, Uri, Authority),
58 uri_authority_data(user, As, User),
59 uri_authority_data(password, As, Password),
60 uri_authority_data(host, As, Host),
61 uri_authority_data(port, As, Port),
62
63 uriqq_data(user, UriQQ, User),
64 uriqq_data(password, UriQQ, Password),
65 uriqq_data(host, UriQQ, Host),
66 uriqq_data(port, UriQQ, Port),
67
68 ( var(Authority), var(User), var(Password), var(Host), var(Port)
69 ; uri_authority_components(Authority, As)
70 ).
71
72path(Uri, UriQQ) :-
73 uri_data(path, Uri, PathA),
74 uriqq_data(path, UriQQ, PathB),
75 ( var(PathA), var(PathB)
76 ; nonvar(PathB),
77 maplist(path_term,PathC,PathB),
78 atomic_list_concat(PathC,/,PathA)
79 ; atomic_list_concat(PathB,/,PathA)
80 ).
81
82search(Uri, UriQQ) :-
83 uri_data(search, Uri, Search),
84 uriqq_data(search, UriQQ, Pairs),
85 ( var(Search), var(Pairs)
86 ; atom(Search), atom_concat('$', _, Search), Pairs=Search
87 ; is_dict(Pairs),
88 dict_pairs(Pairs, _, Pairs1),
89 uri_query_components(Search, Pairs1)
90 ; uri_query_components(Search, Pairs)
91 ).
92
93fragment(Uri, UriQQ) :-
94 uri_data(fragment, Uri, Fragment),
95 uriqq_data(fragment, UriQQ, Fragment).
96
97replace_variables(Vars, Term0, Term) :-
98 99 atom(Term0),
100 atom_concat('$', Name, Term0),
101 !,
102 ( memberchk(Name=Value, Vars) ->
103 Term = Value
104 ; 105 Term = Term0
106 ).
107replace_variables(Vars, Term0, Term) :-
108 109 nonvar(Term0),
110 Term0 =.. [Name|Args0],
111 !,
112 maplist(replace_variables(Vars), Args0, Args),
113 Term =.. [Name|Args].
114replace_variables(_, Term, Term) :-
115 116 true.
117
118path_term(Path, Term) :-
119 var(Path),
120 Term = _/_,
121 !,
122 list_slashes(PathList, Term),
123 atomic_list_concat(PathList, /, Path).
124path_term(Path, Term) :-
125 atom(Term),
126 Path = Term.
127
129list_slashes(List, Slashes) :-
130 nonvar(List),
131 !,
132 reverse(List, ReverseList),
133 list_slashes_(ReverseList, Slashes).
134list_slashes(List, Slashes) :-
135 nonvar(Slashes),
136 list_slashes_(ReverseList, Slashes),
137 reverse(ReverseList, List).
138
139list_slashes_([Tail|Path], Head/Tail) :-
140 Path \== [],
141 !,
142 list_slashes_(Path, Head).
143list_slashes_([X], X).
144
146qq(Stream, Vars, MaybeBase, Result) :-
147 read_stream_to_codes(Stream, Codes),
148 atom_codes(Atom, Codes),
149 qq_an_atom(Atom, Vars, UriQQ),
150 uriqq_data(scheme, UriQQ, Scheme),
151 ( var(Scheme) ->
152 ( MaybeBase = just(Base) ->
153 Result = uri_relative(Base, UriQQ)
154 ; 155 Result = uri_suffix(UriQQ)
156 )
157 ; 158 Result = uri_absolute(UriQQ)
159 ).
160
161qq_an_atom(Atom, Vars, Result) :-
162 atom_uri(Atom, Uri0),
163 replace_variables(Vars, Uri0, Result).
164
165:- quasi_quotation_syntax(uri). 166uri(Content,Args,Vars,Result) :-
167 ( Args = [Base] ->
168 MaybeBase = just(Base)
169 ; 170 MaybeBase = none
171 ),
172 with_quasi_quotation_input(Content, Stream, qq(Stream,Vars,MaybeBase,Result)).
173
174
175:- use_module(library(function_expansion)). 176user:function_expansion( uri_absolute(UriQQ)
177 , Atom
178 , once(uri_qq:atom_uri(Atom,UriQQ))
179 ).
180user:function_expansion( uri_relative(Base, UriQQ)
181 , Atom
182 , ( once(uri_qq:atom_uri(RelUri,UriQQ))
183 , uri_resolve(RelUri, Base, Atom)
184 )
185 ).
186user:function_expansion( uri_suffix(UriQQ)
187 , Atom
188 , ( once(uri_qq:atom_uri(Suffix,UriQQ))
189 , atom_concat('http://', Suffix, Atom)
190 )
191 )