◊(Local Yarn Code "Check-in [cf26929b]")

*.html
*.out
*.ltx
*.aux
*.log
*.xml
*.toc
*.mark

# Licensing

This project includes both writing and code. I want people to be able to use the code safely and
without restriction, but for authors to have tighter control over their writing, images and other
content.

Accordingly:

* Each file is licensed separately. The header of each file, or its reference in `NOTICES.txt`,
  determines how you are allowed to use the contents of that file.
* The source code files generally use a very permissive license, the Blue Oak Model license. A copy
  of that license is included below).
* Other files, such as those containing the content of the website and books, are included here by
  permission of their authors, and are generally not licensed for reuse unless specifically
  provided.

Note that nothing here applies to files that aren’t included in [this project’s Fossil
repository](https://thelocalyarn.com/cgi-bin/yarncode/dir?ci=tip).

## Giving Credit

Please consider giving public credit to this project if you use significant amounts of its code in
any software or system, or if you publish any work using code from this project. This credit should
be a short notice that, at a minimum, includes this project’s name *The Local Yarn* and its domain
name `thelocalyarn.com`.

Suggested examples:

* If users access your system or work by running a program you provide, include the notice in the
  program’s *About* screen (for a graphical or interactive program) or in the output of the
  program’s “version” argument (for command-line programs).
* If users access your system or work via the World Wide Web, put the notice or a link to the notice
  at the bottom of the home page. 
* If your work is published as a printed book, include the notice in the book’s front matter.

# Blue Oak Model License

Version 1.0.0

## Purpose

This license gives everyone as much permission to work with this software as possible, while
protecting contributors from liability.

## Acceptance

In order to receive this license, you must agree to its rules. The rules of this license are both
obligations under that agreement and conditions to your license. You must not do anything with this
software that triggers a rule that you cannot or will not follow.

## Copyright

Each contributor licenses you to do everything with this software that would otherwise infringe that
contributor's copyright in it.




















## Notices

You must ensure that everyone who gets a copy of any part of this software from you, with or without
changes, also gets the text of this license or a link to <https://blueoakcouncil.org/license/1.0.0>.


## Excuse

If anyone notifies you in writing that you have not complied with [Notices](#notices), you can keep
your license by taking all practical steps to comply within 30 days after the notice.  If you do not
do so, your license ends immediately.

## Patent

Each contributor licenses you to do everything with this software that would otherwise infringe any
patent claims they can license or become able to license.

## Reliability

#lang pollen/mode racket/base

;; Copyright (c) 2019 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
;; You may also obtain a copy of the License at
;;
;;       http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; Author contact information:
;;   joel@jdueck.net
;;   https://joeldueck.com
;; -------------------------------------------------------------------------

;; Builds the paginated “blog” HTML files (blog-pg1.html ...) from the SQLite cache
;; The files will be written out every time this module is evaluated! (see end)

(require "crystalize.rkt"
         "snippets-html.rkt"
         racket/file
         sugar/list)

(provide main)

;; How many items per blog page
(define per-page 5)

;; Returns a string containing the entire HTML contents of a given blog page
(define (blog-page posts-str pagenum total-pages)
  (define page-nav (html$-paginate-navlinks pagenum total-pages "blog"))
  ◊string-append{
 <!DOCTYPE html>
 <html lang="en">
 ◊html$-page-head[(format "The Local Yarn: Blog, p. ~a" pagenum)]
 ◊html$-page-body-open[]

 <aside><i>Everything, in reverse time order. Well, almost everything.</i></aside>

 <nav id="top-nav"><ul>◊|page-nav|</ul></nav>

 ◊posts-str

 <nav id="bottom-nav"><ul>◊|page-nav|</ul></nav>

 ◊html$-page-body-close[]
 </html>})

;; Grabs all the articles+notes from the cache and writes out all the blog page files
(define (build-blog)
  (spell-of-summoning!) ; Turn on the DB
  
  (define articles+notes (slice-at (list/articles+notes 'listing_full_html #:series #f) per-page))
  (define pagecount (length articles+notes))
  
  (for ([pagenum (in-range 1 (+ 1 pagecount))]
        [page    (in-list articles+notes)])
    (define filename (format "blog-pg~a.html" pagenum))
    (displayln (format "Writing: ~a" filename))
    (display-to-file (blog-page (apply string-append page) pagenum pagecount)
                     filename
                     #:mode 'text
                     #:exists 'replace)))

(define (main)
  ;; Do it!
  (build-blog))

“Crystalizing” is an extra layer in between docs and templates that destructures the doc and stores
it in various pieces in a SQLite cache. Individual articles save chunks of rendered HTML to the
cache when their individual pages are rendered. The SQLite cache is then referenced by any page that
collects multiple articles and notes together. This is much faster than fetching docs and metas
through Pollen’s cache and re-converting them to HTML.



@defproc[(spell-of-summoning!) void?]

Initializes the SQLite database cache file. This involves creating the file
(@filepath{vitreous.sqlite}) if it does not exist, and running queries to create tables in the
database if they do not exist.




This function is called automatically in @filepath{pollen.rkt} whenever HTML is the target output.


@defproc[(crystalize-article! [pagenode pagenode?] [doc txexpr?]) non-empty-string?]

Returns a string containing the HTML of @racket[_doc]. @margin-note{This is one function that breaks
my convention of using a prefix of @tt{html$-} for functions that return strings of HTML.}
Privately, it does a lot of other work. The article is saved to the SQLite cache. If the article
specifies a @racket['series] meta, information about that series is fetched and used in the
rendering of the article. If there are @racket[note]s in the doc, they are parsed and saved
individually to the SQLite cache. If any of the notes use the @code{#:disposition} attribute,
information about the disposition is parsed out and used in the rendering of the article.

@deftogether[(@defproc[(list/articles [type (or/c 'listing_full_html 
                                                  'listing_short_html
                                                  'listing_excerpt_html)]
                                      [#:series series (or/c string? boolean?) #t]
                                      [#:limit limit stringish? -1]
                                      [order string? "DESC"]) (listof string?)]
              @defproc[(list/articles+notes [type (or/c 'listing_full_html 
                                                        'listing_short_html
                                                        'listing_excerpt_html)]
                                            [#:series series (or/c string? boolean?) #t]
                                            [#:limit limit stringish? -1]
                                            [order string? "DESC"]) (listof string?)])]

Fetches the HTML for all articles from the SQLite cache and returns a list of strings containing the
HTML for each. The articles will be ordered by publish date according to @racket[_order] and
optionally limited to the series specified in @racket[_series].

If @racket[_series] expression evaluates to @racket[#f], articles will not be filtered by series. If
it evaluates to @racket[#t] (the default), articles will be filtered by those that specify the
current output of @racket[here-output-path] in their @tt{series_pagenode} column in the SQLite
cache. If a string is supplied, articles will be filtered by those containing that exact value in
their @tt{series_pagenode} column in the SQLite cache.

The @racket[_order] expression must evaluate to either @racket["ASC"] or @racket["DESC"] and the
@racket[_limit] expressions must evaluate to a value suitable for use in the @tt{LIMIT} clause of
@ext-link["https://sqlite.org/lang_select.html"]{a SQLite @tt{SELECT} statement}. An expression that
evaluates to a negative integer (the default) is the same as having no limit.

@deftogether[(@defproc[(listing<>-short/articles [#:series series (or/c string? boolean?) #t]
                                            [#:limit limit stringish? -1]
                                            [order string? "DESC"]) txexpr?]
              @defproc[(listing<>-full/articles  [#:series series (or/c string? boolean?) #t]
                                            [#:limit limit stringish? -1]
                                            [order string? "DESC"]) txexpr?])]

@margin-note{Notice how the functions that start with @tt{list/} return lists and the functions that
start with @tt{listing<>} return fenced HTML strings. Maybe this is ugly, but it helps me keep these
otherwise too-similar sets of functions straight in my head.}

Fetches the HTML for all articles from the SQLite cache and returns the HTML strings fenced inside
a @racket['style] tagged X-expression. The articles will be ordered by publish date according to
@racket[_order] and optionally limited to the series specified in @racket[_series].

If @racket[_series] expression evaluates to @racket[#f], articles will not be filtered by series. If
it evaluates to @racket[#t] (the default), articles will be filtered by those that specify the
current output of @racket[here-output-path] in their @tt{series_pagenode} column in the SQLite
cache. If a string is supplied, articles will be filtered by those containing that exact value in
their @tt{series_pagenode} column in the SQLite cache.

The @racket[_order] expression must evaluate to either @racket["ASC"] or @racket["DESC"] and the
@racket[_limit] expressions must evaluate to a value suitable for use in the @tt{LIMIT} clause of
@ext-link["https://sqlite.org/lang_select.html"]{a SQLite @tt{SELECT} statement}. An expression that
evaluates to a negative integer (the default) is the same as having no limit.

The reason for enclosing the results in a @racket['style] txexpr is to prevent the HTML from being
escaped by @racket[->html] in the template. This tag was picked for the job because there will
generally never be a need to include any actual CSS information inside a @tt{<style>} tag in any
page, so it can be safely filtered out later. To remove the enclosing @tt{<style>} tag, see
@racket[unfence].

@defproc[(listing<>-full/articles+notes [#:series series (or/c string? #f) #f]
                                   [#:limit limit exact-integer? -1]
                                   [order string? "DESC"]) txexpr?]

Like @racket[listing<>-full/articles] except that notes and articles are combined side by side in
the results.

@defproc[(unfence [html string?]) string?]

Returns @racket[_html] with all occurrences of @racket["<style>"] and @racket["</style>"] removed.
The contents of the style tags are left intact.

Use this with strings returned from @racket[->html] when called on docs containing
@racket[listing<>-full/articles] or its siblings.

@defproc[(article-plain-title [pagenode pagenode?]) non-empty-string?]

Fetches the “plain” title (i.e., with no HTML markup) for the given article from the SQLite cache.
If the article did not specify a title, a default title is supplied. If the article contained
a @racket[note] that used the @code{#:disposition} attribute, the disposition-mark may be included
in the title.

Note that this needs to be called @emph{after} @racket[crystalize-article!] in order to get an
up-to-date value.

@section{Constants}

@defthing[default-authorname string? #:value "Joel Dueck"]

Used as the default author name for @code{note}s, and (possibly in the future) for articles
generally.

@deftogether[(@defthing[articles-folder path-string? #:value "articles"]
              @defthing[series-folder   path-string? #:value "series"])]

The names of the folders that contain the Pollen source documents for Articles and Series
respectively, relative to the project’s document root.

@deftogether[(@defproc[(articles-pagetree) pagetree?]
              @defproc[(series-pagetree) pagetree?])]

These are project-wide pagetrees: @racket[articles-pagetree] contains a pagenode for every Pollen
document contained in @racket[articles-folder], and @racket[series-pagetree] contains a pagenode for
every Pollen document in @racket[series-folder]. The pagenodes themselves point to the rendered
@tt{.html} targets of the source documents.

@defproc[(here-output-path) path?]

Returns the path to the current output file, relative to @racket[current-project-root]. If no metas
are available, raises an error. This is like what you can get from the @tt{here} variable that Pollen
provides, except it is available outside templates.

@defproc[(here-id [suffix (or/c (listof string?) string? #f) #f]) string?]

Returns the 8-character prefix of the SHA1 hash of the current document’s output path. If no metas
are available, raises an error. If @racket[_suffix] evaluates to a string or a list of strings, they
are appended verbatim to the end of the hash.

This ID is used when creating URL fragment links within an article, such as for footnotes and index
entries. As long as the web version of the article is not moved to a new URL, the ID will remain the
same, which ensures deep links using the ID don’t break. The ID also ensures each article’s internal
links will be unique, so that links do not collide when multiple articles are being shown on
a single HTML page.

@section{Metas and @code{txexpr}s}

@defproc[(maybe-attr [key symbol?] [attrs txexpr-attrs?] [missing-expr any/c ""]) any/c]

Find the value of @racket[_key] in the supplied list of attributes, returning the value of
@racket[_missing-expr] if it’s not there.

I had to write this because @racket[attr-ref] wants a whole tagged X-expression (not just the

If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta
value for @racket['noun-singular], then return it, otherwise return @racket[""].

@defproc[(series-title) string?]

If @code{(current-metas)} has the key @racket['series], and if the corresponding series defines a meta
value for @racket['title], then return it, otherwise return @racket[""].

@defproc[(invalidate-series) (or/c void? boolean?)]

If the current article specifies a @racket['series] meta, and if a corresponding @filepath{.poly.pm}
file exists in @racket[series-folder], attempts to “touch” the last-modified timestamp on that file,
returning @racket[#t] on success or @racket[#f] on failure. If either precondition is not true,
returns @|void-const|.

When an article is being rendered, that means the article has changed, and if the article has
changed, its series page (if any) should be updated as well. Touching the @filepath{.poly.pm} file
for a series page triggers a re-render of that page when running @tt{make web} to rebuild the web
content (see @repo-file{makefile}).

Only used in one place, @repo-file{tags-html.rkt}.

@defproc[(disposition-values [str string?]) any]

Given a string @racket[_str], returns two values: the portion of the string coming before the first
space, and the rest of the string.

@examples[#:eval dust-eval

#lang scribble/manual

@; Copyright (c) 2019 Joel Dueck
@;
@; Copying and distribution of this file, with or without modification,
@; are permitted in any medium without royalty provided the copyright
@; notice and this notice are preserved.  This file is offered as-is,
@; without any warranty.

@(require "scribble-helpers.rkt")
@(require (for-label "../pollen.rkt"
                     "../dust.rkt"
                     "../crystalize.rkt"
                     racket/base
                     racket/contract
                     racket/string
                     txexpr
                     pollen/tag
                     pollen/setup
                     pollen/core

If you just need small caps without affecting the paragraph, use @code{smallcaps}.

@deftogether[(@defproc[(section    [element xexpr?] ...) txexpr?]
              @defproc[(subsection [element xexpr?] ...) txexpr?])]

Create second- and third-level headings, respectively. This is counting the article's title as the
first-level header (even if the current article has no title).

@defproc[(block [element xexpr?] ...) txexpr?]

A container for content that should appear grouped together on larger displays. Intended for use in
Series pages, where the template is very minimal. You would want output from
@racket[listing<>-short/articles] to appear inside a @racket[block], but you would want output from
@racket[listing<>-full/articles] to appear outside it (since each article effectively supplies its own
block). Only relevant to HTML output.

@deftogether[(@defproc[(link [link-id stringish?] [link-text xexpr?]) txexpr?]
              @defproc[(url  [link-id stringish?] [url string?]) void?])]

All hyperlinks are specified reference-style. So, to link some text, use the @code{link} tag with
an identifier, which can be a string, symbol or number. Elsewhere in the text, use @code{url} with
the same identifier to specify the URL:

You can refer to a given footnote definition more than once.

The @code{fndef} for a given id may be placed anywhere in the source document, even before it is
referenced. If you create a @code{fn} reference without a corresponding @code{fndef},
a @code{"Missing footnote definition!"} message will be substituted for the footnote text.
Conversely, creating a @code{fndef} that is never referenced will produce no output, warning or
error.

@deftogether[(@defproc[(dialogue [elements xexpr?] ...) txexpr?]
              @defproc[(say [interlocutor string?] [elements xexpr?] ...) txexpr?])]

Use these two tags together for transcripts of dialogue, chats, screenplays, interviews and so
forth.

Example usage:

@codeblock|{
  #lang pollen

  ◊dialogue{
    ◊say["Tavi"]{You also write fiction, or you used to. Do you still?}
    ◊say["Lorde"]{The thing is, when I write now, it comes out as songs.}
  }
}|

@defproc[(index [heading string?] [elements xexpr?] ...) txexpr?]

Creates an entry in the keyword index under @racket[_heading] that points back to this spot in the
document. If @racket[_elements] is not empty, the web edition of the document will use it as the
contents of an understated hyperlink to back to @racket[_heading] in the keyword index.

The example below will create two index entries, one under the heading “compassion” and one under
the heading “cats”:

@codeblock|{
  #lang pollen

  “I have a theory which I suspect is rather immoral,” Smiley 
  went on, more lightly. “Each of us has only a quantum of 
  ◊index["compassion"]{compassion}. That if we lavish our concern
  on every stray ◊index["cats"] cat we never get to the centre of 
  things. What do you think of it?” 
}|

@defproc[(note [#:date date-str non-empty-string?]
               [#:author author string? ""]
               [#:author-url author-url string? ""]
               [#:disposition disp-str string? ""]) txexpr?]

Add a note to the “Further Notes” section of the article. Notes are like blog comments but are

         scribble/manual/lang
         scribble/html-properties
         (only-in net/uri-codec uri-encode))
(provide (all-defined-out))

(define repo-url/ "https://thelocalyarn.com/cgi-bin/yarncode/")

;; Link to a ticket on the Fossil repository by specifying the ticket ID.
;; The "_parent" target breaks out of the iframe used by the Fossil repo web UI.
(define (ticket id-str)
  (hyperlink (string-append repo-url/ "tktview?name=" id-str)
             "ticket "
             (tt id-str)
             #:style (style #f (list (attributes '((target . "_parent")))))))

;; Link to a wiki page on the Fossil repository by specifying the title
(define (wiki title)
  (hyperlink (string-append repo-url/ "wiki?name=" (uri-encode title))
             title
             #:style (style #f (list (attributes '((target . "_parent")))))))

;; Link somewhere outside these docs or Racket docs. The `_blank` target opens in a new tab.
(define (ext-link url-str . elems)
  (keyword-apply hyperlink '(#:style) (list (style #f (list (attributes '((target . "_blank")))))) 
                 url-str
                 elems))

;; Link to show contents of the latest checked-in version of a file
;; (or a file listing if a directory was specified)
(define (repo-file filename)
  (hyperlink (string-append repo-url/ "file/" filename)
             (tt filename)
             #:style (style #f (list (attributes '((target . "_parent")))))))

(define (responsive-retina-image img-path)
  (image img-path 
         #:scale 0.5
         #:style (style #f (list (attributes '((style . "max-width:100%;height:auto;")))))))

                     "../dust.rkt"
                     "../snippets-html.rkt"
                     racket/base
                     racket/contract
                     racket/string
                     pollen/template
                     pollen/pagetree
                     txexpr
                     sugar/coerce))

@title{@filepath{snippets-html.rkt}}

@defmodule["snippets-html.rkt" #:packages ()]

Each “snippet” module provides all the document- and article-level blocks of structural markup

@section{HTML Snippet functions}

@defproc[(html$-page-head [title (or/c string? #f) #f]) non-empty-string?]

Returns the @tt{<head>} section of an HTML document.

@defproc[(html$-page-body-open [body-class string? ""]) non-empty-string?]

Returns the opening @tt{<body>} and @tt{<main>} tags and elements that immediately follow, such as
site header, logo and navigation.

If @racket[_body-class] is a non-empty string, its contents will be included in the @tt{class}
attribute of the @tt{<body>} tag.

@defproc[(html$-article-open [pagenode pagenode?] 
                             [title-specified-in-doc? boolean?] 
                             [title txexpr?] 
                             [pubdate string?])
          non-empty-string?]

Returns the opening @tt{<article>} tag and elements that immediately follow: permlink, publish date,
and opening @tt{<section>} tag.

The @racket[_title-specified-in-doc?] form changes the HTML markup structure used.

@defproc[(html$-article-close [footertext string?]) non-empty-string?]

Returns a string containing a closing @tt{<section>} tag, a @tt{<footer>} element containing
@racket[_footertext], and a closing @tt{<article>} tag. If @racket[_footertext] is empty, the
@tt{<footer>} element will be omitted.

@defproc[(html$-article-listing-short [pagenode pagenode?] [pubdate string?] [title string?])
non-empty-string?]

Returns a string of HTML for an article as it would appear in a listing context in “short” form
(date and title only, with link).

@defproc[(html$-page-body-close) non-empty-string?]

Returns a string containing the page’s @tt{<footer>} and closing tags.

@defproc[(html$-note-title [author string?] [pagenode pagenode?] [parent-title string?])
non-empty-string?]

Like @racket[html$-note-listing-full], but returns HTML for a @racket[note] suitable for display
inside its parent article.

@defproc[(html$-notes-section [note-htmls string?]) non-empty-string?]

Returns the complete HTML for the @italic{Further Notes} section of an article.

@defproc[(html$-paginate-navlinks [current-page exact-positive-integer?] 
                                  [pagecount exact-positive-integer?]
                                  [basename string?]) string?]

On the “blog”, the articles are split across multiple files: @filepath{blog-pg1.html},
@filepath{blog-pg2.html}, etc. This function provides a string containing HTML for a group of links
that can be given within each file, to link to the pages that come before/after it. 

The links are enclosed within @tt{<li>} tags. It’s up to the calling site to provide the enclosing
@tt{<ul>} tag (in case any custom styling or IDs need to be applied).

;; since the database is merely a disposable cache, and since all the input
;; will be coming from me.

(require pollen/setup
         pollen/core
         pollen/template
         racket/string
         racket/function
         txexpr
         db/base
         "sqlite-tools.rkt"
         "snippets-html.rkt"
         "dust.rkt")

;; ~~~ Provides ~~~

(provide spell-of-summoning!
         crystalize-article!
         article-plain-title
         list/articles
         list/articles+notes
         listing<>-short/articles
         listing<>-full/articles
         listing<>-full/articles+notes
         unfence
         sqltools:dbc
         preheat-series!)

;; ~~~ Private use ~~~

(define DBFILE (build-path (current-project-root) "vitreous.sqlite"))

;; Since the DB exists to serve as a high-speed cache, the tables are constructed so that

    note_id
    title_html_flow
    author
    author_url
    date
    disposition
    content_html
    series_pagenode
    listing_full_html
    listing_excerpt_html  ; Not used for now
    listing_short_html))

(define table_series-fields
  '(pagenode
    title
    published
    noun_plural
    noun_singular))

(define table_keywordindex-fields
  '(entry
    subentry
    pagenode
    anchor))

(define table_articles (make-table-schema "articles" table_articles-fields))
(define table_notes (make-table-schema "notes" table_notes-fields #:primary-key-cols '(pagenode note_id)))
(define table_series (make-table-schema "series" table_series-fields))
(define table_keywordindex (make-table-schema "keywordindex"
                                              table_keywordindex-fields
                                              #:primary-key-cols '(pagenode anchor)))

;; ~~~ Provided functions: Initializing; Saving posts and notes

;; Initialize the database connection, creating the database if it doesn’t
;; exist, and executing the table schema queries
;;
(define (spell-of-summoning!)
  (init-db! DBFILE table_articles table_notes table_series table_keywordindex))

;; Save an article and its notes (if any) to the database, and return the
;; rendered HTML of the complete article.
;;
(define (crystalize-article! pagenode doc)
  (define-values
    (doc2 maybe-title) (splitf-txexpr doc (make-tag-predicate 'title)))
  (define-values 
    (body-txpr note-txprs) (splitf-txexpr doc2 (make-tag-predicate 'note)))
  (define-values (disposition disp-note-id)
    (notes->last-disposition-values note-txprs))
  
  (let* ([pubdate (select-from-metas 'published (current-metas))]
         [doc-html    (->html body-txpr #:splice? #t)]
         [title-specified? (not (equal? '() maybe-title))]
         [title-val   (if (not (null? maybe-title)) (car maybe-title) maybe-title)]
         [title-tx    (make-article-title title-val body-txpr disposition disp-note-id)]
         [title-html  (->html title-tx #:splice? #t)]
         [title-plain (tx-strs title-tx)]
         [series-node (series-pagenode)]
         [header      (html$-article-open pagenode title-specified? title-tx pubdate)]
         [footertext (make-article-footertext pagenode series-node disposition disp-note-id (length note-txprs))]
         [footer (html$-article-close footertext)]
         [notes-section-html (crystalize-notes! pagenode title-plain note-txprs)])

    (crystalize-index-entries! pagenode doc) ; Note the original doc is used here

    ;; Values must come in the order defined in table_article_fields
    (define article-record
      (list (symbol->string pagenode)
            title-plain
            title-html
            (bool->int title-specified?)
            pubdate
            (maybe-meta 'updated)
            (maybe-meta 'author default-authorname)
            (maybe-meta 'conceal)
            (symbol->string series-node)
            (maybe-meta 'noun (series-noun))
            (length note-txprs)
            doc-html
            disposition
            disp-note-id
            (string-append header doc-html footer)
            "" ; listing_excerpt_html: Not yet used
            (html$-article-listing-short pagenode pubdate title-plain))) ; listing_short_html: Not yet used

    (apply query! (make-insert/replace-query 'articles table_articles-fields) article-record)
          
    (string-append header doc-html notes-section-html footer)))

;; ~~~ Retrieve listings of articles and notes ~~~
;; ~~~ (Mainly for use on Series pages         ~~~

;; (private) Create a WHERE clause matching a single series or list of series
(define (where/series s)
  (cond [(list? s)
         (let ([series (map (curry (format "~a/~a.html" series-folder)) s)])
           (format "WHERE `series_pagenode` IN ~a" (list->sql-values series)))]
        [(string? s)
         (format "WHERE `series_pagenode` IS \"~a/~a.html\"" series-folder s)]
        [(equal? s #t)
         (format "WHERE `series_pagenode` IS \"~a\"" (here-output-path))]
        [else ""]))

;; Return a combined list of articles and notes sorted by date
(define (list/articles+notes type #:series [s #t] #:limit [limit -1] [order "DESC"])
  (define select #<<@@@@@
     SELECT `~a` FROM
       (SELECT `~a`, `published` FROM `articles`
        UNION SELECT
        `~a`,`date` AS `published` FROM `notes`
        ~a ORDER BY `published` ~a LIMIT ~a)
@@@@@
    )
  (query-list (sqltools:dbc) (format select type type type (where/series s) order limit)))

;; Return a list of articles only, sorted by date
(define (list/articles type #:series [s #t] #:limit [limit -1] [order "DESC"])
  (define select "SELECT `~a` FROM `articles` ~a ORDER BY `published` ~a LIMIT ~a")
  (query-list (sqltools:dbc) (format select type (where/series s) order limit)))

;; ~~~~
;; Return cached HTML of articles and/or notes, fenced within a style txexpr to prevent it being
;; escaped by ->html. See also: definition of `unfence`

(define (listing<>-short/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style "<ul class=\"article-list\">"
          ,@(list/articles "listing_short_html" #:series s #:limit limit order)
          "</ul>"))

(define (listing<>-full/articles #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style ,@(list/articles "listing_full_html" #:series s #:limit limit order)))

;; Return a combined list of articles and notes (“full content” version) sorted by date
(define (listing<>-full/articles+notes #:series [s #t] #:limit [limit -1] [order "DESC"])
  `(style ,@(list/articles+notes "listing_full_html" #:series s #:limit limit order)))

;; Remove "<style>" and "</style>" introduced by using ->html on docs containing output from
;; listing functions
(define (unfence html-str)
  (regexp-replace* #px"<[\\/]{0,1}style>" html-str ""))

;; ~~~ Article-related helper functions ~~~
;;

;; Return a title txexpr for the current article, constructing a default if no title text was specified.
(define (make-article-title supplied-title body-tx disposition disp-note-id)
  (define title-elems
    (cond [(null? supplied-title) (list (default-title (get-elements body-tx)))]

  
;; Convert a bunch of information about an article into some nice English and links.
(define (make-article-footertext pagenode series disposition disp-note-id note-count)
  (define s-title (series-title))
  (define s-noun (series-noun))
  (define series-part
    (cond [(non-empty-string? s-title)
           (format "<span class=\"series-part\">This is ~a, part of <a href=\"/~a\">‘~a’</a>.</span>"
                   s-noun
                   series
                   s-title)]
          [else ""]))
  (define disp-part
    (cond [(non-empty-string? disposition)
           (define-values (mark verb) (disposition-values disposition))

                   pagenode
                   note-count)]
          [(and (note-count . > . 0) (string=? disposition ""))
           (format "There is <a href=\"/~a#furthernotes\">a note</a> appended."
                   pagenode)]
          [else ""]))
  
  (cond [(ormap non-empty-string? (list series-part disp-part notes-part))
         (string-join (list series-part disp-part notes-part))]
        [else ""]))
    

;; ~~~ Notes ~~~

;; Save a collection of ◊note tags to the DB, and return the HTML of the complete
;; “Further Notes” section at the end

              (and ((length (string-split disposition-attr)) . >= . 2)))
    (raise-arguments-error 'note
                           "must be in format \"[symbol] [past-tense-verb]\""
                           "disposition attr"
                           disposition-attr))
  
  ;; Parse out remaining columns
  (define author (maybe-attr 'author attrs default-authorname))
  (define note-id (build-note-id note-tx))
  (define title-html-flow (html$-note-title pagenode parent-title-plain))
  (define author-url (maybe-attr 'author-url attrs))
  (define-values (disp-mark disp-verb) (disposition-values disposition-attr))
  (define content-html (html$-note-contents disp-mark (get-elements note-tx)))
  (define listing-full-html
    (html$-note-listing-full pagenode note-id title-html-flow note-date content-html author author-url))

  (define note-record
    (list pagenode
          note-id
          title-html-flow
          author
          author-url
          note-date
          disposition-attr
          content-html
          (symbol->string (series-pagenode))
          listing-full-html
          "" ; listing_excerpt_html: Not used for now
          "")) ; listing_short_html: Not used for now
  
  ;; save to db
  (define save-note-query
    (format (string-append "INSERT OR REPLACE INTO `notes` (`rowid`, ~a) "
                           "VALUES ((SELECT `rowid` FROM `notes` WHERE `pagenode` = ?1"
                           " AND `note_id` = ?2), ~a)")
            (list->sql-fields table_notes-fields)
            (list->sql-parameters table_notes-fields)))
  (apply query! save-note-query note-record)
  
  ;; return html$ of note
  (html$-note-in-article note-id note-date content-html author author-url))

(define (article-plain-title pagenode)
  (query-value (sqltools:dbc) "SELECT `title_plain` FROM `articles` WHERE `pagenode` = ?1" (symbol->string pagenode)))

;; ~~~ Keyword Index Entries ~~~

;; (private) Save any index entries in doc to the cache
(define (crystalize-index-entries! pagenode doc)
  (define (index-entry? tx)
    (and (txexpr? tx)
         (string=? "index-link" (attr-ref tx 'class "")) ; see definition of html-index
         (attr-ref tx 'data-index-entry #f)))
  (define-values (_ entries) (splitf-txexpr doc index-entry?))

  ; Naive idempotence: delete and re-insert all index entries every time doc is rendered.
  (query! "DELETE FROM `keywordindex` WHERE `pagenode` = ?1" (symbol->string pagenode))
  
  (unless (null? entries)
    (define entry-rows
      (for/list ([entry-tx (in-list entries)])
        (list (attr-ref entry-tx 'data-index-entry)
              "" ; subentries not yet implemented
              (symbol->string pagenode)
              (attr-ref entry-tx 'id))))
    (query! (make-insert-rows-query "keywordindex" table_keywordindex-fields entry-rows))))

;; ~~~ Series ~~~

;; Preloads the SQLite cache with info about each series.
;; I may not actually need this but I’m leaving it for now.
(define (preheat-series!)
  (query! "DELETE FROM `series`")
  (define series-values

;;   joel@jdueck.net
;;   https://joeldueck.com
;; -------------------------------------------------------------------------

(require pollen/core
         pollen/pagetree
         pollen/setup
         pollen/file
         net/uri-codec
         file/sha1
         gregor
         txexpr
         racket/list
         racket/system
         racket/string)

;; Provides common helper functions used throughout the project

(provide maybe-meta     ; Select from (current-metas) or default value ("") if not available
         maybe-attr     ; Return an attribute’s value or a default ("") if not available
         here-output-path
         here-id
         series-noun    ; Retrieve noun-singular from current 'series meta, or ""
         series-title   ; Retrieve title of series in current 'series meta, or ""
         series-pagenode
         invalidate-series
         make-tag-predicate
         tx-strs
         ymd->english
         ymd->dateformat
         default-authorname
         default-title
         articles-folder
         series-folder
         articles-pagetree
         series-pagetree
         first-words
         build-note-id
         notes->last-disposition-values
         disposition-values
         )

(define default-authorname "Joel Dueck")
(define series-folder "series")
(define articles-folder "articles")

(define (default-title body-txprs)
  (format "“~a…”" (first-words body-txprs 5)))

(define (maybe-meta m [missing ""])
  (cond [(current-metas) (or (select-from-metas m (current-metas)) missing)]
        [else missing]))

;; Return the current output path, relative to (current-project-root)
;; Similar to the variable 'here' which is only accessible in Pollen templates,
;; except this is an actual path, not a string.
(define (here-output-path)
  (cond [(current-metas)
         (define-values (_ rel-path-parts)
           (drop-common-prefix (explode-path (current-project-root))
                               (explode-path (string->path (select-from-metas 'here-path (current-metas))))))
         (->output-path (apply build-path rel-path-parts))]
        [else (error "No metas are available")]))

;; Checks current-metas for a 'series meta and returns the pagenode of that series,
;; or '|| if no series is specified.
(define (series-pagenode)
  (define maybe-series (or (select-from-metas 'series (current-metas)) ""))
  (cond
    [(non-empty-string? maybe-series)
     (->pagenode (format "~a/~a.html" series-folder maybe-series))]
    [else '||]))

(define (series-noun)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'noun-singular series-pnode) "")]))

(define (series-title)
  (define series-pnode (series-pagenode)) 
  (case series-pnode
    ['|| ""] ; no series specified
    [else (or (select-from-metas 'title series-pnode) "")]))

;; Generates a short ID for the current article
(define (here-id [suffix #f])
  (define here-hash
    (substring (bytes->hex-string (sha1-bytes (path->bytes (here-output-path)))) 0 8))
  (cond [(list? suffix) (apply string-append here-hash suffix)]
        [(string? suffix) (string-append here-hash suffix)]
        [else here-hash]))

;; “Touches” the last-modified date on the current article’s series, if there is one

(define (invalidate-series)
  (define series-name (maybe-meta 'series #f))
  (when series-name
    (define series-file (build-path (current-project-root)
                                    series-folder
                                    (format "~a.poly.pm" series-name)))
    (when (file-exists? series-file)
      (case (system-type 'os)
        [(windows) (system (format "type nul >> ~a" series-file))]
        [else (system (format "touch ~a" series-file))]))))

;; ~~~ Project-wide Pagetrees ~~~

(define (include-in-pagetree folder extension)
  (define (matching-file? f)
    (string-suffix? f extension))
  (define (file->output-pagenode f)
    (string->symbol (format "~a/~a" folder (string-replace f extension ".html"))))
  (define folder-path (build-path (current-project-root) folder))
  (define file-strs (map path->string (directory-list folder-path)))
  (map file->output-pagenode (filter matching-file? file-strs)))

(define (articles-pagetree)
  `(root ,@(include-in-pagetree articles-folder ".poly.pm")))

(define (series-pagetree)
  `(root ,@(include-in-pagetree series-folder ".poly.pm")))

;; ~~~ Convenience functions for tagged x-expressions ~~~





(define (maybe-attr name attrs [missing ""])
  (define result (assoc name attrs))
  (cond
    [(pair? result) (cadr result)]
    [else missing]))

;; Returns a function will test if a txexpr's tag matches the given symbol.

  (define test-attrs '([name "Hazel"] [rank "Chief"]))

  (parameterize ([current-metas test-metas])
    (check-equal? (maybe-meta 'name) "Fiver") ; present meta
    (check-equal? (maybe-meta 'age) "")       ; missing meta
    (check-equal? (maybe-meta 'age 2) 2))      ; alternate default value
  


  (check-equal? (maybe-attr 'rank test-attrs) "Chief")
  (check-equal? (maybe-attr 'dingus test-attrs) "")
  (check-equal? (maybe-attr 'dingus test-attrs "zippy") "zippy"))

;; Return the first N words out of a list of txexprs. This function will unpack the strings out of
;; the elements of one txexpr at a time until it finds the requested number of words. It aims to be
;; both reliable and fast for any size of list you pass it, and smart about the punctuation it

(define (build-note-id txpr)
  (string-append (maybe-attr 'date (get-attrs txpr))
                 "_"
                 (uri-encode (maybe-attr 'author (get-attrs txpr) default-authorname))))

;; Extract the last disposition (if any), and the ID of the disposing note, out of a list of notes
(define (notes->last-disposition-values txprs)
  (define (contains-disposition? tx) (attrs-have-key? tx 'disposition))
  (define disp-notes (filter contains-disposition? txprs))
  (cond [(not (empty? disp-notes))
         (define latest-disposition-note (last disp-notes))
         (values (attr-ref latest-disposition-note 'disposition)
                 (build-note-id latest-disposition-note))]
        [else (values "" "")]))
        

#lang pollen/mode racket/base

;; Copyright (c) 2019 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
;; You may also obtain a copy of the License at
;;
;;       http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; Author contact information:
;;   joel@jdueck.net
;;   https://joeldueck.com
;; -------------------------------------------------------------------------

;; Builds an HTML page containing the keyword index for all ◊index entries in
;; the articles, by pulling them out of the SQLite cache DB.

(require racket/match
         racket/list
         racket/file
         db/base
         net/uri-codec
         pollen/template)

(require "crystalize.rkt"
         "snippets-html.rkt")

(provide main)

;; Get the index entries from the SQLite cache, return them as a list of vectors
(define (fetch-entries)
  (define q
    ◊string-append{
 SELECT entry, subentry, a.rowid, "/" || k.pagenode || "#" || anchor AS href, title_plain
 FROM keywordindex k INNER JOIN articles a
 ON a.pagenode = k.pagenode
 ORDER BY entry COLLATE NOCASE ASC;})
  (query-rows (sqltools:dbc) q))

;; Convert a vector (row) into a txexpr representing a link to the original article
(define (make-link row)
  `(a [[href ,(vector-ref row 3)]
       [title ,(vector-ref row 4)]]
      ,(number->string (vector-ref row 2))))

;(require sugar/debug)

;; Convert a list of vectors from the cache DB into a list of the form:
;; (list (cons FIRST-LETTER
;;             (list (cons KEYWORD
;;                         (list LINKS ...))
;;                   ...))
;;       ...)
(define (group-entries data)
  (define collated-list
    (for/fold ([entry-table null]
               #:result (reverse entry-table))
              ([row (in-list data)])
      (define this-entry (vector-ref row 0))
      (cond [(and (not (null? entry-table))
                  (string-ci=? (first (first entry-table)) this-entry))
             (match-define (cons (list last-entry last-list) rest-entries) entry-table)
             (cons `(,last-entry ,(append last-list (list (make-link row)))) rest-entries)]
            [else
             (cons `(,this-entry ,(list (make-link row)))
                   entry-table)])))
  (define (first-letter entry)
    (char-upcase (first (string->list (first entry)))))
  
  (for/list ([letter-group (in-list (group-by first-letter collated-list))])
    (list (first-letter (first letter-group)) letter-group)))

(define (entry+links->txexpr entry)
  (match-define (list entry-word links) entry)
  `(li [[id ,(uri-encode (string-downcase entry-word))]]
       ,entry-word nbsp
       ,@(add-between links ", ")))

;; Return the complete HTML for the keyword index. Each letter group begins with a heading for the
;; letter, followed by a definition list for its entries.
(define (html$-index entries)
  (define groups
    (for/list ([letter-group (in-list entries)])
      (match-define (list letter-char entries) letter-group)
      `(section (h2 ,(list->string (list letter-char)))
                (ul ,@(map entry+links->txexpr entries)))))
  (apply string-append (map ->html groups)))

(define (html$-keywordindex-page the-index)
  ◊string-append{
 <!DOCTYPE html>
 <html lang="en">
 ◊html$-page-head{The Local Yarn: Keyword Index}
 ◊html$-page-body-open[]

 <div id="keywordindex">
 ◊the-index
 </div>
 ◊html$-page-body-close[]
 </html>})

(define (main)
  (spell-of-summoning!) ; Turn on DB
  (displayln "Writing keyword-index.html…")
  (display-to-file (html$-keywordindex-page (html$-index (group-entries (fetch-entries))))
                   "keyword-index.html"
                   #:mode 'text
                   #:exists 'replace))

# Licensed under the terms of the Blue Oak Model License 1.0.0
# https://blueoakcouncil.org/license/1.0.0
# You may not use this file except in compliance with that license.
SHELL = /bin/bash

# ~~~ Variables used by rules ~~~
#

core-files := pollen.rkt dust.rkt
html-deps  := snippets-html.rkt tags-html.rkt

article-sources := $(wildcard articles/*.poly.pm)
articles-html   := $(patsubst %.poly.pm, %.html, $(article-sources))
articles-pdf    := $(patsubst %.poly.pm, %.pdf,  $(article-sources))

series-sources  := $(wildcard series/*.poly.pm)
series-html     := $(patsubst %.poly.pm, %.html, $(series-sources))

# ~~~ Rules ~~
#

# The order of these dependencies is important. They will be processed left to right.
web: _article_htmls.mark $(articles-html) $(series-html) blog-pg1.html keyword-index.html
web: ## Rebuild all web content (not PDFs)

# The file article_htmls.mark is a zero-byte file that serves only as a marker. If it is older than
# any of its dependencies (or missing) all of the articles will be rebuilt. Its dependencies are
# also on the Pollen cache watchlist (see pollen.rkt)
_article_htmls.mark: $(core-files) $(html-deps) template.html.p
	raco pollen setup articles/
	raco pollen render -p -t html articles/*.poly.pm
	raco pollen setup series/
	raco pollen render -p -t html series/*.poly.pm
	touch _article_htmls.mark

# If the rule for article_htmls.mark was triggered, all the article HTML files will already have
# been re-rendered.  (That rule comes before this one in the list of dependencies for "all") But if
# not, any individual files that have been edited will get re-rendered.
$(articles-html): %.html: %.poly.pm 
	raco pollen render $@

# Note that if any article is part of a series, it will touch its series .poly.pm file during its
# render, triggering this rule for that series.
$(series-html): %.html: %.poly.pm
	raco pollen render $@

# This target will also rebuild pg2, pg3, etc. as needed
blog-pg1.html: $(core-files) $(html-deps) $(articles-html) blog.rkt
	rm -f blog*.html
	racket -tm blog.rkt

keyword-index.html: $(core-files) $(html-deps) $(articles-html) keyword-index.rkt
	racket -tm keyword-index.rkt

spritz: ## Clear Pollen and Scribble cache
	rm -rf compiled code-docs/compiled articles/compiled series/compiled
	fossil clean code-docs/

publish: check-env
publish: ## Sync all HTML and PDF stuff to the public web server (does not rebuild any files)
	raco pollen publish
	./util/relativize ~/Desktop/publish/
	rsync -av ~/Desktop/publish/ -e 'ssh -p $(WEB_SRV_PORT)' $(LOCALYARN_SRV) \
		--delete \
		--exclude=drafts \
		--exclude=code-docs \
		--exclude=util \
		--exclude=x-mockup \
		--exclude=repo-www \
		--exclude=scribbled \
		--exclude='*.sqlite' \
		--exclude='*.fossil' \
		--exclude=.fossil-settings \
		--exclude=.fslckout \
		--exclude='*.ltx' \
		--exclude='*.swp' \
		--exclude='*.mark' \
		--exclude=.DS_Store \
	    --exclude='template*.*' \
		--exclude=makefile 
	rm -rf ~/Desktop/publish

scribble: ## Rebuild code documentation and update Fossil repo
	scribble --htmls +m --redirect https://docs.racket-lang.org/local-redirect/ code-docs/main.scrbl
	fossil uv rm scribbled/*
	rm -rf scribbled/*
	mv main/* scribbled/
	cp code-docs/scribble-iframe.html scribbled/scribble.html
	rm -rf main
	fossil uv add scribbled/*
	fossil uv sync

# Self-documenting makefile (http://marmelab.com/blog/2016/02/29/auto-documented-makefile.html)
help: ## Displays this help screen
	@grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-15s\033[0m %s\n", $$1, $$2}'

article: ## Start a new article from a template
	racket -tm util/newpost.rkt

.PHONY: all scribble help spritz article publish check-env

.DEFAULT_GOAL := help

check-env:
ifndef LOCALYARN_SRV
	$(error LOCALYARN_SRV env variable not set, should be a destination valid for rsync)
endif
ifndef WEB_SRV_PORT
	$(error WEB_SRV_PORT env variable not set, should be SSH port number for web server)
endif

         "snippets-html.rkt"
         "crystalize.rkt")

(provide (all-defined-out)
         (all-from-out "crystalize.rkt" "snippets-html.rkt"))

(module setup racket/base
  (require syntax/modresolve
           racket/runtime-path
           pollen/setup)
  (provide (all-defined-out))
  (define poly-targets '(html))
  (define block-tags (append '(title style dt) default-block-tags))

  (define-runtime-path tags-html.rkt     "tags-html.rkt")
  (define-runtime-path snippets-html.rkt "snippets-html.rkt")
  (define-runtime-path dust.rkt          "dust.rkt")
  (define-runtime-path crystalize.rkt    "crystalize.rkt")
  (define cache-watchlist
    (map resolve-module-path
         (list tags-html.rkt
               snippets-html.rkt
               dust.rkt
               crystalize.rkt))))

(case (current-poly-target)
  [(html) (spell-of-summoning!)])

;; Macro for defining tag functions that automatically branch based on the 
;; current output format and the list of poly-targets in the setup module.
;; Use this macro when you know you will need keyword arguments.
;;
(define-syntax (poly-branch-kwargs-tag stx)
  (syntax-parse stx

(poly-branch-tag blockquote)
(poly-branch-tag newthought)
(poly-branch-tag smallcaps)
(poly-branch-tag center)
(poly-branch-tag section)
(poly-branch-tag subsection)
(poly-branch-tag code)
(poly-branch-tag dialogue)
(poly-branch-tag say)
(poly-branch-tag index)
(poly-branch-kwargs-tag blockcode)
(poly-branch-kwargs-tag verse)          ; [#:title ""] [#:italic "no"]

(poly-branch-tag link)
(poly-branch-tag url)
(poly-branch-tag fn)
(poly-branch-tag fndef)

(poly-branch-kwargs-tag note)
(poly-branch-tag block)

;; Not yet implemented
; (poly-branch-tag table)         ; #:columns ""
; (poly-branch-tag inline-math)
; (poly-branch-tag margin-note)
; (poly-branch-tag noun)
; (poly-branch-func index-entry entry)

<title>Hello</title>

<img src="/doc/ckout/repo-www/flammarion.jpg" style="--imgwidth:372px" class="spot-image">

You have somehow found your way to the place where I keep the heavy magic for (a new, not-yet-live
version of) <i>[https://thelocalyarn.com|The Local Yarn]</i>. You can see an incomplete

[https://thelocalyarn.com/excursus/test/blog-pg1.html|prototype of the new&nbsp;design].


Here’s what happens here:

  *  I add writings using a custom markup language, and publish them on the web site.  Periodically
  *  I can define collections of writings (by date range, for example, or subject 
  matter), and, from the same source markup, generate the PDF files necessary to self-publish a book
  containing those writings.
  *  The writings, the web and print designs for the writings, the custom markup, and the code
  defining all of them, are available here in their complete history since the beginning of
  the&nbsp;project.

What you are looking at is a Fossil repository — similar to a git&nbsp;repository.

All times shown are <var>[https://www.timeanddate.com/time/aboututc.html|UTC]</var>.

<!DOCTYPE html>
<html lang="en">

◊html$-page-head[(select-from-metas 'title metas)]

◊html$-page-body-open["series-page"]

◊(unfence (->html doc #:splice? #t))

◊html$-page-body-close[]

</html>

;; -------------------------------------------------------------------------

;; Provides functions for displaying content in HTML templates.
(require pollen/core
         pollen/template
         pollen/decode
         racket/string
         racket/function
         racket/list
         txexpr
         openssl/sha1
         "dust.rkt")

(provide html$-page-head
         html$-page-body-open
         html$-article-open
         html$-article-close
         html$-article-listing-short
         html$-page-body-close
         html$-note-title
         html$-note-contents
         html$-note-listing-full
         html$-note-in-article
         html$-notes-section
         html$-paginate-navlinks)

(define (html$-page-head [title #f])
  ◊string-append{<head>
 <title>◊if[title title ""] </title>
 <meta charset="utf-8" />
 <meta name="viewport" content="width=device-width, initial-scale=1">
 <link rel="stylesheet" type="text/css" href="/web-extra/martin.css">
 </head>})

(define (html$-page-body-open [class ""])
  (define body-class (if (non-empty-string? class) (format " class=\"~a\"" class) ""))
  ◊string-append{<body◊|body-class|><main>
 <a href="/"><header>
 <img src="/web-extra/mark.svg" height="103" class="logo">
 <h1>The Local Yarn</h1>
 </header></a>})

(define (html$-article-open pagenode title? title-tx published)
  (cond
    [title?
     ◊string-append{<article class="with-title hentry">
      ◊(->html `(h1 [[class "entry-title"]] ,@(get-elements title-tx)))
      <p class="time"><a href="/◊(symbol->string pagenode)" class="rel-bookmark">
      <time datetime="◊published" class="published">◊ymd->english[published]</time>
      </a></p>
      <section class="entry-content">}]
    [else
     ◊string-append{<article class="no-title hentry">
      <h1><a href="/◊(symbol->string pagenode)" class="rel-bookmark">
      <time datetime="◊published" class="entry-title">◊ymd->english[published]</time>
      </a></h1>
      <section class="entry-content">}]))

(define (html$-article-close footertext)
  (cond [(non-empty-string? footertext)
         ◊string-append{</section>
          <footer class="article-info"><span class="x">(</span>◊|footertext|<span class="x">)</span></footer>
          </article>}]
        [else "</section></article>"]))

(define (html$-article-listing-short pagenode pubdate title)
  ◊string-append{
 <li><a href="/◊(symbol->string pagenode)">
 <div class="article-list-date caps">◊(ymd->english pubdate)</div>
 <div class="article-list-title">◊|title|</div>
 </a></li>})

(define (html$-page-body-close)
  ◊string-append{<footer>By Joel Dueck</footer>
 </main></body>})

;; Notes
;;
(define (html$-note-title pagenode parent-title)






  (format "Re: <a class=\"cross-reference\" href=\"/~a\">~a</a>"
          pagenode
          parent-title))


(define (html$-note-contents disposition-mark elems)

  (define disposition
    (cond [(non-empty-string? disposition-mark)
           `(span [[class "disposition-mark"]] ,disposition-mark)]
          [else ""]))
  (define body-elems
    (cond
      [(and (block-txexpr? (car elems)) (non-empty-string? disposition-mark))
       (define-values (first-tag first-attrs first-elems) (txexpr->values (car elems)))
       (cons (txexpr first-tag first-attrs (cons disposition first-elems)) (cdr elems))]
      [else
       (cons disposition elems)]))
  (string-append* (map ->html body-elems)))

(define (html$-note-listing-full pagenode note-id title-html-flow date contents [author default-authorname] [author-url ""])
  (define author-part
    (cond [(non-empty-string? author-url)
           ◊string-append{
            <div class="note-meta">
            &mdash;<a class="u-author h-card" href="◊|author-url|"><i>◊|author|</i></a>
            </div>}]
          [else ◊string-append{
            <div class="note-meta">
            &mdash;<span class="h-card"><i>◊|author|</i></span>
            </div>}]))
  (define maybe-author-class
    (cond [(string=? author default-authorname) "by-proprietor"]
          [else ""]))
  
  ◊string-append{
 <article class="with-title ◊maybe-author-class hentry">
 <h1 class="entry-title note-full">◊|title-html-flow|</h1>
 <p class="time"><a href="/◊|pagenode|#◊note-id" class="rel-bookmark note-permlink">
 <time datetime="◊date">◊ymd->english[date]</time>
 </a></p>
 <section class="entry-content">
 <div class="p-content p-name">◊|contents|</div>
 ◊author-part
 </section>
 </article>})

 </div>})

(define (html$-notes-section note-htmls)
  ◊string-append{<div class="further-notes" id="furthernotes">
 <h2>Further Notes</h2>
 ◊(apply string-append note-htmls)
 </div>})

;; (private) Returns HTML for a list-item link to a particular page in a set of numbered pages
(define (html$-paginate-link basename pagenum [linktext (number->string pagenum)] [class ""])
  (define cstr (if (non-empty-string? class) (format " class=\"~a\"" class) ""))
  (format "<li~a><a href=\"/~a-pg~a.html\">~a</a></li>" cstr basename pagenum linktext))

;; Returns HTML for a series of list items with links to numbered pages
(define (html$-paginate-navlinks pagenum pagecount basename)
  (define slots 9)
  (define on-first-group? (<= pagenum (- slots 4)))
  (define on-last-group? (>= pagenum (- pagecount slots -4)))
  (define only-one-group? (<= pagecount slots))
  (define group-start (- pagenum (quotient (- slots 4) 2))) ; not always used!
  (define page-func (curry html$-paginate-link basename))

  (define page-group-syms
    (cond [only-one-group?
           `(,@(range 1 (+ 1 pagecount)))]
          [on-first-group?
           `(,@(range 1 (min (+ 1 pagecount) (- slots 1))) "..." ,pagecount)]
          [on-last-group?
           `(1 "..." ,@(range (- pagecount slots -3) (+ pagecount 1)))]
          [else
           `(1
             "..."
             ,@(range group-start (min (+ 1 pagecount) (+ group-start (- slots 4))))
             "..."
             ,pagecount)]))
 
  (define page-group
    (for/list ([psym (in-list page-group-syms)])
      (cond
        [(and (number? psym) (equal? psym pagenum))
         (format "<li class=\"current-page\">~a</li>" psym)]
        [(number? psym) (page-func psym)]
        [else "<li>&#8230;</li>"])))
  
  (define prev-link
    (if (eq? 1 pagenum)
        "<li class=\"nav-text inactive-link\">&larr;Newer</li>"
        (page-func (- pagenum 1) "&larr;&thinsp;Newer" "nav-text")))

  (define next-link
    (if (eq? pagecount pagenum)
        "<li class=\"nav-text inactive-link\">Older&rarr;</li>"
        (page-func (+ pagenum 1) "Older&thinsp;&rarr;" "nav-text")))

  (string-join `(,prev-link ,@page-group ,next-link)))

;; Tag functions used by pollen.rkt when HTML is the output format.

(require (for-syntax racket/base racket/syntax))
(require racket/list
         racket/function
         pollen/decode
         pollen/tag
         net/uri-codec
         txexpr
         "dust.rkt")

(provide html-fn
         html-fndef)

;; Customized paragraph decoder replaces single newlines within paragraphs

(provide html-root
         html-item
         html-section
         html-subsection
         html-newthought
         html-smallcaps
         html-center
         html-block
         html-blockcode
         html-index
         html-dialogue
         html-say
         html-verse
         html-link
         html-url
         html-fn
         html-fndef
         html-note)

(define html-item (default-tag-function 'li))
(define html-section (default-tag-function 'h2))
(define html-subsection (default-tag-function 'h3))
(define html-newthought (default-tag-function 'span #:class "newthought"))
(define html-smallcaps (default-tag-function 'span #:class "smallcaps"))
(define html-center (default-tag-function 'div #:style "text-align: center"))
(define html-dialogue (default-tag-function 'dl #:class "dialogue"))

(define (html-block . elements)
  `(section [[class "content-block"]] (div [[class "content-block-main"]] ,@elements)))

(define (html-root . elements)
  (invalidate-series)
  (define first-pass
    (decode-elements (append elements (list (html-footnote-block)))
                     #:txexpr-elements-proc decode-hardwrapped-paragraphs
                     #:exclude-tags '(script style figure table pre)))
  (define second-pass
    (decode-elements first-pass
                     #:block-txexpr-proc detect-newthoughts
                     #:inline-txexpr-proc decode-link-urls
                     #:string-proc (compose1 smart-quotes smart-dashes)
                     #:exclude-tags '(script style pre code)))
  `(body ,@second-pass))

(define (html-blockcode attrs elems)
  (define file (or (assoc 'filename attrs) ""))
  (define codeblock `(pre [[class "code"]] (code ,@elems)))
  (cond [(string>? file "") `(@ (div [[class "listing-filename"]] 128196 " " ,file) ,codeblock)]
        [else codeblock]))

(define (html-index . elems)
  `(a [[id ,(here-id (list "_idx-" (uri-encode (car elems))))]
       [href ,(string-append "/keyword-index.html#" (uri-encode (string-downcase (car elems))))]
       [data-index-entry ,(car elems)]
       [class "index-link"]]
      ,@(cdr elems)))

(define (html-say . elems)
  `(@ (dt ,(car elems) (span [[class "x"]] ": ")) (dd ,@(cdr elems))))

(define (html-verse attrs elems)
  (let* ([title  (maybe-attr 'title attrs "")]
         [italic? (assoc 'italic attrs)]
         [pre-attrs (cond [italic? '([class "verse"] [style "font-style: italic"])]
                          [else '([class "verse"])])]
         [pre-title (cond [(string>? title "") `(p [[class "verse-heading"]] ,title)]
                          [else ""])])
    `(div [[class "poem"]] ,pre-title (pre ,pre-attrs ,@elems))))

;; There is no way in vanilla CSS to create a selector for “p tags that contain
;; a span of class ‘newthought’”. So we can handle it at the Pollen processing level.
(define (detect-newthoughts block-xpr)
  (define (is-newthought? tx) ; Helper function
    (and (txexpr? tx)
         (eq? 'span (get-tag tx))

                                                                    (fn-id fn-name)
                                                                    (format "~a" (+ 1 fnref-num)))]] "↩"))])
                `(li [[id ,(fndef-id fn-name)]] ,@definition-text ,@backrefs))))
  (cond [(null? note-items) ""]
        [else `(section ((class "footnotes")) (hr) (ol ,@note-items))]))

(define (html-note attrs elems)
  (txexpr 'note attrs (decode-hardwrapped-paragraphs elems)))

<!DOCTYPE html>
<html lang="en">


◊(define article-html (crystalize-article! here doc))
◊(define page-title (article-plain-title here))
◊html$-page-head[page-title]

◊html$-page-body-open[]

◊article-html

◊html$-page-body-close[]

</html>

#lang pollen/mode racket/base

;; Copyright (c) 2018 Joel Dueck.
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; A copy of the License is included with this source code, in the
;; file "LICENSE.txt".
;; You may also obtain a copy of the License at
;;
;;       http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
;; Author contact information:
;;   joel@jdueck.net
;;   https://joeldueck.com
;; -------------------------------------------------------------------------

(require racket/date
         racket/string
         racket/file
         racket/system
         "../dust.rkt")

(provide main)

(define (normalize str)
  (define alphanum-only
    (regexp-replace* #rx"[^A-Za-z0-9 ]" str ""))
  (string-normalize-spaces (string-downcase alphanum-only) #px"\\s+" "-"))

(define (make-filename basename)
  (build-path (current-directory) articles-folder (string-append basename ".poly.pm")))

(define (comment . strs)
  (format "◊; ~a" (apply string-append strs)))

(define date-string
  (parameterize [(date-display-format 'iso-8601)]
    (date->string (current-date))))

(define (make-template-contents title)
  ◊string-append{
 #lang pollen

 ◊comment{Copyright ◊(substring date-string 0 4) by ◊|default-authorname|. All Rights Reserved.}

 ◊"◊"(define-meta published "◊date-string")
 ◊"◊"(define-meta series "seriesname")

 ◊"◊"title{◊title}

 Write here!})

(define (main)
  (display "Enter title: ")
  (define title (read-line))
  (cond [(non-empty-string? title)
         (define post-file (make-filename (normalize title)))
         (define post-contents (make-template-contents title))
         (display-to-file post-contents post-file)
         (displayln (format "Saved to ~a" post-file))

         ; the + argument tells vim to place the cursor at the last line of the file.
         (system (format "mvim + ~a" post-file))]))

#!/bin/bash

# Licensed under the terms of the Blue Oak Model License 1.0.0
# https://blueoakcouncil.org/license/1.0.0

# The HTML generated assumes the whole site lives in the domain root. This script converts all links
# and image sources to relative URLs, so things don't break when accessed from within a subfolder of
# a live web server. (See ‘publish’ target of makefile)

# Stop on any error, forbid uninitialized vars
set -eu

# First parameter is used as working dir, defaults to ./
base_dir=${1:-"./"}

# Ensure directory name ends with a slash
[[ "${base_dir}" != */ ]] && base_dir="${base_dir}/"

# Ensure directory exists
if [[ ! -d "${base_dir}" ]]; then
    echo "[$(date +'%Y-%m-%dT%H:%M:%S%z')]: ${base_dir} not a directory!" >&2
    exit 1
fi

# Root folder: remove leading / from href and src attributes
sed -i '' -- 's/href=\"\//href=\"/g' "${base_dir}"*.html
sed -i '' -- 's/src=\"\//src=\"/g' "${base_dir}"*.html

# subfolders: replace leading / with ../ in href and src attributes
sed -i '' -- 's/href=\"\//href=\"..\//g' "${base_dir}"articles/*.html
sed -i '' -- 's/src=\"\//src=\"..\//g' "${base_dir}"articles/*.html
sed -i '' -- 's/href=\"\//href=\"..\//g' "${base_dir}"series/*.html
sed -i '' -- 's/src=\"\//src=\"..\//g' "${base_dir}"series/*.html

    main {
        background: white;
        margin: 0;
        padding: ◊x-lineheight[0.5] ◊x-lineheight[1];
    }

    main > a > header {
        text-align: center;
    }

    main > a > header h1 {
        display: none;
        /* font-size: ◊x-lineheight[1.5];
        line-height: ◊x-lineheight[2];
        margin: 0 0 ◊x-lineheight[0.5] 0;
        font-weight: normal;
        font-style: italic;
        text-transform: lowercase;
        color: ◊color-pagehead;
        transition: color 0.25s ease; */
    }

    img.logo {
        height: ◊x-lineheight[3];
        filter: none;
        transition: filter 0.5s ease;
    }

    header:hover img.logo {
        filter: invert(12%) sepia(87%) saturate(2559%) hue-rotate(348deg) brightness(125%) contrast(88%);
        transition: filter 0.5s ease;





    }

    /* I read somewhere years ago that you should specify styling for links in the
       following order: Link, Visited, Hover, Active. 
           → Remember the mnemonic: Lord Vader Has Arrived.
       
       Not sure if that's relevant advice any more but I still follow it. It can't hurt. */
       
    a:link, a:visited {         /* [L]ord [V]ader… */
        color: ◊color-link;
        text-decoration: none;
    }

    a:hover, a:active {         /* …[H]as [A]rrived */
        color: ◊color-linkhover;
        background: ◊color-linkbackground;
    }

    a.index-link:link, a.index-link:visited {
        color: ◊color-bodytext;
    }

    a.index-link:hover, a.index-link:active {
        color: #006400;
    }

    a.index-link::after {
        content: '\f89b';
        color: #809102;
        position: relative;
        top: -0.3em;
    }

    main>a {
        color: inherit;
    }
    
    span.links-footnote {
        display: inline-block; /* allows keyframe animation to work */
    }
    
    :target {
        animation: hilite 2.5s;
    }
    @keyframes hilite {
        0% {background: transparent;}
        10% {background: #feffc1;}
        100% {background: transparent;}
    }

    main > aside {
        text-align: center;
    }

    nav {
        font-family: 'Triplicate T4c', monospace;
        font-feature-settings: "onum" off;
        font-size: 0.7rem;
        margin: 0;
        margin-top: 0.5rem;
        text-align: center;
    }

    nav ul {
        list-style-type: none;
        margin: 0.2em auto;
        padding: 0;
    }

    nav li {
        display: none; /* Numbers not displayed on mobile */
        color: gray;
    }

    nav li.nav-text {
        display: inline;
        text-transform: uppercase;
        letter-spacing: 0.05rem;
        font-size: 0.6rem;
    }

    nav li.inactive-link {
        color: gray;
    }

    nav li.current-page {
        color: ◊color-bodytext;
        padding: 0.2rem 0.5rem;
        border-bottom: dotted ◊color-bodytext 2px;
    }

    nav li a {
        padding: 0.2rem 0.5rem;
    }

    nav li a:link, nav li a:visited {
        color: ◊color-bodytext;
    }

    nav li a:hover, nav li a:active {
        color: ◊color-linkhover;
        background: #ebebeb;
    }
    
    i > em { font-style: normal; }
    
    /* On mobile, an <ARTICLE> is just a box. Later we'll do fancy stuff if grid support is detected. */
    article {
        margin: ◊x-lineheight[2] 0 ◊x-lineheight[1] 0;
        padding-top: ◊x-lineheight[1];
    }
    article:first-of-type {
        margin-top: ◊x-lineheight[1];
    }

    /* Here's my thing these days about article titles: they shouldn't be required. When you write in a
       paper journal, do you think of a title for every entry? No! You just write the date. The date is
       the heading. Makes sense. But, this means I've had to think long and hard about how to present two
       different types of articles (those with titles AND dates, and those with just a date for the title). 

        filter: invert(12%) sepia(87%) saturate(359%) hue-rotate(348deg) brightness(105%) contrast(88%);
       For now: By default, the title-less article is assumed to be the norm. On these, we use <H1> to 
       show the date in italics. */
    article>h1 {
        font-size: ◊x-lineheight[1];
        line-height: ◊x-lineheight[1];
        margin: 0 0 ◊x-lineheight[1] 0;
        font-style: italic;
        font-weight: normal;
    }

    /* Titles non-bold, non-smallcaps by default. This can be overridden in document markup. */
    h1.entry-title {
        margin: 0 0 0 0;
        text-transform: none;
        font-style: normal;
        line-height: 1.7rem;
    }

    h1.entry-title.note-full {
        font-feature-settings: "smcp" on, "liga" on, "clig" on, "dlig" on, "kern" on, "onum" on, "pnum" on;
    }

    /* This <SPAN> class is used in titles for Notes appended to earlier articles */
    h1.entry-title .cross-reference {
        font-feature-settings: "smcp" off, "liga" on, "clig" on, "dlig" on, "kern" on, "onum" on, "pnum" on;
        font-style: italic;
        text-transform: none;
    }

    /* I want my *title* permlinks not to be green or underlined. Just your basic raven black, dark green on hover.

       Normally with links, you _don’t_ want to rely on hovers to differentiate them, because there’s no way

        background: none;
        color: ◊color-bodytext;
    }

    a.rel-bookmark:hover,       /* Has     */
    a.rel-bookmark:active {     /* Arrived */
        text-decoration: none;
        background: ◊color-linkbackground;
        color: #006400;
    }

    /* Here's where we add the minty fresh maple leaf glyph. */
    a.rel-bookmark::after {
        content: '\f894'; 
        margin-left: 4px;

        font-feature-settings: "smcp" on, "liga" on, "clig" on, "dlig" on, "kern" on, "onum" on, "pnum" on;
        color: #888;
    }

    footer.article-info::before {
        content: "☞\00a0";
    }
    
    /* Within article info, don’t display series info when on a series page (redundant) */
    body.series-page .series-part {
        display: none;
    }

    p.time::before {
        content: none;
    }

    p.time {
        font-size: ◊x-lineheight[0.75];

        margin: ◊x-lineheight[1] auto;
        display: table;
        white-space: pre-wrap;
        /* Whitespace is preserved by the browser.
           Text will wrap when necessary, and on line breaks */
    }

    p.verse-heading {
        font-feature-settings: "smcp" on, "liga" on, "clig" on, "dlig" on, "kern" on, "onum" on, "pnum" on;
        text-align: center;
        font-size: 1.3rem;
    }
        
    section.entry-content figure {
        margin: ◊x-lineheight[1] 0;
        padding: 0;
    }

    figure>a {
        margin: 0;

        color: ◊color-xrefmark;
        display: inline-block;
        width: 1em;
    }

    /* ******* (Mobile first) Journal View styling *******
     */






    section.content-block {










    }

    ul.article-list {
        margin-top: ◊x-lineheight[1];
        padding: 0;
    }

    ul.article-list li {
        list-style-type: none;
        display: block;
        margin: 0;

    div.article-list-date {
        color: #999;
    }

    div.article-list-title {
        font-size: 1.2rem;
    }
    
    /* ******* (Mobile first) Keyword Index styling *******
     */

    #keywordindex {
        column-width: 7rem;
        margin-top: ◊x-lineheight[2];
    }
    
    #keywordindex section {
        -webkit-column-break-inside: avoid; /* Chrome, Safari, Opera */
        page-break-inside: avoid; /* Firefox */
        break-inside: avoid; /* IE 10+ */
    }

    #keywordindex h2 {
        margin: 0;
    }

    #keywordindex ul {
        margin-top: 0;
        list-style-type: none;
        padding: 0;
    }

    /* End of mobile-first typography and layout */
}


/* Here’s where we start getting funky for any viewport wider than mobile portrait.
   An iPhone 6 is 667px wide in landscape mode, so that’s our breakpoint. */

@media only screen and (min-width: 667px) {
    main {
        margin: 0 auto;
        padding-left: 1rem;
        padding-right: 1rem;
        width: 30rem;
        max-width: 90%;
    }

    nav li { display: inline; } /* Display page numbers on larger screens */

    @supports (grid-area: auto) {
        main { 
            width: 42rem;
            background: none;
        }











        header img.logo {

            height: ◊x-lineheight[3];
            max-height: 103px;
            width: auto;


        }

        /* This header is display:none above, so the following is vestigial */
        main header h1 {
            grid-area: masthead;
            margin: 0;
            line-height: 1em;
        }
        
        article {

            font-size: 0.8rem;
            line-height: ◊derive-lineheight[4 #:per-lines 3];
            margin: 0;
            padding-left: 3px;
        }

        article.no-title footer.article-info {
            margin-top: 1.5rem;
            padding-top: 0;
        }
        
        section.entry-content {
            grid-area: main;
            /* Prevent content from overriding grid column sizing */
            /* See https://css-tricks.com/preventing-a-grid-blowout/ */
            min-width: 0;
        }

        section.entry-content :first-child {
            margin-top: 0 !important;
        }

        article>:last-child::after {
            content: none;
            margin 0;
            display: none;

        div.note h3 {
        }

        /* ******* (Grid support) Journal View styling *******
         */

        section.content-block {
            display: grid;
            grid-template-columns: 8rem 7fr 1fr;
            grid-template-rows: auto auto auto;
            grid-template-areas: "margin main .";


            align-items: start;     /* Puts everything at the top */
            margin-bottom: 0;
            grid-column-gap: 1rem;
            box-shadow: 0.4em 0.4em 10px #e3e3e3;
            background: white;
            border: solid 1px #dedede;
            border-radius: 2px;
        }
        div.content-block-main {
            padding-top: ◊x-lineheight[1];
            padding-bottom: ◊x-lineheight[1];
            grid-area: main;
        }








        div.content-block-main > :first-child {
            margin-top: 0 !important;
        }
    }
}