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
   55user:file_search_path(blog, blog).
   56
   57:- html_resource(pldoc_blog,
   58		 [ ordered(true),
   59                   requires([ jquery,
   60                              js('blog.js')
   61			    ]),
   62		   virtual(true)
   63		 ]).   64:- html_resource(css('blog.css'), []).   65
   66
   67blog(Request) :-
   68    memberchk(path_info(PathInfo), Request),
   69    PathInfo \== '/',
   70    !,
   71    debug(blog, 'Path info ~p', [PathInfo]),
   72    atom_concat(/, File, PathInfo),
   73    safe_file_name(File),
   74    absolute_file_name(blog(File), Path,
   75                       [ access(read)
   76                       ]),
   77    wiki_file_to_dom(Path, DOM0),
   78    extract_title(DOM0, Title, DOM1),
   79    append(DOM1, [\discourse(Request)], DOM),
   80    title_text(Title, TitleString),
   81    http_link_to_id(blog, [], HREF),
   82    reply_html_page(
   83        blog(Path, [a(href(HREF), 'Blog'), ': ' | Title]),
   84        [ title(TitleString)
   85        ],
   86        DOM).
   87blog(_Request) :-
   88    blog_index(Blogs),
   89    reply_html_page(
   90        blog(index),
   91        [ title("SWI-Prolog blog")
   92        ],
   93        \blog_index_page(Blogs)).
   94
   95blog_index_page(Blogs) -->
   96    html_requires(pldoc_blog),
   97    html_requires(css('blog.css')),
   98    blog_index_title,
   99    blog_tags(Blogs),
  100    blog_index(Blogs).
  101
  102blog_index_title -->
  103    html({|html||
  104<p>
  105The SWI-Prolog blog is intended for articles on how to tackle certain problems
  106using SWI-Prolog, experience using SWI-Prolog for larger projects, etc.  Posts
  107can be submitted as pull-requests on
  108<a href="https://github.com/SWI-Prolog/plweb-blog">GitHub</a>.
  109         |}).
 blog_tags(+Blogs)//
  114blog_tags(Blogs) -->
  115    { blog_tag_counts(Blogs, Counts) },
  116    html(div(class('blog-tags'), \sequence(tag, [' '], Counts))).
  117
  118tag(Tag-Count) -->
  119    html(span([ class('blog-tag'),
  120                'data-tag'(Tag)
  121              ],
  122              [ span(class('blog-tag-tag'), Tag),
  123                span(class('blog-tag-cnt'), Count)
  124              ])).
  125
  126blog_tag_counts(Blogs, Pairs) :-
  127    convlist(get_dict(tags), Blogs, Tags),
  128    flatten(Tags, TagList0),
  129    msort(TagList0, TagList),
  130    clumped(TagList, Pairs0),
  131    sort(2, >=, Pairs0, Pairs).
  132
  133blog_index(Index) :-
  134    absolute_file_name(blog('Index.yaml'), File,
  135                       [ access(read)
  136                       ]),
  137    yaml_read(File, Index0),
  138    sort(date, @>=, Index0.posts, Index).
  139
  140blog_index(Blogs) -->
  141    { map_list_to_pairs(key_blog_year, Blogs, Tagged),
  142      group_pairs_by_key(Tagged, ByYear)
  143    },
  144    html(div(class('blog-index'),
  145             \sequence(blog_year, ByYear))).
  146
  147key_blog_year(Blog, Year) :-
  148    split_string(Blog.get(date), "-", "", [YS|_]),
  149    number_string(Year, YS).
  150
  151blog_year(Year-Blogs) -->
  152    html(div(class('blog-year-index'),
  153             [ div(class('blog-year'), Year),
  154               div(class('blog-year-entries'),
  155                   \sequence(blog_index_entry, Blogs))
  156             ])).
  157
  158blog_index_entry(Blog) -->
  159    { atomics_to_string(Blog.get(tags,[]),"|",Tags),
  160      http_link_to_id(blog, path_postfix(Blog.file), HREF)
  161    },
  162    html(a([ class('blog-index-entry'),
  163             'data-tags'(Tags),
  164             href(HREF)
  165           ],
  166           [ \block_date(Blog),
  167             \block_title(Blog)
  168           ])).
  169
  170block_date(Blog) -->
  171    optional(html(span(class('blog-index-date'),Blog.get(date))), []).
  172block_title(Blog) -->
  173    optional(html(span(class('blog-index-title'),Blog.get(title))), []).
  174
  175
  176		 /*******************************
  177		 *            DISCOURSE		*
  178		 *******************************/
  179
  180discourse(Request) -->
  181    { cdn_url(Request, URL) },
  182    html(div(id('discourse-comments'), [])),
  183    js_script({|javascript(URL)||
  184window.DiscourseEmbed = { discourseUrl: 'https://swi-prolog.discourse.group/',
  185                   discourseEmbedUrl: URL };
  186
  187(function() {
  188  var d = document.createElement('script'); d.type = 'text/javascript'; d.async = true;
  189  d.src = window.DiscourseEmbed.discourseUrl + 'javascripts/embed.js';
  190  (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(d);
  191})();
  192|}).
  193
  194
  195cdn_url(Request, CDNURL) :-
  196    memberchk(request_uri(ReqURL), Request),
  197    server(cdn, CDN, _),
  198    format(atom(CDNURL), 'https://~w~w', [CDN, ReqURL]).
  199
  200
  201		 /*******************************
  202		 *            UPDATE		*
  203		 *******************************/
 pull_blogs
Do a git pull on the blog repo
  209pull_blogs :-
  210    (   absolute_file_name(blog(.), BlogDir,
  211                           [ file_type(directory),
  212                             access(write),
  213                             solutions(all)
  214                           ]),
  215        is_git_directory(BlogDir),
  216        git([pull], [directory(BlogDir)]),
  217        fail
  218    ;   purge_location('/blog')
  219    ).
  220
  221
  222		 /*******************************
  223		 *             HTTP		*
  224		 *******************************/
  225
  226:- http_handler(root(blog/pull), pull_blogs, []).  227
  228pull_blogs(Request) :-
  229    (   option(method(post), Request)
  230    ->  http_read_json(Request, JSON),
  231        print_message(informational, got(JSON))
  232    ;   true
  233    ),
  234    call_showing_messages(pull_blogs, [])