aat

git mirror of https://ccx.te2000.cz/bzr/aat
git clone https://ccx.te2000.cz/git/aat
Log | Files | Refs | README

query.pl (6175B)


      1 #!/usr/bin/env swipl
      2 % vim: ft=prolog textwidth=80 tabstop=4 softtabstop=4 shiftwidth=4 expandtab
      3 
      4 %% :- use_module(library(pure_input)).
      5 %%% :- use_module(library(dcg/basics)).
      6 
      7 :- initialization main.
      8 :- multifile prolog:message//1.
      9 
     10 query_name([H|T]) -->
     11     [H], { code_type(H, csymf) },
     12     query_name_next(T).
     13 query_name_next([H|T]) -->
     14     [H], { H = 0'.; code_type(H, csym) },
     15     !,
     16     query_name_next(T).
     17 query_name_next([]) --> [].
     18 
     19 query_default_text([H|T]) -->
     20     [H],
     21     {\+memberchk(H,`'<>`)},
     22     !,
     23     query_default_text(T).
     24 query_default_text([]) --> [].
     25 
     26 query_content([name(Name)|T]) --> query_name(Name), query_content(T).
     27 query_content([expr(Expr)|T]) --> `'`, query_awk(Expr), `'`, query_content(T).
     28 query_content([query(Query, Filters, Default)|T]) -->
     29     query_exp(Query, Filters, Default), query_content(T).
     30 query_content([]) --> [].
     31 
     32 query_default([string(String)|T]) --> awk_string(String), query_default(T).
     33 query_default([expr(Expr)|T]) --> `'`, query_awk(Expr), `'`, query_default(T).
     34 % query_default([query(Query)|T]) --> query_exp(Query), query_default(T).
     35 query_default([query(Query, Filters, Default)|T]) -->
     36     query_exp(Query, Filters, Default), query_default(T).
     37 query_default([]) --> [].
     38 
     39 query_exp(Content, Filters, Default) -->
     40     `<`,
     41     query_content(Content),
     42     query_exp_filters(Filters),
     43     query_exp_default(Default),
     44     `>`.
     45 
     46 query_exp_filters([H|T]) -->
     47     `|`, query_name(H), query_exp_filters(T).
     48 query_exp_filters([]) --> [].
     49 
     50 query_exp_default(none) --> [].
     51 query_exp_default(Default) --> `:`, query_default(Default).
     52 
     53 awk_string(String) --> `"`, awk_string_content(String), `"`.
     54 
     55 awk_string_content([0'\\,H|T],R) -->
     56     [0'\\,H],
     57     !,
     58     awk_string_content(T,R).
     59 awk_string_content([H|T],R) -->
     60     [H], { H\=0'\\, H\=0'" },
     61     !,
     62     awk_string_content(T,R).
     63 awk_string_content(R,R) --> [].
     64 awk_string_content(L) --> awk_string_content(L,[]).
     65 
     66 awk_regex_content([0'\\,H|T],R) -->
     67     [0'\\,H],
     68     !,
     69     awk_regex_content(T,R).
     70 awk_regex_content([H|T],R) -->
     71     [H], { H\=0'\\, H\=0'/ },
     72     !,
     73     awk_regex_content(T,R).
     74 awk_regex_content(R,R) --> [].
     75 awk_regex_content(L) --> awk_regex_content(L,[]).
     76 
     77 awk_comment([0'\n|R],R) --> `\n`, !.
     78 awk_comment([H|T],R) -->
     79     [H], {assertion(H \= 0'\n)},
     80     !,
     81     awk_comment(T,R).
     82 % awk_comment(L) --> awk_comment(L,[]).
     83 
     84 awk_code([0'"|T0],R,_,F) -->
     85     `"`, !, awk_string_content(T0,T1), `"`, { T1=[0'"|T2] }, awk_code(T2,R,expr,F).
     86 awk_code([0'/|T0],R,Prev,F) -->
     87     { memberchk(Prev, [delim, op]) },
     88     `/`, !, awk_regex_content(T0,T1), `/`, { T1=[0'/|T2] }, awk_code(T2,R,expr,F).
     89 awk_code([0'#|T],R,_,F) -->
     90     `#`, !, awk_comment(T,T1), awk_code(T1,R,op,F).
     91 awk_code([H|T],R,Prev,F) -->
     92     [H], { code_type(H, white) }, !, awk_code(T,R,Prev,F).
     93 awk_code([H|T],R,_,F) -->
     94     [H], { memberchk(H, `\n,;([{=`) }, !, awk_code(T,R,delim,F).
     95 awk_code([H|T],R,_,F) -->
     96     [H], { memberchk(H, `!+-*/%^&|?:>~`) }, !, awk_code(T,R,op,F).
     97 % awk_code([0'<|T],R,Prev,F) -->
     98 %     `<`, !, { Prev \= delim }, awk_code(T,R,op,F).
     99 awk_code([H|T],R,Prev,F) -->
    100     [H],
    101     { H \= 0'', H \= 0'@, (H \= 0'< ; Prev \= delim ) },
    102     !,
    103     awk_code(T,R,expr,F).
    104 awk_code(R,R,L,L) --> [].
    105 % awk_code(L) --> awk_code(L,[],delim,_).
    106 
    107 query_awk([query(Query, Filters, Default)|T],delim) -->
    108     query_exp(Query, Filters, Default),
    109     query_awk(T, expr).
    110 query_awk([code(Code)|T], Last) -->
    111     awk_code(Code, [], Last, Next),
    112     { Code \= [] },
    113     query_awk(T, Next).
    114 query_awk([], _) --> [].
    115 query_awk(L) --> query_awk(L,delim).
    116 
    117 %%%
    118 
    119 out_awk([code(Code)|T]) --> Code, out_awk(T).
    120 out_awk([query(Query, Filters, Default)|T]) -->
    121     out_query(Query, Filters, Default), out_awk(T).
    122 out_awk([]) --> [].
    123 
    124 out_query(Query, Filters, none) -->
    125     out_filters(Filters, out_f_get(Query)).
    126 out_query(Query, Filters, Default) -->
    127     `(find(`, out_query_content(Query), `)?`,
    128     out_filters(Filters, out_f_found),
    129     `:`, out_default(Default), `)`.
    130 
    131 out_f_get(Query) -->
    132     `get(`, out_query_content(Query), `)`.
    133 
    134 out_f_found --> `found`.
    135 
    136 out_filters([H|T], Pred) -->
    137     H, `(`, out_filters(T, Pred), `)`.
    138 out_filters([], Pred) --> call(Pred).
    139 
    140 out_query_content([name(Name)|T]) --> `"`, Name, `"`, out_query_content(T).
    141 out_query_content([expr(Expr)|T]) --> `(`, out_awk(Expr), `)`, out_query_content(T).
    142 out_query_content([query(Query, Filters, Default)|T]) -->
    143     out_query(Query, Filters, Default), out_query_content(T).
    144 out_query_content([]) --> [].
    145 
    146 out_default([]) --> `""`.
    147 out_default([H|T]) --> out_default_aux([H|T]).
    148 out_default_aux([string(String)|T]) --> awk_string(String), out_default_aux(T).
    149 out_default_aux([expr(Expr)|T]) --> `(`, out_awk(Expr), `)`, out_default_aux(T).
    150 out_default_aux([query(Query, Filters, Default)|T]) -->
    151     out_query(Query, Filters, Default), out_default_aux(T).
    152 out_default_aux([]) --> [].
    153 
    154 %%%
    155 
    156 
    157 parse_file(InFile) :-
    158     (  open(InFile, read, Fd, [encoding(utf8)]), read_stream_to_codes(Fd, Codes)
    159     -> true
    160     ;  throw(read_error(InFile))
    161     ),
    162     (  
    163        % phrase_from_file(query_awk(Awk), InFile)
    164        phrase(query_awk(Awk), Codes)
    165     -> true
    166     ;  throw(parsing_failed(InFile))
    167     ),
    168     (  phrase(out_awk(Awk), Out)
    169     -> true
    170     ;  throw(formatting_failed(InFile,Awk))
    171     ),
    172     current_stream(1, write, OutStream),
    173     set_stream(OutStream, encoding(utf8)),
    174     format('~s', [Out]).
    175 
    176 main :- current_prolog_flag(argv, Argv), main(Argv).
    177 
    178 main(Args) :-
    179     set_prolog_flag(verbose, false),
    180     (  (Args=[] -> InFile='/dev/stdin' ; Args=[InFile])
    181     -> catch(parse_file(InFile), E, (print_message(error, E), halt(1)))
    182     ;  write('usage: query.pl: [filename]\n'), halt(2)
    183     ),
    184     halt.
    185 
    186 %    current_input(In), set_stream(In, tty(false)),
    187 %    (phrase_from_stream(query_awk(Awk), In) -> true ; throw(parsing_failed)),
    188 %    (phrase(out_awk(Awk), Out) -> true ; throw(formatting_failed(Awk))),
    189 %    format('~s', [Out]).
    190 
    191 prolog:message(read_error(File)) -->
    192     ['Unable to read file: ~w'-[File]].
    193 prolog:message(parsing_failed(File)) -->
    194     ['Unable to parse AWK/query file: ~w'-[File]].
    195 prolog:message(formatting_failed(File,_)) -->
    196     ['Failed generating AWK code from file: ~w'-[File]].