View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        jan@swi-prolog.org
    5    WWW:           https://www.swi-prolog.org
    6    Copyright (C): 2020, SWI-Prolog Solutions b.v.
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalexpandidate any other reasons why the executable file might be
   27    covered by the GNU General Public License.
   28*/
   29
   30:- module(blog,
   31          []).   32:- use_module(library(http/html_head)).   33:- use_module(library(http/html_write)).   34:- use_module(library(http/http_dispatch)).   35:- use_module(library(debug)).   36:- use_module(library(yaml)).   37:- use_module(library(dcg/high_order)).   38:- use_module(library(apply)).   39:- use_module(library(lists)).   40:- use_module(library(pairs)).   41:- use_module(library(git)).   42:- use_module(library(option)).   43:- use_module(library(http/http_json)).   44:- use_module(library(http/http_host)).   45:- use_module(library(http/js_write)).   46:- use_module(library(uri)).   47
   48:- use_module(wiki).   49:- use_module(messages).   50:- use_module(fastly).   51:- use_module(parms).   52
   53:- http_handler(root(blog), blog, [prefix, id(blog)]).   54
   55:- html_resource(pldoc_blog,
   56		 [ ordered(true),
   57                   requires([ jquery,
   58                              js('blog.js')
   59			    ]),
   60		   virtual(true)
   61		 ]).   62:- html_resource(css('blog.css'), []).   63
   64
   65blog(Request) :-
   66    memberchk(path_info(PathInfo), Request),
   67    PathInfo \== '/',
   68    !,
   69    debug(blog, 'Path info ~p', [PathInfo]),
   70    atom_concat(/, File, PathInfo),
   71    safe_file_name(File),
   72    absolute_file_name(blog(File), Path,
   73                       [ access(read)
   74                       ]),
   75    wiki_file_to_dom(Path, DOM0),
   76    extract_title(DOM0, Title, DOM1),
   77    append(DOM1, [\discourse(Request)], DOM),
   78    title_text(Title, TitleString),
   79    http_link_to_id(blog, [], HREF),
   80    reply_html_page(
   81        blog(Path, [a(href(HREF), 'Blog'), ': ' | Title]),
   82        [ title(TitleString)
   83        ],
   84        DOM).
   85blog(_Request) :-
   86    blog_index(Blogs),
   87    reply_html_page(
   88        blog(index),
   89        [ title("SWI-Prolog blog")
   90        ],
   91        \blog_index_page(Blogs)).
   92
   93blog_index_page(Blogs) -->
   94    html_requires(pldoc_blog),
   95    html_requires(css('blog.css')),
   96    blog_index_title,
   97    blog_tags(Blogs),
   98    blog_index(Blogs).
   99
  100blog_index_title -->
  101    html({|html||
  102<p>
  103The SWI-Prolog blog is intended for articles on how to tackle certain problems
  104using SWI-Prolog, experience using SWI-Prolog for larger projects, etc.  Posts
  105can be submitted as pull-requests on
  106<a href="https://github.com/SWI-Prolog/plweb-blog">GitHub</a>.
  107         |}).
 blog_tags(+Blogs)//
  112blog_tags(Blogs) -->
  113    { blog_tag_counts(Blogs, Counts) },
  114    html(div(class('blog-tags'), \sequence(tag, [' '], Counts))).
  115
  116tag(Tag-Count) -->
  117    html(span([ class('blog-tag'),
  118                'data-tag'(Tag)
  119              ],
  120              [ span(class('blog-tag-tag'), Tag),
  121                span(class('blog-tag-cnt'), Count)
  122              ])).
  123
  124blog_tag_counts(Blogs, Pairs) :-
  125    convlist(get_dict(tags), Blogs, Tags),
  126    flatten(Tags, TagList0),
  127    msort(TagList0, TagList),
  128    clumped(TagList, Pairs0),
  129    sort(2, >=, Pairs0, Pairs).
  130
  131blog_index(Index) :-
  132    absolute_file_name(blog('Index.yaml'), File,
  133                       [ access(read)
  134                       ]),
  135    yaml_read(File, Index0),
  136    sort(date, @>=, Index0.posts, Index).
  137
  138blog_index(Blogs) -->
  139    { map_list_to_pairs(key_blog_year, Blogs, Tagged),
  140      group_pairs_by_key(Tagged, ByYear)
  141    },
  142    html(div(class('blog-index'),
  143             \sequence(blog_year, ByYear))).
  144
  145key_blog_year(Blog, Year) :-
  146    split_string(Blog.get(date), "-", "", [YS|_]),
  147    number_string(Year, YS).
  148
  149blog_year(Year-Blogs) -->
  150    html(div(class('blog-year-index'),
  151             [ div(class('blog-year'), Year),
  152               div(class('blog-year-entries'),
  153                   \sequence(blog_index_entry, Blogs))
  154             ])).
  155
  156blog_index_entry(Blog) -->
  157    { atomics_to_string(Blog.get(tags,[]),"|",Tags),
  158      http_link_to_id(blog, path_postfix(Blog.file), HREF)
  159    },
  160    html(a([ class('blog-index-entry'),
  161             'data-tags'(Tags),
  162             href(HREF)
  163           ],
  164           [ \block_date(Blog),
  165             \block_title(Blog)
  166           ])).
  167
  168block_date(Blog) -->
  169    optional(html(span(class('blog-index-date'),Blog.get(date))), []).
  170block_title(Blog) -->
  171    optional(html(span(class('blog-index-title'),Blog.get(title))), []).
  172
  173
  174		 /*******************************
  175		 *            DISCOURSE		*
  176		 *******************************/
  177
  178discourse(Request) -->
  179    { cdn_url(Request, URL) },
  180    html(div(id('discourse-comments'), [])),
  181    js_script({|javascript(URL)||
  182window.DiscourseEmbed = { discourseUrl: 'https://swi-prolog.discourse.group/',
  183                   discourseEmbedUrl: URL };
  184
  185(function() {
  186  var d = document.createElement('script'); d.type = 'text/javascript'; d.async = true;
  187  d.src = window.DiscourseEmbed.discourseUrl + 'javascripts/embed.js';
  188  (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(d);
  189})();
  190|}).
  191
  192
  193cdn_url(Request, CDNURL) :-
  194    memberchk(request_uri(ReqURL), Request),
  195    server(cdn, CDN, _),
  196    format(atom(CDNURL), 'https://~w~w', [CDN, ReqURL]).
  197
  198
  199		 /*******************************
  200		 *            UPDATE		*
  201		 *******************************/
 pull_blogs
Do a git pull on the blog repo
  207pull_blogs :-
  208    (   absolute_file_name(blog(.), BlogDir,
  209                           [ file_type(directory),
  210                             access(write),
  211                             solutions(all)
  212                           ]),
  213        is_git_directory(BlogDir),
  214        git([pull], [directory(BlogDir)]),
  215        fail
  216    ;   purge_location('/blog')
  217    ).
  218
  219
  220		 /*******************************
  221		 *             HTTP		*
  222		 *******************************/
  223
  224:- http_handler(root(blog/pull), pull_blogs, []).  225
  226pull_blogs(Request) :-
  227    (   option(method(post), Request)
  228    ->  http_read_json(Request, JSON),
  229        print_message(informational, got(JSON))
  230    ;   true
  231    ),
  232    call_showing_messages(pull_blogs, [])