Compare commits
18 Commits
Author | SHA1 | Date |
---|---|---|
Tissevert | e7e44f8c63 | |
Tissevert | 7a9c1a65c2 | |
Tissevert | 7e7d7e0804 | |
Tissevert | 3e223e7169 | |
Tissevert | ffea469559 | |
Tissevert | e8f84561df | |
Tissevert | 191a8b0771 | |
Tissevert | 1ac53e90d7 | |
Tissevert | f19331bf11 | |
Tissevert | 4f93b92cc4 | |
Tissevert | 4e402174b1 | |
Tissevert | 7ef89ae93d | |
Tissevert | fd714e93ff | |
Tissevert | add68897ad | |
Tissevert | 36651ddc38 | |
Tissevert | 94e323d715 | |
Tissevert | ccb7491170 | |
Tissevert | 0d9b331ccb |
26
CHANGELOG.md
26
CHANGELOG.md
|
@ -1,5 +1,31 @@
|
|||
# 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
|
||||
|
||||
* 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)
|
||||
* This fix alas requires to «anchor» the generated website at a given location by means of the new `--site-url` option. OpenGraph cards are just completely disabled if you prefer your website to remain portable.
|
||||
|
||||
## 1.0.2.0 -- 2019-08-27
|
||||
|
||||
* Format for [conditional blocks](/Tissevert/hablo/wiki/Template-variables#metadata) changed to allow an internal simplification. This is transparent if you're creating a new blog or using the default wording but be sure to edit your wording if you're using a custom one :
|
||||
|
||||
`${? … ?}` becomes `{? … ?}`
|
||||
|
||||
## 1.0.1.0 -- 2019-04-28
|
||||
|
||||
* Print warnings about malformed Markdown articles instead of ignoring them silently
|
||||
|
||||
## 1.0.0.0 -- 2019-04-19
|
||||
|
||||
* First version. Finally released by an unexpecting developer
|
||||
|
|
22
README.md
22
README.md
|
@ -20,6 +20,16 @@ cabal new-install hablo
|
|||
|
||||
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
|
||||
|
||||
Get a copy of this repository
|
||||
|
@ -40,6 +50,18 @@ Install the result
|
|||
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)
|
||||
|
||||
Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog)
|
||||
|
|
|
@ -24,7 +24,7 @@ Pages include a banner, a navigation `<div>` with links to the various tags and
|
|||
|
||||
### Article pages
|
||||
|
||||
Ideally, the markdown files would be enough and there wouldn't be any HTML generated for articles. Unfortunately, in order to share direct links to articles, some HTML is necessary to reach the blog's interface, loading some JS, to handle the navigation and not only display a markdown file. The additional HTML also allows to generate [open-graph](http://ogp.me/) cards to make the links look nicer on [social media](#fediverse).
|
||||
Ideally, the markdown files would be enough and there wouldn't be any HTML generated for articles. Unfortunately, in order to share direct links to articles, some HTML is necessary to reach the blog's interface, loading some JS, to handle the navigation and not only display a markdown file. The additional HTML also allows to generate [Open Graph](http://ogp.me/) cards to make the links look nicer on [social media](#fediverse).
|
||||
|
||||
The article pages' content is the body of the markdown file wrapped in a HTML `<pre>` element and its title.
|
||||
|
||||
|
@ -48,6 +48,6 @@ Hablo takes a stand against this. It aims at generating HTML files that are simp
|
|||
|
||||
## Fediverse
|
||||
|
||||
Hablo is conceived from the start to interact with the [fediverse](https://fediverse.network/) and social media in general so all pages generated embed a set of basic [open-graph](http://ogp.me/) metadata in their header. This allows links posted on social media to appear in a nice box with a picture, the name of the blog and a short description.
|
||||
Hablo is conceived from the start to interact with the [fediverse](https://fediverse.network/) and social media in general. It can embed a set of basic [Open Graph](http://ogp.me/) metadata in the header of all generated pages if you [provide the URL](https://git.marvid.fr/Tissevert/hablo/wiki/Command-line#site-url) where your blog will be deployed to hablo. This allows links posted on social media to appear in a nice box with a picture, the name of the blog and a short description.
|
||||
|
||||
Also, being static, hablo doesn't handle dynamic things like comments directly. Instead, comments are [toots](https://git.marvid.fr/Tissevert/hablo/wiki/Customizing%20your%20blog#how-do-i-customize-the-templates-) listed on a fediverse instance.
|
||||
|
|
|
@ -32,6 +32,8 @@ hablo --articles turtles /path/to/your/blog
|
|||
|
||||
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
|
||||
|
||||
`-b, --banner`
|
||||
|
@ -41,20 +43,18 @@ 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.
|
||||
|
||||
```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
|
||||
|
||||
`-c, --card-image`
|
||||
|
||||
By default, hablo will try to find the image to use for cards [automatically](https://git.marvid.fr/Tissevert/hablo/src/branch/master/src/Blog/Skin.hs#L36). It will look for a file with the [name](#name) of your blog and the extension `.ico`, `.gif`, `.jpeg`, `.jpg`, `.png` or `.svg` located at the root of the blog or in a directory called `image`, `images`, `pictures`, `skin` or `static`.
|
||||
By default, hablo will try to find the image to use for cards [automatically](https://git.marvid.fr/Tissevert/hablo/src/branch/main/src/Blog/Skin.hs#L36). It will look for a file with the [name](#name) of your blog and the extension `.ico`, `.gif`, `.jpeg`, `.jpg`, `.png` or `.svg` located at the root of the blog or in a directory called `image`, `images`, `pictures`, `skin` or `static`.
|
||||
|
||||
This option allows you to skip the auto-discover step or to use an image that wouldn't be found with the above method and directly tell hablo what file to use.
|
||||
This option allows you to skip the auto-discover step or to use an image that wouldn't be found with the above method and directly tell hablo what file to use. It is of course only relevant if you have [enabled](#site-url) Open Graph cards for your website by providing its deployment URL to hablo. Since it already knows the root URL of your website, this option expects only the local path to the image of course.
|
||||
|
||||
Note that not all cards generated for your blog will necessarily contain an image. If none of the expected path for card images exists and you don't provide one with this option, then pages won't embed an [open-graph](http://ogp.me/) picture in their card by default but articles with a [featured image](https://git.marvid.fr/Tissevert/hablo/wiki/Metadata#featured-image) will still do (and the image used for the card will be the featured image of the article).
|
||||
|
||||
Card images in themselves are only relevant once your blog is deployed and accessed by a browser or linked to. Hablo only includes a link to them or not, so of course the value of this option must be a relative path within your blog's structure. If you put a file outside, your web server will of course return 404 errors whenever something will read the corresponding header and attempt to access it.
|
||||
Note that not all cards generated for your blog will necessarily contain an image. If none of the expected path for card images exists and you don't provide one with this option, then pages won't embed an [Open Graph](http://ogp.me/) picture in their card by default but articles with a [featured image](https://git.marvid.fr/Tissevert/hablo/wiki/Metadata#featured-image) will still do (and the image used for the card will be the featured image of the article).
|
||||
|
||||
```bash
|
||||
hablo --card-image skin/defaultCardImage.png
|
||||
|
@ -90,7 +90,7 @@ hablo --favicon skin/eyeOfTheTurtle.jpg
|
|||
|
||||
`-H, --head`
|
||||
|
||||
The header section of the HTML pages includes several things such as the [open-graph](http://ogp.me/) metadata, the script inclusions for hablo's client code and for its [dependencies](https://git.marvid.fr/Tissevert/hablo/wiki/Deploying%20a%20hablo%20blog).
|
||||
The header section of the HTML pages includes several things such as the [Open Graph](http://ogp.me/) metadata, the script inclusions for hablo's client code and for its [dependencies](https://git.marvid.fr/Tissevert/hablo/wiki/Deploying%20a%20hablo%20blog).
|
||||
|
||||
Use the `--head` option to add some arbitrary HTML elements to the header of your pages. This is the way to use a CSS theme for your blog, as is shown in the [customization](https://git.marvid.fr/Tissevert/hablo/wiki/Customizing%20your%20blog#how-do-i-use-a-custom-skin-) how-to.
|
||||
|
||||
|
@ -98,7 +98,7 @@ Use the `--head` option to add some arbitrary HTML elements to the header of you
|
|||
|
||||
`-n, --name`
|
||||
|
||||
Each blog has a name which is used in the default banner of your site and as the title of all pages (displayed in the tab's name and in the window name when your blog's tab is focused). Hablo infers it from the name of the directory containing it. It works on an absolute version the path it receives, so it won't suddenly think your blog is called `..` because you ran
|
||||
Each blog has a name which is used in the default banner of your site and as the title of all pages (displayed in the tab's name and in the window name when your blog's tab is focused). Hablo infers it from the name of the directory containing it. It works on an absolute version of the path it receives, so it won't suddenly think your blog is called `..` because you ran
|
||||
|
||||
```bash
|
||||
hablo ..
|
||||
|
@ -112,11 +112,31 @@ You can use this option if you want to override this behaviour and provide a dif
|
|||
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`
|
||||
|
||||
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
|
||||
|
||||
|
@ -128,7 +148,7 @@ On the page that [lists](https://git.marvid.fr/Tissevert/hablo/wiki/Architectura
|
|||
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
|
||||
|
||||
|
@ -146,11 +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.
|
||||
|
||||
## 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
|
||||
|
||||
`-u, --site-url`
|
||||
|
||||
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 or RSS feeds. Setting it for no reason will trigger a warning.
|
||||
|
||||
## 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
|
||||
hablo --wording /blogs/translations/fr-ca.conf /path/to/your/blog
|
||||
|
|
|
@ -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 ?
|
||||
|
||||
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.
|
||||
|
||||
|
@ -104,4 +104,4 @@ Now, when you generate your blog, tell hablo to look for comments on the instanc
|
|||
hablo --comments-at https://turtles.social
|
||||
```
|
||||
|
||||
Be sure to clear the cache of your web browser before visiting your article again. A «comments» section now shows after your article, with possibly some comments if someone has already answered your post on the fediverse.
|
||||
Be sure to clear the cache of your web browser before visiting your article again. A «comments» section now shows after your article, with possibly some comments if someone has already answered your post on the fediverse. Also, please note that, as comments are purely handled by the fediverse so is the moderation : you should preferably use this feature on an instance where you have moderation rights and will be able to delete hateful comments or where you know the moderation team will be able to react appropriately.
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
# 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
|
||||
|
||||
|
@ -29,30 +29,11 @@ sudo nginx -s reload
|
|||
|
||||
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
|
||||
|
||||
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
|
||||
wget 'https://cdnjs.cloudflare.com/ajax/libs/remarkable/1.7.1/remarkable.min.js' -O js/remarkable.min.js
|
||||
|
|
|
@ -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.
|
||||
|
||||
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
|
||||
mkdir -p articles/tags/Sea\ turtles
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
# 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
|
||||
|
||||
|
@ -41,11 +41,11 @@ comments: 101781535999718634
|
|||
|
||||
Hablo associates to each article the date when it was written or last edited to sort articles chronologically and to display it. Trying to [reuse](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%20choices#reuse) as much as possible, this date is by default the «last modified» Unix date of the file that contains the article.
|
||||
|
||||
You can override this behaviour by setting a `date` metadata. It can contain a date with an optional time (hour and minute) and a timezone, also optional. If you don't set a timezone the current one will be used. Note that this means that some of your article might seem to have their dates «moving» a bit, if for example you set the date for one of your article (but not the timezone), generate your blog, then travel to a place with a very different timezone, and generate your blog again.
|
||||
You can override this behaviour by setting a `date` metadata. It can contain a date with an optional time (hour and minute) and a timezone, also optional. If you don't set a timezone the current one will be used. Note that this means that some of your articles might seem to have their dates «moving» a bit, if for example you set the date for one of your article (but not the timezone), generate your blog, then travel to a place with a very different timezone, and generate your blog again.
|
||||
|
||||
### 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, 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
|
||||
featuredImage: /media/turtles/olive-ridley.jpg
|
||||
|
@ -53,7 +53,7 @@ featuredImage: /media/turtles/olive-ridley.jpg
|
|||
|
||||
### 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.
|
||||
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
|
||||
summary: This week, I'm gonna tell you everything about the olive ridley sea turtle !
|
||||
|
|
|
@ -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`).
|
||||
|
||||
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.
|
||||
|
||||
## 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).
|
||||
|
||||
It of course expects one variable named `$tag` : the name of the tag for the given page.
|
||||
|
||||
## commentsLink
|
||||
### commentsLink
|
||||
|
||||
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.
|
||||
|
||||
## 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 :
|
||||
|
||||
|
@ -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"}]
|
||||
```
|
||||
|
||||
## 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.
|
||||
|
||||
## 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).
|
||||
|
||||
It of course expects one variable named `$tag` : the name of the tag for the given page.
|
||||
|
||||
## metadata
|
||||
### 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
|
||||
|
||||
|
@ -60,15 +62,23 @@ The template of the text used to present the metadata associated to each article
|
|||
- `$date`
|
||||
- `$tags`
|
||||
|
||||
As mentioned in the introduction, some of them may be null so you may want to protect the whole `metadata` template with `${? ?}` like it is done in this variable's default value :
|
||||
As mentioned in the introduction, some of them may be null so you may want to protect the whole `metadata` template with `{? ?}` like it is done in this variable's default value :
|
||||
|
||||
```
|
||||
metadata = ${?by ${author} ?}on ${date}${? tagged ${tags}?}
|
||||
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.
|
||||
|
||||
## 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.
|
||||
|
||||
|
|
|
@ -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))
|
|
@ -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+)))
|
83
hablo.cabal
83
hablo.cabal
|
@ -3,16 +3,16 @@ cabal-version: >= 1.10
|
|||
-- For further documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: hablo
|
||||
version: 1.0.0.0
|
||||
version: 1.1.0.1
|
||||
synopsis: A minimalist static blog generator
|
||||
description:
|
||||
Hablo is a fediverse-oriented static blog generator for articles written
|
||||
in Markdown. It tries to generate as little HTML as needed and uses
|
||||
Javascript to implement dynamic features in the browser.
|
||||
|
||||
Those features include the handling of comments and a cached navigation
|
||||
to minimize the queries to the server. Hablo also generate cards for all
|
||||
pages, including articles for prettier shares on social-networks.
|
||||
Those features include the handling of comments and a cached navigation to
|
||||
minimize the number of queries to the server. Hablo also generates RSS feeds
|
||||
and Open Graph cards for prettier shares on social networks.
|
||||
homepage: https://git.marvid.fr/Tissevert/hablo
|
||||
-- bug-reports:
|
||||
license: BSD3
|
||||
|
@ -27,37 +27,86 @@ data-dir: share
|
|||
data-files: js/*.js
|
||||
defaultWording.conf
|
||||
|
||||
executable hablo
|
||||
main-is: Main.hs
|
||||
other-modules: Arguments
|
||||
library
|
||||
exposed-modules: Arguments
|
||||
, Article
|
||||
, ArticlesList
|
||||
, Blog
|
||||
, Blog.Path
|
||||
, Blog.Template
|
||||
, Blog.Skin
|
||||
, Blog.URL
|
||||
, Blog.Wording
|
||||
, Dom
|
||||
, Collection
|
||||
, DOM
|
||||
, DOM.Card
|
||||
, Files
|
||||
, HTML
|
||||
, JS
|
||||
, JSON
|
||||
, Markdown
|
||||
, Page
|
||||
, Paths_hablo
|
||||
, Pretty
|
||||
, RSS
|
||||
-- other-extensions:
|
||||
build-depends: aeson >= 1.4.2 && < 1.5
|
||||
, base >= 4.12.0 && < 4.13
|
||||
, bytestring >= 0.10.8 && < 0.11
|
||||
, containers >= 0.6.0 && < 0.7
|
||||
, directory >= 1.3.3 && < 1.4
|
||||
build-depends: aeson >= 1.2.0 && < 2.1
|
||||
, base >= 4.9.1 && < 4.17
|
||||
, bytestring >= 0.10.8 && < 0.12
|
||||
, containers >= 0.5.11 && < 0.7
|
||||
, directory >= 1.3.1 && < 1.4
|
||||
, filepath >= 1.4.2 && < 1.5
|
||||
, lucid >= 2.9.11 && < 2.10
|
||||
, lucid >= 2.8.0 && < 2.12
|
||||
, mtl >= 2.2.2 && < 2.3
|
||||
, optparse-applicative >= 0.14.3 && < 0.15
|
||||
, optparse-applicative >= 0.14.0 && < 0.18
|
||||
, parsec >= 3.1.13 && < 3.2
|
||||
, template >= 0.2.0 && < 0.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
|
||||
ghc-options: -Wall -dynamic
|
||||
ghc-options: -Wall
|
||||
hs-source-dirs: src
|
||||
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
|
||||
|
|
|
@ -1,11 +1,14 @@
|
|||
allLink = See all
|
||||
allPage = All articles
|
||||
allTaggedPage = All articles tagged ${tag}
|
||||
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
|
||||
latestTaggedPage = Latest articles tagged ${tag}
|
||||
metadata = ${?by ${author} ?}on ${date}${? tagged ${tags}?}
|
||||
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
|
||||
|
|
|
@ -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]);});
|
||||
}
|
|
@ -0,0 +1,5 @@
|
|||
import replaceMarkdown from DomRenderer;
|
||||
import hijackLinks from Navigation;
|
||||
|
||||
replaceMarkdown();
|
||||
hijackLinks();
|
|
@ -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)
|
||||
})
|
||||
});
|
||||
}
|
|
@ -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);
|
||||
})
|
||||
)
|
||||
);
|
||||
}
|
|
@ -0,0 +1,8 @@
|
|||
import remarkableConfig from Hablo.Config;
|
||||
|
||||
var md = new Remarkable(remarkableConfig);
|
||||
md.block.ruler.enable(['footnote']);
|
||||
|
||||
return {
|
||||
md: md
|
||||
};
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
|
@ -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))
|
||||
];
|
||||
};
|
||||
}
|
||||
}
|
|
@ -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();
|
||||
});
|
|
@ -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.path.commentsAt + '/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.path.commentsAt != 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)
|
||||
})
|
||||
});
|
||||
}
|
||||
}
|
|
@ -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);
|
||||
})
|
||||
)
|
||||
);
|
||||
}
|
||||
}
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
|
@ -1,29 +1,38 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
module Arguments (
|
||||
Arguments(..)
|
||||
, get
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,11,0)
|
||||
import Data.Monoid ((<>))
|
||||
#endif
|
||||
import Data.Version (showVersion)
|
||||
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 Paths_hablo as Hablo (version)
|
||||
import System.FilePath (dropTrailingPathSeparator, isValid)
|
||||
|
||||
data Arguments = BlogConfig {
|
||||
sourceDir :: FilePath
|
||||
, articlesPath :: FilePath
|
||||
, articlesPath :: Maybe FilePath
|
||||
, bannerPath :: Maybe FilePath
|
||||
, cardImage :: Maybe FilePath
|
||||
, commentsAt :: Maybe String
|
||||
, commentsURL :: Maybe String
|
||||
, favicon :: Maybe FilePath
|
||||
, headPath :: Maybe FilePath
|
||||
, name :: Maybe String
|
||||
, openGraphCards :: Bool
|
||||
, pagesPath :: Maybe FilePath
|
||||
, previewArticlesCount :: Int
|
||||
, previewLinesCount :: Int
|
||||
, remarkableConfig :: Maybe FilePath
|
||||
, rss :: Bool
|
||||
, siteURL :: Maybe String
|
||||
, wording :: Maybe FilePath
|
||||
}
|
||||
| Version
|
||||
|
@ -41,21 +50,17 @@ option readM aShort aLong aMetavar aHelpMessage =
|
|||
blogConfig :: Parser Arguments
|
||||
blogConfig = BlogConfig
|
||||
<$> argument filePath (value "." <> metavar "INPUT_DIR")
|
||||
<*> Optparse.option filePath (
|
||||
metavar "DIRECTORY"
|
||||
<> value "articles"
|
||||
<> short 'a'
|
||||
<> long "articles"
|
||||
<> help "relative path to the directory containing the articles within INPUT_DIR"
|
||||
)
|
||||
<*> option filePath 'a' "articles" "DIRECTORY"
|
||||
"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 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
|
||||
<*> option filePath 'C' "comments-at" "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 '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 filePath 'p' "pages"
|
||||
"DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR"
|
||||
<*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
|
||||
<*> option filePath 'p' "pages" "DIRECTORY"
|
||||
"relative path to the directory containing the pages within INPUT_DIR"
|
||||
<*> Optparse.option auto (
|
||||
metavar "INTEGER"
|
||||
<> value 3
|
||||
|
@ -72,6 +77,8 @@ blogConfig = BlogConfig
|
|||
)
|
||||
<*> option filePath 'r' "remarkable-config" "FILE"
|
||||
"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 'w' "wording" "FILE" "path to the file containing the wording to use"
|
||||
|
||||
version :: Parser Arguments
|
||||
|
|
|
@ -1,71 +1,23 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module Article (
|
||||
Article(..)
|
||||
, at
|
||||
, getKey
|
||||
, preview
|
||||
) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map (fromList, alter)
|
||||
import qualified Data.Map as Map (alter)
|
||||
import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
|
||||
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
||||
import Foreign.C.Types (CTime)
|
||||
import System.FilePath (dropExtension, takeFileName)
|
||||
import Markdown (Markdown(..), MarkdownContent(..), Metadata)
|
||||
import qualified Markdown (at)
|
||||
import System.Posix.Files (getFileStatus, modificationTime)
|
||||
import Text.ParserCombinators.Parsec (
|
||||
ParseError
|
||||
, Parser
|
||||
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
|
||||
, oneOf, option, parse, skipMany, sourceLine, string, try
|
||||
)
|
||||
import Text.ParserCombinators.Parsec (ParseError)
|
||||
|
||||
type Metadata = Map String String
|
||||
|
||||
data Article = Article {
|
||||
key :: String
|
||||
, title :: String
|
||||
, metadata :: Metadata
|
||||
, bodyOffset :: Int
|
||||
, body :: [String]
|
||||
}
|
||||
|
||||
articleP :: Parser (String, Metadata, Int, [String])
|
||||
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
|
||||
)
|
||||
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
|
||||
|
||||
eol :: Parser String
|
||||
eol = try (string "\r\n") <|> string "\r" <|> string "\n"
|
||||
|
||||
no :: String -> Parser String
|
||||
no = many1 . noneOf
|
||||
newtype Article = Article Markdown
|
||||
instance MarkdownContent Article where
|
||||
getMarkdown (Article markdown) = markdown
|
||||
|
||||
setDate :: String -> CTime -> Metadata -> Metadata
|
||||
setDate tzOffset defaultDate = Map.alter timeStamp "date"
|
||||
|
@ -78,26 +30,16 @@ setDate tzOffset defaultDate = Map.alter timeStamp "date"
|
|||
let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
|
||||
foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
|
||||
|
||||
makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article)
|
||||
makeArticle metaFilter markdown@(Markdown {key, metadata}) =
|
||||
(key, Article $ markdown {metadata = metaFilter metadata})
|
||||
|
||||
at :: FilePath -> IO (Either ParseError (String, Article))
|
||||
at filePath = do
|
||||
tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
|
||||
fileDate <- modificationTime <$> getFileStatus filePath
|
||||
let build = makeArticle (setDate tzOffset fileDate)
|
||||
fmap build . parse articleP filePath <$> readFile filePath
|
||||
where
|
||||
makeArticle metaFilter (title, metadata, bodyOffset, body) = (
|
||||
getKey filePath
|
||||
, Article {
|
||||
key = getKey filePath
|
||||
, title
|
||||
, metadata = metaFilter metadata
|
||||
, bodyOffset
|
||||
, body
|
||||
}
|
||||
)
|
||||
fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath
|
||||
|
||||
getKey :: FilePath -> String
|
||||
getKey = dropExtension . takeFileName
|
||||
|
||||
preview :: Int -> Article -> Article
|
||||
preview linesCount article = article {body = take linesCount $ body article}
|
||||
preview :: Int -> Article -> Markdown
|
||||
preview linesCount (Article markdown@(Markdown {body})) =
|
||||
markdown {body = take linesCount $ body}
|
||||
|
|
|
@ -3,35 +3,46 @@
|
|||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module ArticlesList (
|
||||
ArticlesList(..)
|
||||
, otherUrl
|
||||
, pageTitle
|
||||
, description
|
||||
, getArticles
|
||||
, otherURL
|
||||
, rssLinkTexts
|
||||
) where
|
||||
|
||||
import Article (Article)
|
||||
import Blog (Blog(..), Wording(..), get)
|
||||
import Control.Monad.Reader (MonadReader)
|
||||
import Blog (Blog(..), Renderer, Skin(..), template)
|
||||
import Collection (Collection(..))
|
||||
import Control.Monad.Reader (MonadReader, asks)
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Lazy (toStrict)
|
||||
import Data.Text.Template (render)
|
||||
import Files (absoluteLink)
|
||||
import Pretty ((.$))
|
||||
import System.FilePath.Posix ((</>))
|
||||
|
||||
data ArticlesList = ArticlesList {
|
||||
tagged :: Maybe String
|
||||
, full :: Bool
|
||||
, featured :: [Article]
|
||||
full :: Bool
|
||||
, collection :: Collection
|
||||
}
|
||||
|
||||
otherUrl :: ArticlesList -> String
|
||||
otherUrl (ArticlesList {full, tagged}) = absoluteLink $
|
||||
(if full then id else (</> "all.html")) $ maybe "" id tagged
|
||||
getArticles :: MonadReader Blog m => ArticlesList -> m [Article]
|
||||
getArticles (ArticlesList {full, collection = Collection {featured}}) = do
|
||||
limit <- take <$> (asks $skin.$previewArticlesCount)
|
||||
return $ if full then featured else limit featured
|
||||
|
||||
pageTitle :: (MonadReader Blog m) => ArticlesList -> m Text
|
||||
pageTitle (ArticlesList {full, tagged}) = do
|
||||
template <- Blog.get $wording.$(if full then allTaggedPage else latestTaggedPage)
|
||||
untagged <- Blog.get $wording.$(if full then allPage else latestPage)
|
||||
return $ maybe untagged (toStrict . render template . tag) tagged
|
||||
otherURL :: ArticlesList -> String
|
||||
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
|
||||
tag :: String -> Text -> Text
|
||||
tag t = \"tag" -> pack t
|
||||
page = if full then "allPage" else "latestPage"
|
||||
environment = maybe [] $ \value -> [("tag", pack value)]
|
||||
|
||||
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
|
||||
|
|
100
src/Blog.hs
100
src/Blog.hs
|
@ -1,88 +1,126 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
module Blog (
|
||||
Blog(..)
|
||||
, Path(..)
|
||||
, Renderer
|
||||
, Skin(..)
|
||||
, Wording(..)
|
||||
, URL(..)
|
||||
, Wording
|
||||
, build
|
||||
, get
|
||||
, template
|
||||
) where
|
||||
|
||||
import Arguments (Arguments)
|
||||
import qualified Arguments (name, sourceDir)
|
||||
import Article (Article)
|
||||
import qualified Article (at, getKey)
|
||||
import qualified Article (at)
|
||||
import Blog.Path (Path(..))
|
||||
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 qualified Blog.Skin as Skin (build)
|
||||
import Blog.Wording (Wording(..))
|
||||
import Blog.URL (URL(..))
|
||||
import qualified Blog.URL as URL (build)
|
||||
import Blog.Wording (Wording)
|
||||
import qualified Blog.Wording as Wording (build)
|
||||
import Control.Monad ((>=>), filterM, forM)
|
||||
import Control.Monad.Reader (MonadReader, ask)
|
||||
import Data.Either (rights)
|
||||
import Data.Map (Map, lookup)
|
||||
import qualified Data.Map as Map (fromList)
|
||||
import Control.Monad ((>=>), filterM, foldM, forM)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.Reader (MonadReader, asks)
|
||||
import Data.Map (Map, insert, lookup)
|
||||
import qualified Data.Map as Map (empty, fromList)
|
||||
import Data.Set (Set)
|
||||
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 Markdown (getKey)
|
||||
import Page (Page)
|
||||
import qualified Page (at)
|
||||
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 Text.Parsec (ParseError)
|
||||
|
||||
type Collection = Map String Article
|
||||
type Collection = Map String
|
||||
type Parsed a = Either ParseError (String, a)
|
||||
|
||||
data Blog = Blog {
|
||||
articles :: Collection
|
||||
articles :: Collection Article
|
||||
, hasRSS :: Bool
|
||||
, name :: String
|
||||
, pages :: Collection Page
|
||||
, path :: Path
|
||||
, skin :: Skin
|
||||
, tags :: Map String (Set String)
|
||||
, tags :: Collection (Set String)
|
||||
, templates :: Templates
|
||||
, urls :: URL
|
||||
, wording :: Wording
|
||||
}
|
||||
|
||||
get :: MonadReader Blog m => (Blog -> a) -> m a
|
||||
get = (<$> ask)
|
||||
type Renderer m = (MonadIO m, MonadReader Blog m)
|
||||
|
||||
findArticles :: FilePath -> IO (Map String Article)
|
||||
findArticles =
|
||||
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) =
|
||||
forM [show parseErrors, "=> Ignoring this text"] putStrLn
|
||||
>> return accumulator
|
||||
keepOrWarn accumulator (Right (key, article)) =
|
||||
return $ insert key article accumulator
|
||||
|
||||
find :: (FilePath -> IO (Parsed a)) -> FilePath -> IO (Collection a)
|
||||
find parser =
|
||||
Files.find
|
||||
>=> filterM isMarkDownFile
|
||||
>=> mapM Article.at
|
||||
>=> return . Map.fromList . rights
|
||||
>=> mapM parser
|
||||
>=> foldM keepOrWarn Map.empty
|
||||
where
|
||||
isMarkDownFile path = do
|
||||
let correctExtension = takeExtension path == ".md"
|
||||
(correctExtension &&) <$> doesFileExist path
|
||||
|
||||
tagged :: Collection -> FilePath -> IO (String, Set String)
|
||||
tagged :: Collection Article -> FilePath -> IO (String, Set String)
|
||||
tagged collection path = do
|
||||
links <- Files.find path
|
||||
keys <- forM links $ \link -> do
|
||||
fileExists <- doesFileExist link
|
||||
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)
|
||||
else Set.empty
|
||||
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
|
||||
articles <- findArticles $ articlesPath path
|
||||
tags <- Map.fromList . filter (not . Set.null . snd)
|
||||
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
|
||||
return (articles, tags)
|
||||
(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)
|
||||
<$> (Files.find (somePath </> "tags") >>= mapM (articles `tagged`))
|
||||
return (articles, tags)
|
||||
|
||||
build :: Arguments -> IO Blog
|
||||
build arguments = do
|
||||
urls <- URL.build arguments
|
||||
let hasRSS = maybe False (\_-> True) $ rss urls
|
||||
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
|
||||
path <- Path.build root arguments
|
||||
path <- assertRight =<< Path.build root arguments
|
||||
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
|
||||
$ Arguments.name arguments
|
||||
skin <- Skin.build name arguments
|
||||
(articles, tags) <- discover path
|
||||
return $ Blog {articles, name, path, skin, tags, wording}
|
||||
(articles, pages, tags) <- discover path
|
||||
return $ Blog {
|
||||
articles, hasRSS, name, pages, path, skin, tags, templates, urls, wording
|
||||
}
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Blog.Path (
|
||||
Path(..)
|
||||
, build
|
||||
|
@ -8,33 +9,44 @@ module Blog.Path (
|
|||
|
||||
import Arguments (Arguments)
|
||||
import qualified Arguments as Arguments (Arguments(..))
|
||||
import Control.Monad (join)
|
||||
import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT)
|
||||
import Data.Aeson (ToJSON(..), (.=), pairs)
|
||||
#if !MIN_VERSION_base(4,11,0)
|
||||
import Data.Monoid ((<>))
|
||||
#endif
|
||||
import Files (File(..), filePath)
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
data Path = Path {
|
||||
articlesPath :: FilePath
|
||||
, commentsAt :: Maybe String
|
||||
articlesPath :: Maybe FilePath
|
||||
, pagesPath :: Maybe FilePath
|
||||
, remarkableConfig :: Maybe FilePath
|
||||
, root :: FilePath
|
||||
} deriving Generic
|
||||
} deriving (Eq, Generic, Show)
|
||||
|
||||
instance ToJSON Path where
|
||||
toEncoding (Path {articlesPath, commentsAt, pagesPath}) = pairs (
|
||||
toEncoding (Path {articlesPath, pagesPath}) = pairs (
|
||||
"articlesPath" .= articlesPath
|
||||
<> "commentsAt" .= commentsAt
|
||||
<> "pagesPath" .= pagesPath
|
||||
)
|
||||
|
||||
build :: FilePath -> Arguments -> IO Path
|
||||
build root arguments = do
|
||||
articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
|
||||
pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
|
||||
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
|
||||
return $ Path {
|
||||
articlesPath, commentsAt, pagesPath, remarkableConfig, root
|
||||
}
|
||||
checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
|
||||
checkFor fileOrDir = ExceptT . fmap (Just <$>) . filePath . fileOrDir
|
||||
|
||||
getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT String IO (Maybe FilePath)
|
||||
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
|
||||
commentsAt = Arguments.commentsAt arguments
|
||||
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}
|
||||
ignore = return Nothing
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Blog.Skin (
|
||||
Skin(..)
|
||||
, build
|
||||
|
@ -11,7 +12,9 @@ import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArt
|
|||
import Control.Monad (filterM)
|
||||
import Data.Aeson (ToJSON(..), (.=), pairs)
|
||||
import Data.Maybe (listToMaybe)
|
||||
#if !MIN_VERSION_base(4,11,0)
|
||||
import Data.Monoid ((<>))
|
||||
#endif
|
||||
import Files (absoluteLink)
|
||||
import GHC.Generics (Generic)
|
||||
import Prelude hiding (head)
|
||||
|
@ -36,7 +39,7 @@ instance ToJSON Skin where
|
|||
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
|
||||
findImage _ (Just path) = return . Just $ absoluteLink path
|
||||
findImage name Nothing =
|
||||
fmap absoluteLink . listToMaybe <$> filterM doesFileExist pathsToCheck
|
||||
listToMaybe <$> filterM doesFileExist pathsToCheck
|
||||
where
|
||||
directories = [".", "image", "images", "pictures", "skin", "static"]
|
||||
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]
|
||||
|
|
|
@ -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
|
|
@ -0,0 +1,45 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Blog.URL (
|
||||
URL(..)
|
||||
, build
|
||||
) where
|
||||
|
||||
import Arguments (Arguments)
|
||||
import qualified Arguments as Arguments (Arguments(..))
|
||||
import Data.Aeson (ToJSON(..), (.=), pairs)
|
||||
import GHC.Generics (Generic)
|
||||
import System.Exit (die)
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Text.Printf (printf)
|
||||
|
||||
data URL = URL {
|
||||
cards :: Maybe String
|
||||
, comments :: Maybe String
|
||||
, rss :: Maybe String
|
||||
} deriving Generic
|
||||
|
||||
instance ToJSON URL where
|
||||
toEncoding (URL {comments}) = pairs (
|
||||
"comments" .= comments
|
||||
)
|
||||
|
||||
build :: Arguments -> IO URL
|
||||
build arguments = do
|
||||
cards <- getSiteURL argOGCards "Open Graph cards"
|
||||
rss <- getSiteURL argRSS "RSS feeds"
|
||||
checksUsed (argOGCards || argRSS) siteURL
|
||||
return $ URL {cards, comments, rss}
|
||||
where
|
||||
comments = Arguments.commentsURL 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 ()
|
|
@ -1,20 +1,17 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Blog.Wording (
|
||||
Wording(..)
|
||||
, build
|
||||
, variables
|
||||
) where
|
||||
|
||||
import Arguments (Arguments(..))
|
||||
import Control.Monad (foldM)
|
||||
import Data.Aeson (ToJSON(..), (.=), object, pairs)
|
||||
import Data.List (intercalate)
|
||||
import Data.Map (Map, (!))
|
||||
import qualified Data.Map as Map (empty, fromList, map, union)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Aeson (ToJSON(..))
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map (empty, fromList, keys, map, union)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text (pack, unpack)
|
||||
import Data.Text.Template (Template, renderA, showTemplate, templateSafe)
|
||||
import qualified Data.Text as Text (pack)
|
||||
import Paths_hablo (getDataFileName)
|
||||
import Text.ParserCombinators.Parsec (
|
||||
Parser
|
||||
|
@ -23,40 +20,29 @@ import Text.ParserCombinators.Parsec (
|
|||
)
|
||||
import System.Exit (die)
|
||||
|
||||
data Wording = Wording {
|
||||
allLink :: Text
|
||||
, allPage :: Text
|
||||
, allTaggedPage :: Template
|
||||
, commentsLink :: Text
|
||||
, commentsSection :: Text
|
||||
, dateFormat :: Text
|
||||
, latestLink :: Text
|
||||
, latestPage :: Text
|
||||
, latestTaggedPage :: Template
|
||||
, metadata :: Text
|
||||
, tagsList :: Text
|
||||
}
|
||||
newtype Wording = Wording (Map String Text)
|
||||
|
||||
keys :: [String]
|
||||
keys = [
|
||||
"allLink", "allPage", "allTaggedPage", "commentsLink", "commentsSection"
|
||||
, "dateFormat", "latestLink", "latestPage", "latestTaggedPage", "metadata"
|
||||
, "tagsList"
|
||||
variables :: Map String [Text]
|
||||
variables = Map.fromList [
|
||||
("allLink", [])
|
||||
, ("allPage", ["tag"])
|
||||
, ("articleDescription", ["name"])
|
||||
, ("commentsLink", [])
|
||||
, ("commentsSection", [])
|
||||
, ("dateFormat", [])
|
||||
, ("latestLink", [])
|
||||
, ("latestPage", ["tag"])
|
||||
, ("metadata", ["author", "date", "tags"])
|
||||
, ("pageDescription", ["name"])
|
||||
, ("pagesList", [])
|
||||
, ("rssLink", [])
|
||||
, ("rssTitle", ["tag"])
|
||||
, ("tagsList", [])
|
||||
]
|
||||
|
||||
values :: [Wording -> Text]
|
||||
values = [
|
||||
allLink, allPage, showTemplate . allTaggedPage, commentsLink, commentsSection
|
||||
, dateFormat, latestLink, latestPage, showTemplate . latestTaggedPage
|
||||
, metadata, tagsList
|
||||
]
|
||||
|
||||
texts :: Wording -> [Text]
|
||||
texts wording = ($ wording) <$> values
|
||||
|
||||
instance ToJSON Wording where
|
||||
toJSON = object . zipWith (.=) (Text.pack <$> keys) . texts
|
||||
toEncoding = pairs . foldl (<>) mempty . zipWith (.=) (Text.pack <$> keys) . texts
|
||||
toJSON (Wording m) = toJSON m
|
||||
toEncoding (Wording m) = toEncoding m
|
||||
|
||||
addWording :: Map String Text -> FilePath -> IO (Map String Text)
|
||||
addWording currentWording wordingFile = do
|
||||
|
@ -72,41 +58,12 @@ wordingP = Map.map Text.pack . Map.fromList <$>
|
|||
restOfLine = many $ noneOf "\r\n"
|
||||
eol = try (string "\r\n") <|> string "\r" <|> string "\n"
|
||||
skip = optional (char '#' *> restOfLine) *> eol
|
||||
line = (,) <$> (choice (try . string <$> keys) <* equal) <*> restOfLine
|
||||
varEqual = choice (try . string <$> Map.keys variables) <* equal
|
||||
line = (,) <$> varEqual <*> restOfLine
|
||||
equal = many (char ' ') *> char '=' *> many (char ' ')
|
||||
|
||||
checkTemplateWith :: [Text] -> String -> Map String Text -> IO Template
|
||||
checkTemplateWith variables key wording =
|
||||
let templateText = wording ! key in
|
||||
let testEnvironment = flip lookup [(s, "") | s <- variables] 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 =
|
||||
" (available variables: " ++ intercalate ", " (Text.unpack <$> variables) ++ ")"
|
||||
syntaxError row col =
|
||||
"Syntax error in template for variable " ++ key ++ "at l." ++ row ++ ", c." ++ col
|
||||
badTemplate = "Invalid template for variable " ++ key ++ availableVariables
|
||||
|
||||
build :: Arguments -> IO Wording
|
||||
build arguments = do
|
||||
defaultWording <- getDataFileName "defaultWording.conf"
|
||||
let wordingFiles = maybe id (:) (wording arguments) $ [defaultWording]
|
||||
wording <- foldM addWording Map.empty wordingFiles
|
||||
allTaggedPage <- checkTemplateWith ["tag"] "allTaggedPage" wording
|
||||
latestTaggedPage <- checkTemplateWith ["tag"] "latestTaggedPage" wording
|
||||
return Wording {
|
||||
allLink = wording ! "allLink"
|
||||
, allPage = wording ! "allPage"
|
||||
, allTaggedPage
|
||||
, commentsLink = wording ! "commentsLink"
|
||||
, commentsSection = wording ! "commentsSection"
|
||||
, dateFormat = wording ! "dateFormat"
|
||||
, latestLink = wording ! "latestLink"
|
||||
, latestPage = wording ! "latestPage"
|
||||
, latestTaggedPage
|
||||
, metadata = wording ! "metadata"
|
||||
, tagsList = wording ! "tagsList"
|
||||
}
|
||||
Wording <$> foldM addWording Map.empty wordingFiles
|
||||
|
|
|
@ -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
|
|
@ -0,0 +1,124 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module DOM (
|
||||
HasContent(..)
|
||||
, htmlDocument
|
||||
) where
|
||||
|
||||
import Article (Article)
|
||||
import qualified Article (preview)
|
||||
import ArticlesList (
|
||||
ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
|
||||
)
|
||||
import Blog (Blog(..), Skin(..), URL(..), template)
|
||||
import Control.Monad.Reader (ReaderT, asks)
|
||||
import Data.Map as Map (Map, toList)
|
||||
import Data.Text (Text, pack, empty)
|
||||
import DOM.Card (HasCard)
|
||||
import qualified DOM.Card as Card (make)
|
||||
import Files (absoluteLink)
|
||||
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 Pretty ((.$))
|
||||
import System.FilePath.Posix ((<.>))
|
||||
|
||||
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
||||
|
||||
class HasCard a => HasContent a where
|
||||
content :: a -> HtmlGenerator ()
|
||||
|
||||
instance HasContent Article where
|
||||
content = mDContent True . getMarkdown
|
||||
|
||||
instance HasContent Page where
|
||||
content = mDContent True . getMarkdown
|
||||
|
||||
instance HasContent ArticlesList where
|
||||
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"] (
|
||||
mapM_ (mDContent False . preview) =<< getArticles al
|
||||
)
|
||||
where
|
||||
otherLink =
|
||||
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 ()
|
||||
|
||||
mDContent :: Bool -> Markdown -> HtmlGenerator ()
|
||||
mDContent raw markdown@(Markdown {key, body}) =
|
||||
article_ [id_ $ pack key] (do
|
||||
header_ . h1_ $ mDLink raw markdown
|
||||
pre_ . toHtml $ unlines body
|
||||
)
|
||||
|
||||
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 name =
|
||||
a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
|
||||
|
||||
defaultBanner :: HtmlGenerator ()
|
||||
defaultBanner =
|
||||
div_ [id_ "header"] (
|
||||
a_ [href_ "/"] (
|
||||
h1_ . toHtml =<< asks name
|
||||
)
|
||||
)
|
||||
|
||||
faviconLink :: FilePath -> HtmlGenerator ()
|
||||
faviconLink url = link_ [
|
||||
rel_ "shortcut icon", href_ . pack $ absoluteLink url, type_ "image/x-icon"
|
||||
]
|
||||
|
||||
optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
|
||||
optional = maybe (return ())
|
||||
|
||||
navigationSection ::
|
||||
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
|
||||
head_ (do
|
||||
meta_ [charset_ "utf-8"]
|
||||
title_ . toHtml =<< asks name
|
||||
script_ [src_ "/js/remarkable.min.js"] empty
|
||||
script_ [src_ "/js/hablo.js"] empty
|
||||
optional faviconLink =<< (asks $skin.$favicon)
|
||||
optional (Card.make someContent) =<< (asks $urls.$cards)
|
||||
optional toHtmlRaw =<< (asks $skin.$head)
|
||||
)
|
||||
body_ (do
|
||||
maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
|
||||
asks tags >>= navigationSection "tags" "tagsList"
|
||||
(\(key, _) -> tag key)
|
||||
asks pages >>= navigationSection "pages" "pagesList"
|
||||
(\(_, page) -> mDLink False $ getMarkdown page)
|
||||
div_ [id_ "contents"] $ content someContent
|
||||
)
|
||||
)
|
|
@ -0,0 +1,91 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module DOM.Card (
|
||||
HasCard(..)
|
||||
, make
|
||||
) where
|
||||
|
||||
import Article (Article(..))
|
||||
import ArticlesList (ArticlesList(..))
|
||||
import qualified ArticlesList (description)
|
||||
import Blog (Blog(..), Renderer, Skin(..), template)
|
||||
import Collection (Collection(..))
|
||||
import qualified Collection (title)
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad.Reader (asks)
|
||||
import qualified Data.Map as Map (lookup)
|
||||
import Data.Text (Text, pack)
|
||||
import Lucid (HtmlT, content_, meta_)
|
||||
import Lucid.Base (makeAttribute)
|
||||
import Markdown (MarkdownContent(..), metadata)
|
||||
import qualified Markdown (Markdown(..))
|
||||
import Page (Page(..))
|
||||
import Pretty ((.$))
|
||||
import System.FilePath.Posix ((</>), (<.>))
|
||||
|
||||
class HasCard a where
|
||||
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 attribute value =
|
||||
meta_ [
|
||||
makeAttribute "property" $ "og:" <> attribute
|
||||
, content_ value
|
||||
]
|
||||
|
||||
make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
|
||||
make element siteURL = do
|
||||
og "url" . sitePrefix =<< urlPath element
|
||||
og "type" =<< cardType element
|
||||
og "title" . pack =<< title element
|
||||
og "description" =<< description element
|
||||
maybeImage =<< ((<|>) <$> image element <*> (asks $skin.$cardImage))
|
||||
og "site_name" =<< (asks $name.$pack)
|
||||
where
|
||||
maybeImage = maybe (return ()) (og "image" . sitePrefix)
|
||||
sitePrefix = pack . (siteURL </>)
|
||||
|
||||
mDImage :: (Renderer m, MarkdownContent a ) => a -> m (Maybe String)
|
||||
mDImage = return . Map.lookup "featuredImage" . metadata . getMarkdown
|
||||
|
||||
mDTitle :: (Renderer m, MarkdownContent a) => a -> m String
|
||||
mDTitle = return . Markdown.title . getMarkdown
|
||||
|
||||
mDUrlPath :: (Renderer m, MarkdownContent a) => a -> m String
|
||||
mDUrlPath a = return $ Markdown.path (getMarkdown a) <.> "html"
|
||||
|
||||
mDDescription :: (Renderer m, MarkdownContent a) => String -> a -> m Text
|
||||
mDDescription key =
|
||||
getDescription . Map.lookup "summary" . metadata . getMarkdown
|
||||
where
|
||||
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
|
||||
cardType _ = return "website"
|
||||
description = ArticlesList.description
|
||||
image _ = return Nothing
|
||||
title (ArticlesList {collection}) = Collection.title collection
|
||||
urlPath al@(ArticlesList {collection}) =
|
||||
return $ maybe "" id (tag collection) </> file
|
||||
where
|
||||
file = (if full al then "all" else "index") <.> ".html"
|
115
src/Dom.hs
115
src/Dom.hs
|
@ -1,115 +0,0 @@
|
|||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Dom (
|
||||
page
|
||||
) where
|
||||
|
||||
import Article (Article(..))
|
||||
import qualified Article (preview)
|
||||
import ArticlesList (ArticlesList(..), otherUrl, pageTitle)
|
||||
import Blog (Blog(..), Path(..), Skin(..), Wording(..))
|
||||
import qualified Blog (get)
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad.Reader (ReaderT)
|
||||
import qualified Data.Map as Map (keys, lookup)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text, pack, empty)
|
||||
import Files (absoluteLink)
|
||||
import Lucid
|
||||
import Lucid.Base (makeAttribute)
|
||||
import Prelude hiding (head, lookup)
|
||||
import Pretty ((.$))
|
||||
import System.FilePath.Posix ((</>), (<.>))
|
||||
|
||||
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
||||
|
||||
class Page a where
|
||||
card :: a -> HtmlGenerator ()
|
||||
content :: a -> HtmlGenerator ()
|
||||
|
||||
instance Page Article where
|
||||
card (Article {title, Article.metadata}) = do
|
||||
description <- getDescription (Map.lookup "summary" metadata)
|
||||
makeCard title (pack description) (Map.lookup "featuredImage" metadata)
|
||||
where
|
||||
getDescription = maybe (Blog.get $name.$("A new article on " <>)) return
|
||||
|
||||
content = article True
|
||||
|
||||
instance Page ArticlesList where
|
||||
card al = do
|
||||
cardTitle <- getTitle <$> Blog.get name
|
||||
description <- pageTitle al
|
||||
makeCard cardTitle description Nothing
|
||||
where
|
||||
getTitle name = maybe name ((name ++ " - ") ++) $ tagged al
|
||||
|
||||
content al@(ArticlesList {featured, full}) = do
|
||||
preview <- Article.preview <$> (Blog.get $skin.$previewLinesCount)
|
||||
h2_ . toHtml =<< pageTitle al
|
||||
a_ [href_ . pack $ otherUrl al] . toHtml =<< otherLink
|
||||
div_ [class_ "articles"] (
|
||||
mapM_ (article False . preview) featured
|
||||
)
|
||||
where
|
||||
otherLink = Blog.get $wording.$(if full then latestLink else allLink)
|
||||
|
||||
article :: Bool -> Article -> HtmlGenerator ()
|
||||
article raw (Article {key, body, title}) = do
|
||||
url <- absoluteLink . (</> key <.> extension) <$> (Blog.get $path.$articlesPath)
|
||||
article_ [id_ $ pack key] (do
|
||||
header_ (do
|
||||
a_ [href_ . pack $ url] . h1_ $ toHtml title
|
||||
)
|
||||
pre_ . toHtml $ unlines body
|
||||
)
|
||||
where extension = if raw then "md" else "html"
|
||||
|
||||
makeCard :: String -> Text -> Maybe String -> HtmlGenerator ()
|
||||
makeCard title description image = do
|
||||
og "title" $ pack title
|
||||
og "description" description
|
||||
maybeImage =<< ((image <|>) <$> (Blog.get $skin.$cardImage))
|
||||
og "site_name" =<< (Blog.get $name.$pack)
|
||||
where
|
||||
og attribute value = meta_ [makeAttribute "property" $ "og:" <> attribute , content_ value]
|
||||
maybeImage = maybe (return ()) (og "image" . pack)
|
||||
|
||||
tag :: String -> HtmlGenerator ()
|
||||
tag tagName = li_ (
|
||||
a_ [href_ . pack $ absoluteLink tagName, class_ "tag"] $ toHtml tagName
|
||||
)
|
||||
|
||||
defaultBanner :: HtmlGenerator ()
|
||||
defaultBanner = do
|
||||
div_ [id_ "header"] (
|
||||
a_ [href_ "/"] (
|
||||
h1_ . toHtml =<< Blog.get name
|
||||
)
|
||||
)
|
||||
|
||||
faviconLink :: FilePath -> HtmlGenerator ()
|
||||
faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"]
|
||||
|
||||
page :: Page a => a -> HtmlGenerator ()
|
||||
page aPage =
|
||||
doctypehtml_ (do
|
||||
head_ (do
|
||||
meta_ [charset_ "utf-8"]
|
||||
title_ . toHtml =<< Blog.get name
|
||||
script_ [src_ "/js/unit.js"] empty
|
||||
script_ [src_ "/js/remarkable.min.js"] empty
|
||||
script_ [src_ "/js/hablo.js"] empty
|
||||
maybe (toHtml empty) faviconLink =<< (Blog.get $skin.$favicon)
|
||||
card aPage
|
||||
(Blog.get $skin.$head) >>= maybe (toHtml empty) toHtmlRaw
|
||||
)
|
||||
body_ (do
|
||||
maybe defaultBanner toHtmlRaw =<< (Blog.get $skin.$banner)
|
||||
div_ [id_ "navigator"] (do
|
||||
h2_ =<< (Blog.get $wording.$tagsList.$toHtml)
|
||||
ul_ . mapM_ tag . Map.keys =<< Blog.get tags
|
||||
)
|
||||
div_ [id_ "contents"] $ content aPage
|
||||
)
|
||||
)
|
31
src/Files.hs
31
src/Files.hs
|
@ -1,35 +1,32 @@
|
|||
module Files (
|
||||
File(..)
|
||||
, absolute
|
||||
, absoluteLink
|
||||
, filePath
|
||||
, find
|
||||
) where
|
||||
|
||||
import System.Exit (die)
|
||||
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
|
||||
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
|
||||
import System.FilePath ((</>))
|
||||
|
||||
data File = File FilePath | Dir FilePath
|
||||
|
||||
absolute :: File -> IO (FilePath)
|
||||
absolute file = filePath file >>= makeAbsolute
|
||||
|
||||
absoluteLink :: FilePath -> FilePath
|
||||
absoluteLink ('.':path) = path
|
||||
absoluteLink path = "/" </> path
|
||||
|
||||
filePath :: File -> IO FilePath
|
||||
filePath file = do
|
||||
let (thePath, test, errorMessage) =
|
||||
case file of
|
||||
File path -> (path, doesFileExist, (++ ": no such file"))
|
||||
Dir path -> (path, doesDirectoryExist, (++ ": no such directory"))
|
||||
bool <- test thePath
|
||||
if bool
|
||||
then return thePath
|
||||
else die $ errorMessage thePath
|
||||
filePath :: File -> IO (Either String FilePath)
|
||||
filePath = filePathAux
|
||||
where
|
||||
filePathAux (File path) = ifIO doesFileExist path Right (notExist . File)
|
||||
filePathAux (Dir path) = ifIO doesDirectoryExist path Right (notExist . Dir)
|
||||
ifIO predicate value whenTrue whenFalse = do
|
||||
result <- predicate value
|
||||
return $ if result then whenTrue value else whenFalse value
|
||||
notExist (File path) = Left $ path ++ ": no such file"
|
||||
notExist (Dir path) = Left $ path ++ ": no such directory"
|
||||
|
||||
find :: FilePath -> IO [FilePath]
|
||||
find path =
|
||||
fmap (path </>) <$> listDirectory path
|
||||
filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
|
||||
where
|
||||
emptyIfMissing = either (\_ -> return [])
|
||||
|
|
92
src/HTML.hs
92
src/HTML.hs
|
@ -4,81 +4,43 @@ module HTML (
|
|||
generate
|
||||
) where
|
||||
|
||||
import Article(Article(..))
|
||||
import ArticlesList (ArticlesList(..))
|
||||
import Blog (Blog(..), Path(..), Skin(..))
|
||||
import qualified Blog (get)
|
||||
import Control.Monad (forM)
|
||||
import Blog (Blog(..), Path(..))
|
||||
import Collection (Collection(..))
|
||||
import qualified Collection (getAll)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Reader (MonadReader(..), ReaderT)
|
||||
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 Control.Monad.Reader (ReaderT, asks)
|
||||
import qualified Data.Map as Map (elems)
|
||||
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
|
||||
import Dom (page)
|
||||
import Lucid
|
||||
import DOM (HasContent, htmlDocument)
|
||||
import Lucid (renderTextT)
|
||||
import Markdown (Markdown(..), MarkdownContent(..))
|
||||
import Pretty ((.$))
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
import System.FilePath.Posix ((</>), (<.>))
|
||||
|
||||
data Collection = Collection {
|
||||
articlesFeatured :: [Article]
|
||||
, basePath :: FilePath
|
||||
, 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
|
||||
}
|
||||
articlesLists :: Collection -> [(FilePath, ArticlesList)]
|
||||
articlesLists collection@(Collection {basePath}) = [
|
||||
(path full, ArticlesList {collection, full}) | full <- [False, True]
|
||||
]
|
||||
where
|
||||
sortByDate = sortOn (Down . (! "date") . metadata)
|
||||
file bool = if bool then "all" else "index"
|
||||
path bool = basePath </> file bool <.> "html"
|
||||
|
||||
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
|
||||
})
|
||||
]
|
||||
|
||||
generateArticles :: [Article] -> ReaderT Blog IO ()
|
||||
generateArticles = mapM_ $ \article -> do
|
||||
baseDir <- (</>) <$> (Blog.get $path.$root) <*> (Blog.get $path.$articlesPath)
|
||||
(renderTextT $ page article)
|
||||
>>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html")
|
||||
generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO ()
|
||||
generateMarkdown = mapM_ $ \content -> do
|
||||
let relativePath = Markdown.path (getMarkdown content) <.> "html"
|
||||
filePath <- (</> relativePath) <$> (asks $Blog.path.$root)
|
||||
(renderTextT $ htmlDocument content) >>= liftIO . TextIO.writeFile filePath
|
||||
|
||||
generateCollection :: Collection -> ReaderT Blog IO ()
|
||||
generateCollection (Collection {articlesFeatured = []}) = return ()
|
||||
generateCollection aCollection = do
|
||||
liftIO . createDirectoryIfMissing False $ basePath aCollection
|
||||
articlesLists aCollection
|
||||
>>= (mapM_ $ \(filePath, articlesList) ->
|
||||
(renderTextT $ page articlesList)
|
||||
>>= liftIO . TextIO.writeFile filePath
|
||||
)
|
||||
generateCollection (Collection {featured = []}) = return ()
|
||||
generateCollection collection =
|
||||
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
|
||||
(renderTextT $ htmlDocument articlesList)
|
||||
>>= liftIO . TextIO.writeFile filePath
|
||||
|
||||
generate :: ReaderT Blog IO ()
|
||||
generate = do
|
||||
Blog {articles, tags} <- ask
|
||||
generateArticles $ Map.elems articles
|
||||
collection (Map.elems articles) Nothing >>= generateCollection
|
||||
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)
|
||||
asks articles >>= generateMarkdown . Map.elems
|
||||
Collection.getAll >>= mapM_ generateCollection
|
||||
asks pages >>= generateMarkdown . Map.elems
|
||||
|
|
57
src/JS.hs
57
src/JS.hs
|
@ -3,38 +3,57 @@ module JS (
|
|||
generate
|
||||
) where
|
||||
|
||||
import Data.Aeson (encode)
|
||||
|
||||
import Blog (Blog(..), Path(..))
|
||||
import qualified Blog (get)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Reader (ReaderT)
|
||||
import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
|
||||
import Control.Monad.Reader (ReaderT, asks)
|
||||
import Data.ByteString.Lazy (
|
||||
ByteString, concat, intercalate, fromStrict, readFile, writeFile
|
||||
)
|
||||
import Data.ByteString.Lazy.Char8 (pack)
|
||||
import qualified Files (find)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import JSON (exportBlog)
|
||||
import Paths_hablo (getDataDir)
|
||||
import Pretty ((.$))
|
||||
import SJW (compile, source)
|
||||
import System.Directory (createDirectoryIfMissing)
|
||||
import System.Exit (die)
|
||||
import System.FilePath ((</>))
|
||||
import Prelude hiding (concat, readFile, writeFile)
|
||||
|
||||
compile :: [ByteString] -> ByteString
|
||||
compile sources = concat (header:sources ++ [footer])
|
||||
object :: [ByteString] -> ByteString
|
||||
object sources = concat [header, intercalate ",\n" sources, footer]
|
||||
where
|
||||
header = "(function() {\n"
|
||||
footer = "})();"
|
||||
header = "return {\n"
|
||||
footer = "\n};"
|
||||
|
||||
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 = do
|
||||
destinationDir <- (</> "js") <$> (Blog.get $path.$root)
|
||||
blogJSON <- exportBlog
|
||||
remarkablePath <- Blog.get $path.$remarkableConfig
|
||||
liftIO $ do
|
||||
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 )
|
||||
destinationDir <- asks $path.$root.$(</> "js")
|
||||
liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
|
||||
generateConfig destinationDir
|
||||
liftIO $ generateMain destinationDir
|
||||
|
|
68
src/JSON.hs
68
src/JSON.hs
|
@ -4,54 +4,60 @@ module JSON (
|
|||
exportBlog
|
||||
) where
|
||||
|
||||
import Article (Article)
|
||||
import qualified Article (Article(..))
|
||||
import Blog (Blog, Path, Skin, Wording)
|
||||
import Blog (Blog, Path, Skin, URL, Wording)
|
||||
import qualified Blog (Blog(..))
|
||||
import Control.Monad.Reader (ReaderT, ask)
|
||||
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Aeson (Options(..), ToJSON(..), genericToEncoding, defaultOptions)
|
||||
import Data.Map (Map, mapWithKey)
|
||||
import qualified Data.Map as Map (filter, keys)
|
||||
import qualified Data.Set as Set (elems, member)
|
||||
import GHC.Generics
|
||||
import Markdown (Markdown, MarkdownContent(..))
|
||||
import qualified Markdown (Markdown(..))
|
||||
|
||||
data ArticleExport = ArticleExport {
|
||||
data MarkdownExport = MarkdownExport {
|
||||
title :: String
|
||||
, bodyOffset :: Int
|
||||
, metadata :: Map String String
|
||||
, tagged :: [String]
|
||||
, bodyOffset :: Int
|
||||
, tagged :: Maybe [String]
|
||||
} deriving (Generic)
|
||||
|
||||
instance ToJSON ArticleExport where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
instance ToJSON MarkdownExport where
|
||||
toEncoding = genericToEncoding (defaultOptions {omitNothingFields = True})
|
||||
|
||||
data BlogDB = BlogDB {
|
||||
articles :: Map String ArticleExport
|
||||
exportMarkdown :: Maybe [String] -> Markdown -> MarkdownExport
|
||||
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
|
||||
, pages :: Map String MarkdownExport
|
||||
, skin :: Skin
|
||||
, tags :: Map String [String]
|
||||
, urls :: URL
|
||||
, wording :: Wording
|
||||
} deriving (Generic)
|
||||
|
||||
instance ToJSON BlogDB where
|
||||
instance ToJSON BlogExport where
|
||||
toEncoding = genericToEncoding defaultOptions
|
||||
|
||||
exportArticle :: Blog -> String -> Article -> ArticleExport
|
||||
exportArticle blog key article = ArticleExport {
|
||||
title = Article.title article
|
||||
, bodyOffset = Article.bodyOffset article
|
||||
, metadata = Article.metadata article
|
||||
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
|
||||
exportBlog :: Blog -> BlogExport
|
||||
exportBlog blog = BlogExport {
|
||||
articles = getArticles $ getMarkdown <$> Blog.articles blog
|
||||
, hasRSS = Blog.hasRSS blog
|
||||
, pages = getPages $ getMarkdown <$> Blog.pages blog
|
||||
, path = Blog.path blog
|
||||
, skin = Blog.skin blog
|
||||
, tags = Set.elems <$> Blog.tags blog
|
||||
, urls = Blog.urls blog
|
||||
, wording = Blog.wording blog
|
||||
}
|
||||
|
||||
exportBlog :: ReaderT Blog IO ByteString
|
||||
exportBlog = do
|
||||
blog <- ask
|
||||
return . encode $ BlogDB {
|
||||
articles = mapWithKey (exportArticle blog) $ Blog.articles blog
|
||||
, path = Blog.path blog
|
||||
, skin = Blog.skin blog
|
||||
, tags = Set.elems <$> Blog.tags 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)
|
||||
|
|
|
@ -8,6 +8,7 @@ import Data.Version (showVersion)
|
|||
import qualified HTML (generate)
|
||||
import qualified JS (generate)
|
||||
import qualified Paths_hablo as Hablo (version)
|
||||
import qualified RSS (generate)
|
||||
import System.Exit (exitSuccess)
|
||||
|
||||
main :: IO ()
|
||||
|
@ -18,4 +19,5 @@ main = do
|
|||
config@(BlogConfig {}) -> Blog.build config >>= runReaderT (do
|
||||
HTML.generate
|
||||
JS.generate
|
||||
RSS.generate
|
||||
)
|
||||
|
|
|
@ -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
|
|
@ -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)
|
|
@ -1,6 +1,16 @@
|
|||
module Pretty (
|
||||
(.$)
|
||||
(.$)
|
||||
, assertRight
|
||||
, onRight
|
||||
) where
|
||||
|
||||
import System.Exit (die)
|
||||
|
||||
(.$) :: (a -> b) -> (b -> c) -> (a -> c)
|
||||
(.$) 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
|
||||
|
|
|
@ -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)
|
|
@ -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"
|
||||
}
|
|
@ -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 []}
|
|
@ -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
|
|
@ -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
|
|
@ -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"
|
||||
}
|
|
@ -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
|
||||
}
|
|
@ -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
|
|
@ -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}
|
|
@ -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")
|
||||
]
|
|
@ -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"
|
||||
}
|
|
@ -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 = []
|
||||
}
|
|
@ -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)
|
||||
]
|
|
@ -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
|
||||
]
|
|
@ -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" </>)
|
|
@ -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]
|
|
@ -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]
|
|
@ -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]
|
|
@ -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">
|
|
@ -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">
|
|
@ -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">
|
|
@ -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's a test"><meta property="og:site_name" content="The Test Blog">
|
|
@ -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">
|
|
@ -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">
|
|
@ -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's a test"><meta property="og:image" content="https://test.net/test.png"><meta property="og:site_name" content="The Test Blog">
|
Loading…
Reference in New Issue