Compare commits

..

14 commits

Author SHA1 Message Date
e7e44f8c63 Add a development package for guix and fix SJW incompatibility since
the 0.1.3.1 bugfix
2023-08-02 23:42:12 +02:00
7a9c1a65c2 Update dependencies versions 2023-07-31 19:32:31 +02:00
7e7d7e0804 Release 1.1.0.1 2021-01-20 13:48:21 +01:00
3e223e7169 Release 1.1.0.0 with RSS feeds and static pages 2020-12-14 10:24:01 +01:00
ffea469559 Update dependencies versions known to work 2020-12-06 17:26:22 +01:00
e8f84561df Fix broken URL in markdown links, a plural typo, the missing end of a sentence and a mistake in the syntax for template conditional blocks 2020-10-28 14:27:55 +01:00
191a8b0771 Fix broken Markdown link due to a ' ' in a URL 2020-10-28 10:57:27 +01:00
1ac53e90d7 Merge branch 'main' into goSJW 2020-05-09 21:02:50 +02:00
f19331bf11 Generate links to RSS feeds generated, generalize conditional blocks for static templating thus simplifying some variables and clarify some data structures for Collections and ArticleLists 2020-05-08 15:51:25 +02:00
4f93b92cc4 Merge branch 'main' into goSJW 2020-03-25 19:48:46 +01:00
4e402174b1 Implement RSS feeds generation 2020-03-25 19:47:28 +01:00
7ef89ae93d Add missing imports, reorder them alphabetically 2020-01-11 09:05:32 +01:00
fd714e93ff Require SJW, generate blog config as a standalone file because it's always nice to have (if you want to expose its content as a read-only API) and handle hablo.js compilation with SJW 2020-01-10 18:58:42 +01:00
add68897ad Adapt hablo's JS to SJW and stop requiring unitJS separately (since it's gonna get pulled in by sjw at compile time) 2020-01-10 18:56:59 +01:00
81 changed files with 2108 additions and 922 deletions

View file

@ -1,5 +1,16 @@
# Revision history for hablo # Revision history for hablo
## 1.1.0.1 -- 2021-01-20
* Ensure compilation on Nix as far as 18.09
* Fix missing metadata when landing on articles
## 1.1.0.0 -- 2020-12-13
* Implement static pages
* Implement RSS feeds
* Use SJW to pack JS into a single script and simplify deployment
## 1.0.3.0 -- 2019-12-21 ## 1.0.3.0 -- 2019-12-21
* Fix OpenGraph cards displayed for links to hablo-generated pages posted on the Fediverse (should work elsewhere too but I don't care and have never tested) * Fix OpenGraph cards displayed for links to hablo-generated pages posted on the Fediverse (should work elsewhere too but I don't care and have never tested)

View file

@ -20,6 +20,16 @@ cabal new-install hablo
Alternatively, if you prefer to do things yourself you can do a Alternatively, if you prefer to do things yourself you can do a
#### Simple install with nix
Want to give hablo a quick try using nix ?
```bash
nix-env -f 'https://git.marvid.fr/Tissevert/mynixpkgs/archive/main.tar.gz' -i hablo
```
Visit my [Nix packages](https://git.marvid.fr/Tissevert/mynixpkgs) for a more declarative setup.
#### Manual install from this repository #### Manual install from this repository
Get a copy of this repository Get a copy of this repository
@ -40,6 +50,18 @@ Install the result
cabal new-install hablo cabal new-install hablo
``` ```
### Dependencies
Hablo requires [UnitJS](https://git.marvid.fr/Tissevert/UnitJS) which is handled by [SJW](https://git.marvid.fr/Tissevert/SJW). Make sure you have installed it regularly with `SJW`. If it isn't yet, the following commands should help you:
```bash
cd /tmp
git clone https://git.marvid.fr/Tissevert/UnitJS.git
cd UnitJS
mkdir -p ~/.sjw
cp -r src/ ~/.sjw/unitJS
```
### Using hablo (tutorials) ### Using hablo (tutorials)
Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog) Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog)

View file

