1:- module(bc_mail_template, [
    2    bc_mail_register_template/3, % +Name, +Subject, +Text
    3    bc_mail_render_template/3    % +Name, +Data, -Dict
    4]).    5
    6:- use_module(library(error)).    7:- use_module(library(debug)).    8:- use_module(library(st/st_render)).    9
   10:- use_module(bc_data_config).   11
   12:- dynamic(template/3).
 bc_mail_register_template(+Name, +Subject, +Text) is det
Adds or replaces the given file.
   18bc_mail_register_template(Name, Subject, Text):-
   19    must_be(atom, Name),
   20    must_be(string, Subject),
   21    must_be(string, Text),
   22    retractall(template(Name, _, _)),
   23    assertz(template(Name, Subject, Text)),
   24    debug(bc_mail, 'registered mail template ~w', [Name]).
 bc_mail_render_template(+Name, +Data, -Dict) is det
Renders the mail template with given data.
   30bc_mail_render_template(Name, Data, Dict):-
   31    must_be(atom, Name),
   32    must_be(dict, Data),
   33    (   template(Name, SubjectSource, BodySource)
   34    ->  true
   35    ;   throw(error(existence_error(mail_template, Name), _))),
   36    bc_config_dict(Config),
   37    RenderData = Data.put(config, Config),
   38    render_subject(Name, SubjectSource, RenderData, Subject),
   39    render_body(Name, BodySource, RenderData, Body),
   40    Dict = _{ subject: Subject, body: Body }.
   41
   42% Renders subject line template.
   43
   44render_subject(Name, Source, Data, Subject):-
   45    with_output_to(string(Subject), (
   46        current_output(Out),
   47        st_render_string(Source, Data,
   48            Out, mail/Name/subject, _{
   49            extension: txt,
   50            cache: true,
   51            strip: false,
   52            frontend: simple
   53        }))).
   54
   55% Renders body template.
   56
   57render_body(Name, Source, Data, Body):-
   58    with_output_to(string(Body), (
   59        current_output(Out),
   60        st_render_string(Source, Data,
   61            Out, mail/Name, _{
   62            extension: txt,
   63            cache: true,
   64            strip: false,
   65            frontend: simple
   66        }))).
   67
   68% Reads mail template. File is relative
   69% to mail templates directory.
   70
   71read_mail_template(File, Source):-
   72    mail_directory(Directory),
   73    read_file_to_string(Directory/File, Source, []).
   74
   75% Mail templates directory.
   76
   77mail_directory(Directory):-
   78    module_property(bc_mail_template, file(File)),
   79    file_directory_name(File, Dir),
   80    atom_concat(Dir, '/mail', Directory).
   81
   82% Default mail template for mention mails.
   83
   84:-  read_mail_template('mention.txt', Body),
   85    bc_mail_register_template(
   86        mention, "{{= entry.title }} - comment", Body).   87
   88% Default mail template for reply mails.
   89
   90:-  read_mail_template('reply.txt', Body),
   91    bc_mail_register_template(
   92        reply, "{{= entry.title }} - reply", Body).   93
   94% Default mail template for comment notifications
   95% to the entry author.
   96
   97:-  read_mail_template('comment.txt', Body),
   98    bc_mail_register_template(
   99        comment, "{{= entry.title }} - new comment", Body).