Compare commits
10 commits
main
...
link-to-rs
| Author | SHA1 | Date | |
|---|---|---|---|
| 3cda3fb5ae | |||
| 5c2ac28ce9 | |||
| 58d2f3c1c2 | |||
| e180fef293 | |||
| e136b97746 | |||
| 049576154a | |||
| 2a7d721a35 | |||
| 107a9767ab | |||
| 6c70281e3f | |||
| 3c19a2c568 |
77 changed files with 746 additions and 1686 deletions
11
CHANGELOG.md
11
CHANGELOG.md
|
|
@ -1,16 +1,5 @@
|
||||||
# Revision history for hablo
|
# Revision history for hablo
|
||||||
|
|
||||||
## 1.1.0.1 -- 2021-01-20
|
|
||||||
|
|
||||||
* Ensure compilation on Nix as far as 18.09
|
|
||||||
* Fix missing metadata when landing on articles
|
|
||||||
|
|
||||||
## 1.1.0.0 -- 2020-12-13
|
|
||||||
|
|
||||||
* Implement static pages
|
|
||||||
* Implement RSS feeds
|
|
||||||
* Use SJW to pack JS into a single script and simplify deployment
|
|
||||||
|
|
||||||
## 1.0.3.0 -- 2019-12-21
|
## 1.0.3.0 -- 2019-12-21
|
||||||
|
|
||||||
* Fix OpenGraph cards displayed for links to hablo-generated pages posted on the Fediverse (should work elsewhere too but I don't care and have never tested)
|
* Fix OpenGraph cards displayed for links to hablo-generated pages posted on the Fediverse (should work elsewhere too but I don't care and have never tested)
|
||||||
|
|
|
||||||
22
README.md
22
README.md
|
|
@ -20,16 +20,6 @@ cabal new-install hablo
|
||||||
|
|
||||||
Alternatively, if you prefer to do things yourself you can do a
|
Alternatively, if you prefer to do things yourself you can do a
|
||||||
|
|
||||||
#### Simple install with nix
|
|
||||||
|
|
||||||
Want to give hablo a quick try using nix ?
|
|
||||||
|
|
||||||
```bash
|
|
||||||
nix-env -f 'https://git.marvid.fr/Tissevert/mynixpkgs/archive/main.tar.gz' -i hablo
|
|
||||||
```
|
|
||||||
|
|
||||||
Visit my [Nix packages](https://git.marvid.fr/Tissevert/mynixpkgs) for a more declarative setup.
|
|
||||||
|
|
||||||
#### Manual install from this repository
|
#### Manual install from this repository
|
||||||
|
|
||||||
Get a copy of this repository
|
Get a copy of this repository
|
||||||
|
|
@ -50,18 +40,6 @@ Install the result
|
||||||
cabal new-install hablo
|
cabal new-install hablo
|
||||||
```
|
```
|
||||||
|
|
||||||
### Dependencies
|
|
||||||
|
|
||||||
Hablo requires [UnitJS](https://git.marvid.fr/Tissevert/UnitJS) which is handled by [SJW](https://git.marvid.fr/Tissevert/SJW). Make sure you have installed it regularly with `SJW`. If it isn't yet, the following commands should help you:
|
|
||||||
|
|
||||||
```bash
|
|
||||||
cd /tmp
|
|
||||||
git clone https://git.marvid.fr/Tissevert/UnitJS.git
|
|
||||||
cd UnitJS
|
|
||||||
mkdir -p ~/.sjw
|
|
||||||
cp -r src/ ~/.sjw/unitJS
|
|
||||||
```
|
|
||||||
|
|
||||||
### Using hablo (tutorials)
|
### Using hablo (tutorials)
|
||||||
|
|
||||||
Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog)
|
Wanna give it a try ? Start by [generating your blog](https://git.marvid.fr/Tissevert/hablo/wiki/Generating%20your%20blog)
|
||||||
|
|
|
||||||
|
|
@ -32,8 +32,6 @@ hablo --articles turtles /path/to/your/blog
|
||||||
|
|
||||||
See ? It was still `turtles` and not ~~`/path/to/your/blog/turtles`~~.
|
See ? It was still `turtles` and not ~~`/path/to/your/blog/turtles`~~.
|
||||||
|
|
||||||
Also note that articles are partly optional : you can use hablo to generate a website with a fix content and no articles. In that case, just make sure no directory named `articles/` exists at the root of your website (see [pages](#pages-path)) and keep in mind that it should have static pages (hablo, just like other famous entities should not be invoked in vain and will exit in error suspecting something went wrong when invoked on an empty website with no articles and no pages, which to it means nothing to do).
|
|
||||||
|
|
||||||
## Banner
|
## Banner
|
||||||
|
|
||||||
`-b, --banner`
|
`-b, --banner`
|
||||||
|
|
@ -43,7 +41,7 @@ By default hablo will generate a very simple banner for your blog with its name
|
||||||
The banner is processed when your blog is generated so it's not relative to the root of your blog, the banner file can totally be outside of your blog structure.
|
The banner is processed when your blog is generated so it's not relative to the root of your blog, the banner file can totally be outside of your blog structure.
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
hablo --banner /my/set/of/banners/turtles.html /path/to/your/blog
|
hablo --banner /my/set/of/banner/turtles.html /path/to/your/blog
|
||||||
```
|
```
|
||||||
|
|
||||||
## Card image
|
## Card image
|
||||||
|
|
@ -118,25 +116,11 @@ hablo --name "Turtles/Paradize"
|
||||||
|
|
||||||
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).
|
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
|
## Pages
|
||||||
|
|
||||||
`-p, --pages`
|
`-p, --pages`
|
||||||
|
|
||||||
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.
|
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.
|
||||||
|
|
||||||
So if for instance your blog is for a community of authors and a presentation of each of them is all you want to publish as «static» content, you could have this directory called «authors» and run `hablo` like this :
|
|
||||||
|
|
||||||
```bash
|
|
||||||
hablo --pages authors
|
|
||||||
```
|
|
||||||
|
|
||||||
This option is very similar to the one for [articles](#articles-path). Like the articles path, the pages path is of course relative to the blog's root. Pages are also partly optional : you don't have to have static pages in your blog in which case you should just make sure no directory named `pages/` exists at the root of your website and you have articles (because like we said above hablo is highly suspicious of being invoked to perform no work and will suspect this is a mistake and report it as an error).
|
|
||||||
|
|
||||||
Final tip : if you're using hablo to edit a static website with no articles, then you probably don't want to put your pages in a sub-directory but have them at the root of your website instead. This is possible, just remember that the current directory is called `.` in UNIX and run :
|
|
||||||
|
|
||||||
```bash
|
|
||||||
hablo -p .
|
|
||||||
```
|
|
||||||
|
|
||||||
## Number of articles previewed
|
## Number of articles previewed
|
||||||
|
|
||||||
|
|
@ -170,7 +154,7 @@ The file is read by hablo when the blog is generated and its content gets includ
|
||||||
|
|
||||||
`-R, --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.
|
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 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).
|
Note that this feature requires setting your site URL with [`--site-url`](#site-url).
|
||||||
|
|
||||||
|
|
@ -186,7 +170,7 @@ Note that this is purely optional and you don't have to use this option if you d
|
||||||
|
|
||||||
`-w, --wording`
|
`-w, --wording`
|
||||||
|
|
||||||
This option makes hablo look for the value of the texts used to [generate the pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%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.
|
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.
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
hablo --wording /blogs/translations/fr-ca.conf /path/to/your/blog
|
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 ?
|
## How do I activate comments on my blog ?
|
||||||
|
|
||||||
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.
|
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.
|
||||||
|
|
||||||
Let's say you published an article, tell people about it from your fediverse instance by posting a link to that article. First, we need to find the status [`id`](https://docs.joinmastodon.org/api/entities#status) of your post.
|
Let's say you published an article, tell people about it from your fediverse instance by posting a link to that article. First, we need to find the status [`id`](https://docs.joinmastodon.org/api/entities#status) of your post.
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# Deployment
|
# Deployment
|
||||||
|
|
||||||
Since hablo generates static blogs, deployment is a fairly easy step. The only detail to pay attention to is the handling of JS dependencies.
|
Since hablo generates static blogs, deployment is a fairly easy step. The only detail to pay attention to is the handling of dependencies.
|
||||||
|
|
||||||
We show here a simple local deployment of your blog assuming you use NGinx but this is fairly easy to transpose to your favourite web server. First let's create an NGinx configuration file for your blog. Let's put the following basic configuration
|
We show here a simple local deployment of your blog assuming you use NGinx but this is fairly easy to transpose to your favourite web server. First let's create an NGinx configuration file for your blog. Let's put the following basic configuration
|
||||||
|
|
||||||
|
|
@ -29,11 +29,30 @@ sudo nginx -s reload
|
||||||
|
|
||||||
Now let's install the dependencies.
|
Now let's install the dependencies.
|
||||||
|
|
||||||
|
## UnitJS
|
||||||
|
|
||||||
|
Hablo requires [UnitJS](https://git.marvid.fr/Tissevert/UnitJS). Go to some temporary work directory, clone it and generate the packed JS module.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd /tmp
|
||||||
|
git clone https://git.marvid.fr/Tissevert/UnitJS.git
|
||||||
|
cd UnitJS
|
||||||
|
make
|
||||||
|
```
|
||||||
|
|
||||||
|
It's in `dist/unit.js`. Let's go back to your blog's directory and copy it.
|
||||||
|
|
||||||
|
```bash
|
||||||
|
cd "/path/to/My perfect life is better than yours"
|
||||||
|
mkdir -p js
|
||||||
|
cp /tmp/UnitJS/dist/unit.js js
|
||||||
|
```
|
||||||
|
|
||||||
## Remarkable
|
## Remarkable
|
||||||
|
|
||||||
The markdown is converted to HTML in the client browser with the JS library [remarkable](https://github.com/jonschlinkert/remarkable).
|
The markdown is converted to HTML in the client browser with the JS library [remarkable](https://github.com/jonschlinkert/remarkable).
|
||||||
|
|
||||||
We can simply download it in the `js` subdirectory of your blog hablo created when you first invoked it.
|
We can simply download it in your `js` directory.
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
wget 'https://cdnjs.cloudflare.com/ajax/libs/remarkable/1.7.1/remarkable.min.js' -O js/remarkable.min.js
|
wget 'https://cdnjs.cloudflare.com/ajax/libs/remarkable/1.7.1/remarkable.min.js' -O js/remarkable.min.js
|
||||||
|
|
|
||||||
|
|
@ -25,7 +25,7 @@ EOF
|
||||||
|
|
||||||
Ok, ok, not everyone uses heredocs to write their articles. Personally I don't. You're writing a blog so you probably already have a favourite text editor; use it. The only thing I care about is, at this point, that you've created the file `Olive\ ridley\ sea\ turtle.md` in the `articles` directory with some markdown content in it.
|
Ok, ok, not everyone uses heredocs to write their articles. Personally I don't. You're writing a blog so you probably already have a favourite text editor; use it. The only thing I care about is, at this point, that you've created the file `Olive\ ridley\ sea\ turtle.md` in the `articles` directory with some markdown content in it.
|
||||||
|
|
||||||
Ready ? Good news, we're almost done. The only thing left is to tag your first article. With hablo articles don't have to be put in a single category but they can be tagged this and that to indicate that they are somehow linked to one topic or another (they don't have to, you can perfectly leave an article untagged). 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 but the tags directory itself must exist). Tags live in a subdirectory of `articles`.
|
||||||
|
|
||||||
```bash
|
```bash
|
||||||
mkdir -p articles/tags/Sea\ turtles
|
mkdir -p articles/tags/Sea\ turtles
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,6 @@
|
||||||
# Metadata
|
# Metadata
|
||||||
|
|
||||||
Markdown articles are rendered as late as possible into HTML, even the [article pages](https://git.marvid.fr/Tissevert/hablo/wiki/Architectural%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.
|
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.
|
||||||
|
|
||||||
## Format
|
## Format
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ All template variables are checked at «[compile-time](https://git.marvid.fr/Tis
|
||||||
|
|
||||||
## Conditional blocks
|
## Conditional blocks
|
||||||
|
|
||||||
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 :
|
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}?}
|
allPage = The articles{? about ${tag}?}
|
||||||
|
|
|
||||||
|
|
@ -1,27 +0,0 @@
|
||||||
(use-modules (gnu packages haskell-xyz)
|
|
||||||
(gnu packages haskell-web)
|
|
||||||
(guix build-system haskell)
|
|
||||||
(guix download)
|
|
||||||
(guix gexp)
|
|
||||||
(guix git-download)
|
|
||||||
(guix licenses)
|
|
||||||
(guix packages))
|
|
||||||
|
|
||||||
(package
|
|
||||||
(name "ghc-template")
|
|
||||||
(version "0.2.0.10")
|
|
||||||
(source (origin
|
|
||||||
(method url-fetch)
|
|
||||||
(uri (hackage-uri "template" version))
|
|
||||||
(sha256
|
|
||||||
(base32
|
|
||||||
"10mcnhi2rdflmv79z0359nn5sylifvk9ih38xnjqqby6n4hs7mcg"))))
|
|
||||||
(build-system haskell-build-system)
|
|
||||||
(properties '((upstream-name . "template")))
|
|
||||||
(home-page "http://hackage.haskell.org/package/template")
|
|
||||||
(synopsis "Simple string substitution")
|
|
||||||
(description
|
|
||||||
"Simple string substitution library that supports \\\"$\\\"-based substitution.
|
|
||||||
Meant to be used when Text.Printf or string concatenation would lead to code
|
|
||||||
that is hard to read but when a full blown templating system is overkill.")
|
|
||||||
(license bsd-3))
|
|
||||||
44
guix.scm
44
guix.scm
|
|
@ -1,44 +0,0 @@
|
||||||
(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+)))
|
|
||||||
72
hablo.cabal
72
hablo.cabal
|
|
@ -3,16 +3,16 @@ cabal-version: >= 1.10
|
||||||
-- For further documentation, see http://haskell.org/cabal/users-guide/
|
-- For further documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
name: hablo
|
name: hablo
|
||||||
version: 1.1.0.1
|
version: 1.0.3.0
|
||||||
synopsis: A minimalist static blog generator
|
synopsis: A minimalist static blog generator
|
||||||
description:
|
description:
|
||||||
Hablo is a fediverse-oriented static blog generator for articles written
|
Hablo is a fediverse-oriented static blog generator for articles written
|
||||||
in Markdown. It tries to generate as little HTML as needed and uses
|
in Markdown. It tries to generate as little HTML as needed and uses
|
||||||
Javascript to implement dynamic features in the browser.
|
Javascript to implement dynamic features in the browser.
|
||||||
|
|
||||||
Those features include the handling of comments and a cached navigation to
|
Those features include the handling of comments and a cached navigation
|
||||||
minimize the number of queries to the server. Hablo also generates RSS feeds
|
to minimize the queries to the server. Hablo also generate cards for all
|
||||||
and Open Graph cards for prettier shares on social networks.
|
pages, including articles for prettier shares on social-networks.
|
||||||
homepage: https://git.marvid.fr/Tissevert/hablo
|
homepage: https://git.marvid.fr/Tissevert/hablo
|
||||||
-- bug-reports:
|
-- bug-reports:
|
||||||
license: BSD3
|
license: BSD3
|
||||||
|
|
@ -27,8 +27,9 @@ data-dir: share
|
||||||
data-files: js/*.js
|
data-files: js/*.js
|
||||||
defaultWording.conf
|
defaultWording.conf
|
||||||
|
|
||||||
library
|
executable hablo
|
||||||
exposed-modules: Arguments
|
main-is: Main.hs
|
||||||
|
other-modules: Arguments
|
||||||
, Article
|
, Article
|
||||||
, ArticlesList
|
, ArticlesList
|
||||||
, Blog
|
, Blog
|
||||||
|
|
@ -44,69 +45,24 @@ library
|
||||||
, HTML
|
, HTML
|
||||||
, JS
|
, JS
|
||||||
, JSON
|
, JSON
|
||||||
, Markdown
|
|
||||||
, Page
|
|
||||||
, Paths_hablo
|
, Paths_hablo
|
||||||
, Pretty
|
, Pretty
|
||||||
, RSS
|
, RSS
|
||||||
-- other-extensions:
|
-- other-extensions:
|
||||||
build-depends: aeson >= 1.2.0 && < 2.1
|
build-depends: aeson >= 1.4.0 && < 1.5
|
||||||
, base >= 4.9.1 && < 4.17
|
, base >= 4.9.1 && < 4.13
|
||||||
, bytestring >= 0.10.8 && < 0.12
|
, bytestring >= 0.10.8 && < 0.11
|
||||||
, containers >= 0.5.11 && < 0.7
|
, containers >= 0.5.11 && < 0.7
|
||||||
, directory >= 1.3.1 && < 1.4
|
, directory >= 1.3.1 && < 1.4
|
||||||
, filepath >= 1.4.2 && < 1.5
|
, filepath >= 1.4.2 && < 1.5
|
||||||
, lucid >= 2.8.0 && < 2.12
|
, lucid >= 2.9.11 && < 2.10
|
||||||
, mtl >= 2.2.2 && < 2.3
|
, mtl >= 2.2.2 && < 2.3
|
||||||
, optparse-applicative >= 0.14.0 && < 0.18
|
, optparse-applicative >= 0.14.3 && < 0.16
|
||||||
, parsec >= 3.1.13 && < 3.2
|
, parsec >= 3.1.13 && < 3.2
|
||||||
, template >= 0.2.0 && < 0.3
|
, template >= 0.2.0 && < 0.3
|
||||||
, text >= 1.2.3 && < 1.3
|
, text >= 1.2.3 && < 1.3
|
||||||
, time >= 1.8.0 && < 1.12
|
, time >= 1.8.0 && < 1.9
|
||||||
, SJW >= 0.1.2 && < 0.2
|
|
||||||
, unix >= 2.7.2 && < 2.8
|
, unix >= 2.7.2 && < 2.8
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall -dynamic
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable hablo
|
|
||||||
main-is: src/Main.hs
|
|
||||||
other-modules: Paths_hablo
|
|
||||||
-- other-extensions:
|
|
||||||
build-depends: base
|
|
||||||
, hablo
|
|
||||||
, mtl >= 2.2.2 && < 2.3
|
|
||||||
ghc-options: -Wall
|
|
||||||
default-language: Haskell2010
|
|
||||||
|
|
||||||
test-suite tests
|
|
||||||
type: detailed-0.9
|
|
||||||
test-module: Tests
|
|
||||||
other-modules: Mock.Arguments
|
|
||||||
, Mock.Article
|
|
||||||
, Mock.ArticlesList
|
|
||||||
, Mock.Blog
|
|
||||||
, Mock.Blog.Path
|
|
||||||
, Mock.Blog.Skin
|
|
||||||
, Mock.Blog.Template
|
|
||||||
, Mock.Blog.URL
|
|
||||||
, Mock.Blog.Wording
|
|
||||||
, Mock.Collection
|
|
||||||
, Mock.Markdown
|
|
||||||
, Structure
|
|
||||||
, Utils
|
|
||||||
, XML.Card
|
|
||||||
, XML.Card.Component
|
|
||||||
, XML.Card.Output
|
|
||||||
build-depends: base
|
|
||||||
, Cabal
|
|
||||||
, containers
|
|
||||||
, directory
|
|
||||||
, filepath
|
|
||||||
, hablo
|
|
||||||
, lucid
|
|
||||||
, mtl
|
|
||||||
, text
|
|
||||||
hs-source-dirs: test
|
|
||||||
ghc-options: -Wall
|
|
||||||
default-language: Haskell2010
|
|
||||||
|
|
|
||||||
|
|
@ -1,14 +1,11 @@
|
||||||
allLink = See all
|
allLink = See all
|
||||||
allPage = All articles{? tagged ${tag}?}
|
allPage = All articles{? tagged ${tag}?}
|
||||||
articleDescription = A new article on ${name}
|
|
||||||
commentsLink = Comment on the fediverse
|
commentsLink = Comment on the fediverse
|
||||||
commentsSection = Comments
|
commentsSection = Comments
|
||||||
dateFormat = en-US
|
dateFormat = en-US
|
||||||
latestLink = See only latest
|
latestLink = See only latest
|
||||||
latestPage = Latest articles{? tagged ${tag}?}
|
latestPage = Latest articles{? tagged ${tag}?}
|
||||||
metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
|
metadata = {?by ${author} ?}on ${date}{? tagged ${tags}?}
|
||||||
pageDescription = Read on ${name}
|
|
||||||
pagesList = Pages
|
|
||||||
rssLink = Subscribe
|
rssLink = Subscribe
|
||||||
rssTitle = Follow all articles{? tagged ${tag}?}
|
rssTitle = Follow all articles{? tagged ${tag}?}
|
||||||
tagsList = Tags
|
tagsList = Tags
|
||||||
|
|
|
||||||
|
|
@ -1,143 +0,0 @@
|
||||||
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]);});
|
|
||||||
}
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
import replaceMarkdown from DomRenderer;
|
|
||||||
import hijackLinks from Navigation;
|
|
||||||
|
|
||||||
replaceMarkdown();
|
|
||||||
hijackLinks();
|
|
||||||
|
|
@ -1,159 +0,0 @@
|
||||||
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)
|
|
||||||
})
|
|
||||||
});
|
|
||||||
}
|
|
||||||
|
|
@ -1,121 +0,0 @@
|
||||||
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);
|
|
||||||
})
|
|
||||||
)
|
|
||||||
);
|
|
||||||
}
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
import remarkableConfig from Hablo.Config;
|
|
||||||
|
|
||||||
var md = new Remarkable(remarkableConfig);
|
|
||||||
md.block.ruler.enable(['footnote']);
|
|
||||||
|
|
||||||
return {
|
|
||||||
md: md
|
|
||||||
};
|
|
||||||
|
|
@ -1,35 +0,0 @@
|
||||||
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;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
106
share/js/domRenderer.js
Normal file
106
share/js/domRenderer.js
Normal file
|
|
@ -0,0 +1,106 @@
|
||||||
|
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) {
|
||||||
|
return modules.template.render(all ? 'allPage' : 'latestPage', {tag: tag});
|
||||||
|
}
|
||||||
|
|
||||||
|
function otherUrl(tag, all) {
|
||||||
|
return '/' + (tag || '') + (all ? '/' : '/all.html');
|
||||||
|
}
|
||||||
|
|
||||||
|
function articlesList(tag, all) {
|
||||||
|
return function(articlePreviews) {
|
||||||
|
return [
|
||||||
|
modules.dom.make('h2', {innerText: pageTitle(tag, all)}),
|
||||||
|
modules.dom.make('ul', {}, articlesListLinks(tag, all)),
|
||||||
|
modules.dom.make('div', {class: 'articles'},
|
||||||
|
articlePreviews.filter(modules.fun.defined)
|
||||||
|
)
|
||||||
|
];
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
function articlesListLinks(tag, all) {
|
||||||
|
var links = [
|
||||||
|
modules.dom.make('a', {
|
||||||
|
innerText: all ? blog.wording.latestLink : blog.wording.allLink,
|
||||||
|
href: otherUrl(tag, all),
|
||||||
|
class: 'other'
|
||||||
|
})
|
||||||
|
];
|
||||||
|
if(blog.hasRSS) {
|
||||||
|
links.unshift(modules.dom.make('a', {
|
||||||
|
innerText: blog.wording.rssLink,
|
||||||
|
href: 'rss.xml',
|
||||||
|
class: 'RSS',
|
||||||
|
title: modules.template.render('rssTitle', {tag: tag})
|
||||||
|
}));
|
||||||
|
}
|
||||||
|
return links.map(function(e) {return modules.dom.make('li', {}, [e]);});
|
||||||
|
}
|
||||||
|
}
|
||||||
14
share/js/main.js
Normal file
14
share/js/main.js
Normal file
|
|
@ -0,0 +1,14 @@
|
||||||
|
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();
|
||||||
|
});
|
||||||
155
share/js/metadata.js
Normal file
155
share/js/metadata.js
Normal file
|
|
@ -0,0 +1,155 @@
|
||||||
|
function Metadata(modules) {
|
||||||
|
var comments = modules.cache.make(function(threadId) {
|
||||||
|
return modules.async.bind(
|
||||||
|
modules.async.parallel(
|
||||||
|
getJSON(url(threadId)),
|
||||||
|
getJSON(url(threadId) + '/context'),
|
||||||
|
),
|
||||||
|
modules.async.map(function(t) {
|
||||||
|
return [renderLink(t[0]), renderAnswers(t[1])];
|
||||||
|
})
|
||||||
|
);
|
||||||
|
});
|
||||||
|
return {
|
||||||
|
get: get,
|
||||||
|
getComments: getComments
|
||||||
|
};
|
||||||
|
|
||||||
|
function url(threadId) {
|
||||||
|
return blog.urls.comments + '/api/v1/statuses/' + threadId;
|
||||||
|
}
|
||||||
|
|
||||||
|
function getJSON(url) {
|
||||||
|
return modules.async.bind(
|
||||||
|
modules.async.http({method: 'GET', url: url}),
|
||||||
|
function(queryResult) {
|
||||||
|
if(queryResult.status == 200) {
|
||||||
|
try {
|
||||||
|
return modules.async.wrap(JSON.parse(queryResult.responseText));
|
||||||
|
} catch(e) {
|
||||||
|
return modules.async.fail('Server returned invalid JSON for ' + url);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
return modules.async.fail('Could not load page ' + url);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
function getComments(articleKey) {
|
||||||
|
var threadId = blog.articles[articleKey].metadata.comments;
|
||||||
|
if(blog.urls.comments != undefined && threadId != undefined) {
|
||||||
|
var ul = modules.dom.make('ul');
|
||||||
|
var div = emptySection(ul);
|
||||||
|
modules.async.run(
|
||||||
|
modules.async.bind(
|
||||||
|
comments.get(threadId), modules.async.map(populateComments(div, ul))
|
||||||
|
)
|
||||||
|
);
|
||||||
|
return [div];
|
||||||
|
} else {
|
||||||
|
return [];
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function populateComments(div, ul) {
|
||||||
|
return function(apiResults) {
|
||||||
|
var post = apiResults[0], comments = apiResults[1];
|
||||||
|
div.appendChild(post);
|
||||||
|
comments.forEach(function(comment) {ul.appendChild(comment);});
|
||||||
|
};
|
||||||
|
}
|
||||||
|
|
||||||
|
function emptySection(ul) {
|
||||||
|
return modules.dom.make('div', {class: 'comments'}, [
|
||||||
|
modules.dom.make('h2', {innerText: blog.wording.commentsSection}),
|
||||||
|
ul
|
||||||
|
]);
|
||||||
|
}
|
||||||
|
|
||||||
|
function renderLink(post) {
|
||||||
|
return modules.dom.make('a', {
|
||||||
|
href: post.url,
|
||||||
|
innerText: blog.wording.commentsLink
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function getContent(descendant) {
|
||||||
|
return descendant.content.replace(/:([^: ]+):/g, function(pattern, shortcode) {
|
||||||
|
var emoji = descendant.emojis.find(function(e) {return e.shortcode == shortcode;});
|
||||||
|
if(emoji) {
|
||||||
|
return [
|
||||||
|
'<img title=', shortcode, ' alt=', shortcode, ' src=', emoji.url, ' class="emoji"/>'
|
||||||
|
].join('"');
|
||||||
|
} else {
|
||||||
|
return pattern;
|
||||||
|
}
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function renderAnswers(comments) {
|
||||||
|
return comments.descendants.map(function(descendant) {
|
||||||
|
return modules.dom.make('li', {}, [
|
||||||
|
modules.dom.make('a', {href: descendant.account.url}, [
|
||||||
|
modules.dom.make('img', {
|
||||||
|
src: descendant.account.avatar,
|
||||||
|
alt: descendant.account.username + "'s profile picture"
|
||||||
|
})
|
||||||
|
]),
|
||||||
|
modules.dom.make('div', {
|
||||||
|
class: "metadata",
|
||||||
|
innerHTML: modules.template.render('metadata', {
|
||||||
|
author: author(descendant.account.url, descendant.account.username),
|
||||||
|
date: date(descendant.created_at)
|
||||||
|
})
|
||||||
|
}),
|
||||||
|
modules.dom.make('div', {innerHTML: getContent(descendant)})
|
||||||
|
]);
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
function author(key, name) {
|
||||||
|
var authorUrl = key;
|
||||||
|
if(blog.articles[key] != undefined) {
|
||||||
|
authorUrl = blog.articles[key].metadata.author;
|
||||||
|
}
|
||||||
|
if(authorUrl) {
|
||||||
|
var author = name || authorUrl.replace(/.*\//, '');
|
||||||
|
return '<a href="' + authorUrl + '">' + author + '</a>';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function date(key) {
|
||||||
|
if(blog.articles[key] != undefined) {
|
||||||
|
var date = new Date(blog.articles[key].metadata.date * 1000);
|
||||||
|
} else {
|
||||||
|
var date = new Date(key);
|
||||||
|
}
|
||||||
|
var format = blog.wording.dateFormat;
|
||||||
|
if(format[0] != '[') {
|
||||||
|
if(format[0] != '"') {
|
||||||
|
format = '"' + format + '"';
|
||||||
|
}
|
||||||
|
format = '[' + format + ']';
|
||||||
|
}
|
||||||
|
return Date.prototype.toLocaleDateString.apply(date, JSON.parse(format));
|
||||||
|
}
|
||||||
|
|
||||||
|
function tags(key) {
|
||||||
|
var tags = blog.articles[key].tagged;
|
||||||
|
return tags.length < 1 ? null : tags.map(function(tag) {
|
||||||
|
return '<a class="tag" href="/' + tag + '">' + tag + '</a>';
|
||||||
|
}).join(', ');
|
||||||
|
}
|
||||||
|
|
||||||
|
function get(key) {
|
||||||
|
return modules.dom.make('div', {
|
||||||
|
class: "metadata",
|
||||||
|
innerHTML: modules.template.render('metadata', {
|
||||||
|
author: author(key),
|
||||||
|
date: date(key),
|
||||||
|
tags: tags(key)
|
||||||
|
})
|
||||||
|
});
|
||||||
|
}
|
||||||
|
}
|
||||||
117
share/js/navigation.js
Normal file
117
share/js/navigation.js
Normal file
|
|
@ -0,0 +1,117 @@
|
||||||
|
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);
|
||||||
|
})
|
||||||
|
)
|
||||||
|
);
|
||||||
|
}
|
||||||
|
}
|
||||||
35
share/js/template.js
Normal file
35
share/js/template.js
Normal file
|
|
@ -0,0 +1,35 @@
|
||||||
|
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,12 +1,9 @@
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
module Arguments (
|
module Arguments (
|
||||||
Arguments(..)
|
Arguments(..)
|
||||||
, get
|
, get
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#if !MIN_VERSION_base(4,11,0)
|
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
#endif
|
|
||||||
import Data.Version (showVersion)
|
import Data.Version (showVersion)
|
||||||
import Control.Applicative ((<|>), (<**>), optional)
|
import Control.Applicative ((<|>), (<**>), optional)
|
||||||
import Options.Applicative (
|
import Options.Applicative (
|
||||||
|
|
@ -19,7 +16,7 @@ import System.FilePath (dropTrailingPathSeparator, isValid)
|
||||||
|
|
||||||
data Arguments = BlogConfig {
|
data Arguments = BlogConfig {
|
||||||
sourceDir :: FilePath
|
sourceDir :: FilePath
|
||||||
, articlesPath :: Maybe FilePath
|
, articlesPath :: FilePath
|
||||||
, bannerPath :: Maybe FilePath
|
, bannerPath :: Maybe FilePath
|
||||||
, cardImage :: Maybe FilePath
|
, cardImage :: Maybe FilePath
|
||||||
, commentsURL :: Maybe String
|
, commentsURL :: Maybe String
|
||||||
|
|
@ -50,8 +47,13 @@ option readM aShort aLong aMetavar aHelpMessage =
|
||||||
blogConfig :: Parser Arguments
|
blogConfig :: Parser Arguments
|
||||||
blogConfig = BlogConfig
|
blogConfig = BlogConfig
|
||||||
<$> argument filePath (value "." <> metavar "INPUT_DIR")
|
<$> argument filePath (value "." <> metavar "INPUT_DIR")
|
||||||
<*> option filePath 'a' "articles" "DIRECTORY"
|
<*> Optparse.option filePath (
|
||||||
"relative path to the directory containing the articles within INPUT_DIR"
|
metavar "DIRECTORY"
|
||||||
|
<> value "articles"
|
||||||
|
<> short 'a'
|
||||||
|
<> long "articles"
|
||||||
|
<> help "relative path to the directory containing the articles within INPUT_DIR"
|
||||||
|
)
|
||||||
<*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner"
|
<*> option filePath 'b' "banner" "FILE" "path to the file to use for the blog's banner"
|
||||||
<*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
|
<*> option filePath 'c' "card-image" "FILE" "relative path to the image to use for the blog's card"
|
||||||
<*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored"
|
<*> option filePath 'C' "comments-url" "URL" "URL of the instance where comments are stored"
|
||||||
|
|
@ -59,8 +61,8 @@ blogConfig = BlogConfig
|
||||||
<*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
|
<*> option filePath 'H' "head" "FILE" "path to the file to add in the blog's head"
|
||||||
<*> option str 'n' "name" "BLOG_NAME" "name of the blog"
|
<*> option str 'n' "name" "BLOG_NAME" "name of the blog"
|
||||||
<*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
|
<*> switch (short 'O' <> long "open-graph-cards" <> help "enable Open Graph cards")
|
||||||
<*> option filePath 'p' "pages" "DIRECTORY"
|
<*> option filePath 'p' "pages"
|
||||||
"relative path to the directory containing the pages within INPUT_DIR"
|
"DIRECTORY" "relative path to the directory containing the pages within INPUT_DIR"
|
||||||
<*> Optparse.option auto (
|
<*> Optparse.option auto (
|
||||||
metavar "INTEGER"
|
metavar "INTEGER"
|
||||||
<> value 3
|
<> value 3
|
||||||
|
|
|
||||||
|
|
@ -1,23 +1,75 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
module Article (
|
module Article (
|
||||||
Article(..)
|
Article(..)
|
||||||
, at
|
, at
|
||||||
|
, getKey
|
||||||
, preview
|
, preview
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
import qualified Data.Map as Map (alter)
|
import Data.Map (Map)
|
||||||
|
import qualified Data.Map as Map (fromList, alter)
|
||||||
import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
|
import Data.Time (defaultTimeLocale, getCurrentTimeZone, parseTimeM, timeZoneOffsetString)
|
||||||
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
||||||
import Foreign.C.Types (CTime)
|
import Foreign.C.Types (CTime)
|
||||||
import Markdown (Markdown(..), MarkdownContent(..), Metadata)
|
import System.FilePath (dropExtension, takeFileName)
|
||||||
import qualified Markdown (at)
|
|
||||||
import System.Posix.Files (getFileStatus, modificationTime)
|
import System.Posix.Files (getFileStatus, modificationTime)
|
||||||
import Text.ParserCombinators.Parsec (ParseError)
|
import Text.ParserCombinators.Parsec (
|
||||||
|
ParseError
|
||||||
|
, Parser
|
||||||
|
, (<?>)
|
||||||
|
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
|
||||||
|
, oneOf, option, parse, skipMany, sourceLine, string, try
|
||||||
|
)
|
||||||
|
|
||||||
newtype Article = Article Markdown
|
type Metadata = Map String String
|
||||||
instance MarkdownContent Article where
|
|
||||||
getMarkdown (Article markdown) = markdown
|
data Article = Article {
|
||||||
|
key :: String
|
||||||
|
, title :: String
|
||||||
|
, metadata :: Metadata
|
||||||
|
, bodyOffset :: Int
|
||||||
|
, body :: [String]
|
||||||
|
}
|
||||||
|
|
||||||
|
type ProtoArticle = (String, Metadata, Int, [String])
|
||||||
|
|
||||||
|
articleP :: Parser ProtoArticle
|
||||||
|
articleP =
|
||||||
|
skipMany eol *> headerP <* skipMany eol <*> lineOffset <*> bodyP
|
||||||
|
where
|
||||||
|
headerP =
|
||||||
|
try ((,,,) <$> titleP <* many eol <*> metadataP)
|
||||||
|
<|> flip (,,,) <$> metadataP <* many eol<*> titleP
|
||||||
|
lineOffset = pred . sourceLine <$> getPosition
|
||||||
|
bodyP = lines <$> many anyChar <* eof
|
||||||
|
|
||||||
|
metadataP :: Parser Metadata
|
||||||
|
metadataP = Map.fromList <$> option [] (
|
||||||
|
metaSectionSeparator *> many eol *>
|
||||||
|
(try keyVal) `endBy` (many1 eol)
|
||||||
|
<* metaSectionSeparator
|
||||||
|
) <?> "metadata section"
|
||||||
|
where
|
||||||
|
metaSectionSeparator = count 3 (oneOf "~-") *> eol
|
||||||
|
spaces = skipMany $ char ' '
|
||||||
|
keyVal = (,) <$> (no ": \r\n" <* spaces <* char ':' <* spaces) <*> no "\r\n"
|
||||||
|
|
||||||
|
titleP :: Parser String
|
||||||
|
titleP = try (singleLine <|> underlined)
|
||||||
|
where
|
||||||
|
singleLine = char '#' *> char ' ' *> no "\r\n" <* eol
|
||||||
|
underlined =
|
||||||
|
no "\r\n" <* eol
|
||||||
|
>>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
|
||||||
|
<?> "'#' or '=' to underline the title"
|
||||||
|
|
||||||
|
eol :: Parser String
|
||||||
|
eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
|
||||||
|
|
||||||
|
no :: String -> Parser String
|
||||||
|
no = many1 . noneOf
|
||||||
|
|
||||||
setDate :: String -> CTime -> Metadata -> Metadata
|
setDate :: String -> CTime -> Metadata -> Metadata
|
||||||
setDate tzOffset defaultDate = Map.alter timeStamp "date"
|
setDate tzOffset defaultDate = Map.alter timeStamp "date"
|
||||||
|
|
@ -30,16 +82,27 @@ setDate tzOffset defaultDate = Map.alter timeStamp "date"
|
||||||
let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
|
let parsedTimes = parseTimeM True defaultTimeLocale <$> formats <*> dates in
|
||||||
foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
|
foldr (<|>) (timeStamp Nothing) (fmap epoch <$> parsedTimes)
|
||||||
|
|
||||||
makeArticle :: (Metadata -> Metadata) -> Markdown -> (String, Article)
|
makeArticle :: FilePath -> (Metadata -> Metadata) -> ProtoArticle -> (String, Article)
|
||||||
makeArticle metaFilter markdown@(Markdown {key, metadata}) =
|
makeArticle filePath metaFilter (title, metadata, bodyOffset, body) = (
|
||||||
(key, Article $ markdown {metadata = metaFilter metadata})
|
getKey filePath
|
||||||
|
, Article {
|
||||||
|
key = getKey filePath
|
||||||
|
, title
|
||||||
|
, metadata = metaFilter metadata
|
||||||
|
, bodyOffset
|
||||||
|
, body
|
||||||
|
}
|
||||||
|
)
|
||||||
|
|
||||||
at :: FilePath -> IO (Either ParseError (String, Article))
|
at :: FilePath -> IO (Either ParseError (String, Article))
|
||||||
at filePath = do
|
at filePath = do
|
||||||
tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
|
tzOffset <- timeZoneOffsetString <$> getCurrentTimeZone
|
||||||
fileDate <- modificationTime <$> getFileStatus filePath
|
fileDate <- modificationTime <$> getFileStatus filePath
|
||||||
fmap (makeArticle (setDate tzOffset fileDate)) <$> Markdown.at filePath
|
let build = makeArticle filePath (setDate tzOffset fileDate)
|
||||||
|
fmap build . parse articleP filePath <$> readFile filePath
|
||||||
|
|
||||||
preview :: Int -> Article -> Markdown
|
getKey :: FilePath -> String
|
||||||
preview linesCount (Article markdown@(Markdown {body})) =
|
getKey = dropExtension . takeFileName
|
||||||
markdown {body = take linesCount $ body}
|
|
||||||
|
preview :: Int -> Article -> Article
|
||||||
|
preview linesCount article = article {body = take linesCount $ body article}
|
||||||
|
|
|
||||||
56
src/Blog.hs
56
src/Blog.hs
|
|
@ -15,7 +15,7 @@ module Blog (
|
||||||
import Arguments (Arguments)
|
import Arguments (Arguments)
|
||||||
import qualified Arguments (name, sourceDir)
|
import qualified Arguments (name, sourceDir)
|
||||||
import Article (Article)
|
import Article (Article)
|
||||||
import qualified Article (at)
|
import qualified Article (at, getKey)
|
||||||
import Blog.Path (Path(..))
|
import Blog.Path (Path(..))
|
||||||
import qualified Blog.Path as Path (build)
|
import qualified Blog.Path as Path (build)
|
||||||
import Blog.Template (Environment, Templates, render)
|
import Blog.Template (Environment, Templates, render)
|
||||||
|
|
@ -34,28 +34,22 @@ import qualified Data.Map as Map (empty, fromList)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as Set (empty, null, singleton, union)
|
import qualified Data.Set as Set (empty, null, singleton, union)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Files (File(..), filePath)
|
import Files (File(..), absolute)
|
||||||
import qualified Files (find)
|
import qualified Files (find)
|
||||||
import Markdown (getKey)
|
|
||||||
import Page (Page)
|
|
||||||
import qualified Page (at)
|
|
||||||
import Prelude hiding (lookup)
|
import Prelude hiding (lookup)
|
||||||
import Pretty (assertRight, onRight)
|
import System.Directory (doesFileExist, withCurrentDirectory)
|
||||||
import System.Directory (doesFileExist, makeAbsolute, withCurrentDirectory)
|
|
||||||
import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
|
import System.FilePath ((</>), dropTrailingPathSeparator, takeExtension, takeFileName)
|
||||||
import Text.Parsec (ParseError)
|
import Text.Parsec (ParseError)
|
||||||
|
|
||||||
type Collection = Map String
|
type Collection = Map String Article
|
||||||
type Parsed a = Either ParseError (String, a)
|
|
||||||
|
|
||||||
data Blog = Blog {
|
data Blog = Blog {
|
||||||
articles :: Collection Article
|
articles :: Collection
|
||||||
, hasRSS :: Bool
|
, hasRSS :: Bool
|
||||||
, name :: String
|
, name :: String
|
||||||
, pages :: Collection Page
|
|
||||||
, path :: Path
|
, path :: Path
|
||||||
, skin :: Skin
|
, skin :: Skin
|
||||||
, tags :: Collection (Set String)
|
, tags :: Map String (Set String)
|
||||||
, templates :: Templates
|
, templates :: Templates
|
||||||
, urls :: URL
|
, urls :: URL
|
||||||
, wording :: Wording
|
, wording :: Wording
|
||||||
|
|
@ -66,47 +60,41 @@ type Renderer m = (MonadIO m, MonadReader Blog m)
|
||||||
template :: Renderer m => String -> Environment -> m Text
|
template :: Renderer m => String -> Environment -> m Text
|
||||||
template key environment = asks templates >>= render key environment
|
template key environment = asks templates >>= render key environment
|
||||||
|
|
||||||
keepOrWarn :: Collection a -> Parsed a -> IO (Collection a)
|
keepOrWarn :: Map String Article -> Either ParseError (String, Article) -> IO (Map String Article)
|
||||||
keepOrWarn accumulator (Left parseErrors) =
|
keepOrWarn accumulator (Left parseErrors) =
|
||||||
forM [show parseErrors, "=> Ignoring this text"] putStrLn
|
forM [show parseErrors, "=> Ignoring this article"] putStrLn
|
||||||
>> return accumulator
|
>> return accumulator
|
||||||
keepOrWarn accumulator (Right (key, article)) =
|
keepOrWarn accumulator (Right (key, article)) =
|
||||||
return $ insert key article accumulator
|
return $ insert key article accumulator
|
||||||
|
|
||||||
find :: (FilePath -> IO (Parsed a)) -> FilePath -> IO (Collection a)
|
findArticles :: FilePath -> IO (Map String Article)
|
||||||
find parser =
|
findArticles =
|
||||||
Files.find
|
Files.find
|
||||||
>=> filterM isMarkDownFile
|
>=> filterM isMarkDownFile
|
||||||
>=> mapM parser
|
>=> mapM Article.at
|
||||||
>=> foldM keepOrWarn Map.empty
|
>=> foldM keepOrWarn Map.empty
|
||||||
where
|
where
|
||||||
isMarkDownFile path = do
|
isMarkDownFile path = do
|
||||||
let correctExtension = takeExtension path == ".md"
|
let correctExtension = takeExtension path == ".md"
|
||||||
(correctExtension &&) <$> doesFileExist path
|
(correctExtension &&) <$> doesFileExist path
|
||||||
|
|
||||||
tagged :: Collection Article -> FilePath -> IO (String, Set String)
|
tagged :: Collection -> FilePath -> IO (String, Set String)
|
||||||
tagged collection path = do
|
tagged collection path = do
|
||||||
links <- Files.find path
|
links <- Files.find path
|
||||||
keys <- forM links $ \link -> do
|
keys <- forM links $ \link -> do
|
||||||
fileExists <- doesFileExist link
|
fileExists <- doesFileExist link
|
||||||
return $ if fileExists
|
return $ if fileExists
|
||||||
then let articleKey = getKey link in
|
then let articleKey = Article.getKey link in
|
||||||
maybe Set.empty (\_ -> Set.singleton articleKey) (lookup articleKey collection)
|
maybe Set.empty (\_ -> Set.singleton articleKey) (lookup articleKey collection)
|
||||||
else Set.empty
|
else Set.empty
|
||||||
return (takeFileName path, foldl Set.union Set.empty keys)
|
return (takeFileName path, foldl Set.union Set.empty keys)
|
||||||
|
|
||||||
discover :: Path -> IO (Collection Article, Collection Page, Collection (Set String))
|
discover :: Path -> IO (Collection, Map String (Set String))
|
||||||
discover path = do
|
discover path = do
|
||||||
(articles, tags) <- discoverArticles $ articlesPath path
|
articles <- findArticles $ articlesPath path
|
||||||
pages <- maybe (return Map.empty) (find Page.at) $ pagesPath path
|
tags <- Map.fromList . filter (not . Set.null . snd)
|
||||||
return (articles, pages, tags)
|
<$> (Files.find (articlesPath path </> "tags") >>= mapM (articles `tagged`))
|
||||||
where
|
return (articles, tags)
|
||||||
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 -> IO Blog
|
||||||
build arguments = do
|
build arguments = do
|
||||||
|
|
@ -114,13 +102,13 @@ build arguments = do
|
||||||
let hasRSS = maybe False (\_-> True) $ rss urls
|
let hasRSS = maybe False (\_-> True) $ rss urls
|
||||||
wording <- Wording.build arguments
|
wording <- Wording.build arguments
|
||||||
templates <- Template.build wording
|
templates <- Template.build wording
|
||||||
root <- onRight makeAbsolute =<< filePath (Dir $ Arguments.sourceDir arguments)
|
root <- Files.absolute . Dir $ Arguments.sourceDir arguments
|
||||||
withCurrentDirectory root $ do
|
withCurrentDirectory root $ do
|
||||||
path <- assertRight =<< Path.build root arguments
|
path <- Path.build root arguments
|
||||||
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
|
let name = maybe (takeFileName $ dropTrailingPathSeparator root) id
|
||||||
$ Arguments.name arguments
|
$ Arguments.name arguments
|
||||||
skin <- Skin.build name arguments
|
skin <- Skin.build name arguments
|
||||||
(articles, pages, tags) <- discover path
|
(articles, tags) <- discover path
|
||||||
return $ Blog {
|
return $ Blog {
|
||||||
articles, hasRSS, name, pages, path, skin, tags, templates, urls, wording
|
articles, hasRSS, name, path, skin, tags, templates, urls, wording
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
module Blog.Path (
|
module Blog.Path (
|
||||||
Path(..)
|
Path(..)
|
||||||
, build
|
, build
|
||||||
|
|
@ -9,21 +8,17 @@ module Blog.Path (
|
||||||
|
|
||||||
import Arguments (Arguments)
|
import Arguments (Arguments)
|
||||||
import qualified Arguments as Arguments (Arguments(..))
|
import qualified Arguments as Arguments (Arguments(..))
|
||||||
import Control.Monad (join)
|
|
||||||
import Control.Monad.Except (MonadError(..), ExceptT(..), runExceptT)
|
|
||||||
import Data.Aeson (ToJSON(..), (.=), pairs)
|
import Data.Aeson (ToJSON(..), (.=), pairs)
|
||||||
#if !MIN_VERSION_base(4,11,0)
|
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
#endif
|
|
||||||
import Files (File(..), filePath)
|
import Files (File(..), filePath)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
data Path = Path {
|
data Path = Path {
|
||||||
articlesPath :: Maybe FilePath
|
articlesPath :: FilePath
|
||||||
, pagesPath :: Maybe FilePath
|
, pagesPath :: Maybe FilePath
|
||||||
, remarkableConfig :: Maybe FilePath
|
, remarkableConfig :: Maybe FilePath
|
||||||
, root :: FilePath
|
, root :: FilePath
|
||||||
} deriving (Eq, Generic, Show)
|
} deriving Generic
|
||||||
|
|
||||||
instance ToJSON Path where
|
instance ToJSON Path where
|
||||||
toEncoding (Path {articlesPath, pagesPath}) = pairs (
|
toEncoding (Path {articlesPath, pagesPath}) = pairs (
|
||||||
|
|
@ -31,22 +26,9 @@ instance ToJSON Path where
|
||||||
<> "pagesPath" .= pagesPath
|
<> "pagesPath" .= pagesPath
|
||||||
)
|
)
|
||||||
|
|
||||||
checkFor :: (FilePath -> File) -> FilePath -> ExceptT String IO (Maybe FilePath)
|
build :: FilePath -> Arguments -> IO Path
|
||||||
checkFor fileOrDir = ExceptT . fmap (Just <$>) . filePath . fileOrDir
|
build root arguments = do
|
||||||
|
articlesPath <- filePath . Dir $ Arguments.articlesPath arguments
|
||||||
getMarkdownPath :: FilePath -> Maybe FilePath -> ExceptT String IO (Maybe FilePath)
|
pagesPath <- mapM (filePath . Dir) $ Arguments.pagesPath arguments
|
||||||
getMarkdownPath defaultPath Nothing =
|
remarkableConfig <- mapM (filePath . File) $ Arguments.remarkableConfig arguments
|
||||||
ExceptT . (Right . either (\_ -> Nothing) Just <$>) . filePath $ Dir defaultPath
|
return $ Path {articlesPath, pagesPath, remarkableConfig, root}
|
||||||
getMarkdownPath _ (Just customPath) = checkFor Dir customPath
|
|
||||||
|
|
||||||
build :: FilePath -> Arguments -> IO (Either String Path)
|
|
||||||
build root arguments = runExceptT . join $ pack
|
|
||||||
<$> getMarkdownPath "articles" (Arguments.articlesPath arguments)
|
|
||||||
<*> getMarkdownPath "pages" (Arguments.pagesPath arguments)
|
|
||||||
<*> maybe ignore (checkFor File) (Arguments.remarkableConfig arguments)
|
|
||||||
where
|
|
||||||
pack Nothing Nothing _ =
|
|
||||||
throwError "No articles ? No pages ? Why did you wake me up ? I'm going back to sleep"
|
|
||||||
pack articlesPath pagesPath remarkableConfig =
|
|
||||||
return $ Path {articlesPath, pagesPath, remarkableConfig, root}
|
|
||||||
ignore = return Nothing
|
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE CPP #-}
|
|
||||||
module Blog.Skin (
|
module Blog.Skin (
|
||||||
Skin(..)
|
Skin(..)
|
||||||
, build
|
, build
|
||||||
|
|
@ -12,9 +11,7 @@ import qualified Arguments (bannerPath, favicon, cardImage, headPath, previewArt
|
||||||
import Control.Monad (filterM)
|
import Control.Monad (filterM)
|
||||||
import Data.Aeson (ToJSON(..), (.=), pairs)
|
import Data.Aeson (ToJSON(..), (.=), pairs)
|
||||||
import Data.Maybe (listToMaybe)
|
import Data.Maybe (listToMaybe)
|
||||||
#if !MIN_VERSION_base(4,11,0)
|
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
#endif
|
|
||||||
import Files (absoluteLink)
|
import Files (absoluteLink)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import Prelude hiding (head)
|
import Prelude hiding (head)
|
||||||
|
|
@ -39,7 +36,7 @@ instance ToJSON Skin where
|
||||||
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
|
findImage :: String -> Maybe FilePath -> IO (Maybe FilePath)
|
||||||
findImage _ (Just path) = return . Just $ absoluteLink path
|
findImage _ (Just path) = return . Just $ absoluteLink path
|
||||||
findImage name Nothing =
|
findImage name Nothing =
|
||||||
listToMaybe <$> filterM doesFileExist pathsToCheck
|
fmap absoluteLink . listToMaybe <$> filterM doesFileExist pathsToCheck
|
||||||
where
|
where
|
||||||
directories = [".", "image", "images", "pictures", "skin", "static"]
|
directories = [".", "image", "images", "pictures", "skin", "static"]
|
||||||
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]
|
extensions = ["ico", "gif", "jpeg", "jpg", "png", "svg"]
|
||||||
|
|
|
||||||
|
|
@ -26,15 +26,12 @@ variables :: Map String [Text]
|
||||||
variables = Map.fromList [
|
variables = Map.fromList [
|
||||||
("allLink", [])
|
("allLink", [])
|
||||||
, ("allPage", ["tag"])
|
, ("allPage", ["tag"])
|
||||||
, ("articleDescription", ["name"])
|
|
||||||
, ("commentsLink", [])
|
, ("commentsLink", [])
|
||||||
, ("commentsSection", [])
|
, ("commentsSection", [])
|
||||||
, ("dateFormat", [])
|
, ("dateFormat", [])
|
||||||
, ("latestLink", [])
|
, ("latestLink", [])
|
||||||
, ("latestPage", ["tag"])
|
, ("latestPage", ["tag"])
|
||||||
, ("metadata", ["author", "date", "tags"])
|
, ("metadata", ["author", "date", "tags"])
|
||||||
, ("pageDescription", ["name"])
|
|
||||||
, ("pagesList", [])
|
|
||||||
, ("rssLink", [])
|
, ("rssLink", [])
|
||||||
, ("rssTitle", ["tag"])
|
, ("rssTitle", ["tag"])
|
||||||
, ("tagsList", [])
|
, ("tagsList", [])
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@ module Collection (
|
||||||
, title
|
, title
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Article(Article)
|
import Article(Article(metadata))
|
||||||
import Blog (Blog(..), Path(..))
|
import Blog (Blog(..), Path(..))
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
import Control.Monad.Reader (MonadReader(..), ReaderT, asks)
|
import Control.Monad.Reader (MonadReader(..), ReaderT, asks)
|
||||||
|
|
@ -15,7 +15,6 @@ import Data.Map ((!))
|
||||||
import qualified Data.Map as Map (elems, filterWithKey, toList)
|
import qualified Data.Map as Map (elems, filterWithKey, toList)
|
||||||
import Data.Ord (Down(..))
|
import Data.Ord (Down(..))
|
||||||
import qualified Data.Set as Set (member)
|
import qualified Data.Set as Set (member)
|
||||||
import Markdown (Markdown(metadata), MarkdownContent(..))
|
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import System.Directory (createDirectoryIfMissing)
|
import System.Directory (createDirectoryIfMissing)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
|
|
@ -35,7 +34,7 @@ build featured tag = do
|
||||||
featured = sortByDate featured, basePath, tag
|
featured = sortByDate featured, basePath, tag
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
sortByDate = sortOn (Down . (! "date") . metadata . getMarkdown)
|
sortByDate = sortOn (Down . (! "date") . metadata)
|
||||||
|
|
||||||
getAll :: ReaderT Blog IO [Collection]
|
getAll :: ReaderT Blog IO [Collection]
|
||||||
getAll = do
|
getAll = do
|
||||||
|
|
|
||||||
82
src/DOM.hs
82
src/DOM.hs
|
|
@ -1,19 +1,18 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
{-# LANGUAGE NamedFieldPuns #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module DOM (
|
module DOM (
|
||||||
HasContent(..)
|
page
|
||||||
, htmlDocument
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Article (Article)
|
import Article (Article(..))
|
||||||
import qualified Article (preview)
|
import qualified Article (preview)
|
||||||
import ArticlesList (
|
import ArticlesList (
|
||||||
ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
|
ArticlesList(..), description, getArticles, otherURL, rssLinkTexts
|
||||||
)
|
)
|
||||||
import Blog (Blog(..), Skin(..), URL(..), template)
|
import Blog (Blog(..), Path(..), Skin(..), URL(..), template)
|
||||||
import Control.Monad.Reader (ReaderT, asks)
|
import Control.Monad.Reader (ReaderT, asks)
|
||||||
import Data.Map as Map (Map, toList)
|
import qualified Data.Map as Map (keys)
|
||||||
import Data.Text (Text, pack, empty)
|
import Data.Text (pack, empty)
|
||||||
import DOM.Card (HasCard)
|
import DOM.Card (HasCard)
|
||||||
import qualified DOM.Card as Card (make)
|
import qualified DOM.Card as Card (make)
|
||||||
import Files (absoluteLink)
|
import Files (absoluteLink)
|
||||||
|
|
@ -22,24 +21,19 @@ import Lucid (
|
||||||
, head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
|
, head_, header_, href_, li_, link_, id_, meta_, pre_, rel_, script_, src_
|
||||||
, title_, toHtml, toHtmlRaw, type_, ul_
|
, title_, toHtml, toHtmlRaw, type_, ul_
|
||||||
)
|
)
|
||||||
import Markdown (Markdown(..), MarkdownContent(..))
|
|
||||||
import Page (Page)
|
|
||||||
import Prelude hiding (head, lookup)
|
import Prelude hiding (head, lookup)
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import System.FilePath.Posix ((<.>))
|
import System.FilePath.Posix ((</>), (<.>))
|
||||||
|
|
||||||
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
type HtmlGenerator = HtmlT (ReaderT Blog IO)
|
||||||
|
|
||||||
class HasCard a => HasContent a where
|
class HasCard a => Page a where
|
||||||
content :: a -> HtmlGenerator ()
|
content :: a -> HtmlGenerator ()
|
||||||
|
|
||||||
instance HasContent Article where
|
instance Page Article where
|
||||||
content = mDContent True . getMarkdown
|
content = article True
|
||||||
|
|
||||||
instance HasContent Page where
|
instance Page ArticlesList where
|
||||||
content = mDContent True . getMarkdown
|
|
||||||
|
|
||||||
instance HasContent ArticlesList where
|
|
||||||
content al@(ArticlesList {full}) = do
|
content al@(ArticlesList {full}) = do
|
||||||
preview <- Article.preview <$> (asks $skin.$previewLinesCount)
|
preview <- Article.preview <$> (asks $skin.$previewLinesCount)
|
||||||
h2_ . toHtml =<< description al
|
h2_ . toHtml =<< description al
|
||||||
|
|
@ -47,7 +41,7 @@ instance HasContent ArticlesList where
|
||||||
asks hasRSS >>= rssLink
|
asks hasRSS >>= rssLink
|
||||||
li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
|
li_ . a_ [href_ . pack $ otherURL al, class_ "other"] =<< otherLink
|
||||||
div_ [class_ "articles"] (
|
div_ [class_ "articles"] (
|
||||||
mapM_ (mDContent False . preview) =<< getArticles al
|
mapM_ (article False . preview) =<< getArticles al
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
otherLink =
|
otherLink =
|
||||||
|
|
@ -58,25 +52,24 @@ instance HasContent ArticlesList where
|
||||||
li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
|
li_ . a_ [href_ "rss.xml", class_ "RSS", title_ title] $ toHtml text
|
||||||
rssLink False = return ()
|
rssLink False = return ()
|
||||||
|
|
||||||
mDContent :: Bool -> Markdown -> HtmlGenerator ()
|
article :: Bool -> Article -> HtmlGenerator ()
|
||||||
mDContent raw markdown@(Markdown {key, body}) =
|
article raw (Article {key, body, Article.title}) = do
|
||||||
|
url <- absoluteLink . (</> key <.> extension) <$> (asks $path.$articlesPath)
|
||||||
article_ [id_ $ pack key] (do
|
article_ [id_ $ pack key] (do
|
||||||
header_ . h1_ $ mDLink raw markdown
|
header_ (do
|
||||||
|
a_ [href_ $ pack url] . h1_ $ toHtml title
|
||||||
|
)
|
||||||
pre_ . toHtml $ unlines body
|
pre_ . toHtml $ unlines body
|
||||||
)
|
)
|
||||||
|
where extension = if raw then "md" else "html"
|
||||||
mDLink :: Bool -> Markdown -> HtmlGenerator ()
|
|
||||||
mDLink raw (Markdown {Markdown.path, title}) =
|
|
||||||
a_ [href_ $ pack url] $ toHtml title
|
|
||||||
where
|
|
||||||
url = absoluteLink $ path <.> (if raw then "md" else "html")
|
|
||||||
|
|
||||||
tag :: String -> HtmlGenerator ()
|
tag :: String -> HtmlGenerator ()
|
||||||
tag name =
|
tag name = li_ (
|
||||||
a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
|
a_ [href_ . pack $ absoluteLink name ++ "/", class_ "tag"] $ toHtml name
|
||||||
|
)
|
||||||
|
|
||||||
defaultBanner :: HtmlGenerator ()
|
defaultBanner :: HtmlGenerator ()
|
||||||
defaultBanner =
|
defaultBanner = do
|
||||||
div_ [id_ "header"] (
|
div_ [id_ "header"] (
|
||||||
a_ [href_ "/"] (
|
a_ [href_ "/"] (
|
||||||
h1_ . toHtml =<< asks name
|
h1_ . toHtml =<< asks name
|
||||||
|
|
@ -84,41 +77,30 @@ defaultBanner =
|
||||||
)
|
)
|
||||||
|
|
||||||
faviconLink :: FilePath -> HtmlGenerator ()
|
faviconLink :: FilePath -> HtmlGenerator ()
|
||||||
faviconLink url = link_ [
|
faviconLink url = link_ [rel_ "shortcut icon", href_ $ pack url, type_ "image/x-icon"]
|
||||||
rel_ "shortcut icon", href_ . pack $ absoluteLink url, type_ "image/x-icon"
|
|
||||||
]
|
|
||||||
|
|
||||||
optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
|
optional :: (a -> HtmlGenerator ()) -> Maybe a -> HtmlGenerator ()
|
||||||
optional = maybe (return ())
|
optional = maybe (return ())
|
||||||
|
|
||||||
navigationSection ::
|
page :: Page a => a -> HtmlGenerator ()
|
||||||
Text -> String -> ((String, a) -> HtmlGenerator ()) -> Map String a -> HtmlGenerator ()
|
page aPage =
|
||||||
navigationSection sectionId templateKey generator collection
|
|
||||||
| null collection = return ()
|
|
||||||
| otherwise =
|
|
||||||
div_ [id_ sectionId, class_ "navigator"] (do
|
|
||||||
h2_ . toHtml =<< template templateKey []
|
|
||||||
ul_ . mapM_ (li_ . generator) $ Map.toList collection
|
|
||||||
)
|
|
||||||
|
|
||||||
htmlDocument :: HasContent a => a -> HtmlGenerator ()
|
|
||||||
htmlDocument someContent =
|
|
||||||
doctypehtml_ (do
|
doctypehtml_ (do
|
||||||
head_ (do
|
head_ (do
|
||||||
meta_ [charset_ "utf-8"]
|
meta_ [charset_ "utf-8"]
|
||||||
title_ . toHtml =<< asks name
|
title_ . toHtml =<< asks name
|
||||||
|
script_ [src_ "/js/unit.js"] empty
|
||||||
script_ [src_ "/js/remarkable.min.js"] empty
|
script_ [src_ "/js/remarkable.min.js"] empty
|
||||||
script_ [src_ "/js/hablo.js"] empty
|
script_ [src_ "/js/hablo.js"] empty
|
||||||
optional faviconLink =<< (asks $skin.$favicon)
|
optional faviconLink =<< (asks $skin.$favicon)
|
||||||
optional (Card.make someContent) =<< (asks $urls.$cards)
|
optional (Card.make aPage) =<< (asks $urls.$cards)
|
||||||
optional toHtmlRaw =<< (asks $skin.$head)
|
optional toHtmlRaw =<< (asks $skin.$head)
|
||||||
)
|
)
|
||||||
body_ (do
|
body_ (do
|
||||||
maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
|
maybe defaultBanner toHtmlRaw =<< (asks $skin.$banner)
|
||||||
asks tags >>= navigationSection "tags" "tagsList"
|
div_ [id_ "navigator"] (do
|
||||||
(\(key, _) -> tag key)
|
h2_ . toHtml =<< template "tagsList" []
|
||||||
asks pages >>= navigationSection "pages" "pagesList"
|
ul_ . mapM_ tag . Map.keys =<< asks tags
|
||||||
(\(_, page) -> mDLink False $ getMarkdown page)
|
)
|
||||||
div_ [id_ "contents"] $ content someContent
|
div_ [id_ "contents"] $ content aPage
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -2,14 +2,15 @@
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module DOM.Card (
|
module DOM.Card (
|
||||||
HasCard(..)
|
Card(..)
|
||||||
|
, HasCard(..)
|
||||||
, make
|
, make
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Article (Article(..))
|
import qualified Article (Article(..))
|
||||||
import ArticlesList (ArticlesList(..))
|
import ArticlesList (ArticlesList(..))
|
||||||
import qualified ArticlesList (description)
|
import qualified ArticlesList (description)
|
||||||
import Blog (Blog(..), Renderer, Skin(..), template)
|
import Blog (Blog(..), Renderer, Skin(..))
|
||||||
import Collection (Collection(..))
|
import Collection (Collection(..))
|
||||||
import qualified Collection (title)
|
import qualified Collection (title)
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
|
|
@ -18,18 +19,18 @@ import qualified Data.Map as Map (lookup)
|
||||||
import Data.Text (Text, pack)
|
import Data.Text (Text, pack)
|
||||||
import Lucid (HtmlT, content_, meta_)
|
import Lucid (HtmlT, content_, meta_)
|
||||||
import Lucid.Base (makeAttribute)
|
import Lucid.Base (makeAttribute)
|
||||||
import Markdown (MarkdownContent(..), metadata)
|
|
||||||
import qualified Markdown (Markdown(..))
|
|
||||||
import Page (Page(..))
|
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import System.FilePath.Posix ((</>), (<.>))
|
|
||||||
|
data Card = Card {
|
||||||
|
cardType :: Text
|
||||||
|
, description :: Text
|
||||||
|
, image :: Maybe String
|
||||||
|
, title :: String
|
||||||
|
, urlPath :: String
|
||||||
|
}
|
||||||
|
|
||||||
class HasCard a where
|
class HasCard a where
|
||||||
cardType :: Renderer m => a -> m Text
|
getCard :: Renderer m => a -> m Card
|
||||||
description :: Renderer m => a -> m Text
|
|
||||||
image :: Renderer m => a -> m (Maybe String)
|
|
||||||
title :: Renderer m => a -> m String
|
|
||||||
urlPath :: Renderer m => a -> m String
|
|
||||||
|
|
||||||
og :: Applicative m => Text -> Text -> HtmlT m ()
|
og :: Applicative m => Text -> Text -> HtmlT m ()
|
||||||
og attribute value =
|
og attribute value =
|
||||||
|
|
@ -40,52 +41,39 @@ og attribute value =
|
||||||
|
|
||||||
make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
|
make :: (HasCard a, Renderer m) => a -> String -> HtmlT m ()
|
||||||
make element siteURL = do
|
make element siteURL = do
|
||||||
og "url" . sitePrefix =<< urlPath element
|
Card {cardType, description, image, title, urlPath} <- getCard element
|
||||||
og "type" =<< cardType element
|
og "url" . pack $ siteURL ++ urlPath
|
||||||
og "title" . pack =<< title element
|
og "type" cardType
|
||||||
og "description" =<< description element
|
og "title" $ pack title
|
||||||
maybeImage =<< ((<|>) <$> image element <*> (asks $skin.$cardImage))
|
og "description" description
|
||||||
|
maybeImage =<< ((image <|>) <$> (asks $skin.$cardImage))
|
||||||
og "site_name" =<< (asks $name.$pack)
|
og "site_name" =<< (asks $name.$pack)
|
||||||
where
|
where
|
||||||
maybeImage = maybe (return ()) (og "image" . sitePrefix)
|
maybeImage = maybe (return ()) (og "image" . pack . (siteURL++))
|
||||||
sitePrefix = pack . (siteURL </>)
|
|
||||||
|
|
||||||
mDImage :: (Renderer m, MarkdownContent a ) => a -> m (Maybe String)
|
instance HasCard Article.Article where
|
||||||
mDImage = return . Map.lookup "featuredImage" . metadata . getMarkdown
|
getCard (Article.Article {Article.title, Article.metadata}) = do
|
||||||
|
description <- pack <$> getDescription (Map.lookup "summary" metadata)
|
||||||
mDTitle :: (Renderer m, MarkdownContent a) => a -> m String
|
return $ Card {
|
||||||
mDTitle = return . Markdown.title . getMarkdown
|
cardType = "article"
|
||||||
|
, description
|
||||||
mDUrlPath :: (Renderer m, MarkdownContent a) => a -> m String
|
, image = (Map.lookup "featuredImage" metadata)
|
||||||
mDUrlPath a = return $ Markdown.path (getMarkdown a) <.> "html"
|
, DOM.Card.title
|
||||||
|
, urlPath = "/articles/" ++ title ++ ".html"
|
||||||
mDDescription :: (Renderer m, MarkdownContent a) => String -> a -> m Text
|
}
|
||||||
mDDescription key =
|
where
|
||||||
getDescription . Map.lookup "summary" . metadata . getMarkdown
|
getDescription = maybe (asks $name.$("A new article on " <>)) return
|
||||||
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
|
instance HasCard ArticlesList where
|
||||||
cardType _ = return "website"
|
getCard al@(ArticlesList {collection}) = do
|
||||||
description = ArticlesList.description
|
cardTitle <- Collection.title collection
|
||||||
image _ = return Nothing
|
description <- ArticlesList.description al
|
||||||
title (ArticlesList {collection}) = Collection.title collection
|
return $ Card {
|
||||||
urlPath al@(ArticlesList {collection}) =
|
cardType = "website"
|
||||||
return $ maybe "" id (tag collection) </> file
|
, description
|
||||||
|
, image = Nothing
|
||||||
|
, DOM.Card.title = cardTitle
|
||||||
|
, urlPath = maybe "" ('/':) (tag collection) ++ file
|
||||||
|
}
|
||||||
where
|
where
|
||||||
file = (if full al then "all" else "index") <.> ".html"
|
file = '/' : (if full al then "all" else "index") ++ ".html"
|
||||||
|
|
|
||||||
31
src/Files.hs
31
src/Files.hs
|
|
@ -1,32 +1,35 @@
|
||||||
module Files (
|
module Files (
|
||||||
File(..)
|
File(..)
|
||||||
|
, absolute
|
||||||
, absoluteLink
|
, absoluteLink
|
||||||
, filePath
|
, filePath
|
||||||
, find
|
, find
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
|
import System.Exit (die)
|
||||||
|
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
|
|
||||||
data File = File FilePath | Dir FilePath
|
data File = File FilePath | Dir FilePath
|
||||||
|
|
||||||
|
absolute :: File -> IO (FilePath)
|
||||||
|
absolute file = filePath file >>= makeAbsolute
|
||||||
|
|
||||||
absoluteLink :: FilePath -> FilePath
|
absoluteLink :: FilePath -> FilePath
|
||||||
absoluteLink ('.':path) = path
|
absoluteLink ('.':path) = path
|
||||||
absoluteLink path = "/" </> path
|
absoluteLink path = "/" </> path
|
||||||
|
|
||||||
filePath :: File -> IO (Either String FilePath)
|
filePath :: File -> IO FilePath
|
||||||
filePath = filePathAux
|
filePath file = do
|
||||||
where
|
let (thePath, test, errorMessage) =
|
||||||
filePathAux (File path) = ifIO doesFileExist path Right (notExist . File)
|
case file of
|
||||||
filePathAux (Dir path) = ifIO doesDirectoryExist path Right (notExist . Dir)
|
File path -> (path, doesFileExist, (++ ": no such file"))
|
||||||
ifIO predicate value whenTrue whenFalse = do
|
Dir path -> (path, doesDirectoryExist, (++ ": no such directory"))
|
||||||
result <- predicate value
|
bool <- test thePath
|
||||||
return $ if result then whenTrue value else whenFalse value
|
if bool
|
||||||
notExist (File path) = Left $ path ++ ": no such file"
|
then return thePath
|
||||||
notExist (Dir path) = Left $ path ++ ": no such directory"
|
else die $ errorMessage thePath
|
||||||
|
|
||||||
find :: FilePath -> IO [FilePath]
|
find :: FilePath -> IO [FilePath]
|
||||||
find path =
|
find path =
|
||||||
filePath (Dir path) >>= emptyIfMissing (fmap ((path </>) <$>) . listDirectory)
|
fmap (path </>) <$> listDirectory path
|
||||||
where
|
|
||||||
emptyIfMissing = either (\_ -> return [])
|
|
||||||
|
|
|
||||||
20
src/HTML.hs
20
src/HTML.hs
|
|
@ -4,6 +4,7 @@ module HTML (
|
||||||
generate
|
generate
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Article(Article(..))
|
||||||
import ArticlesList (ArticlesList(..))
|
import ArticlesList (ArticlesList(..))
|
||||||
import Blog (Blog(..), Path(..))
|
import Blog (Blog(..), Path(..))
|
||||||
import Collection (Collection(..))
|
import Collection (Collection(..))
|
||||||
|
|
@ -12,9 +13,8 @@ import Control.Monad.IO.Class (MonadIO(..))
|
||||||
import Control.Monad.Reader (ReaderT, asks)
|
import Control.Monad.Reader (ReaderT, asks)
|
||||||
import qualified Data.Map as Map (elems)
|
import qualified Data.Map as Map (elems)
|
||||||
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
|
import qualified Data.Text.Lazy.IO as TextIO (writeFile)
|
||||||
import DOM (HasContent, htmlDocument)
|
import DOM (page)
|
||||||
import Lucid (renderTextT)
|
import Lucid (renderTextT)
|
||||||
import Markdown (Markdown(..), MarkdownContent(..))
|
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import System.FilePath.Posix ((</>), (<.>))
|
import System.FilePath.Posix ((</>), (<.>))
|
||||||
|
|
||||||
|
|
@ -26,21 +26,19 @@ articlesLists collection@(Collection {basePath}) = [
|
||||||
file bool = if bool then "all" else "index"
|
file bool = if bool then "all" else "index"
|
||||||
path bool = basePath </> file bool <.> "html"
|
path bool = basePath </> file bool <.> "html"
|
||||||
|
|
||||||
generateMarkdown :: (HasContent a, MarkdownContent a) => [a] -> ReaderT Blog IO ()
|
generateArticles :: [Article] -> ReaderT Blog IO ()
|
||||||
generateMarkdown = mapM_ $ \content -> do
|
generateArticles = mapM_ $ \article -> do
|
||||||
let relativePath = Markdown.path (getMarkdown content) <.> "html"
|
baseDir <- (</>) <$> (asks $path.$root) <*> (asks $path.$articlesPath)
|
||||||
filePath <- (</> relativePath) <$> (asks $Blog.path.$root)
|
(renderTextT $ page article)
|
||||||
(renderTextT $ htmlDocument content) >>= liftIO . TextIO.writeFile filePath
|
>>= liftIO . TextIO.writeFile (baseDir </> key article <.> "html")
|
||||||
|
|
||||||
generateCollection :: Collection -> ReaderT Blog IO ()
|
generateCollection :: Collection -> ReaderT Blog IO ()
|
||||||
generateCollection (Collection {featured = []}) = return ()
|
generateCollection (Collection {featured = []}) = return ()
|
||||||
generateCollection collection =
|
generateCollection collection =
|
||||||
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
|
flip mapM_ (articlesLists collection) $ \(filePath, articlesList) ->
|
||||||
(renderTextT $ htmlDocument articlesList)
|
(renderTextT $ page articlesList) >>= liftIO . TextIO.writeFile filePath
|
||||||
>>= liftIO . TextIO.writeFile filePath
|
|
||||||
|
|
||||||
generate :: ReaderT Blog IO ()
|
generate :: ReaderT Blog IO ()
|
||||||
generate = do
|
generate = do
|
||||||
asks articles >>= generateMarkdown . Map.elems
|
asks articles >>= generateArticles . Map.elems
|
||||||
Collection.getAll >>= mapM_ generateCollection
|
Collection.getAll >>= mapM_ generateCollection
|
||||||
asks pages >>= generateMarkdown . Map.elems
|
|
||||||
|
|
|
||||||
54
src/JS.hs
54
src/JS.hs
|
|
@ -3,57 +3,37 @@ module JS (
|
||||||
generate
|
generate
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Aeson (encode)
|
|
||||||
|
|
||||||
import Blog (Blog(..), Path(..))
|
import Blog (Blog(..), Path(..))
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
import Control.Monad.Reader (ReaderT, asks)
|
import Control.Monad.Reader (ReaderT, asks)
|
||||||
import Data.ByteString.Lazy (
|
import Data.ByteString.Lazy (ByteString, concat, readFile, writeFile)
|
||||||
ByteString, concat, intercalate, fromStrict, readFile, writeFile
|
|
||||||
)
|
|
||||||
import Data.ByteString.Lazy.Char8 (pack)
|
import Data.ByteString.Lazy.Char8 (pack)
|
||||||
import Data.Text.Encoding (encodeUtf8)
|
import qualified Files (find)
|
||||||
import JSON (exportBlog)
|
import JSON (exportBlog)
|
||||||
import Paths_hablo (getDataDir)
|
import Paths_hablo (getDataDir)
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import SJW (compile, source)
|
|
||||||
import System.Directory (createDirectoryIfMissing)
|
import System.Directory (createDirectoryIfMissing)
|
||||||
import System.Exit (die)
|
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import Prelude hiding (concat, readFile, writeFile)
|
import Prelude hiding (concat, readFile, writeFile)
|
||||||
|
|
||||||
object :: [ByteString] -> ByteString
|
compile :: [ByteString] -> ByteString
|
||||||
object sources = concat [header, intercalate ",\n" sources, footer]
|
compile sources = concat (header:sources ++ [footer])
|
||||||
where
|
where
|
||||||
header = "return {\n"
|
header = "(function() {\n"
|
||||||
footer = "\n};"
|
footer = "})();"
|
||||||
|
|
||||||
var :: (String, ByteString) -> ByteString
|
var :: (String, ByteString) -> ByteString
|
||||||
var (varName, content) = concat ["\t", pack varName, " : ", content]
|
var (varName, content) = concat ["var ", pack varName, " = ", content, ";\n"]
|
||||||
|
|
||||||
generateConfig :: FilePath -> ReaderT Blog IO ()
|
|
||||||
generateConfig destinationDir = do
|
|
||||||
blogJSON <- asks (encode . exportBlog)
|
|
||||||
remarkablePath <- asks $path.$remarkableConfig
|
|
||||||
liftIO $ do
|
|
||||||
remarkableJSON <- maybe (return "{html: true}") readFile remarkablePath
|
|
||||||
let jsVars = [("blog", blogJSON), ("remarkableConfig", remarkableJSON)]
|
|
||||||
writeFile configModule . object $ var <$> jsVars
|
|
||||||
where
|
|
||||||
configModule = destinationDir </> "Hablo" </> "Config.js"
|
|
||||||
|
|
||||||
generateMain :: FilePath -> IO ()
|
|
||||||
generateMain destinationDir = do
|
|
||||||
habloSources <- (</> "js") <$> getDataDir
|
|
||||||
compile (source [destinationDir, "unitJS", habloSources])
|
|
||||||
>>= either abort (output . fst)
|
|
||||||
where
|
|
||||||
output = writeFile (destinationDir </> "hablo.js") . fromStrict . encodeUtf8
|
|
||||||
abort = die . (<> "JS compilation failed\n")
|
|
||||||
|
|
||||||
generate :: ReaderT Blog IO ()
|
generate :: ReaderT Blog IO ()
|
||||||
generate = do
|
generate = do
|
||||||
destinationDir <- asks $path.$root.$(</> "js")
|
destinationDir <- (</> "js") <$> (asks $path.$root)
|
||||||
liftIO . createDirectoryIfMissing True $ destinationDir </> "Hablo"
|
blogJSON <- exportBlog
|
||||||
generateConfig destinationDir
|
remarkablePath <- asks $path.$remarkableConfig
|
||||||
liftIO $ generateMain destinationDir
|
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 )
|
||||||
|
|
|
||||||
66
src/JSON.hs
66
src/JSON.hs
|
|
@ -4,60 +4,58 @@ module JSON (
|
||||||
exportBlog
|
exportBlog
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Article (Article)
|
||||||
|
import qualified Article (Article(..))
|
||||||
import Blog (Blog, Path, Skin, URL, Wording)
|
import Blog (Blog, Path, Skin, URL, Wording)
|
||||||
import qualified Blog (Blog(..))
|
import qualified Blog (Blog(..))
|
||||||
import Data.Aeson (Options(..), ToJSON(..), genericToEncoding, defaultOptions)
|
import Control.Monad.Reader (ReaderT, ask)
|
||||||
|
import Data.Aeson (ToJSON(..), genericToEncoding, defaultOptions, encode)
|
||||||
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Map (Map, mapWithKey)
|
import Data.Map (Map, mapWithKey)
|
||||||
import qualified Data.Map as Map (filter, keys)
|
import qualified Data.Map as Map (filter, keys)
|
||||||
import qualified Data.Set as Set (elems, member)
|
import qualified Data.Set as Set (elems, member)
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
import Markdown (Markdown, MarkdownContent(..))
|
|
||||||
import qualified Markdown (Markdown(..))
|
|
||||||
|
|
||||||
data MarkdownExport = MarkdownExport {
|
data ArticleExport = ArticleExport {
|
||||||
title :: String
|
title :: String
|
||||||
, metadata :: Map String String
|
|
||||||
, bodyOffset :: Int
|
, bodyOffset :: Int
|
||||||
, tagged :: Maybe [String]
|
, metadata :: Map String String
|
||||||
|
, tagged :: [String]
|
||||||
} deriving (Generic)
|
} deriving (Generic)
|
||||||
|
|
||||||
instance ToJSON MarkdownExport where
|
instance ToJSON ArticleExport where
|
||||||
toEncoding = genericToEncoding (defaultOptions {omitNothingFields = True})
|
toEncoding = genericToEncoding defaultOptions
|
||||||
|
|
||||||
exportMarkdown :: Maybe [String] -> Markdown -> MarkdownExport
|
data BlogDB = BlogDB {
|
||||||
exportMarkdown tagged markdown = MarkdownExport {
|
articles :: Map String ArticleExport
|
||||||
title = Markdown.title markdown
|
|
||||||
, metadata = Markdown.metadata markdown
|
|
||||||
, bodyOffset = Markdown.bodyOffset markdown
|
|
||||||
, tagged
|
|
||||||
}
|
|
||||||
|
|
||||||
data BlogExport = BlogExport {
|
|
||||||
articles :: Map String MarkdownExport
|
|
||||||
, hasRSS :: Bool
|
, hasRSS :: Bool
|
||||||
, path :: Path
|
, path :: Path
|
||||||
, pages :: Map String MarkdownExport
|
|
||||||
, skin :: Skin
|
, skin :: Skin
|
||||||
, tags :: Map String [String]
|
, tags :: Map String [String]
|
||||||
, urls :: URL
|
, urls :: URL
|
||||||
, wording :: Wording
|
, wording :: Wording
|
||||||
} deriving (Generic)
|
} deriving (Generic)
|
||||||
|
|
||||||
instance ToJSON BlogExport where
|
instance ToJSON BlogDB where
|
||||||
toEncoding = genericToEncoding defaultOptions
|
toEncoding = genericToEncoding defaultOptions
|
||||||
|
|
||||||
exportBlog :: Blog -> BlogExport
|
exportArticle :: Blog -> String -> Article -> ArticleExport
|
||||||
exportBlog blog = BlogExport {
|
exportArticle blog key article = ArticleExport {
|
||||||
articles = getArticles $ getMarkdown <$> Blog.articles blog
|
title = Article.title article
|
||||||
, hasRSS = Blog.hasRSS blog
|
, bodyOffset = Article.bodyOffset article
|
||||||
, pages = getPages $ getMarkdown <$> Blog.pages blog
|
, metadata = Article.metadata article
|
||||||
, path = Blog.path blog
|
, tagged = Map.keys . Map.filter (Set.member key) $ Blog.tags blog
|
||||||
, skin = Blog.skin blog
|
|
||||||
, tags = Set.elems <$> Blog.tags blog
|
|
||||||
, urls = Blog.urls blog
|
|
||||||
, wording = Blog.wording blog
|
|
||||||
}
|
}
|
||||||
where
|
|
||||||
tag key = Just . Map.keys . Map.filter (Set.member key) $ Blog.tags blog
|
exportBlog :: ReaderT Blog IO ByteString
|
||||||
getArticles = mapWithKey (exportMarkdown . tag)
|
exportBlog = do
|
||||||
getPages = mapWithKey (\_-> exportMarkdown Nothing)
|
blog <- ask
|
||||||
|
return . encode $ BlogDB {
|
||||||
|
articles = mapWithKey (exportArticle blog) $ Blog.articles blog
|
||||||
|
, hasRSS = Blog.hasRSS blog
|
||||||
|
, path = Blog.path blog
|
||||||
|
, skin = Blog.skin blog
|
||||||
|
, tags = Set.elems <$> Blog.tags blog
|
||||||
|
, urls = Blog.urls blog
|
||||||
|
, wording = Blog.wording blog
|
||||||
|
}
|
||||||
|
|
|
||||||
|
|
@ -1,76 +0,0 @@
|
||||||
{-# LANGUAGE NamedFieldPuns #-}
|
|
||||||
module Markdown (
|
|
||||||
Markdown(..)
|
|
||||||
, MarkdownContent(..)
|
|
||||||
, Metadata
|
|
||||||
, at
|
|
||||||
, getKey
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
|
||||||
import Data.Map (Map)
|
|
||||||
import qualified Data.Map as Map (fromList)
|
|
||||||
import System.FilePath (dropExtension, takeFileName)
|
|
||||||
import Text.ParserCombinators.Parsec (
|
|
||||||
ParseError, Parser
|
|
||||||
, (<?>)
|
|
||||||
, anyChar, char, count, endBy, eof, getPosition, many, many1, noneOf
|
|
||||||
, oneOf, option, parse, skipMany, sourceLine, sourceName, string, try
|
|
||||||
)
|
|
||||||
|
|
||||||
type Metadata = Map String String
|
|
||||||
data Markdown = Markdown {
|
|
||||||
key :: String
|
|
||||||
, path :: String
|
|
||||||
, title :: String
|
|
||||||
, metadata :: Metadata
|
|
||||||
, bodyOffset :: Int
|
|
||||||
, body :: [String]
|
|
||||||
}
|
|
||||||
|
|
||||||
class MarkdownContent a where
|
|
||||||
getMarkdown :: a -> Markdown
|
|
||||||
|
|
||||||
parser :: Parser Markdown
|
|
||||||
parser = do
|
|
||||||
(title, metadata) <- skipMany eol *> (headerP <|> reverseHeaderP)
|
|
||||||
bodyOffset <- skipMany eol *> (pred . sourceLine <$> getPosition)
|
|
||||||
body <- lines <$> many anyChar <* eof
|
|
||||||
inputFile <- sourceName <$> getPosition
|
|
||||||
let (key, path) = (getKey inputFile, dropExtension inputFile)
|
|
||||||
return $ Markdown {key, path, title, metadata, bodyOffset, body}
|
|
||||||
where
|
|
||||||
headerP = (,) <$> titleP <* many eol <*> metadataP
|
|
||||||
reverseHeaderP = flip (,) <$> metadataP <* many eol<*> titleP
|
|
||||||
|
|
||||||
metadataP :: Parser Metadata
|
|
||||||
metadataP = Map.fromList <$> option [] (
|
|
||||||
metaSectionSeparator *> many eol *>
|
|
||||||
(try keyVal) `endBy` (many1 eol)
|
|
||||||
<* metaSectionSeparator
|
|
||||||
) <?> "metadata section"
|
|
||||||
where
|
|
||||||
metaSectionSeparator = count 3 (oneOf "~-") *> eol
|
|
||||||
spaces = skipMany $ char ' '
|
|
||||||
keyVal = (,) <$> (no ": \r\n" <* spaces <* char ':' <* spaces) <*> no "\r\n"
|
|
||||||
|
|
||||||
titleP :: Parser String
|
|
||||||
titleP = try (singleLine <|> underlined)
|
|
||||||
where
|
|
||||||
singleLine = char '#' *> char ' ' *> no "\r\n" <* eol
|
|
||||||
underlined =
|
|
||||||
no "\r\n" <* eol
|
|
||||||
>>= \titleLine -> count (length titleLine) (oneOf "#=") *> eol *> return titleLine
|
|
||||||
<?> "'#' or '=' to underline the title"
|
|
||||||
|
|
||||||
eol :: Parser String
|
|
||||||
eol = try (string "\r\n") <|> string "\r" <|> string "\n" <?> "newline"
|
|
||||||
|
|
||||||
no :: String -> Parser String
|
|
||||||
no = many1 . noneOf
|
|
||||||
|
|
||||||
getKey :: FilePath -> String
|
|
||||||
getKey = dropExtension . takeFileName
|
|
||||||
|
|
||||||
at :: FilePath -> IO (Either ParseError Markdown)
|
|
||||||
at filePath = parse parser filePath <$> readFile filePath
|
|
||||||
17
src/Page.hs
17
src/Page.hs
|
|
@ -1,17 +0,0 @@
|
||||||
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,16 +1,6 @@
|
||||||
module Pretty (
|
module Pretty (
|
||||||
(.$)
|
(.$)
|
||||||
, assertRight
|
|
||||||
, onRight
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import System.Exit (die)
|
|
||||||
|
|
||||||
(.$) :: (a -> b) -> (b -> c) -> (a -> c)
|
(.$) :: (a -> b) -> (b -> c) -> (a -> c)
|
||||||
(.$) f g = g . f
|
(.$) f g = g . f
|
||||||
|
|
||||||
onRight :: (a -> IO b) -> Either String a -> IO b
|
|
||||||
onRight = either die
|
|
||||||
|
|
||||||
assertRight :: Either String a -> IO a
|
|
||||||
assertRight = onRight return
|
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,7 @@ module RSS (
|
||||||
import Article (Article(..))
|
import Article (Article(..))
|
||||||
import ArticlesList (ArticlesList(..), getArticles)
|
import ArticlesList (ArticlesList(..), getArticles)
|
||||||
import qualified ArticlesList (description)
|
import qualified ArticlesList (description)
|
||||||
import Blog (Blog(urls), Renderer, URL(..))
|
import Blog (Blog(..), Path(..), Renderer, URL(..))
|
||||||
import Collection (Collection(..), getAll)
|
import Collection (Collection(..), getAll)
|
||||||
import qualified Collection (title)
|
import qualified Collection (title)
|
||||||
import Control.Monad.IO.Class (MonadIO(..))
|
import Control.Monad.IO.Class (MonadIO(..))
|
||||||
|
|
@ -20,7 +20,6 @@ import Data.Time (defaultTimeLocale, formatTime, rfc822DateFormat)
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT)
|
import Lucid (Attribute, HtmlT, Term, ToHtml(..), term, renderTextT)
|
||||||
import Lucid.Base (makeAttribute)
|
import Lucid.Base (makeAttribute)
|
||||||
import Markdown (Markdown(..))
|
|
||||||
import Pretty ((.$))
|
import Pretty ((.$))
|
||||||
import System.FilePath.Posix ((</>), (<.>))
|
import System.FilePath.Posix ((</>), (<.>))
|
||||||
|
|
||||||
|
|
@ -58,12 +57,13 @@ pubDate_ :: Term arg result => arg -> result
|
||||||
pubDate_ = term "pubDate"
|
pubDate_ = term "pubDate"
|
||||||
|
|
||||||
articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
|
articleItem :: MonadReader Blog m => String -> Article -> HtmlT m ()
|
||||||
articleItem siteURL (Article (Markdown {path, metadata, title})) =
|
articleItem siteURL (Article {key, metadata, title}) =
|
||||||
item_ $ do
|
item_ $ do
|
||||||
title_ $ toHtml title
|
title_ $ toHtml title
|
||||||
link_ $ toHtml (siteURL </> path <.> "html")
|
link_ . toHtml =<< link <$> (asks $path.$articlesPath)
|
||||||
pubDate_ . toHtml . rfc822Date $ metadata ! "date"
|
pubDate_ . toHtml . rfc822Date $ metadata ! "date"
|
||||||
where
|
where
|
||||||
|
link path = siteURL </> path </> key <.> "html"
|
||||||
rfc822Date =
|
rfc822Date =
|
||||||
formatTime defaultTimeLocale rfc822DateFormat
|
formatTime defaultTimeLocale rfc822DateFormat
|
||||||
. posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
|
. posixSecondsToUTCTime . fromIntegral . (read :: String -> Int)
|
||||||
|
|
|
||||||
|
|
@ -1,86 +0,0 @@
|
||||||
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"
|
|
||||||
}
|
|
||||||
|
|
@ -1,23 +0,0 @@
|
||||||
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 []}
|
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,39 +0,0 @@
|
||||||
{-# 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
|
|
||||||
|
|
@ -1,66 +0,0 @@
|
||||||
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"
|
|
||||||
}
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,9 +0,0 @@
|
||||||
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
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
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}
|
|
||||||
|
|
@ -1,25 +0,0 @@
|
||||||
{-# 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")
|
|
||||||
]
|
|
||||||
|
|
@ -1,28 +0,0 @@
|
||||||
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"
|
|
||||||
}
|
|
||||||
|
|
@ -1,33 +0,0 @@
|
||||||
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 = []
|
|
||||||
}
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
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)
|
|
||||||
]
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
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
|
|
||||||
]
|
|
||||||
|
|
@ -1,49 +0,0 @@
|
||||||
{-# 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" </>)
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
||||||
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]
|
|
||||||
|
|
@ -1,89 +0,0 @@
|
||||||
{-# 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]
|
|
||||||
|
|
@ -1,49 +0,0 @@
|
||||||
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]
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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">
|
|
||||||
|
|
@ -1 +0,0 @@
|
||||||
<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 a new issue