@ -32,6 +32,8 @@ hablo --articles turtles /path/to/your/blog
See ? It was still `turtles` and not ~~`/path/to/your/blog/turtles`~~. See ? It was still `turtles` and not ~~`/path/to/your/blog/turtles`~~.
Also note that articles are partly optional : you can use hablo to generate a website with a fix content and no articles. In that case, just make sure no directory named `articles/` exists at the root of your website (see [pages](#pages-path)) and keep in mind that it should have static pages (hablo, just like other famous entities should not be invoked in vain and will exit in error suspecting something went wrong when invoked on an empty website with no articles and no pages, which to it means nothing to do).
## Banner ## Banner
`-b, --banner` `-b, --banner`
@ -41,7 +43,7 @@ By default hablo will generate a very simple banner for your blog with its name
The banner is processed when your blog is generated so it's not relative to the root of your blog, the banner file can totally be outside of your blog structure. The banner is processed when your blog is generated so it's not relative to the root of your blog, the banner file can totally be outside of your blog structure.
```bash ```bash
hablo --banner /my/set/of/banner/turtles.html /path/to/your/blog hablo --banner /my/set/of/banners/turtles.html /path/to/your/blog
``` ```
## Card image ## Card image
@ -110,11 +112,31 @@ You can use this option if you want to override this behaviour and provide a dif
hablo --name "Turtles/Paradize" hablo --name "Turtles/Paradize"
``` ```
## Pages ## Open Graph cards
`-O, --open-graph-cards`
Enables Open Graph cards in pages to display a pretty preview of them instead of the raw URL in links posted to social media. Note that this feature requires setting your site URL with [`--site-url`](#site-url).
## Pages path
`-p, --pages` `-p, --pages`
This option doesn't work yet but hablo will support static pages in addition to articles in a future release. Like [articles](#article-path), they will be expected to be located in a sub-directory called `pages/` but this option will allow you to use an arbitrary path within your blog's structure. In addition to «dynamic» lists of articles that grow over time, hablo supports «static» pages to allow you to publish relatively constant information related to your blog. Pages are expected to be located in a sub-directory called `pages/` but this option will allow you to use an arbitrary path within your blog's structure.
So if for instance your blog is for a community of authors and a presentation of each of them is all you want to publish as «static» content, you could have this directory called «authors» and run `hablo` like this :
```bash
hablo --pages authors
```
This option is very similar to the one for [articles](#articles-path). Like the articles path, the pages path is of course relative to the blog's root. Pages are also partly optional : you don't have to have static pages in your blog in which case you should just make sure no directory named `pages/` exists at the root of your website and you have articles (because like we said above hablo is highly suspicious of being invoked to perform no work and will suspect this is a mistake and report it as an error).
Final tip : if you're using hablo to edit a static website with no articles, then you probably don't want to put your pages in a sub-directory but have them at the root of your website instead. This is possible, just remember that the current directory is called `.` in UNIX and run :
```bash
hablo -p .
```
## Number of articles previewed ## Number of articles previewed
@ -126,7 +148,7 @@ On the page that [lists](https://git.marvid.fr/Tissevert/hablo/wiki/Architectura
hablo --preview-articles 5 hablo --preview-articles 5
``` ```
will make all your short pages display 5 articles. will make all your short pages display 5 articles. This number of articles per short page is also used in the RSS feeds if you enable them with [`--rss`](#rss).
## Number of lines preview for articles ## Number of lines preview for articles
@ -144,19 +166,27 @@ Hablo uses [remarkable](https://github.com/jonschlinkert/remarkable) to render y
The file is read by hablo when the blog is generated and its content gets included into the client JS code so it can be located absolutely anywhere, even outside your blog's directory. The file is read by hablo when the blog is generated and its content gets included into the client JS code so it can be located absolutely anywhere, even outside your blog's directory.
## RSS
`-R, --rss`
Enables the generation of RSS feeds for each [list](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#page-types) of articles. The feed consists in an additional `rss.xml` file placed in the same directory as the `index.html` and `all.html` files generated for the general lists. The feeds only include the most recent articles exactly as the «short» versions of each list, which means that they are affected by the use of the [`--preview-articles`](#number-of-articles-previewed) option. When this option is enabled, hablo will also include links to the generated feeds in the list pages. Two [template variables](https://git.marvid.fr/Tissevert/hablo/wiki/Template%20variables#rsslinks) control respectively the content and the title of the link.
Note that this feature requires setting your site URL with [`--site-url`](#site-url).
## Site URL ## Site URL
`-u, --site-url` `-u, --site-url`
To enable Open Graph cards and display a pretty preview of the page instead of the raw URL in links posted to social media, you need to tell Hablo about the URL where the website is going to be deployed. This used to work without but apparently Pleroma no longer considers valid cards with an image path local to the website. All the default content generated by hablo is independent from any host because it doesn't use any full URL with a host name. Enabling [Open Graph cards](#open-graph-cards) or [RSS feeds](#rss) requires to know this information though, which is achieved by setting this option to the desired value.
Note that this is purely optional and you don't have to use this option if you don't care about Open Graph cards. They will simply disappear instead of being generated without the absolute URL. This means that option now works as a switch to enable Open Graph cards or not. Note that this is purely optional and you don't have to use this option if you don't care about Open Graph cards or RSS feeds. Setting it for no reason will trigger a warning.
## Wording ## Wording
`-w, --wording` `-w, --wording`
This option makes hablo look for the value of the texts used to [generate the pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural choices#customization) in an [arbitrary file](https://git.marvid.fr/Tissevert/hablo/wiki/Template variables). It is useful to translate your blog (all texts are in english by default) or to give it a particular feel. This option makes hablo look for the value of the texts used to [generate the pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#customization) in an [arbitrary file](https://git.marvid.fr/Tissevert/hablo/wiki/Template%20variables). It is useful to translate your blog (all texts are in english by default) or to give it a particular feel.
```bash ```bash
hablo --wording /blogs/translations/fr-ca.conf /path/to/your/blog hablo --wording /blogs/translations/fr-ca.conf /path/to/your/blog

View file

@ -70,7 +70,7 @@ If you'd like to read more details about all the available customization, you sh
## How do I activate comments on my blog ? ## How do I activate comments on my blog ?
Since hablo is [static](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural choices#static-and-lazy) there's no way to directly include the comments in the pages. On a blog generated with hablo comments are fetched with JS and dynamically added to the page when it gets rendered in the client. Since hablo is [static](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#static-and-lazy) there's no way to directly include the comments in the pages. On a blog generated with hablo comments are fetched with JS and dynamically added to the page when it gets rendered in the client.
Let's say you published an article, tell people about it from your fediverse instance by posting a link to that article. First, we need to find the status [`id`](https://docs.joinmastodon.org/api/entities#status) of your post. Let's say you published an article, tell people about it from your fediverse instance by posting a link to that article. First, we need to find the status [`id`](https://docs.joinmastodon.org/api/entities#status) of your post.

View file

@ -1,6 +1,6 @@
# Deployment # Deployment
Since hablo generates static blogs, deployment is a fairly easy step. The only detail to pay attention to is the handling of dependencies. Since hablo generates static blogs, deployment is a fairly easy step. The only detail to pay attention to is the handling of JS dependencies.
We show here a simple local deployment of your blog assuming you use NGinx but this is fairly easy to transpose to your favourite web server. First let's create an NGinx configuration file for your blog. Let's put the following basic configuration We show here a simple local deployment of your blog assuming you use NGinx but this is fairly easy to transpose to your favourite web server. First let's create an NGinx configuration file for your blog. Let's put the following basic configuration
@ -29,30 +29,11 @@ sudo nginx -s reload
Now let's install the dependencies. Now let's install the dependencies.
## UnitJS
Hablo requires [UnitJS](https://git.marvid.fr/Tissevert/UnitJS). Go to some temporary work directory, clone it and generate the packed JS module.
```bash
cd /tmp
git clone https://git.marvid.fr/Tissevert/UnitJS.git
cd UnitJS
make
```
It's in `dist/unit.js`. Let's go back to your blog's directory and copy it.
```bash
cd "/path/to/My perfect life is better than yours"
mkdir -p js
cp /tmp/UnitJS/dist/unit.js js
```
## Remarkable ## Remarkable
The markdown is converted to HTML in the client browser with the JS library [remarkable](https://github.com/jonschlinkert/remarkable). The markdown is converted to HTML in the client browser with the JS library [remarkable](https://github.com/jonschlinkert/remarkable).
We can simply download it in your `js` directory. We can simply download it in the `js` subdirectory of your blog hablo created when you first invoked it.
```bash ```bash
wget 'https://cdnjs.cloudflare.com/ajax/libs/remarkable/1.7.1/remarkable.min.js' -O js/remarkable.min.js wget 'https://cdnjs.cloudflare.com/ajax/libs/remarkable/1.7.1/remarkable.min.js' -O js/remarkable.min.js

View file

@ -25,7 +25,7 @@ EOF
Ok, ok, not everyone uses heredocs to write their articles. Personally I don't. You're writing a blog so you probably already have a favourite text editor; use it. The only thing I care about is, at this point, that you've created the file `Olive\ ridley\ sea\ turtle.md` in the `articles` directory with some markdown content in it. Ok, ok, not everyone uses heredocs to write their articles. Personally I don't. You're writing a blog so you probably already have a favourite text editor; use it. The only thing I care about is, at this point, that you've created the file `Olive\ ridley\ sea\ turtle.md` in the `articles` directory with some markdown content in it.
Ready ? Good news, we're almost done. The only thing left is to tag your first article. With hablo articles don't have to be put in a single category but they can be tagged this and that to indicate that they are somehow linked to one topic or another (they don't have to, you can perfectly leave an article untagged but the tags directory itself must exist). Tags live in a subdirectory of `articles`. Ready ? Good news, we're almost done. The only thing left is to tag your first article. With hablo articles don't have to be put in a single category but they can be tagged this and that to indicate that they are somehow linked to one topic or another (they don't have to, you can perfectly leave an article untagged). Tags live in a subdirectory of `articles`.
```bash ```bash
mkdir -p articles/tags/Sea\ turtles mkdir -p articles/tags/Sea\ turtles

View file

@ -1,6 +1,6 @@
# Metadata # Metadata
Markdown articles are rendered as late as possible into HTML, even the [article pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural choices#article-pages) only wrap the markdown content into a `<pre></pre>` element. But metadata are still read by hablo when it analyses your blog because some metadata trigger special behaviors. Markdown articles are rendered as late as possible into HTML, even the [article pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#article-pages) only wrap the markdown content into a `<pre></pre>` element. But metadata are still read by hablo when it analyses your blog because some metadata trigger special behaviors.
## Format ## Format
@ -45,7 +45,7 @@ You can override this behaviour by setting a `date` metadata. It can contain a d
### Featured image ### Featured image
Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [Open Graph](http://ogp.me/) card of your article if you've [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url) them, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it). Every article can contain as many pictures as you like, anywhere you like in it. But you can choose one of them (or even one that doesn't appear in your article) to appear in the [Open Graph](http://ogp.me/) card of your article if you've [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#open-graph-cards) them, so that it is displayed and «represents» your article when you paste links to it on social media. The exact name of the metadata is `featuredImage`, camel-case, and it expects the site-root relative link of the picture (so the path as seen from your blog by a client accessing it).
```YAML ```YAML
featuredImage: /media/turtles/olive-ridley.jpg featuredImage: /media/turtles/olive-ridley.jpg
@ -53,7 +53,7 @@ featuredImage: /media/turtles/olive-ridley.jpg
### Summary ### Summary
You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the Open Graph [description](http://ogp.me/#optional) of the card generated for the article (like above for the featured image, if they're [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url)) You can write a short description of your article and use it as the value of its `summary` metadata and this text will be used in the Open Graph [description](http://ogp.me/#optional) of the card generated for the article (like above for the featured image, if they're [enabled](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#open-graph-cards))
```YAML ```YAML
summary: This week, I'm gonna tell you everything about the olive ridley sea turtle ! summary: This week, I'm gonna tell you everything about the olive ridley sea turtle !

View file

@ -4,33 +4,39 @@ Here is the full list of the available text template variables that you can cust
Variables are prefixed by a `$` and may be enclosed in brackets `{ }` to lift any ambiguity and separate the variable from the surrounding characters (exemple : does the template `the $nth` refers to a `nth` variable or is it the variable `n` followed by the literal characters `th` ? the first interpretation prevails, and if you want the second one you should write `the ${n}th`). Variables are prefixed by a `$` and may be enclosed in brackets `{ }` to lift any ambiguity and separate the variable from the surrounding characters (exemple : does the template `the $nth` refers to a `nth` variable or is it the variable `n` followed by the literal characters `th` ? the first interpretation prevails, and if you want the second one you should write `the ${n}th`).
Most of the templates are used «at [compile-time](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#static-and-lazy)» when the blog is generated and so errors, missing variables etc. are caught early but some like [metadata](#metadata) are only used client-side and hence need to be more resistant. If a variable present in a template is missing when the template is rendered, an `undefined` JS value is returned. All template variables are checked at «[compile-time](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#static-and-lazy)» when the blog is generated and so syntax errors, missing or unexpected variables etc. are caught early.
Now some contexts, especially article contexts may vary a bit so some templates like `metadata` need a way to «catch» those null values and keep up templating. For instance, an article may or may not have an author or tags. You could for instance decide that the base articles of your blog aren't signed because they obviously come from you or the organization that publish the blog but that when the blog publishes an article by a special guest it needs a special mention. To «harden» a template string against possible null values, just enclose the corresponding optional part between `${? ?}`. ## Conditional blocks
## allLink Now some contexts may vary a bit and sometimes «lack» a variable so some templates like `metadata` need a way to «catch» those possible null values and keep templating. You could for instance decide that most articles of your blog aren't signed because they obviously come from you or the organization that publishes the blog but that when the blog features an article by a special guest it needs a special mention and you would put the corresponding part using the `${author}` variable in a conditional block. The syntax to do so and «warn» the templating system of possible null values is to enclose the corresponding optional part inside `{? ?}` like so :
```
allPage = The articles{? about ${tag}?}
```
This will yield just `The articles` on the general pages without tags and `The articles about sea turtles` on the pages for the tag `sea turtles`. Note that conditional blocks are «flat», you can't nest one under another.
## Available variables
### allLink
The text used in the link to the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page on the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page of the same category. The text used in the link to the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page on the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page of the same category.
## allPage ### allPage
The `<h2>` title used on the [full page for all the articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). The `<h2>` title used on the [full page for articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages).
## allTaggedPage It can use the variable named `$tag` : the name of the tag for the given page. Be careful that this variable will be null for the untagged «general» pages, so you want to escape it using the [conditional](#conditional-blocks) syntax described above if your template string does contain `${tag}`.
The template for the `<h2>` title used on the [full pages for all the articles tagged a given tag](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). ### commentsLink
It of course expects one variable named `$tag` : the name of the tag for the given page.
## commentsLink
The text displayed after the comments as a link to the toot that opens the comments section inviting visitors to comment the post. The text displayed after the comments as a link to the toot that opens the comments section inviting visitors to comment the post.
## commentsSection ### commentsSection
The content of the `<h2>` element at the begining of the comments on the pages of articles that have comments enabled. The content of the `<h2>` element at the begining of the comments on the pages of articles that have comments enabled.
## dateFormat ### dateFormat
This isn't really a template per-se but impacts the way the dates are generated to use in the [metadata](#metadata) template. More precisely it contains the arguments passed to the [toLocaleDateString](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleDateString) method. It can thus only consist in a locale name, but since `toLocaleDateString` also accepts an object as second argument, you can write the whole thing using JSON like this : This isn't really a template per-se but impacts the way the dates are generated to use in the [metadata](#metadata) template. More precisely it contains the arguments passed to the [toLocaleDateString](https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Date/toLocaleDateString) method. It can thus only consist in a locale name, but since `toLocaleDateString` also accepts an object as second argument, you can write the whole thing using JSON like this :
@ -38,21 +44,17 @@ This isn't really a template per-se but impacts the way the dates are generated
dateFormat = ["en-AU", {"month":"long", "day":"2-digit"}] dateFormat = ["en-AU", {"month":"long", "day":"2-digit"}]
``` ```
## latestLink ### latestLink
The text used in the link to the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page on the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page of the same category. The text used in the link to the [latest](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#latest-pages) page on the [full](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#full-pages) page of the same category.
## latestPage ### latestPage
The `<h2>` title used on the [latest page for all the articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). This page is the main page of your blog so this is more or less the first title that people see when they come to your blog. The `<h2>` title used on the [latest page for articles](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). The latest page without tags is the «main» page of your blog so this is more or less the first title that people see when they come to your blog.
## latestTaggedPage Just like the [allPage](#allpage) above it makes use of the `$tag` variable, that will be null for the untagged «general» pages. Again, see the [conditional](#conditional-blocks) section above to handle this properly.
The template for the `<h2>` title used on the [latest pages for all the articles tagged a given tag](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). ### metadata
It of course expects one variable named `$tag` : the name of the tag for the given page.
## metadata
The template of the text used to present the metadata associated to each article. This template is used both in the preview of an article on any page that lists it and on the article's page itself. It expects three possible variables The template of the text used to present the metadata associated to each article. This template is used both in the preview of an article on any page that lists it and on the article's page itself. It expects three possible variables
@ -68,7 +70,15 @@ metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
If an article has an author, the rendered `metadata` string will start with «by <AUTHOR>», otherwise it will directly start with «on <SOME DATE>». Likewise all articles with tags will have their `metadata` end with « tagged » and then the list of comma-separated tags but if an article doesn't have tags, it will simply end after the date. If an article has an author, the rendered `metadata` string will start with «by <AUTHOR>», otherwise it will directly start with «on <SOME DATE>». Likewise all articles with tags will have their `metadata` end with « tagged » and then the list of comma-separated tags but if an article doesn't have tags, it will simply end after the date.
## tagsList ### rssLink
This template variable contains the text displayed in the link element pointing to the [RSS feed](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#rss) to each [list page](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages). This template is a constant and doesn't expect any templating variable.
### rssTitle
This template variable contains the title attribute of the link element pointing to the [RSS feed](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#rss) to each [list page](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#list-pages) that will be visible on mouse hover. The only templating variable it expects is `$tag` (which should be preferably [protected](#conditional-blocks) if you use it because `$tag` will be null on the main page containing a link to the general feed containing all the articles published on your blog).
### tagsList
The content of the `<h2>` element in the navigation `<div>` that lists all the tags of your blog. The content of the `<h2>` element in the navigation `<div>` that lists all the tags of your blog.

27
ghc-template.scm Normal file
View file

@ -0,0 +1,27 @@
(use-modules (gnu packages haskell-xyz)
(gnu packages haskell-web)
(guix build-system haskell)
(guix download)
(guix gexp)
(guix git-download)
(guix licenses)
(guix packages))
(package
(name "ghc-template")
(version "0.2.0.10")
(source (origin
(method url-fetch)
(uri (hackage-uri "template" version))
(sha256
(base32
"10mcnhi2rdflmv79z0359nn5sylifvk9ih38xnjqqby6n4hs7mcg"))))
(build-system haskell-build-system)
(properties '((upstream-name . "template")))
(home-page "http://hackage.haskell.org/package/template")
(synopsis "Simple string substitution")
(description
"Simple string substitution library that supports \\\"$\\\"-based substitution.
Meant to be used when Text.Printf or string concatenation would lead to code
that is hard to read but when a full blown templating system is overkill.")
(license bsd-3))

44
guix.scm Normal file
View file

@ -0,0 +1,44 @@
(use-modules (gnu packages haskell-xyz)
(gnu packages haskell-web)
(guix build-system haskell)
(guix download)
(guix gexp)
(guix git-download)
(guix licenses)
(guix packages)
(loom packages sjw))
(let
((%source-dir (dirname (current-filename)))
(ghc-template (load "ghc-template.scm")))
(package
(name "hablo")
(version "devel")
(source
(local-file %source-dir
#:recursive? #t
#:select? (git-predicate %source-dir)))
(build-system haskell-build-system)
(inputs
(list ghc-aeson
ghc-attoparsec
ghc-lucid
ghc-optparse-applicative
ghc-parsec
ghc-random
ghc-sjw
ghc-template
ghc-xdg-basedir))
(native-search-paths
(list
(search-path-specification (variable "SJW_PATH")
(files '("lib/SJW")))))
(home-page "https://git.marvid.fr/Tissevert/SJW")
(synopsis "The Simple Javascript Wrench")
(description
"SJW is a very simple tool to pack several JS modules into a single
script. It doesn't really do proper compilation work (yet) except
resolving the modules dependencies and detecting import loops but it
provides each module with an independent execution context in the
resulting script.")
(license gpl3+)))

View file

@ -3,16 +3,16 @@ cabal-version: >= 1.10
-- For further documentation, see http://haskell.org/cabal/users-guide/ -- For further documentation, see http://haskell.org/cabal/users-guide/
name: hablo name: hablo
version: 1.0.3.0 version: 1.1.0.1
synopsis: A minimalist static blog generator synopsis: A minimalist static blog generator
description: description:
Hablo is a fediverse-oriented static blog generator for articles written Hablo is a fediverse-oriented static blog generator for articles written
in Markdown. It tries to generate as little HTML as needed and uses in Markdown. It tries to generate as little HTML as needed and uses
Javascript to implement dynamic features in the browser. Javascript to implement dynamic features in the browser.
Those features include the handling of comments and a cached navigation Those features include the handling of comments and a cached navigation to
to minimize the queries to the server. Hablo also generate cards for all minimize the number of queries to the server. Hablo also generates RSS feeds
pages, including articles for prettier shares on social-networks. and Open Graph cards for prettier shares on social networks.
homepage: https://git.marvid.fr/Tissevert/hablo homepage: https://git.marvid.fr/Tissevert/hablo
-- bug-reports: -- bug-reports:
license: BSD3 license: BSD3
@ -27,39 +27,86 @@ data-dir: share
data-files: js/*.js data-files: js/*.js
defaultWording.conf defaultWording.conf
executable hablo library
main-is: Main.hs exposed-modules: Arguments
other-modules: Arguments
, Article , Article
, ArticlesList , ArticlesList
, Blog , Blog
, Blog.Path , Blog.Path
, Blog.Template
, Blog.Skin , Blog.Skin
, Blog.URL , Blog.URL
, Blog.Wording , Blog.Wording
, Collection
, DOM , DOM
, DOM.Card , DOM.Card
, Files , Files
, HTML , HTML
, JS , JS
, JSON , JSON
, Markdown
, Page
, Paths_hablo , Paths_hablo
, Pretty , Pretty
, RSS
-- other-extensions: -- other-extensions:
build-depends: aeson >= 1.4.0 && < 1.5 build-depends: aeson >= 1.2.0 && < 2.1
, base >= 4.9.1 && < 4.13 , base >= 4.9.1 && < 4.17
, bytestring >= 0.10.8 && < 0.11 , bytestring >= 0.10.8 && < 0.12
, containers >= 0.5.11 && < 0.7 , containers >= 0.5.11 && < 0.7
, directory >= 1.3.1 && < 1.4 , directory >= 1.3.1 && < 1.4
, filepath >= 1.4.2 && < 1.5 , filepath >= 1.4.2 && < 1.5
, lucid >= 2.9.11 && < 2.10 , lucid >= 2.8.0 && < 2.12
, mtl >= 2.2.2 && < 2.3 , mtl >= 2.2.2 && < 2.3
, optparse-applicative >= 0.14.3 && < 0.16 , optparse-applicative >= 0.14.0 && < 0.18
, parsec >= 3.1.13 && < 3.2 , parsec >= 3.1.13 && < 3.2
, template >= 0.2.0 && < 0.3 , template >= 0.2.0 && < 0.3
, text >= 1.2.3 && < 1.3 , text >= 1.2.3 && < 1.3
, time >= 1.8.0 && < 1.9 , time >= 1.8.0 && < 1.12
, SJW >= 0.1.2 && < 0.2
, unix >= 2.7.2 && < 2.8 , unix >= 2.7.2 && < 2.8
ghc-options: -Wall -dynamic ghc-options: -Wall
hs-source-dirs: src hs-source-dirs: src
default-language: Haskell2010 default-language: Haskell2010
executable hablo
main-is: src/Main.hs
other-modules: Paths_hablo
-- other-extensions:
build-depends: base
, hablo
, mtl >= 2.2.2 && < 2.3
ghc-options: -Wall
default-language: Haskell2010
test-suite tests
type: detailed-0.9
test-module: Tests
other-modules: Mock.Arguments
, Mock.Article
, Mock.ArticlesList
, Mock.Blog
, Mock.Blog.Path
, Mock.Blog.Skin
, Mock.Blog.Template
, Mock.Blog.URL
, Mock.Blog.Wording
, Mock.Collection
, Mock.Markdown
, Structure
, Utils
, XML.Card
, XML.Card.Component
, XML.Card.Output
build-depends: base
, Cabal
, containers
, directory
, filepath
, hablo
, lucid
, mtl
, text
hs-source-dirs: test
ghc-options: -Wall
default-language: Haskell2010

View file

@ -1,11 +1,14 @@
allLink = See all allLink = See all
allPage = All articles allPage = All articles{? tagged ${tag}?}
allTaggedPage = All articles tagged ${tag} articleDescription = A new article on ${name}
commentsLink = Comment on the fediverse commentsLink = Comment on the fediverse
commentsSection = Comments commentsSection = Comments
dateFormat = en-US dateFormat = en-US
latestLink = See only latest latestLink = See only latest
latestPage = Latest articles latestPage = Latest articles{? tagged ${tag}?}
latestTaggedPage = Latest articles tagged ${tag}
metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?} metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
pageDescription = Read on ${name}
pagesList = Pages
rssLink = Subscribe
rssTitle = Follow all articles{? tagged ${tag}?}
tagsList = Tags tagsList = Tags

143
share/js/DomRenderer.js Normal file
View file

@ -0,0 +1,143 @@
import blog from Hablo.Config;
import Metadata;
import Remarkable;
import Template;
import * as Dom from UnitJS.Dom;
import {defined} from UnitJS.Fun;
return {
articlesList: articlesList,
getResource: getResource,
render: render,
replaceMarkdown: replaceMarkdown
};
function getResource(url) {
var i = url.lastIndexOf('/');
var path = url.slice(1, i);
if(path == blog.path.articlesPath) {
return {type: 'article', key: url.slice(i+1).replace(/\.html/, '')};
} else if(path == blog.path.pagesPath) {
return {type: 'page', key: url.slice(i+1).replace(/\.html/, '')};
} else if(path == '' || blog.tags[path] != undefined) {
var tag = path.length > 0 ? path : undefined;
return {type: 'list', tag: tag, all: url.slice(i+1) == 'all.html'};
} else {
return {type: 'unknown'};
}
}
function resourceUrl(resource, limit) {
var directory = blog.path[resource.type + 'sPath'];
var extension = limit != undefined ? '.html' : '.md';
return ["", directory, resource.key + extension].join('/');
}
function replaceMarkdown() {
var div = document.getElementById('contents');
if(div.children[0] && div.children[0].tagName.toLowerCase() == 'article') {
var resourceType = getResource(window.location.pathname).type;
convertContent(resourceType, div.children[0], true);
} else {
var articles = div.getElementsByClassName('articles')[0];
if(articles != undefined) {
for(var i = 0; i < articles.children.length; i++) {
convertContent('article', articles.children[i]);
}
} else {
console.log('No articles found for this page');
}
}
}
function convertContent(resourceType, article, comments) {
var header = article.getElementsByTagName('header')[0];
if(resourceType == 'article') {
header.appendChild(Metadata.get(article.id));
}
var text = article.getElementsByTagName('pre')[0];
if(text != undefined) {
article.replaceChild(getDiv(text.innerText), text);
if(resourceType == 'article' && comments) {
Metadata.getComments(article.id)
.forEach(article.appendChild.bind(article));
}
} else {
console.log('No content found for this article');
}
}
function getDiv(markdown) {
var d= Dom.make('div', {
innerHTML: Remarkable.md.render(markdown)
});
var scripts = d.getElementsByTagName('script');
for(var i = 0; i < scripts.length; i++) {
var run = Dom.make('script',
{type: 'text/javascript', src: scripts[i].src, textContent: scripts[i].textContent}
);
scripts[i].parentNode.replaceChild(run, scripts[i]);
}
return d;
}
function commentsSection(resource, limit) {
if(resource.type != 'article' || limit != undefined) {
return [];
} else {
return Metadata.getComments(resource.key);
}
}
function render(resource, markdown, limit) {
var url = resourceUrl(resource, limit);
var content = blog[resource.type + 's'][resource.key];
var lines = markdown.split(/\n/).slice(content.bodyOffset);
var div = getDiv(lines.slice(0, limit).join('\n'));
return Dom.make('article', {}, [
Dom.make('header', {}, [
Dom.make('h1', {}, [
Dom.make('a', {href: url, innerText: content.title})
])].concat(resource.type == 'article' ? Metadata.get(resource.key) : [])
),
div
].concat(commentsSection(resource, limit)));
}
function pageTitle(resource) {
return Template.render(resource.all ? 'allPage' : 'latestPage', {tag: resource.tag});
}
function otherUrl(resource) {
var path = [resource.tag, resource.all ? '' : 'all.html'];
return '/' + path.filter(defined).join('/');
}
function articlesList(resource) {
return function(articlePreviews) {
return [
Dom.make('h2', {innerText: pageTitle(resource)}),
Dom.make('ul', {}, articlesListLinks(resource)),
Dom.make('div', {class: 'articles'}, articlePreviews.filter(defined))
];
};
}
function articlesListLinks(resource) {
var links = [
Dom.make('a', {
innerText: resource.all ? blog.wording.latestLink : blog.wording.allLink,
href: otherUrl(resource),
class: 'other'
})
];
if(blog.hasRSS) {
links.unshift(Dom.make('a', {
innerText: blog.wording.rssLink,
href: 'rss.xml',
class: 'RSS',
title: Template.render('rssTitle', {tag: resource.tag})
}));
}
return links.map(function(e) {return Dom.make('li', {}, [e]);});
}

5
share/js/Main.js Normal file
View file

@ -0,0 +1,5 @@
import replaceMarkdown from DomRenderer;
import hijackLinks from Navigation;
replaceMarkdown();
hijackLinks();

159
share/js/Metadata.js Normal file
View file

@ -0,0 +1,159 @@
import blog from Hablo.Config;
import Template;
import * as Async from UnitJS.Async;
import * as Cache from UnitJS.Cache;
import * as Dom from UnitJS.Dom;
var comments = Cache.make(function(threadId) {
return Async.bind(
Async.parallel(
getJSON(url(threadId)),
getJSON(url(threadId) + '/context'),
),
Async.map(function(t) {
return [renderLink(t[0]), renderAnswers(t[1])];
})
);
});
return {
get: get,
getComments: getComments
};
function url(threadId) {
return blog.urls.comments + '/api/v1/statuses/' + threadId;
}
function getJSON(url) {
return Async.bind(
Async.http({method: 'GET', url: url}),
function(queryResult) {
if(queryResult.status == 200) {
try {
return Async.wrap(JSON.parse(queryResult.responseText));
} catch(e) {
return Async.fail('Server returned invalid JSON for ' + url);
}
} else {
return Async.fail('Could not load page ' + url);
}
}
);
}
function getComments(articleKey) {
var threadId = blog.articles[articleKey].metadata.comments;
if(blog.urls.comments != undefined && threadId != undefined) {
var ul = Dom.make('ul');
var div = emptySection(ul);
Async.run(
Async.bind(
comments.get(threadId), Async.map(populateComments(div, ul))
)
);
return [div];
} else {
return [];
}
}
function populateComments(div, ul) {
return function(apiResults) {
var post = apiResults[0], comments = apiResults[1];
div.appendChild(post);
comments.forEach(function(comment) {ul.appendChild(comment);});
};
}
function emptySection(ul) {
return Dom.make('div', {class: 'comments'}, [
Dom.make('h2', {innerText: blog.wording.commentsSection}),
ul
]);
}
function renderLink(post) {
return Dom.make('a', {
href: post.url,
innerText: blog.wording.commentsLink
});
}
function getContent(descendant) {
return descendant.content.replace(/:([^: ]+):/g, function(pattern, shortcode) {
var emoji = descendant.emojis.find(function(e) {return e.shortcode == shortcode;});
if(emoji) {
return [
'<img title=', shortcode, ' alt=', shortcode, ' src=', emoji.url, ' class="emoji"/>'
].join('"');
} else {
return pattern;
}
});
}
function renderAnswers(comments) {
return comments.descendants.map(function(descendant) {
return Dom.make('li', {}, [
Dom.make('a', {href: descendant.account.url}, [
Dom.make('img', {
src: descendant.account.avatar,
alt: descendant.account.username + "'s profile picture"
})
]),
Dom.make('div', {
class: "metadata",
innerHTML: Template.render('metadata', {
author: author(descendant.account.url, descendant.account.username),
date: date(descendant.created_at)
})
}),
Dom.make('div', {innerHTML: getContent(descendant)})
]);
});
}
function author(key, name) {
var authorUrl = key;
if(blog.articles[key] != undefined) {
authorUrl = blog.articles[key].metadata.author;
}
if(authorUrl) {
var author = name || authorUrl.replace(/.*\//, '');
return '<a href="' + authorUrl + '">' + author + '</a>';
}
}
function date(key) {
if(blog.articles[key] != undefined) {
var date = new Date(blog.articles[key].metadata.date * 1000);
} else {
var date = new Date(key);
}
var format = blog.wording.dateFormat;
if(format[0] != '[') {
if(format[0] != '"') {
format = '"' + format + '"';
}
format = '[' + format + ']';
}
return Date.prototype.toLocaleDateString.apply(date, JSON.parse(format));
}
function tags(key) {
var tags = blog.articles[key].tagged;
return tags.length < 1 ? null : tags.map(function(tag) {
return '<a class="tag" href="/' + tag + '">' + tag + '</a>';
}).join(', ');
}
function get(key) {
return Dom.make('div', {
class: "metadata",
innerHTML: Template.render('metadata', {
author: author(key),
date: date(key),
tags: tags(key)
})
});
}

121
share/js/Navigation.js Normal file
View file

@ -0,0 +1,121 @@
import {articlesList, getResource, render} from DomRenderer;
import blog from Hablo.Config;
import * as Async from UnitJS.Async;
import * as Cache from UnitJS.Cache;
import * as Dom from UnitJS.Dom;
import * as Fun from UnitJS.Fun;
var cache = {};
['article', 'page'].forEach(function(contentType) {
cache[contentType] = Cache.make(function(key) {
var url = ["", blog.path[contentType + 'sPath'], key + '.md'].join('/');
return Async.bind(
Async.http({method: 'GET', url: url}),
function(queryResult) {
if(queryResult.status == 200) {
return Async.wrap(queryResult.responseText);
} else {
return Async.fail(
"Could not load " + contentType + " " + url + " (" + queryResult.status + " " + queryResult.statusText + ")"
);
}
}
);
});
});
window.addEventListener('popstate', function(e) {
if(e.state != undefined) {
navigate(e.state.url);
}
});
history.replaceState({url: window.location.pathname}, 'Blog - title', window.location.pathname);
return {
hijackLinks: hijackLinks
};
function hijackLinks(domElem) {
domElem = domElem || document;
var links = domElem.getElementsByTagName('a');
for(var i = 0; i < links.length; i++) {
var a = links[i];
var href = a.getAttribute("href");
if((href[0] == "/" && href.slice(-3) != ".md") || href[0] == "#") {
a.addEventListener('click', visit(a.getAttribute("href")));
}
}
}
function visit(url) {
return function(e) {
e.preventDefault();
if(url[0] == '#') {
window.location = url;
history.replaceState({url: window.location.pathname}, 'Blog - title', url);
} else {
navigate(url);
history.pushState({url: url}, 'Blog - title', url);
}
};
}
function navigate(url) {
var resource = getResource(url);
switch(resource.type) {
case 'list': show(getArticlesList(resource)); break;
case 'article':
case 'page': show(getCached(resource)); break;
default: console.log("No idea how to navigate to " + url);
}
}
function getCached(resource) {
return Async.bind(
cache[resource.type].get(resource.key),
Async.map(
function(contents) {return [render(resource, contents)];}
)
);
}
function preview(key) {
return Async.bind(
cache.article.get(key),
function(contents) {
return Async.wrap(
render({type: 'article', key: key}, contents, blog.skin.previewLinesCount)
);
}
);
}
function articleIds(resource) {
var ids = resource.tag != undefined ? blog.tags[resource.tag] : Object.keys(blog.articles);
var reverseDate = function (id) {return -blog.articles[id].metadata.date;};
ids.sort(Fun.compare(reverseDate));
return ids.slice(0, resource.all ? undefined : blog.skin.previewArticlesCount);
}
function getArticlesList(resource) {
return Async.bind(
Async.parallel.apply(null, articleIds(resource).map(preview)),
Async.map(articlesList(resource))
);
}
function show(contents) {
Async.run(
Async.bind(
contents,
Async.map(function (domElems) {
domElems = domElems.filter(Fun.defined);
var div = document.getElementById('contents');
Dom.clear(div);
for(var i = 0; i < domElems.length; i++) {
div.appendChild(domElems[i]);
}
hijackLinks(div);
})
)
);
}

8
share/js/Remarkable.js Normal file
View file

@ -0,0 +1,8 @@
import remarkableConfig from Hablo.Config;
var md = new Remarkable(remarkableConfig);
md.block.ruler.enable(['footnote']);
return {
md: md
};

35
share/js/Template.js Normal file
View file

@ -0,0 +1,35 @@
import blog from Hablo.Config;
return {
render: render
};
function render(template, environment) {
if(blog.wording[template] != undefined) {
var template = blog.wording[template];
}
template = template.replace(/{\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
var failed = [false];
var result = template.replace(
/([^$]|^)\$(?:{(\w+)}|(\w+)\b)/g,
substitute(environment, failed)
);
return failed[0] ? null : result;
}
function renderSub(environment) {
return function(_, sub) {
return render(sub, environment) || '';
};
}
function substitute(environment, failed) {
return function(_, before, bracketed, raw) {
var replaced = environment[bracketed || raw];
if(replaced != undefined) {
return before + replaced;
} else {
failed[0] = true;
}
}
}

View file

@ -1,94 +0,0 @@
function DomRenderer(modules) {
return {
article: article,
articlesList: articlesList,
replaceMarkdown: replaceMarkdown
};
function replaceMarkdown() {
var div = document.getElementById('contents');
if(div.children[0] && div.children[0].tagName.toLowerCase() == 'article') {
convertArticle(div.children[0], true);
} else {
var articles = div.getElementsByClassName('articles')[0];
if(articles != undefined) {
for(var i = 0; i < articles.children.length; i++) {
convertArticle(articles.children[i]);
}
} else {
console.log('No articles found for this page');
}
}
}
function convertArticle(article, comments) {
var header = article.getElementsByTagName('header')[0];
header.appendChild(modules.metadata.get(article.id));
var text = article.getElementsByTagName('pre')[0];
if(text != undefined) {
article.replaceChild(getDiv(text.innerText), text);
if(comments) {
modules.metadata.getComments(article.id)
.forEach(article.appendChild.bind(article));
}
} else {
console.log('No content found for this article');
}
}
function getDiv(markdown) {
var d= modules.dom.make('div', {
innerHTML: modules.md.render(markdown)
});
var scripts = d.getElementsByTagName('script');
for(var i = 0; i < scripts.length; i++) {
var run = modules.dom.make('script',
{type: 'text/javascript', src: scripts[i].src, textContent: scripts[i].textContent}
);
scripts[i].parentNode.replaceChild(run, scripts[i]);
}
return d;
}
function article(key, markdown, limit) {
var url = ["", blog.path.articlesPath, key + (limit != undefined ? '.html' : '.md')].join('/');
var lines = markdown.split(/\n/).slice(blog.articles[key].bodyOffset);
var div = getDiv(lines.slice(0, limit).join('\n'));
return modules.dom.make('article', {}, [
modules.dom.make('header', {}, [
modules.dom.make('a', {href: url}, [
modules.dom.make('h1', {innerText: blog.articles[key].title})
]),
modules.metadata.get(key)
]),
div
].concat(limit != undefined ? [] : modules.metadata.getComments(key)));
}
function pageTitle(tag, all) {
if(tag != undefined) {
var template = all ? 'allTaggedPage' : 'latestTaggedPage';
return modules.template.render(template, {tag: tag});
} else {
return blog.wording[all ? 'allPage' : 'latestPage'];
}
}
function otherUrl(tag, all) {
var path = [tag, all ? null : 'all.html'];
return '/' + path.filter(modules.fun.defined).join('/');
}
function articlesList(tag, all) {
return function(articlePreviews) {
return [
modules.dom.make('h2', {innerText: pageTitle(tag, all)}),
modules.dom.make('a', {
innerText: all ? blog.wording.latestLink : blog.wording.allLink,
href: otherUrl(tag, all)
}),
modules.dom.make('div', {class: 'articles'}, articlePreviews.filter(modules.fun.defined))
];
};
}
}

View file

@ -1,14 +0,0 @@
window.addEventListener('load', function() {
var async = unitJS.Async();
var cache = unitJS.Cache();
var dom = unitJS.Dom();
var fun = unitJS.Fun();
var md = new Remarkable(remarkableConfig);
md.block.ruler.enable(['footnote']);
var template = Template();
var metadata = Metadata({async: async, cache: cache, dom: dom, fun:fun, template: template});
var domRenderer = DomRenderer({dom: dom, fun: fun, md: md, metadata: metadata, template: template});
var navigation = Navigation({async: async, cache: cache, dom: dom, domRenderer: domRenderer, fun: fun, md: md});
domRenderer.replaceMarkdown();
navigation.hijackLinks();
});

View file

@ -1,155 +0,0 @@
function Metadata(modules) {
var comments = modules.cache.make(function(threadId) {
return modules.async.bind(
modules.async.parallel(
getJSON(url(threadId)),
getJSON(url(threadId) + '/context'),
),
modules.async.map(function(t) {
return [renderLink(t[0]), renderAnswers(t[1])];
})
);
});
return {
get: get,
getComments: getComments
};
function url(threadId) {
return blog.urls.comments + '/api/v1/statuses/' + threadId;
}
function getJSON(url) {
return modules.async.bind(
modules.async.http({method: 'GET', url: url}),
function(queryResult) {
if(queryResult.status == 200) {
try {
return modules.async.wrap(JSON.parse(queryResult.responseText));
} catch(e) {
return modules.async.fail('Server returned invalid JSON for ' + url);
}
} else {
return modules.async.fail('Could not load page ' + url);
}
}
);
}
function getComments(articleKey) {
var threadId = blog.articles[articleKey].metadata.comments;
if(blog.urls.comments != undefined && threadId != undefined) {
var ul = modules.dom.make('ul');
var div = emptySection(ul);
modules.async.run(
modules.async.bind(
comments.get(threadId), modules.async.map(populateComments(div, ul))
)
);
return [div];
} else {
return [];
}
}
function populateComments(div, ul) {
return function(apiResults) {
var post = apiResults[0], comments = apiResults[1];
div.appendChild(post);
comments.forEach(function(comment) {ul.appendChild(comment);});
};
}
function emptySection(ul) {
return modules.dom.make('div', {class: 'comments'}, [
modules.dom.make('h2', {innerText: blog.wording.commentsSection}),
ul
]);
}
function renderLink(post) {
return modules.dom.make('a', {
href: post.url,
innerText: blog.wording.commentsLink
});
}
function getContent(descendant) {
return descendant.content.replace(/:([^: ]+):/g, function(pattern, shortcode) {
var emoji = descendant.emojis.find(function(e) {return e.shortcode == shortcode;});
if(emoji) {
return [
'<img title=', shortcode, ' alt=', shortcode, ' src=', emoji.url, ' class="emoji"/>'
].join('"');
} else {
return pattern;
}
});
}
function renderAnswers(comments) {
return comments.descendants.map(function(descendant) {
return modules.dom.make('li', {}, [
modules.dom.make('a', {href: descendant.account.url}, [
modules.dom.make('img', {
src: descendant.account.avatar,
alt: descendant.account.username + "'s profile picture"
})
]),
modules.dom.make('div', {
class: "metadata",
innerHTML: modules.template.render('metadata', {
author: author(descendant.account.url, descendant.account.username),
date: date(descendant.created_at)
})
}),
modules.dom.make('div', {innerHTML: getContent(descendant)})
]);
});
}
function author(key, name) {
var authorUrl = key;
if(blog.articles[key] != undefined) {
authorUrl = blog.articles[key].metadata.author;
}
if(authorUrl) {
var author = name || authorUrl.replace(/.*\//, '');
return '<a href="' + authorUrl + '">' + author + '</a>';
}
}
function date(key) {
if(blog.articles[key] != undefined) {
var date = new Date(blog.articles[key].metadata.date * 1000);
} else {
var date = new Date(key);
}
var format = blog.wording.dateFormat;
if(format[0] != '[') {
if(format[0] != '"') {
format = '"' + format + '"';
}
format = '[' + format + ']';
}
return Date.prototype.toLocaleDateString.apply(date, JSON.parse(format));
}
function tags(key) {
var tags = blog.articles[key].tagged;
return tags.length < 1 ? null : tags.map(function(tag) {
return '<a class="tag" href="/' + tag + '">' + tag + '</a>';
}).join(', ');
}
function get(key) {
return modules.dom.make('div', {
class: "metadata",
innerHTML: modules.template.render('metadata', {
author: author(key),
date: date(key),
tags: tags(key)
})
});
}
}

View file

@ -1,117 +0,0 @@
function Navigation(modules) {
var articles = modules.cache.make(function(key) {
var url = ["", blog.path.articlesPath, key + '.md'].join('/');
return modules.async.bind(
modules.async.http({method: 'GET', url: url}),
function(queryResult) {
if(queryResult.status == 200) {
return modules.async.wrap(queryResult.responseText);
} else {
return modules.async.fail(
"Could not load article " + url + " (" + queryResult.status + " " + queryResult.statusText + ")"
);
}
}
);
});
window.addEventListener('popstate', function(e) {
if(e.state != undefined) {
navigate(e.state.url);
}
});
history.replaceState({url: window.location.pathname}, 'Blog - title', window.location.pathname);
return {
hijackLinks: hijackLinks
};
function hijackLinks(domElem) {
domElem = domElem || document;
var links = domElem.getElementsByTagName('a');
for(var i = 0; i < links.length; i++) {
var a = links[i];
var href = a.getAttribute("href");
if((href[0] == "/" && href.slice(-3) != ".md") || href[0] == "#") {
a.addEventListener('click', visit(a.getAttribute("href")));
}
}
}
function visit(url) {
return function(e) {
e.preventDefault();
if(url[0] == '#') {
window.location = url;
history.replaceState({url: window.location.pathname}, 'Blog - title', url);
} else {
navigate(url);
history.pushState({url: url}, 'Blog - title', url);
}
};
}
function navigate(url) {
var path = decodeURI(url).split("/").slice(1);
if(blog.tags[path[0]] != undefined) {
show(getArticlesList(path[0], path[1] == "all.html"));
} else if(path[0] == blog.path.articlesPath) {
show(getArticle(path[1].replace(/\.html$/, '')));
} else {
show(getArticlesList(null, path[0] == "all.html"));
}
}
function getArticle(key) {
return modules.async.bind(
articles.get(key),
modules.async.map(
function(contents) {return [modules.domRenderer.article(key, contents)];}
)
);
}
function preview(key) {
return modules.async.bind(
articles.get(key),
function(contents) {
return modules.async.wrap(
modules.domRenderer.article(
key,
contents,
blog.skin.previewLinesCount
)
);
}
);
}
function articleIds(tag, all) {
var ids = tag != undefined ? blog.tags[tag] : Object.keys(blog.articles);
var reverseDate = function (id) {return -blog.articles[id].metadata.date;};
ids.sort(modules.fun.compare(reverseDate));
return ids.slice(0, all ? undefined : blog.skin.previewArticlesCount);
}
function getArticlesList(tag, all) {
return modules.async.bind(
modules.async.parallel.apply(null, articleIds(tag, all).map(preview)),
modules.async.map(modules.domRenderer.articlesList(tag, all))
);
}
function show(contents) {
modules.async.run(
modules.async.bind(
contents,
modules.async.map(function (domElems) {
domElems = domElems.filter(modules.fun.defined);
var div = document.getElementById('contents');
modules.dom.clear(div);
for(var i = 0; i < domElems.length; i++) {
div.appendChild(domElems[i]);
}
hijackLinks(div);
})
)
);
}
}

View file

@ -1,35 +0,0 @@
function Template() {
return {
render: render
};
function render(template, environment) {
if(blog.wording[template] != undefined) {
var template = blog.wording[template];
}
template = template.replace(/{\?((?:[^?]|\?[^}])*)\?}/g, renderSub(environment));
var failed = [false];
var result = template.replace(
/([^$]|^)\$(?:{(\w+)}|(\w+)\b)/g,
substitute(environment, failed)
);
return failed[0] ? null : result;
}
function renderSub(environment) {
return function(_, sub) {
return render(sub, environment) || '';
};
}
function substitute(environment, failed) {
return function(_, before, bracketed, raw) {
var replaced = environment[bracketed || raw];
if(replaced != undefined) {
return before + replaced;
} else {
failed[0] = true;
}
}
}
}

View file

@ -1,29 +1,37 @@
{-# LANGUAGE CPP #-}
module Arguments ( module Arguments (
Arguments(..) Arguments(..)
, get , get
) where ) where
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif
import Data.Version (showVersion) import Data.Version (showVersion)
import Control.Applicative ((<|>), (<**>), optional) import Control.Applicative ((<|>), (<**>), optional)
import Options.Applicative (Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc, header, help, helper, info, long, metavar, short, str, value) import Options.Applicative (
Parser, ReadM, argument, auto, eitherReader, execParser, flag', fullDesc
, header, help, helper, info, long, metavar, short, str, switch, value
)
import qualified Options.Applicative as Optparse (option) import qualified Options.Applicative as Optparse (option)
import qualified Paths_hablo as Hablo (version) import qualified Paths_hablo as Hablo (version)
import System.FilePath (dropTrailingPathSeparator, isValid) import System.FilePath (dropTrailingPathSeparator, isValid)
data Arguments = BlogConfig { data Arguments = BlogConfig {
sourceDir :: FilePath sourceDir :: FilePath
, articlesPath :: FilePath , articlesPath :: Maybe FilePath
, bannerPath :: Maybe FilePath , bannerPath :: Maybe FilePath
, cardImage :: Maybe FilePath , cardImage :: Maybe FilePath
, commentsURL :: Maybe String , commentsURL :: Maybe String
, favicon :: Maybe FilePath , favicon :: Maybe FilePath
, headPath :: Maybe FilePath , headPath :: Maybe FilePath
, name :: Maybe String , name :: Maybe String
, openGraphCards :: Bool
, pagesPath :: Maybe FilePath , pagesPath :: Maybe FilePath
, previewArticlesCount :: Int , previewArticlesCount :: Int
, previewLinesCount :: Int , previewLinesCount :: Int
, remarkableConfig :: Maybe FilePath , remarkableConfig :: Maybe FilePath
, rss :: Bool
, siteURL :: Maybe String , siteURL :: Maybe String
, wording :: Maybe FilePath , wording :: Maybe FilePath
} }
@ -42,21 +50,17 @@ option readM aShort aLong aMetavar aHelpMessage =
blogConfig :: Parser Arguments blogConfig :: Parser Arguments
blogConfig = BlogConfig blogConfig = BlogConfig
<$> argument filePath (value "." <> metavar "INPUT_DIR") <$> argument filePath (value "." <> metavar "INPUT_DIR")
<*> Optparse.option filePath ( <*> option filePath 'a' "articles" "DIRECTORY"
metavar "DIRECTORY" "relative path to the directory containing the articles within INPUT_DIR"
<> value "articles"
<> short 'a'
<> long "articles"
<> help "relative path to the directory containing the articles within INPUT_DIR"
)
<*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner" <*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner"
<*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card" <*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
<*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored" <*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored"
<*> option filePath 'f' "favicon" "FILE" "path to the image to use for the blog's favicon" <*> option filePath 'f' "favicon" "FILE" "path to the image to use for the blog's favicon"
<*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head" <*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
<*> option str 'n' "name" "BLOG_NAME" "name of the blog" <*> option str 'n' "name" "BLOG_NAME" "name of the blog"
<*> option filePath 'p' "pages" <*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
"DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR" <*> option filePath 'p' "pages" "DIRECTORY"
"relative path to the directory containing the pages within INPUT_DIR"
<*> Optparse.option auto ( <*> Optparse.option auto (
metavar "INTEGER" metavar "INTEGER"
<> value 3 <> value 3
@ -73,6 +77,7 @@ blogConfig = BlogConfig
) )
<*> option filePath 'r' "remarkable-config" "FILE" <*> option filePath 'r' "remarkable-config" "FILE"
"path to a file containing a custom RemarkableJS configuration" "path to a file containing a custom RemarkableJS configuration"
<*> switch (short 'R' <> long "rss" <> help "enable RSS feeds generation")
<*> option filePath 'u' "site-url" "URL" "URL where the blog is published" <*> option filePath 'u' "site-url" "URL" "URL where the blog is published"
<*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use" <*> option filePath 'w' "wording" "FILE" "path to the file containing the wording to use"

View file

@ -1,111 +1,45 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module Article ( module Article (
Article(..) Article(..)
, at , at
, getKey
, preview , preview
) where ) where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Map (Map) import qualified Data.Map as Map (alter)
import qualified Data.Map as Map (fromList, alter) import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
import Data.Time ( import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
UTCTime, defaultTimeLocale, getCurrentTimeZone, parseTimeM import Foreign.C.Types (CTime)
, timeZoneOffsetString import Markdown (Markdown(..), MarkdownContent(..), Metadata)
) import qualified Markdown (at)
import Data.Time.Clock.System (systemSeconds, utcToSystemTime) import System.Posix.Files (getFileStatus, modificationTime)
import System.Directory (getModificationTime) import Text.ParserCombinators.Parsec (ParseError)
import System.FilePath (dropExtension, takeFileName)
import Text.ParserCombinators.Parsec (
ParseError
, Parser
, (<?>)
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
, oneOf, option, parse, skipMany, sourceLine, string, try
)
type Metadata = Map String String newtype Article = Article Markdown
instance MarkdownContent Article where
getMarkdown (Article markdown) = markdown
data Article = Article { setDate :: String -> CTime -> Metadata -> Metadata
key :: String
, title :: String
, metadata :: Metadata
, bodyOffset :: Int
, body :: [String]
}
type ProtoArticle = (String, Metadata, Int, [String])
articleP :: Parser ProtoArticle
articleP =
skipMany eol *> headerP <* skipMany eol <*> lineOffset <*> bodyP
where
headerP =
try ((,,,) <$> titleP <* many eol <*> metadataP)
<|> flip (,,,) <$> metadataP <* many eol<*> titleP
lineOffset = pred . sourceLine <$> getPosition
bodyP = lines <$> many anyChar <* eof
metadataP :: Parser Metadata
metadataP = Map.fromList <$> option [] (
metaSectionSeparator *> many eol *>
(try keyVal) `endBy` (many1 eol)
<* metaSectionSeparator
) <?> "metadata section"
where
metaSectionSeparator = count 3 (oneOf "~-") *> eol
spaces = skipMany $ char ' '
keyVal = (,) <$> (no ": \r\n" <* spaces <* char ':' <* spaces) <*> no "\r\n"
titleP :: Parser String
titleP = try (singleLine <|> underlined)
where
singleLine = char '#' *> char ' ' *> no "\r\n" <* eol
underlined =
no "\r\n" <* eol
>>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
<?> "'#' or '=' to underline the title"
eol :: Parser String
eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
no :: String -> Parser String
no = many1 . noneOf
getTimestamp :: UTCTime -> String
getTimestamp = show . systemSeconds . utcToSystemTime
setDate :: String -> String -> Metadata -> Metadata
setDate tzOffset defaultDate = Map.alter timeStamp "date" setDate tzOffset defaultDate = Map.alter timeStamp "date"
where where
formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"] formats = ("%Y-%m-%d" ++) . (++ " %z") <$> ["", " %H:%M"]
timeStamp = maybe (Just defaultDate) $ \date -> epoch = show . (truncate :: POSIXTime -> Integer) . utcTimeToPOSIXSeconds
timeStamp Nothing = Just $ show defaultDate
timeStamp (Just date) =
let dates = [date, date ++ " " ++ tzOffset] in let dates = [date, date ++ " " ++ tzOffset] in
let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
foldr (<|>) (timeStamp Nothing) (fmap getTimestamp <$> parsedTimes) foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article) makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article)
makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = ( makeArticle metaFilter markdown@(Markdown {key, metadata}) =
getKey filePath (key, Article $ markdown {metadata = metaFilter metadata})
, Article {
key = getKey filePath
, title
, metadata = metaFilter metadata
, bodyOffset
, body
}
)
at :: FilePath -> IO (Either ParseError (String, Article)) at :: FilePath -> IO (Either ParseError (String, Article))
at filePath = do at filePath = do
tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
fileDate <- getTimestamp <$> getModificationTime filePath fileDate <- modificationTime <$> getFileStatus filePath
let build = makeArticle filePath (setDate tzOffset fileDate) fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath
fmap build . parse articleP filePath <$> readFile filePath
getKey :: FilePath -> String preview :: Int -> Article -> Markdown
getKey = dropExtension . takeFileName preview linesCount (Article markdown@(Markdown {body})) =
markdown {body = take linesCount $ body}
preview :: Int -> Article -> Article
preview linesCount article = article {body = take linesCount $ body article}

View file

@ -3,36 +3,46 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module ArticlesList ( module ArticlesList (
ArticlesList(..) ArticlesList(..)
, otherUrl , description
, pageTitle , getArticles
, otherURL
, rssLinkTexts
) where ) where
import Article (Article) import Article (Article)
import Blog (Blog(..), get) import Blog (Blog(..), Renderer, Skin(..), template)
import Blog.Wording (render) import Collection (Collection(..))
import Control.Monad.Reader (MonadReader) import Control.Monad.Reader (MonadReader, asks)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Files (absoluteLink) import Files (absoluteLink)
import Pretty ((.$))
import System.FilePath.Posix ((</>)) import System.FilePath.Posix ((</>))
data ArticlesList = ArticlesList { data ArticlesList = ArticlesList {
tagged :: Maybe String full :: Bool
, full :: Bool , collection :: Collection
, featured :: [Article]
} }
otherUrl :: ArticlesList -> String getArticles :: MonadReader Blog m => ArticlesList -> m [Article]
otherUrl (ArticlesList {full, tagged}) = absoluteLink $ getArticles (ArticlesList {full, collection = Collection {featured}}) = do
(if full then id else (</> "all.html")) $ maybe "" id tagged limit <- take <$> (asks $skin.$previewArticlesCount)
return $ if full then featured else limit featured
pageTitle :: (MonadReader Blog m) => ArticlesList -> m Text otherURL :: ArticlesList -> String
pageTitle (ArticlesList {full, tagged}) = title (full, tagged) <$> Blog.get wording otherURL (ArticlesList {full, collection}) = absoluteLink $
(if full then id else (</> "all.html")) . maybe "" id $ tag collection
description :: Renderer m => ArticlesList -> m Text
description (ArticlesList {full, collection}) =
template page . environment $ tag collection
where where
title (True, Nothing) = render "allPage" [] page = if full then "allPage" else "latestPage"
title (True, Just tag) = render "allTaggedPage" [("tag", pack tag)] environment = maybe [] $ \value -> [("tag", pack value)]
title (False, Nothing) = render "latestPage" []
title (False, Just tag) = render "latestTaggedPage" [("tag", pack tag)]
rssLinkTexts :: Renderer m => ArticlesList -> m (Text, Text)
rssLinkTexts (ArticlesList {collection}) = do
text <- template "rssLink" []
title <- template "rssTitle" environment
return (text, title)
where
environment = maybe [] (\v -> [("tag", pack v)]) $ tag collection

View file

@ -1,21 +1,25 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ConstraintKinds #-}
module Blog ( module Blog (
Blog(..) Blog(..)
, Path(..) , Path(..)
, Renderer
, Skin(..) , Skin(..)
, URL(..) , URL(..)
, Wording , Wording
, build , build
, get , template
) where ) where
import Arguments (Arguments) import Arguments (Arguments)
import qualified Arguments (name, sourceDir) import qualified Arguments (name, sourceDir)
import Article (Article) import Article (Article)
import qualified Article (at, getKey) import qualified Article (at)
import Blog.Path (Path(..)) import Blog.Path (Path(..))
import qualified Blog.Path as Path (build) import qualified Blog.Path as Path (build)
import Blog.Template (Environment, Templates, render)
import qualified Blog.Template as Template (build)
import Blog.Skin (Skin(..)) import Blog.Skin (Skin(..))
import qualified Blog.Skin as Skin (build) import qualified Blog.Skin as Skin (build)
import Blog.URL (URL(..)) import Blog.URL (URL(..))
@ -23,78 +27,100 @@ import qualified Blog.URL as URL (build)
import Blog.Wording (Wording) import Blog.Wording (Wording)
import qualified Blog.Wording as Wording (build) import qualified Blog.Wording as Wording (build)
import Control.Monad ((>=>), filterM, foldM, forM) import Control.Monad ((>=>), filterM, foldM, forM)
import Control.Monad.Reader (MonadReader, ask) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadReader, asks)
import Data.Map (Map, insert, lookup) import Data.Map (Map, insert, lookup)
import qualified Data.Map as Map (empty, fromList) import qualified Data.Map as Map (empty, fromList)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set (empty, null, singleton, union) import qualified Data.Set as Set (empty, null, singleton, union)
import Files (File(..), absolute) import Data.Text (Text)
import Files (File(..), filePath)
import qualified Files (find) import qualified Files (find)
import Markdown (getKey)
import Page (Page)
import qualified Page (at)
import Prelude hiding (lookup) import Prelude hiding (lookup)
import System.Directory (doesFileExist, withCurrentDirectory) import Pretty (assertRight, onRight)
import System.Directory (doesFileExist, makeAbsolute, withCurrentDirectory)
import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName) import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
import Text.Parsec (ParseError) import Text.Parsec (ParseError)
type Collection = Map String Article type Collection = Map String
type Parsed a = Either ParseError (String, a)
data Blog = Blog { data Blog = Blog {
articles :: Collection articles :: Collection Article
, hasRSS :: Bool
, name :: String , name :: String
, pages :: Collection Page
, path :: Path , path :: Path
, skin :: Skin , skin :: Skin
, tags :: Map String (Set String) , tags :: Collection (Set String)
, templates :: Templates
, urls :: URL , urls :: URL
, wording :: Wording , wording :: Wording
} }
get :: MonadReader Blog m => (Blog -> a) -> m a type Renderer m = (MonadIO m, MonadReader Blog m)
get = (<$> ask)
keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article) template :: Renderer m => String -> Environment -> m Text
template key environment = asks templates >>= render key environment
keepOrWarn :: Collection a -> Parsed a -> IO (Collection a)
keepOrWarn accumulator (Left parseErrors) = keepOrWarn accumulator (Left parseErrors) =
forM [show parseErrors, "=> Ignoring this article"] putStrLn forM [show parseErrors, "=> Ignoring this text"] putStrLn
>> return accumulator >> return accumulator
keepOrWarn accumulator (Right (key, article)) = keepOrWarn accumulator (Right (key, article)) =
return $ insert key article accumulator return $ insert key article accumulator
findArticles :: FilePath -> IO (Map String Article) find :: (FilePath -> IO (Parsed a)) -> FilePath -> IO (Collection a)
findArticles = find parser =
Files.find Files.find
>=> filterM isMarkDownFile >=> filterM isMarkDownFile
>=> mapM Article.at >=> mapM parser
>=> foldM keepOrWarn Map.empty >=> foldM keepOrWarn Map.empty
where where
isMarkDownFile path = do isMarkDownFile path = do
let correctExtension = takeExtension path == ".md" let correctExtension = takeExtension path == ".md"
(correctExtension &&) <$> doesFileExist path (correctExtension &&) <$> doesFileExist path
tagged :: Collection -> FilePath -> IO (String, Set String) tagged :: Collection Article -> FilePath -> IO (String, Set String)
tagged collection path = do tagged collection path = do
links <- Files.find path links <- Files.find path
keys <- forM links $ \link -> do keys <- forM links $ \link -> do
fileExists <- doesFileExist link fileExists <- doesFileExist link
return $ if fileExists return $ if fileExists
then let articleKey = Article.getKey link in then let articleKey = getKey link in
maybe Set.empty (\_ -> Set.singleton articleKey) (lookup articleKey collection) maybe Set.empty (\_ -> Set.singleton articleKey) (lookup articleKey collection)
else Set.empty else Set.empty
return (takeFileName path, foldl Set.union Set.empty keys) return (takeFileName path, foldl Set.union Set.empty keys)
discover :: Path -> IO (Collection, Map String (Set String)) discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String))
discover path = do discover path = do
articles <- findArticles $ articlesPath path (articles, tags) <- discoverArticles $ articlesPath path
pages <- maybe (return Map.empty) (find Page.at) $ pagesPath path
return (articles, pages, tags)
where
discoverArticles Nothing = return (Map.empty, Map.empty)
discoverArticles (Just somePath) = do
articles <- find Article.at somePath
tags <- Map.fromList . filter (not . Set.null . snd) tags <- Map.fromList . filter (not . Set.null . snd)
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`)) <$> (Files.find (somePath </> "tags") >>= mapM (articles `tagged`))
return (articles, tags) return (articles, tags)
build :: Arguments -> IO Blog build :: Arguments -> IO Blog
build arguments = do build arguments = do
urls <- URL.build arguments urls <- URL.build arguments
let hasRSS = maybe False (\_-> True) $ rss urls
wording <- Wording.build arguments wording <- Wording.build arguments
root <- Files.absolute . Dir $ Arguments.sourceDir arguments templates <- Template.build wording
root <- onRight makeAbsolute =<< filePath (Dir $ Arguments.sourceDir arguments)
withCurrentDirectory root $ do withCurrentDirectory root $ do
path <- Path.build root arguments path <- assertRight =<< Path.build root arguments
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
$ Arguments.name arguments $ Arguments.name arguments
skin <- Skin.build name arguments skin <- Skin.build name arguments
(articles, tags) <- discover path (articles, pages, tags) <- discover path
return $ Blog {articles, name, path, skin, tags, urls, wording} return $ Blog {
articles, hasRSS, name, pages, path, skin, tags, templates, urls, wording
}

View file

@ -1,6 +1,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Blog.Path ( module Blog.Path (
Path(..) Path(..)
, build , build
@ -8,17 +9,21 @@ module Blog.Path (
import Arguments (Arguments) import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..)) import qualified Arguments as Arguments (Arguments(..))
import Control.Monad (join)
import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT)
import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Aeson (ToJSON(..), (.=), pairs)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif
import Files (File(..), filePath) import Files (File(..), filePath)
import GHC.Generics (Generic) import GHC.Generics (Generic)
data Path = Path { data Path = Path {
articlesPath :: FilePath articlesPath :: Maybe FilePath
, pagesPath :: Maybe FilePath , pagesPath :: Maybe FilePath
, remarkableConfig :: Maybe FilePath , remarkableConfig :: Maybe FilePath
, root :: FilePath , root :: FilePath
} deriving Generic } deriving (Eq, Generic, Show)
instance ToJSON Path where instance ToJSON Path where
toEncoding (Path {articlesPath, pagesPath}) = pairs ( toEncoding (Path {articlesPath, pagesPath}) = pairs (
@ -26,9 +31,22 @@ instance ToJSON Path where
<> "pagesPath" .= pagesPath <> "pagesPath" .= pagesPath
) )
build :: FilePath -> Arguments -> IO Path checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
build root arguments = do checkFor fileOrDir = ExceptT . fmap (Just <$>) . filePath . fileOrDir
articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT String IO (Maybe FilePath)
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments getMarkdownPath defaultPath Nothing =
ExceptT . (Right . either (\_ -> Nothing) Just <$>) . filePath $ Dir defaultPath
getMarkdownPath _ (Just customPath) = checkFor Dir customPath
build :: FilePath -> Arguments -> IO (Either String Path)
build root arguments = runExceptT . join $ pack
<$> getMarkdownPath "articles" (Arguments.articlesPath arguments)
<*> getMarkdownPath "pages" (Arguments.pagesPath arguments)
<*> maybe ignore (checkFor File) (Arguments.remarkableConfig arguments)
where
pack Nothing Nothing _ =
throwError "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
pack articlesPath pagesPath remarkableConfig =
return $ Path {articlesPath, pagesPath, remarkableConfig, root} return $ Path {articlesPath, pagesPath, remarkableConfig, root}
ignore = return Nothing

View file

@ -1,6 +1,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Blog.Skin ( module Blog.Skin (
Skin(..) Skin(..)
, build , build
@ -11,7 +12,9 @@ import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArt
import Control.Monad (filterM) import Control.Monad (filterM)
import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Aeson (ToJSON(..), (.=), pairs)
import Data.Maybe (listToMaybe) import Data.Maybe (listToMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
#endif
import Files (absoluteLink) import Files (absoluteLink)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Prelude hiding (head) import Prelude hiding (head)
@ -36,7 +39,7 @@ instance ToJSON Skin where
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath) findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
findImage _ (Just path) = return . Just $ absoluteLink path findImage _ (Just path) = return . Just $ absoluteLink path
findImage name Nothing = findImage name Nothing =
fmap absoluteLink . listToMaybe <$> filterM doesFileExist pathsToCheck listToMaybe <$> filterM doesFileExist pathsToCheck
where where
directories = [".", "image", "images", "pictures", "skin", "static"] directories = [".", "image", "images", "pictures", "skin", "static"]
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"] extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]

69
src/Blog/Template.hs Normal file
View file

@ -0,0 +1,69 @@
{-# LANGUAGE OverloadedStrings #-}
module Blog.Template (
Environment
, Templates(..)
, build
, render
) where
import Blog.Wording (Wording(..), variables)
import Control.Monad (foldM)
import Control.Monad.IO.Class (MonadIO(..))
import Data.List (intercalate)
import Data.Map (Map, (!))
import qualified Data.Map as Map (empty, insert, keys)
import Data.Text (Text, breakOn)
import qualified Data.Text as Text (concat, drop, null, unpack)
import Data.Text.Lazy (toStrict)
import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
import System.Exit (die)
data TemplateChunk = Top Template | Sub Template
newtype HabloTemplate = HabloTemplate [TemplateChunk]
newtype Templates = Templates (Map String HabloTemplate)
type Environment = [(Text, Text)]
render :: MonadIO m => String -> Environment -> Templates -> m Text
render key environment (Templates templates) =
(Text.concat . fmap toStrict) <$> mapM renderChunk templateChunks
where
HabloTemplate templateChunks = templates ! key
renderer template = renderA template (flip lookup environment)
renderChunk (Top template) =
let err = "Could not template " ++ Text.unpack (showTemplate template) in
maybe (liftIO $ die err) return $ renderer template
renderChunk (Sub template) = return . maybe "" id $ renderer template
makeTemplate :: String -> Text -> IO Template
makeTemplate key templateText =
let testEnvironment = flip lookup [(s, "") | s <- availableVariables] in
case templateSafe templateText of
Left (row, col) -> die $ syntaxError (show row) (show col)
Right template ->
maybe (die badTemplate) (return . const template) (renderA template testEnvironment)
where
availableVariables = variables ! key
variablesMessage =
" (available variables: " ++ intercalate ", " (Text.unpack <$> availableVariables) ++ ")"
syntaxError row col =
"Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col
badTemplate = "Invalid template for variable " ++ key ++ variablesMessage
makeHabloTemplate :: String -> Map String Text -> IO HabloTemplate
makeHabloTemplate key wording = HabloTemplate <$> toHablo True (wording ! key)
where
toHablo _ "" = return []
toHablo atTop template = do
let (start, rest) = (Text.drop 2) <$> breakOn (delimiter atTop) template
push atTop start <*> toHablo (not atTop) rest
delimiter atTop = if atTop then "{?" else "?}"
push atTop t
| Text.null t = return id
| otherwise = (:) . (if atTop then Top else Sub) <$> makeTemplate key t
build :: Wording -> IO Templates
build (Wording wordingMap) =
Templates <$> foldM templateWording Map.empty (Map.keys variables)
where
templateWording templated key =
flip (Map.insert key) templated <$> makeHabloTemplate key wordingMap

View file

@ -10,10 +10,14 @@ import Arguments (Arguments)
import qualified Arguments as Arguments (Arguments(..)) import qualified Arguments as Arguments (Arguments(..))
import Data.Aeson (ToJSON(..), (.=), pairs) import Data.Aeson (ToJSON(..), (.=), pairs)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import System.Exit (die)
import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)
data URL = URL { data URL = URL {
comments :: Maybe String cards :: Maybe String
, site :: Maybe String , comments :: Maybe String
, rss :: Maybe String
} deriving Generic } deriving Generic
instance ToJSON URL where instance ToJSON URL where
@ -22,7 +26,20 @@ instance ToJSON URL where
) )
build :: Arguments -> IO URL build :: Arguments -> IO URL
build arguments = return $ URL {comments, site} build arguments = do
cards <- getSiteURL argOGCards "Open Graph cards"
rss <- getSiteURL argRSS "RSS feeds"
checksUsed (argOGCards || argRSS) siteURL
return $ URL {cards, comments, rss}
where where
comments = Arguments.commentsURL arguments comments = Arguments.commentsURL arguments
site = Arguments.siteURL arguments siteURL = Arguments.siteURL arguments
argOGCards = Arguments.openGraphCards arguments
argRSS = Arguments.rss arguments
errorMsg :: String -> String
errorMsg = printf "Enabling %s requires setting the site url with --site-url"
getSiteURL False _ = return Nothing
getSiteURL True name = maybe (die $ errorMsg name) (return . Just) siteURL
checksUsed False (Just _) =
hPutStrLn stderr "Site url is set but not used, did you forget --open-graph-cards or --rss ?"
checksUsed _ _ = return ()

View file

@ -1,22 +1,17 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Blog.Wording ( module Blog.Wording (
Wording(..) Wording(..)
, build , build
, render , variables
) where ) where
import Arguments (Arguments(..)) import Arguments (Arguments(..))
import Control.Monad (foldM) import Control.Monad (foldM)
import Data.Aeson (ToJSON(..)) import Data.Aeson (ToJSON(..))
import Data.List (intercalate) import Data.Map (Map)
import Data.Map (Map, (!)) import qualified Data.Map as Map (empty, fromList, keys, map, union)
import qualified Data.Map as Map (empty, fromList, insert, keys, map, union)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text (pack, unpack) import qualified Data.Text as Text (pack)
import Data.Text.Lazy (toStrict)
import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
import qualified Data.Text.Template as Template (render)
import Paths_hablo (getDataFileName) import Paths_hablo (getDataFileName)
import Text.ParserCombinators.Parsec ( import Text.ParserCombinators.Parsec (
Parser Parser
@ -25,31 +20,29 @@ import Text.ParserCombinators.Parsec (
) )
import System.Exit (die) import System.Exit (die)
newtype Wording = Wording (Map String Template) newtype Wording = Wording (Map String Text)
variables :: Map String [Text] variables :: Map String [Text]
variables = Map.fromList [ variables = Map.fromList [
("allLink", []) ("allLink", [])
, ("allPage", []) , ("allPage", ["tag"])
, ("allTaggedPage", ["tag"]) , ("articleDescription", ["name"])
, ("commentsLink", []) , ("commentsLink", [])
, ("commentsSection", []) , ("commentsSection", [])
, ("dateFormat", []) , ("dateFormat", [])
, ("latestLink", []) , ("latestLink", [])
, ("latestPage", []) , ("latestPage", ["tag"])
, ("latestTaggedPage", ["tag"])
, ("metadata", ["author", "date", "tags"]) , ("metadata", ["author", "date", "tags"])
, ("pageDescription", ["name"])
, ("pagesList", [])
, ("rssLink", [])
, ("rssTitle", ["tag"])
, ("tagsList", []) , ("tagsList", [])
] ]
instance ToJSON Wording where instance ToJSON Wording where
toJSON (Wording m) = toJSON (showTemplate <$> m) toJSON (Wording m) = toJSON m
toEncoding (Wording m) = toEncoding (showTemplate <$> m) toEncoding (Wording m) = toEncoding m
render :: String -> [(Text, Text)] -> Wording -> Text
render key env (Wording wMap) =
toStrict $ Template.render (wMap ! key) (Map.fromList env !)
addWording :: Map String Text -> FilePath -> IO (Map String Text) addWording :: Map String Text -> FilePath -> IO (Map String Text)
addWording currentWording wordingFile = do addWording currentWording wordingFile = do
@ -65,30 +58,12 @@ wordingP = Map.map Text.pack . Map.fromList <$>
restOfLine = many $ noneOf "\r\n" restOfLine = many $ noneOf "\r\n"
eol = try (string "\r\n") <|> string "\r" <|> string "\n" eol = try (string "\r\n") <|> string "\r" <|> string "\n"
skip = optional (char '#' *> restOfLine) *> eol skip = optional (char '#' *> restOfLine) *> eol
line = (,) <$> (choice (try . string <$> Map.keys variables) <* equal) <*> restOfLine varEqual = choice (try . string <$> Map.keys variables) <* equal
line = (,) <$> varEqual <*> restOfLine
equal = many (char ' ') *> char '=' *> many (char ' ') equal = many (char ' ') *> char '=' *> many (char ' ')
makeTemplate :: String -> Map String Text -> IO Template
makeTemplate key wording =
let templateText = wording ! key in
let testEnvironment = flip lookup [(s, "") | s <- availableVariables] in
case templateSafe templateText of
Left (row, col) -> die $ syntaxError (show row) (show col)
Right template ->
maybe (die badTemplate) (return . const template) (renderA template testEnvironment)
where
availableVariables = variables ! key
variablesMessage =
" (available variables: " ++ intercalate ", " (Text.unpack <$> availableVariables) ++ ")"
syntaxError row col =
"Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col
badTemplate = "Invalid template for variable " ++ key ++ variablesMessage
build :: Arguments -> IO Wording build :: Arguments -> IO Wording
build arguments = do build arguments = do
defaultWording <- getDataFileName "defaultWording.conf" defaultWording <- getDataFileName "defaultWording.conf"
let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording] let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording]
wordindMap <- foldM addWording Map.empty wordingFiles Wording <$> foldM addWording Map.empty wordingFiles
Wording <$> foldM (
\templated key -> flip (Map.insert key) templated <$> makeTemplate key wordindMap
) Map.empty (Map.keys variables)

54
src/Collection.hs Normal file
View file

@ -0,0 +1,54 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE FlexibleContexts #-}
module Collection (
Collection(..)
, getAll
, title
) where
import Article(Article)
import Blog (Blog(..), Path(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader(..), ReaderT, asks)
import Data.List (sortOn)
import Data.Map ((!))
import qualified Data.Map as Map (elems, filterWithKey, toList)
import Data.Ord (Down(..))
import qualified Data.Set as Set (member)
import Markdown (Markdown(metadata), MarkdownContent(..))
import Pretty ((.$))
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
data Collection = Collection {
featured :: [Article]
, basePath :: FilePath
, tag :: Maybe String
}
build :: MonadIO m => [Article] -> Maybe String -> ReaderT Blog m Collection
build featured tag = do
root <- asks $path.$root
let basePath = maybe root (root </>) tag
liftIO $ createDirectoryIfMissing False basePath
return $ Collection {
featured = sortByDate featured, basePath, tag
}
where
sortByDate = sortOn (Down . (! "date") . metadata . getMarkdown)
getAll :: ReaderT Blog IO [Collection]
getAll = do
Blog {articles, tags} <- ask
(:)
<$> (build (Map.elems articles) Nothing)
<*> (flip mapM (Map.toList tags) $
\(tag, tagged) -> build (getArticles tagged articles) $ Just tag
)
where
getArticles tagged =
Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)
title :: MonadReader Blog m => Collection -> m String
title (Collection {tag}) = do
asks $ (\name -> maybe name ((name ++ " - ") ++) tag) . name

View file

@ -1,95 +1,124 @@
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module DOM ( module DOM (
page HasContent(..)
, htmlDocument
) where ) where
import Article (Article(..)) import Article (Article)
import qualified Article (preview) import qualified Article (preview)
import ArticlesList (ArticlesList(..), otherUrl, pageTitle) import ArticlesList (
import Blog (Blog(..), Path(..), Skin(..), URL(..)) ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
import qualified Blog (get) )
import Blog.Wording (render) import Blog (Blog(..), Skin(..), URL(..), template)
import Control.Monad.Reader (ReaderT) import Control.Monad.Reader (ReaderT, asks)
import qualified Data.Map as Map (keys) import Data.Map as Map (Map, toList)
import Data.Text (pack, empty) import Data.Text (Text, pack, empty)
import DOM.Card (HasCard) import DOM.Card (HasCard)
import qualified DOM.Card as Card (make) import qualified DOM.Card as Card (make)
import Files (absoluteLink) import Files (absoluteLink)
import Lucid import Lucid (
HtmlT, a_, article_, body_, charset_, class_, div_, doctypehtml_, h1_, h2_
, head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
, title_, toHtml, toHtmlRaw, type_, ul_
)
import Markdown (Markdown(..), MarkdownContent(..))
import Page (Page)
import Prelude hiding (head, lookup) import Prelude hiding (head, lookup)
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((<.>))
type HtmlGenerator = HtmlT (ReaderT Blog IO) type HtmlGenerator = HtmlT (ReaderT Blog IO)
class HasCard a => Page a where class HasCard a => HasContent a where
content :: a -> HtmlGenerator () content :: a -> HtmlGenerator ()
instance Page Article where instance HasContent Article where
content = article True content = mDContent True . getMarkdown
instance Page ArticlesList where instance HasContent Page where
content al@(ArticlesList {featured, full}) = do content = mDContent True . getMarkdown
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
h2_ . toHtml =<< pageTitle al instance HasContent ArticlesList where
a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink content al@(ArticlesList {full}) = do
preview <- Article.preview <$> (asks $skin.$previewLinesCount)
h2_ . toHtml =<< description al
ul_ $ do
asks hasRSS >>= rssLink
li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
div_ [class_ "articles"] ( div_ [class_ "articles"] (
mapM_ (article False . preview) featured mapM_ (mDContent False . preview) =<< getArticles al
) )
where where
link = render (if full then "latestLink" else "allLink") [] otherLink =
otherLink = Blog.get $wording.$(link) toHtml <$> template (if full then "latestLink" else "allLink") []
rssLink :: Bool -> HtmlGenerator ()
rssLink True = do
(text, title) <- rssLinkTexts al
li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
rssLink False = return ()
article :: Bool -> Article -> HtmlGenerator () mDContent :: Bool -> Markdown -> HtmlGenerator ()
article raw (Article {key, body, Article.title}) = do mDContent raw markdown@(Markdown {key, body}) =
url <- absoluteLink . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
article_ [id_ $ pack key] (do article_ [id_ $ pack key] (do
header_ (do header_ . h1_ $ mDLink raw markdown
a_ [href_ . pack $ url] . h1_ $ toHtml title
)
pre_ . toHtml $ unlines body pre_ . toHtml $ unlines body
) )
where extension = if raw then "md" else "html"
mDLink :: Bool -> Markdown -> HtmlGenerator ()
mDLink raw (Markdown {Markdown.path, title}) =
a_ [href_ $ pack url] $ toHtml title
where
url = absoluteLink $ path <.> (if raw then "md" else "html")
tag :: String -> HtmlGenerator () tag :: String -> HtmlGenerator ()
tag tagName = li_ ( tag name =
a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
)
defaultBanner :: HtmlGenerator () defaultBanner :: HtmlGenerator ()
defaultBanner = do defaultBanner =
div_ [id_ "header"] ( div_ [id_ "header"] (
a_ [href_ "/"] ( a_ [href_ "/"] (
h1_ . toHtml =<< Blog.get name h1_ . toHtml =<< asks name
) )
) )
faviconLink :: FilePath -> HtmlGenerator () faviconLink :: FilePath -> HtmlGenerator ()
faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"] faviconLink url = link_ [
rel_ "shortcut icon", href_ . pack $ absoluteLink url, type_ "image/x-icon"
]
optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator () optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
optional = maybe (return ()) optional = maybe (return ())
page :: Page a => a -> HtmlGenerator () navigationSection ::
page aPage = Text -> String -> ((String, a) -> HtmlGenerator ()) -> Map String a -> HtmlGenerator ()
navigationSection sectionId templateKey generator collection
| null collection = return ()
| otherwise =
div_ [id_ sectionId, class_ "navigator"] (do
h2_ . toHtml =<< template templateKey []
ul_ . mapM_ (li_ . generator) $ Map.toList collection
)
htmlDocument :: HasContent a => a -> HtmlGenerator ()
htmlDocument someContent =
doctypehtml_ (do doctypehtml_ (do
head_ (do head_ (do
meta_ [charset_ "utf-8"] meta_ [charset_ "utf-8"]
title_ . toHtml =<< Blog.get name title_ . toHtml =<< asks name
script_ [src_ "/js/unit.js"] empty
script_ [src_ "/js/remarkable.min.js"] empty script_ [src_ "/js/remarkable.min.js"] empty
script_ [src_ "/js/hablo.js"] empty script_ [src_ "/js/hablo.js"] empty
optional faviconLink =<< (Blog.get $skin.$favicon) optional faviconLink =<< (asks $skin.$favicon)
optional (Card.make aPage) =<< (Blog.get $urls.$site) optional (Card.make someContent) =<< (asks $urls.$cards)
(Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw optional toHtmlRaw =<< (asks $skin.$head)
) )
body_ (do body_ (do
maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner) maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
div_ [id_ "navigator"] (do asks tags >>= navigationSection "tags" "tagsList"
h2_ =<< (Blog.get $wording.$(render "tagsList" []).$toHtml) (\(key, _) -> tag key)
ul_ . mapM_ tag . Map.keys =<< Blog.get tags asks pages >>= navigationSection "pages" "pagesList"
) (\(_, page) -> mDLink False $ getMarkdown page)
div_ [id_ "contents"] $ content aPage div_ [id_ "contents"] $ content someContent
) )
) )

View file

@ -2,33 +2,34 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module DOM.Card ( module DOM.Card (
Card(..) HasCard(..)
, HasCard(..)
, make , make
) where ) where
import qualified Article (Article(..)) import Article (Article(..))
import ArticlesList (ArticlesList(..), pageTitle) import ArticlesList (ArticlesList(..))
import Blog (Blog(..), Skin(..)) import qualified ArticlesList (description)
import qualified Blog (get) import Blog (Blog(..), Renderer, Skin(..), template)
import Collection (Collection(..))
import qualified Collection (title)
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad.Reader (MonadReader) import Control.Monad.Reader (asks)
import qualified Data.Map as Map (lookup) import qualified Data.Map as Map (lookup)
import Data.Text (Text, pack) import Data.Text (Text, pack)
import Lucid (HtmlT, content_, meta_) import Lucid (HtmlT, content_, meta_)
import Lucid.Base (makeAttribute) import Lucid.Base (makeAttribute)
import Markdown (MarkdownContent(..), metadata)
import qualified Markdown (Markdown(..))
import Page (Page(..))
import Pretty ((.$)) import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))
data Card = Card {
cardType :: Text
, description :: Text
, image :: Maybe String
, title :: String
, urlPath :: String
}
class HasCard a where class HasCard a where
getCard :: MonadReader Blog m => a -> m Card cardType :: Renderer m => a -> m Text
description :: Renderer m => a -> m Text
image :: Renderer m => a -> m (Maybe String)
title :: Renderer m => a -> m String
urlPath :: Renderer m => a -> m String
og :: Applicative m => Text -> Text -> HtmlT m () og :: Applicative m => Text -> Text -> HtmlT m ()
og attribute value = og attribute value =
@ -37,42 +38,54 @@ og attribute value =
, content_ value , content_ value
] ]
make :: (HasCard a, MonadReader Blog m) => a -> String -> HtmlT m () make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
make element siteURL = do make element siteURL = do
Card {cardType, description, image, title, urlPath} <- getCard element og "url" . sitePrefix =<< urlPath element
og "url" . pack $ siteURL ++ urlPath og "type" =<< cardType element
og "type" cardType og "title" . pack =<< title element
og "title" $ pack title og "description" =<< description element
og "description" description maybeImage =<< ((<|>) <$> image element <*> (asks $skin.$cardImage))
maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage)) og "site_name" =<< (asks $name.$pack)
og "site_name" =<< (Blog.get $name.$pack)
where where
maybeImage = maybe (return ()) (og "image" . pack . (siteURL++)) maybeImage = maybe (return ()) (og "image" . sitePrefix)
sitePrefix = pack . (siteURL </>)
instance HasCard Article.Article where mDImage :: (Renderer m, MarkdownContent a ) => a -> m (Maybe String)
getCard (Article.Article {Article.title, Article.metadata}) = do mDImage = return . Map.lookup "featuredImage" . metadata . getMarkdown
description <- pack <$> getDescription (Map.lookup "summary" metadata)
return $ Card { mDTitle :: (Renderer m, MarkdownContent a) => a -> m String
cardType = "article" mDTitle = return . Markdown.title . getMarkdown
, description
, image = (Map.lookup "featuredImage" metadata) mDUrlPath :: (Renderer m, MarkdownContent a) => a -> m String
, DOM.Card.title mDUrlPath a = return $ Markdown.path (getMarkdown a) <.> "html"
, urlPath = "/articles/" ++ title ++ ".html"
} mDDescription :: (Renderer m, MarkdownContent a) => String -> a -> m Text
mDDescription key =
getDescription . Map.lookup "summary" . metadata . getMarkdown
where where
getDescription = maybe (Blog.get $name.$("A new article on " <>)) return getDescription = maybe defaultDescription (return . pack)
defaultDescription = asks name >>= template key . \v -> [("name", pack v)]
instance HasCard Article where
cardType _ = return "article"
description = mDDescription "articleDescription"
image = mDImage
title = mDTitle
urlPath = mDUrlPath
instance HasCard Page where
cardType _ = return "website"
description = mDDescription "pageDescription"
image = mDImage
title = mDTitle
urlPath = mDUrlPath
instance HasCard ArticlesList where instance HasCard ArticlesList where
getCard al = do cardType _ = return "website"
cardTitle <- getTitle <$> Blog.get name description = ArticlesList.description
description <- pageTitle al image _ = return Nothing
return $ Card { title (ArticlesList {collection}) = Collection.title collection
cardType = "website" urlPath al@(ArticlesList {collection}) =
, description return $ maybe "" id (tag collection) </> file
, image = Nothing
, DOM.Card.title = cardTitle
, urlPath = maybe "" ('/':) (tagged al) ++ file
}
where where
getTitle name = maybe name ((name ++ " - ") ++) $ tagged al file = (if full al then "all" else "index") <.> ".html"
file = '/' : (if full al then "all" else "index") ++ ".html"

View file

@ -1,35 +1,32 @@
module Files ( module Files (
File(..) File(..)
, absolute
, absoluteLink , absoluteLink
, filePath , filePath
, find , find
) where ) where
import System.Exit (die) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
import System.FilePath ((</>)) import System.FilePath ((</>))
data File = File FilePath | Dir FilePath data File = File FilePath | Dir FilePath
absolute :: File -> IO (FilePath)
absolute file = filePath file >>= makeAbsolute
absoluteLink :: FilePath -> FilePath absoluteLink :: FilePath -> FilePath
absoluteLink ('.':path) = path absoluteLink ('.':path) = path
absoluteLink path = "/" </> path absoluteLink path = "/" </> path
filePath :: File -> IO FilePath filePath :: File -> IO (Either String FilePath)
filePath file = do filePath = filePathAux
let (thePath, test, errorMessage) = where
case file of filePathAux (File path) = ifIO doesFileExist path Right (notExist . File)
File path -> (path, doesFileExist, (++ ": no such file")) filePathAux (Dir path) = ifIO doesDirectoryExist path Right (notExist . Dir)
Dir path -> (path, doesDirectoryExist, (++ ": no such directory")) ifIO predicate value whenTrue whenFalse = do
bool <- test thePath result <- predicate value
if bool return $ if result then whenTrue value else whenFalse value
then return thePath notExist (File path) = Left $ path ++ ": no such file"
else die $ errorMessage thePath notExist (Dir path) = Left $ path ++ ": no such directory"
find :: FilePath -> IO [FilePath] find :: FilePath -> IO [FilePath]
find path = find path =
fmap (path </>) <$> listDirectory path filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
where
emptyIfMissing = either (\_ -> return [])

View file

@ -4,81 +4,43 @@ module HTML (
generate generate
) where ) where
import Article(Article(..))
import ArticlesList (ArticlesList(..)) import ArticlesList (ArticlesList(..))
import Blog (Blog(..), Path(..), Skin(..)) import Blog (Blog(..), Path(..))
import qualified Blog (get) import Collection (Collection(..))
import Control.Monad (forM) import qualified Collection (getAll)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader(..), ReaderT) import Control.Monad.Reader (ReaderT, asks)
import Data.List (sortOn) import qualified Data.Map as Map (elems)
import Data.Map ((!))
import qualified Data.Map as Map (elems, filterWithKey, toList)
import Data.Ord (Down(..))
import qualified Data.Set as Set (member)
import qualified Data.Text.Lazy.IO as TextIO (writeFile) import qualified Data.Text.Lazy.IO as TextIO (writeFile)
import DOM (page) import DOM (HasContent, htmlDocument)
import Lucid import Lucid (renderTextT)
import Markdown (Markdown(..), MarkdownContent(..))
import Pretty ((.$)) import Pretty ((.$))
import System.Directory (createDirectoryIfMissing)
import System.FilePath.Posix ((</>), (<.>)) import System.FilePath.Posix ((</>), (<.>))
data Collection = Collection { articlesLists :: Collection -> [(FilePath, ArticlesList)]
articlesFeatured :: [Article] articlesLists collection@(Collection {basePath}) = [
, basePath :: FilePath (path full, ArticlesList {collection, full}) | full <- [False, True]
, tag :: Maybe String
}
collection :: Monad m => [Article] -> Maybe String -> ReaderT Blog m Collection
collection articlesFeatured tag = do
root <- Blog.get $path.$root
return $ Collection {
articlesFeatured = sortByDate articlesFeatured
, basePath = maybe root (root </>) tag
, tag
}
where
sortByDate = sortOn (Down . (! "date") . metadata)
articlesLists :: Monad m => Collection -> ReaderT Blog m [(FilePath, ArticlesList)]
articlesLists (Collection {articlesFeatured, basePath, tag}) = do
limit <- take <$> (Blog.get $skin.$previewArticlesCount)
return [
(basePath </> "index.html", ArticlesList {
tagged = tag
, full = False
, featured = limit articlesFeatured
})
, (basePath </> "all.html", ArticlesList {
tagged = tag
, full = True
, featured = articlesFeatured
})
] ]
where
file bool = if bool then "all" else "index"
path bool = basePath </> file bool <.> "html"
generateArticles :: [Article] -> ReaderT Blog IO () generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO ()
generateArticles = mapM_ $ \article -> do generateMarkdown = mapM_ $ \content -> do
baseDir <- (</>) <$> (Blog.get $path.$root) <*> (Blog.get $path.$articlesPath) let relativePath = Markdown.path (getMarkdown content) <.> "html"
(renderTextT $ page article) filePath <- (</> relativePath) <$> (asks $Blog.path.$root)
>>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html") (renderTextT $ htmlDocument content) >>= liftIO . TextIO.writeFile filePath
generateCollection :: Collection -> ReaderT Blog IO () generateCollection :: Collection -> ReaderT Blog IO ()
generateCollection (Collection {articlesFeatured = []}) = return () generateCollection (Collection {featured = []}) = return ()
generateCollection aCollection = do generateCollection collection =
liftIO . createDirectoryIfMissing False $ basePath aCollection flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
articlesLists aCollection (renderTextT $ htmlDocument articlesList)
>>= (mapM_ $ \(filePath, articlesList) ->
(renderTextT $ page articlesList)
>>= liftIO . TextIO.writeFile filePath >>= liftIO . TextIO.writeFile filePath
)
generate :: ReaderT Blog IO () generate :: ReaderT Blog IO ()
generate = do generate = do
Blog {articles, tags} <- ask asks articles >>= generateMarkdown . Map.elems
generateArticles $ Map.elems articles Collection.getAll >>= mapM_ generateCollection
collection (Map.elems articles) Nothing >>= generateCollection asks pages >>= generateMarkdown . Map.elems
forM (Map.toList tags) $
\(tag, tagged) -> collection (getArticles tagged articles) $ Just tag
>>= mapM_ generateCollection
where
getArticles tagged = Map.elems . Map.filterWithKey (\k _ -> Set.member k tagged)

View file

@ -3,38 +3,57 @@ module JS (
generate generate
) where ) where
import Data.Aeson (encode)
import Blog (Blog(..), Path(..)) import Blog (Blog(..), Path(..))
import qualified Blog (get)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT) import Control.Monad.Reader (ReaderT, asks)
import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile) import Data.ByteString.Lazy (
ByteString, concat, intercalate, fromStrict, readFile, writeFile
)
import Data.ByteString.Lazy.Char8 (pack) import Data.ByteString.Lazy.Char8 (pack)
import qualified Files (find) import Data.Text.Encoding (encodeUtf8)
import JSON (exportBlog) import JSON (exportBlog)
import Paths_hablo (getDataDir) import Paths_hablo (getDataDir)
import Pretty ((.$)) import Pretty ((.$))
import SJW (compile, source)
import System.Directory (createDirectoryIfMissing) import System.Directory (createDirectoryIfMissing)
import System.Exit (die)
import System.FilePath ((</>)) import System.FilePath ((</>))
import Prelude hiding (concat, readFile, writeFile) import Prelude hiding (concat, readFile, writeFile)
compile :: [ByteString] -> ByteString object :: [ByteString] -> ByteString
compile sources = concat (header:sources ++ [footer]) object sources = concat [header, intercalate ",\n" sources, footer]
where where
header = "(function() {\n" header = "return {\n"
footer = "})();" footer = "\n};"
var :: (String, ByteString) -> ByteString var :: (String, ByteString) -> ByteString
var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"] var (varName, content) = concat ["\t", pack varName, " : ", content]
generateConfig :: FilePath -> ReaderT Blog IO ()
generateConfig destinationDir = do
blogJSON <- asks (encode . exportBlog)
remarkablePath <- asks $path.$remarkableConfig
liftIO $ do
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
writeFile configModule . object $ var <$> jsVars
where
configModule = destinationDir </> "Hablo" </> "Config.js"
generateMain :: FilePath -> IO ()
generateMain destinationDir = do
habloSources <- (</> "js") <$> getDataDir
compile (source [destinationDir, "unitJS", habloSources])
>>= either abort (output . fst)
where
output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8
abort = die . (<> "JS compilation failed\n")
generate :: ReaderT Blog IO () generate :: ReaderT Blog IO ()
generate = do generate = do
destinationDir <- (</> "js") <$> (Blog.get $path.$root) destinationDir <- asks $path.$root.$(</> "js")
blogJSON <- exportBlog liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
remarkablePath <- Blog.get $path.$remarkableConfig generateConfig destinationDir
liftIO $ do liftIO $ generateMain destinationDir
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
let jsVars = var <$> [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
jsFiles <- (</> "js") <$> getDataDir >>= Files.find
jsCode <- mapM readFile jsFiles
createDirectoryIfMissing False destinationDir
writeFile (destinationDir </> "hablo.js") $ compile (jsVars ++ jsCode )

View file

@ -4,56 +4,60 @@ module JSON (
exportBlog exportBlog
) where ) where
import Article (Article)
import qualified Article (Article(..))
import Blog (Blog, Path, Skin, URL, Wording) import Blog (Blog, Path, Skin, URL, Wording)
import qualified Blog (Blog(..)) import qualified Blog (Blog(..))
import Control.Monad.Reader (ReaderT, ask) import Data.Aeson (Options(..), ToJSON(..), genericToEncoding, defaultOptions)
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
import Data.ByteString.Lazy (ByteString)
import Data.Map (Map, mapWithKey) import Data.Map (Map, mapWithKey)
import qualified Data.Map as Map (filter, keys) import qualified Data.Map as Map (filter, keys)
import qualified Data.Set as Set (elems, member) import qualified Data.Set as Set (elems, member)
import GHC.Generics import GHC.Generics
import Markdown (Markdown, MarkdownContent(..))
import qualified Markdown (Markdown(..))
data ArticleExport = ArticleExport { data MarkdownExport = MarkdownExport {
title :: String title :: String
, bodyOffset :: Int
, metadata :: Map String String , metadata :: Map String String
, tagged :: [String] , bodyOffset :: Int
, tagged :: Maybe [String]
} deriving (Generic) } deriving (Generic)
instance ToJSON ArticleExport where instance ToJSON MarkdownExport where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding (defaultOptions {omitNothingFields = True})
data BlogDB = BlogDB { exportMarkdown :: Maybe [String] -> Markdown -> MarkdownExport
articles :: Map String ArticleExport exportMarkdown tagged markdown = MarkdownExport {
title = Markdown.title markdown
, metadata = Markdown.metadata markdown
, bodyOffset = Markdown.bodyOffset markdown
, tagged
}
data BlogExport = BlogExport {
articles :: Map String MarkdownExport
, hasRSS :: Bool
, path :: Path , path :: Path
, pages :: Map String MarkdownExport
, skin :: Skin , skin :: Skin
, tags :: Map String [String] , tags :: Map String [String]
, urls :: URL , urls :: URL
, wording :: Wording , wording :: Wording
} deriving (Generic) } deriving (Generic)
instance ToJSON BlogDB where instance ToJSON BlogExport where
toEncoding = genericToEncoding defaultOptions toEncoding = genericToEncoding defaultOptions
exportArticle :: Blog -> String -> Article -> ArticleExport exportBlog :: Blog -> BlogExport
exportArticle blog key article = ArticleExport { exportBlog blog = BlogExport {
title = Article.title article articles = getArticles $ getMarkdown <$> Blog.articles blog
, bodyOffset = Article.bodyOffset article , hasRSS = Blog.hasRSS blog
, metadata = Article.metadata article , pages = getPages $ getMarkdown <$> Blog.pages blog
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
}
exportBlog :: ReaderT Blog IO ByteString
exportBlog = do
blog <- ask
return . encode $ BlogDB {
articles = mapWithKey (exportArticle blog) $ Blog.articles blog
, path = Blog.path blog , path = Blog.path blog
, skin = Blog.skin blog , skin = Blog.skin blog
, tags = Set.elems <$> Blog.tags blog , tags = Set.elems <$> Blog.tags blog
, urls = Blog.urls blog , urls = Blog.urls blog
, wording = Blog.wording blog , wording = Blog.wording blog
} }
where
tag key = Just . Map.keys . Map.filter (Set.member key) $ Blog.tags blog
getArticles = mapWithKey (exportMarkdown . tag)
getPages = mapWithKey (\_-> exportMarkdown Nothing)

View file

@ -8,6 +8,7 @@ import Data.Version (showVersion)
import qualified HTML (generate) import qualified HTML (generate)
import qualified JS (generate) import qualified JS (generate)
import qualified Paths_hablo as Hablo (version) import qualified Paths_hablo as Hablo (version)
import qualified RSS (generate)
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
main :: IO () main :: IO ()
@ -18,4 +19,5 @@ main = do
config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do
HTML.generate HTML.generate
JS.generate JS.generate
RSS.generate
) )

76
src/Markdown.hs Normal file
View file

@ -0,0 +1,76 @@
{-# LANGUAGE NamedFieldPuns #-}
module Markdown (
Markdown(..)
, MarkdownContent(..)
, Metadata
, at
, getKey
) where
import Control.Applicative ((<|>))
import Data.Map (Map)
import qualified Data.Map as Map (fromList)
import System.FilePath (dropExtension, takeFileName)
import Text.ParserCombinators.Parsec (
ParseError, Parser
, (<?>)
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
, oneOf, option, parse, skipMany, sourceLine, sourceName, string, try
)
type Metadata = Map String String
data Markdown = Markdown {
key :: String
, path :: String
, title :: String
, metadata :: Metadata
, bodyOffset :: Int
, body :: [String]
}
class MarkdownContent a where
getMarkdown :: a -> Markdown
parser :: Parser Markdown
parser = do
(title, metadata) <- skipMany eol *> (headerP <|> reverseHeaderP)
bodyOffset <- skipMany eol *> (pred . sourceLine <$> getPosition)
body <- lines <$> many anyChar <* eof
inputFile <- sourceName <$> getPosition
let (key, path) = (getKey inputFile, dropExtension inputFile)
return $ Markdown {key, path, title, metadata, bodyOffset, body}
where
headerP = (,) <$> titleP <* many eol <*> metadataP
reverseHeaderP = flip (,) <$> metadataP <* many eol<*> titleP
metadataP :: Parser Metadata
metadataP = Map.fromList <$> option [] (
metaSectionSeparator *> many eol *>
(try keyVal) `endBy` (many1 eol)
<* metaSectionSeparator
) <?> "metadata section"
where
metaSectionSeparator = count 3 (oneOf "~-") *> eol
spaces = skipMany $ char ' '
keyVal = (,) <$> (no ": \r\n" <* spaces <* char ':' <* spaces) <*> no "\r\n"
titleP :: Parser String
titleP = try (singleLine <|> underlined)
where
singleLine = char '#' *> char ' ' *> no "\r\n" <* eol
underlined =
no "\r\n" <* eol
>>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
<?> "'#' or '=' to underline the title"
eol :: Parser String
eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
no :: String -> Parser String
no = many1 . noneOf
getKey :: FilePath -> String
getKey = dropExtension . takeFileName
at :: FilePath -> IO (Either ParseError Markdown)
at filePath = parse parser filePath <$> readFile filePath

17
src/Page.hs Normal file
View file

@ -0,0 +1,17 @@
module Page (
Page(..)
, at
) where
import Markdown (Markdown(..), MarkdownContent(..))
import qualified Markdown as Markdown (at)
import Text.ParserCombinators.Parsec (ParseError)
newtype Page = Page Markdown
instance MarkdownContent Page where
getMarkdown (Page markdown) = markdown
at :: FilePath -> IO (Either ParseError (String, Page))
at filePath = fmap makePage <$> Markdown.at filePath
where
makePage markdown = (key markdown, Page markdown)

View file

@ -1,6 +1,16 @@
module Pretty ( module Pretty (
(.$) (.$)
, assertRight
, onRight
) where ) where
import System.Exit (die)
(.$) :: (a -> b) -> (b -> c) -> (a -> c) (.$) :: (a -> b) -> (b -> c) -> (a -> c)
(.$) f g = g . f (.$) f g = g . f
onRight :: (a -> IO b) -> Either String a -> IO b
onRight = either die
assertRight :: Either String a -> IO a
assertRight = onRight return

93
src/RSS.hs Normal file
View file

@ -0,0 +1,93 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module RSS (
generate
) where
import Article (Article(..))
import ArticlesList (ArticlesList(..), getArticles)
import qualified ArticlesList (description)
import Blog (Blog(urls), Renderer, URL(..))
import Collection (Collection(..), getAll)
import qualified Collection (title)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader, ReaderT, asks)
import Data.Text (Text)
import Data.Map ((!))
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT)
import Lucid.Base (makeAttribute)
import Markdown (Markdown(..))
import Pretty ((.$))
import System.FilePath.Posix ((</>), (<.>))
prolog :: Monad m => HtmlT m ()
prolog = toHtmlRaw ("<?xml version=\"1.0\" encoding=\"UTF-8\" ?>" :: String)
version_ :: Text -> Attribute
version_ = makeAttribute "version"
xmlns_content_ :: Text -> Attribute
xmlns_content_ = makeAttribute "xmlns:content"
xmlns_atom_ :: Text -> Attribute
xmlns_atom_ = makeAttribute "xmlns:atom"
rss_ :: Term arg result => arg -> result
rss_ = term "rss"
channel_ :: Term arg result => arg -> result
channel_ = term "channel"
title_ :: Term arg result => arg -> result
title_ = term "title"
link_ :: Term arg result => arg -> result
link_ = term "link"
description_ :: Term arg result => arg -> result
description_ = term "description"
item_ :: Term arg result => arg -> result
item_ = term "item"
pubDate_ :: Term arg result => arg -> result
pubDate_ = term "pubDate"
articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
articleItem siteURL (Article (Markdown {path, metadata, title})) =
item_ $ do
title_ $ toHtml title
link_ $ toHtml (siteURL </> path <.> "html")
pubDate_ . toHtml . rfc822Date $ metadata ! "date"
where
rfc822Date =
formatTime defaultTimeLocale rfc822DateFormat
. posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
feed :: Renderer m => String -> ArticlesList -> HtmlT m ()
feed siteURL al@(ArticlesList {collection}) = do
prolog
rss_ [version, content, atom] $ do
channel_ $ do
title_ . toHtml =<< Collection.title collection
link_ . toHtml $ siteURL </> maybe "" (++ "/") (tag collection)
description_ . toHtml =<< ArticlesList.description al
mapM_ (articleItem siteURL) =<< getArticles al
where
version = version_ "2.0"
content = xmlns_content_ "http://purl.org/rss/1.0/modules/content/"
atom = xmlns_atom_ "http://www.w3.org/2005/Atom"
generateCollection :: String -> Collection -> ReaderT Blog IO ()
generateCollection siteURL collection =
renderTextT (feed siteURL $ ArticlesList {full = False, collection})
>>= liftIO . TextIO.writeFile (basePath collection </> "rss" <.> "xml")
generate :: ReaderT Blog IO ()
generate = (asks $urls.$rss) >>= maybe (return ()) generateAll
where
generateAll siteURL = Collection.getAll >>= mapM_ (generateCollection siteURL)

86
test/Mock/Arguments.hs Normal file
View file

@ -0,0 +1,86 @@
module Mock.Arguments (
badCustomArticles
, badCustomPages
, bothCustom
, bothDefault
, customArticles
, customArticlesDefaultPages
, customPages
, customPagesDefaultArticles
, defaultArticles
, defaultPages
, emptyBlog
) where
import Arguments (Arguments(..))
import Utils (testDataPath)
defaultArticles :: Arguments
defaultArticles = BlogConfig {
sourceDir = testDataPath "Structure/defaultArticles"
, articlesPath = Nothing
, bannerPath = Nothing
, cardImage = Nothing
, commentsURL = Nothing
, favicon = Nothing
, headPath = Nothing
, name = Nothing
, openGraphCards = False
, pagesPath = Nothing
, previewArticlesCount = 3
, previewLinesCount = 10
, remarkableConfig = Nothing
, rss = False
, siteURL = Nothing
, wording = Nothing
}
defaultPages :: Arguments
defaultPages = defaultArticles {
sourceDir = testDataPath "Structure/defaultPages"
}
bothDefault :: Arguments
bothDefault = defaultArticles {
sourceDir = testDataPath "Structure/both"
}
emptyBlog :: Arguments
emptyBlog = defaultArticles {
sourceDir = testDataPath "Structure/custom"
}
customArticles :: Arguments
customArticles = emptyBlog {
articlesPath = Just "customArticles"
}
customArticlesDefaultPages :: Arguments
customArticlesDefaultPages = bothDefault {
articlesPath = Just "customArticles"
}
customPages :: Arguments
customPages = emptyBlog {
pagesPath = Just "customPages"
}
customPagesDefaultArticles :: Arguments
customPagesDefaultArticles = bothDefault {
pagesPath = Just "customPages"
}
bothCustom :: Arguments
bothCustom = customArticles {
pagesPath = Just "customPages"
}
badCustomArticles :: Arguments
badCustomArticles = bothDefault {
articlesPath = Just "missingDirectory"
}
badCustomPages :: Arguments
badCustomPages = bothDefault {
pagesPath = Just "missingDirectory"
}

23
test/Mock/Article.hs Normal file
View file

@ -0,0 +1,23 @@
module Mock.Article (
noDescription
, noImage
, noMeta
, simple
) where
import Article (Article(..))
import qualified Data.Map as Map (fromList)
import Markdown (Markdown(..))
import Mock.Markdown (article)
simple :: Article
simple = Article article
noImage :: Article
noImage = Article $ article {metadata = Map.fromList [("summary", "It's a test")]}
noDescription :: Article
noDescription = Article $ article {metadata = Map.fromList [("featuredImage", "test.png")]}
noMeta :: Article
noMeta = Article $ article {metadata = Map.fromList []}

22
test/Mock/ArticlesList.hs Normal file
View file

@ -0,0 +1,22 @@
module Mock.ArticlesList (
longMain
, longTesting
, shortMain
, shortTesting
) where
import ArticlesList (ArticlesList(..))
import Mock.Collection (main, testing)
import Prelude hiding (all)
shortMain :: IO ArticlesList
shortMain = ArticlesList False <$> main
shortTesting :: IO ArticlesList
shortTesting = ArticlesList False <$> testing
longMain :: IO ArticlesList
longMain = ArticlesList True <$> main
longTesting :: IO ArticlesList
longTesting = ArticlesList True <$> testing

39
test/Mock/Blog.hs Normal file
View file

@ -0,0 +1,39 @@
{-# LANGUAGE NamedFieldPuns #-}
module Mock.Blog (
noCards
, noRSS
, simple
) where
import Blog (Blog(..))
import qualified Data.Map as Map (fromList)
import qualified Data.Set as Set (fromList)
import qualified Mock.Article (simple)
import qualified Mock.Blog.Path (defaultArticles)
import qualified Mock.Blog.Skin (simple)
import qualified Mock.Blog.Template (simple)
import qualified Mock.Blog.URL (simple, noCards)
import qualified Mock.Blog.Wording (defaultWording)
simple :: IO Blog
simple =
let wording = Mock.Blog.Wording.defaultWording in do
templates <- Mock.Blog.Template.simple
return $ Blog {
articles = Map.fromList [("test", Mock.Article.simple)]
, hasRSS = True
, name = "The Test Blog"
, pages = Map.fromList []
, path = Mock.Blog.Path.defaultArticles
, skin = Mock.Blog.Skin.simple
, tags = Map.fromList [("testing", Set.fromList ["test"])]
, templates
, urls = Mock.Blog.URL.simple
, wording
}
noCards :: IO Blog
noCards = (\b -> b {urls = Mock.Blog.URL.noCards}) <$> simple
noRSS :: IO Blog
noRSS = (\b -> b {hasRSS = False}) <$> simple

66
test/Mock/Blog/Path.hs Normal file
View file

@ -0,0 +1,66 @@
module Mock.Blog.Path (
bothCustom
, bothDefault
, customArticles
, customArticlesDefaultPages
, customPages
, customPagesDefaultArticles
, defaultArticles
, defaultPages
) where
import Blog.Path (Path(..))
defaultArticles :: Path
defaultArticles = Path {
articlesPath = Just "articles"
, pagesPath = Nothing
, remarkableConfig = Nothing
, root = "test/Structure/defaultArticles"
}
defaultPages :: Path
defaultPages = Path {
articlesPath = Nothing
, pagesPath = Just "pages"
, remarkableConfig = Nothing
, root = "test/Structure/defaultPages"
}
bothDefault :: Path
bothDefault = Path {
articlesPath = Just "articles"
, pagesPath = Just "pages"
, remarkableConfig = Nothing
, root = "test/Structure/both"
}
customArticles :: Path
customArticles = Path {
articlesPath = Just "customArticles"
, pagesPath = Nothing
, remarkableConfig = Nothing
, root = "test/Structure/custom"
}
bothCustom :: Path
bothCustom = customArticles {
pagesPath = Just "customPages"
}
customPages :: Path
customPages = bothCustom {
articlesPath = Nothing
}
customArticlesDefaultPages :: Path
customArticlesDefaultPages = bothDefault {
articlesPath = Just "customArticles"
, pagesPath = Just "pages"
}
customPagesDefaultArticles :: Path
customPagesDefaultArticles = customArticlesDefaultPages {
articlesPath = Just "articles"
, pagesPath = Just "customPages"
}

16
test/Mock/Blog/Skin.hs Normal file
View file

@ -0,0 +1,16 @@
module Mock.Blog.Skin (
simple
) where
import Blog.Skin (Skin(..))
import Prelude hiding (head)
simple :: Skin
simple = Skin {
banner = Nothing
, cardImage = Nothing
, favicon = Nothing
, head = Nothing
, previewArticlesCount = 3
, previewLinesCount = 10
}

View file

@ -0,0 +1,9 @@
module Mock.Blog.Template (
simple
) where
import Blog.Template (Templates, build)
import Mock.Blog.Wording (defaultWording)
simple :: IO Templates
simple = build Mock.Blog.Wording.defaultWording

16
test/Mock/Blog/URL.hs Normal file
View file

@ -0,0 +1,16 @@
module Mock.Blog.URL (
noCards
, simple
) where
import Blog.URL (URL(..))
simple :: URL
simple = URL {
cards = Just "https://test.net"
, comments = Nothing
, rss = Nothing
}
noCards :: URL
noCards = simple {cards = Nothing}

25
test/Mock/Blog/Wording.hs Normal file
View file

@ -0,0 +1,25 @@
{-# LANGUAGE OverloadedStrings #-}
module Mock.Blog.Wording (
defaultWording
) where
import Blog.Wording (Wording(..))
import qualified Data.Map as Map (fromList)
defaultWording :: Wording
defaultWording = Wording $ Map.fromList [
("allLink", "See all")
, ("allPage", "All articles{? tagged ${tag}?}")
, ("articleDescription", "A new article on ${name}")
, ("commentsLink", "Comment on the fediverse")
, ("commentsSection", "Comments")
, ("dateFormat", "en-US")
, ("latestLink", "See only latest")
, ("latestPage", "Latest articles{? tagged ${tag}?}")
, ("metadata", "{?by ${author} ?}on ${date}{? tagged ${tags}?}")
, ("pageDescription", "Read on ${name}")
, ("pagesList", "Pages")
, ("rssLink", "Subscribe")
, ("rssTitle", "Follow all articles{? tagged ${tag}?}")
, ("tagsList", "Tags")
]

28
test/Mock/Collection.hs Normal file
View file

@ -0,0 +1,28 @@
module Mock.Collection (
main
, testing
) where
import Blog (Blog(..), Path(..))
import Collection (Collection(..))
import Data.Map as Map (elems)
import qualified Mock.Blog (simple)
import System.FilePath ((</>))
main :: IO Collection
main = do
blog <- Mock.Blog.simple
return $ Collection {
featured = Map.elems $ articles blog
, basePath = root $ path blog
, tag = Nothing
}
testing :: IO Collection
testing = do
blog <- Mock.Blog.simple
return $ Collection {
featured = Map.elems $ articles blog
, basePath = root (path blog) </> "testing"
, tag = Just "testing"
}

33
test/Mock/Markdown.hs Normal file
View file

@ -0,0 +1,33 @@
module Mock.Markdown (
article
, page
) where
import qualified Data.Map as Map (fromList)
import Markdown (Markdown(..))
article :: Markdown
article = Markdown {
key = "test"
, path = "articles/test"
, Markdown.title = "Some test"
, metadata = Map.fromList [
("summary", "It's a test")
, ("featuredImage", "test.png")
]
, bodyOffset = 3
, body = []
}
page :: Markdown
page = Markdown {
key = "test"
, path = "pages/test"
, Markdown.title = "A test page"
, metadata = Map.fromList [
("summary", "Tests are useful")
, ("featuredImage", "test.png")
]
, bodyOffset = 3
, body = []
}

40
test/Structure.hs Normal file
View file

@ -0,0 +1,40 @@
module Structure (
test
) where
import Arguments (Arguments(..))
import Blog (Path)
import qualified Blog.Path as Path (build)
import Distribution.TestSuite
import qualified Mock.Arguments as Arguments
import qualified Mock.Blog.Path as Path
import System.Directory (withCurrentDirectory)
import Utils (simpleTest, tag)
checkPath :: Arguments -> Maybe Path -> IO Progress
checkPath input expected = do
withCurrentDirectory root $ do
actual <- either (\_ -> Nothing) Just <$> Path.build root input
return . Finished $
if actual == expected
then Pass
else Fail $ "Expected " ++ show expected ++ " but got " ++ show actual
where
root = sourceDir input
test :: Test
test = tag "structure" . testGroup "Blog structure" $ simpleTest <$> [
("empty structure", checkPath Arguments.emptyBlog Nothing)
, ("default articles", checkPath Arguments.defaultArticles $ Just Path.defaultArticles)
, ("default pages", checkPath Arguments.defaultPages $ Just Path.defaultPages)
, ("both default", checkPath Arguments.bothDefault $ Just Path.bothDefault)
, ("custom articles", checkPath Arguments.customArticles $ Just Path.customArticles)
, ("custom pages", checkPath Arguments.customPages $ Just Path.customPages)
, ("both custom", checkPath Arguments.bothCustom $ Just Path.bothCustom)
, ("custom articles, default pages"
, checkPath Arguments.customArticlesDefaultPages $ Just Path.customArticlesDefaultPages)
, ("custom pages, default articles"
, checkPath Arguments.customPagesDefaultArticles $ Just Path.customPagesDefaultArticles)
, ("bad custom articles", checkPath Arguments.badCustomArticles $ Nothing)
, ("bad custom pages", checkPath Arguments.badCustomPages $ Nothing)
]

View file

View file

View file

View file

View file

14
test/Tests.hs Normal file
View file

@ -0,0 +1,14 @@
module Tests (
tests
) where
import Distribution.TestSuite
import qualified Structure (test)
import Utils (tag)
import qualified XML.Card (test)
tests :: IO [Test]
tests = return $ tag "xml" <$> [
XML.Card.test
, Structure.test
]

49
test/Utils.hs Normal file
View file

@ -0,0 +1,49 @@
{-# LANGUAGE NamedFieldPuns #-}
module Utils (
assertAll
, assertEqual
, simpleTest
, tag
, testDataPath
) where
import Distribution.TestSuite
import System.FilePath ((</>))
import Text.Printf (printf)
tagInstance :: String -> TestInstance -> TestInstance
tagInstance tagName testInstance = testInstance {
tags = tagName : (tags testInstance)
}
tag :: String -> Test -> Test
tag tagName (Test testInstance) = Test (tagInstance tagName testInstance)
tag tagName group = group {groupTests = tag tagName <$> groupTests group}
simpleTest :: (String, IO Progress) -> Test
simpleTest (name, run) = Test testInstance
where
testInstance = TestInstance {
run
, name
, tags = []
, options = []
, setOption = \_ _ -> Right testInstance
}
wrong :: Show a => String -> a -> a -> IO Progress
wrong message expected actual = return . Finished . Fail $
printf "%s: %s vs. %s" message (show expected) (show actual)
assertAll :: [(Bool, IO Progress, String)] -> IO Progress
assertAll = foldr assert (return $ Finished Pass)
where
assert (bool, badIssue, checkMessage) next =
if bool then return $ Progress checkMessage next else badIssue
assertEqual :: (Show a, Eq a) => String -> a -> a -> (Bool, IO Progress, String)
assertEqual what a b =
(a == b, wrong (what ++ " do not match !") a b, what ++ " ok")
testDataPath :: FilePath -> FilePath
testDataPath = ("test" </>)

11
test/XML/Card.hs Normal file
View file

@ -0,0 +1,11 @@
module XML.Card (
test
) where
import Distribution.TestSuite
import Utils (tag)
import qualified XML.Card.Component as Component (test)
import qualified XML.Card.Output as Output (test)
test :: Test
test = tag "card" $ testGroup "Cards" [Component.test, Output.test]

View file

@ -0,0 +1,89 @@
{-# LANGUAGE OverloadedStrings #-}
module XML.Card.Component (
test
) where
import Blog (Blog)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (runReaderT)
import Data.Text (Text)
import Distribution.TestSuite
import DOM.Card (HasCard(..))
import Mock.Blog as Blog (simple)
import Mock.Article as Article (noDescription, noImage, simple)
import Mock.ArticlesList as ArticlesList (
longMain, longTesting, shortMain, shortTesting
)
import Utils (assertAll, assertEqual, simpleTest, tag)
check :: HasCard a => IO Blog -> a -> (Text, Text, Maybe String, String, String) -> IO Progress
check getBlog input (expectedCT, expectedD, expectedI, expectedT, expectedU) =
getBlog >>= runReaderT (
sequence [
assertEqual "card types" expectedCT <$> cardType input
, assertEqual "descriptions" expectedD <$> description input
, assertEqual "images" expectedI <$> image input
, assertEqual "titles" expectedT <$> title input
, assertEqual "urls" expectedU <$> urlPath input
] >>= liftIO . assertAll
)
articleCard :: Test
articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
("simple article components", check Blog.simple Article.simple (
"article"
, "It's a test"
, Just "test.png"
, "Some test"
, "articles/test.html"
))
, ("article components without description", check Blog.simple Article.noDescription (
"article"
, "A new article on The Test Blog"
, Just "test.png"
, "Some test"
, "articles/test.html"
))
, ("article components without image", check Blog.simple Article.noImage (
"article"
, "It's a test"
, Nothing
, "Some test"
, "articles/test.html"
))
]
articlesListCard :: Test
articlesListCard = tag "articlesList" . testGroup "Articles list cards" $ simpleTest <$> [
("short untagged page component", ArticlesList.shortMain >>= (flip (check Blog.simple) (
"website"
, "Latest articles"
, Nothing
, "The Test Blog"
, "index.html"
)))
, ("long untagged page component", ArticlesList.longMain >>= (flip (check Blog.simple) (
"website"
, "All articles"
, Nothing
, "The Test Blog"
, "all.html"
)))
, ("short tagged page component", ArticlesList.shortTesting >>= (flip (check Blog.simple) (
"website"
, "Latest articles tagged testing"
, Nothing
, "The Test Blog - testing"
, "testing/index.html"
)))
, ("long tagged page component", ArticlesList.longTesting >>= (flip (check Blog.simple) (
"website"
, "All articles tagged testing"
, Nothing
, "The Test Blog - testing"
, "testing/all.html"
)))
]
test :: Test
test = tag "component" $ testGroup "Cards components" [articleCard, articlesListCard]

49
test/XML/Card/Output.hs Normal file
View file

@ -0,0 +1,49 @@
module XML.Card.Output (
test
) where
import Blog (Blog(..), URL(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (asks, runReaderT)
import qualified Data.Text.Lazy.IO as Lazy (readFile)
import Distribution.TestSuite
import DOM.Card (HasCard(..), make)
import Lucid (renderTextT)
import Mock.Blog as Blog (noCards, simple)
import Mock.Article as Article (noDescription, noImage, simple)
import Mock.ArticlesList as ArticlesList (
longMain, longTesting, shortMain, shortTesting
)
import Pretty ((.$))
import System.FilePath ((</>))
import Utils (assertAll, assertEqual, simpleTest, tag, testDataPath)
check :: HasCard a => IO Blog -> a -> FilePath -> IO Progress
check getBlog input expectedFile =
getBlog >>= runReaderT (do
actual <- renderTextT $ maybe (return ()) (DOM.Card.make input) =<< (asks $urls.$cards)
expected <- liftIO . Lazy.readFile $ testDataPath "XML/Card/Output" </> expectedFile
liftIO $ assertAll [
assertEqual "card HTML output" expected actual
]
)
articleCard :: Test
articleCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
("simple article output", check Blog.simple Article.simple "simple.html")
, ("article output without description", check Blog.simple Article.noDescription "noDescription.html")
, ("article output without image", check Blog.simple Article.noImage "noImage.html")
, ("no card article output", check Blog.noCards Article.simple "/dev/null")
]
articlesListCard :: Test
articlesListCard = tag "article" . testGroup "Article cards" $ simpleTest <$> [
("short untagged page output", ArticlesList.shortMain >>= flip (check Blog.simple) "shortMain.html")
, ("long untagged page output", ArticlesList.longMain >>= flip (check Blog.simple) "longMain.html")
, ("short tagged page output", ArticlesList.shortTesting >>= flip (check Blog.simple) "shortTesting.html")
, ("long tagged page output", ArticlesList.longTesting >>= flip (check Blog.simple) "longTesting.html")
, ("no card articlesList output", ArticlesList.shortMain >>= flip (check Blog.noCards) "/dev/null")
]
test :: Test
test = tag "output" $ testGroup "Cards outputs" [articleCard, articlesListCard]

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="All articles"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/testing/all.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="All articles tagged testing"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="A new article on The Test Blog"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It&#39;s a test"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog"><meta property="og:description" content="Latest articles"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/testing/index.html"><meta property="og:type" content="website"><meta property="og:title" content="The Test Blog - testing"><meta property="og:description" content="Latest articles tagged testing"><meta property="og:site_name" content="The Test Blog">

View file

@ -0,0 +1 @@
<meta property="og:url" content="https://test.net/articles/test.html"><meta property="og:type" content="article"><meta property="og:title" content="Some test"><meta property="og:description" content="It&#39;s a test"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">