From 52b67951f1e8a7f1af9b85d4ae8e7689d194574a Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 3 Aug 2015 17:43:40 +0200 Subject: Working prototype in hakyll --- .gitignore | 2 + blog.cabal | 5 ++ blog.nix | 4 +- lists/default.md.do | 41 ------------ lists/dirty-haskell/001 | 1 - lists/dirty-haskell/002 | 1 - lists/dirty-haskell/title | 1 - lists/zz_all/001 | 1 - lists/zz_all/002 | 1 - lists/zz_all/003 | 1 - lists/zz_all/title | 1 - posts/blog-documentation.md | 5 -- posts/blog-rss.md | 39 ----------- posts/pwutil.md | 119 --------------------------------- provider/css/default.css | 40 ++++++++++++ provider/index.html | 8 +++ provider/index.md | 3 + provider/posts/blog-documentation.md | 9 +++ provider/posts/blog-rss.md | 43 ++++++++++++ provider/posts/pwutil.md | 122 ++++++++++++++++++++++++++++++++++ provider/templates/default.html | 22 +++++++ provider/templates/index.html | 9 +++ provider/templates/post-list.html | 7 ++ provider/templates/tag.html | 2 + src/Site.hs | 123 +++++++++++++++++++++++++++++++++-- templates/default.html | 55 ---------------- 26 files changed, 393 insertions(+), 272 deletions(-) delete mode 100644 lists/default.md.do delete mode 120000 lists/dirty-haskell/001 delete mode 120000 lists/dirty-haskell/002 delete mode 100644 lists/dirty-haskell/title delete mode 120000 lists/zz_all/001 delete mode 120000 lists/zz_all/002 delete mode 120000 lists/zz_all/003 delete mode 100644 lists/zz_all/title delete mode 100644 posts/blog-documentation.md delete mode 100644 posts/blog-rss.md delete mode 100644 posts/pwutil.md create mode 100644 provider/css/default.css create mode 100644 provider/index.html create mode 100644 provider/index.md create mode 100644 provider/posts/blog-documentation.md create mode 100644 provider/posts/blog-rss.md create mode 100644 provider/posts/pwutil.md create mode 100644 provider/templates/default.html create mode 100644 provider/templates/index.html create mode 100644 provider/templates/post-list.html create mode 100644 provider/templates/tag.html delete mode 100644 templates/default.html diff --git a/.gitignore b/.gitignore index c4a847d..f36f933 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,3 @@ /result +/_cache/ +/_site/ diff --git a/blog.cabal b/blog.cabal index b8daa19..c014a21 100644 --- a/blog.cabal +++ b/blog.cabal @@ -17,7 +17,12 @@ build-type: Simple cabal-version: >=1.10 executable site + default-language: Haskell2010 hs-source-dirs: src main-is: Site.hs build-depends: base >=4.7 && <4.8 , hakyll >=4.6 && <5 + , containers >=0.5 && <0.6 + , pandoc >=1.13 && <2 + , data-default >=0.5 && <0.6 + , filepath >=1.3 && <2 diff --git a/blog.nix b/blog.nix index 52e23ca..a4c5d8c 100644 --- a/blog.nix +++ b/blog.nix @@ -1,7 +1,7 @@ # This file was auto-generated by cabal2nix. Please do NOT edit manually! { mkDerivation, stdenv -, hakyll +, hakyll, containers, pandoc, data-default, filepath }: mkDerivation { @@ -11,7 +11,7 @@ mkDerivation { isExecutable = true; isLibrary = false; buildDepends = [ - hakyll + hakyll containers pandoc data-default filepath ]; license = stdenv.lib.licenses.publicDomain; } diff --git a/lists/default.md.do b/lists/default.md.do deleted file mode 100644 index 55abe6f..0000000 --- a/lists/default.md.do +++ /dev/null @@ -1,41 +0,0 @@ -#!/usr/bin/env bash -redo-ifchange "$2/title" - -POSTS=() -while read -r -d $'\0'; do - post=$(realpath --relative-to=. "$REPLY") - POSTS+=("$post") -done < <(find "$2" -maxdepth 1 -mindepth 1 -not -name 'title' -not -name 'preview' -print0 | sort -z) - -for x in "${POSTS[@]}"; do - printf "%s\0%s\0" "$x" "${x%.md}.html" -done | xargs -r -0 redo-ifchange - -TITLE=$(< $2/title) - -cat <"$2/preview" -prev_no=3 -if [[ ${#POSTS[@]} -gt $prev_no ]]; then - printf "* …\n" >> "$2/preview" -else - prev_no=${#POSTS[@]} -fi - -for n in $(seq $prev_no -1 1); do - printf "* [%s](%s)\n" "${POST_TITLES[-$n]}" "${POSTS[-$n]%.md}.html" >>"$2/preview" -done diff --git a/lists/dirty-haskell/001 b/lists/dirty-haskell/001 deleted file mode 120000 index 92c240d..0000000 --- a/lists/dirty-haskell/001 +++ /dev/null @@ -1 +0,0 @@ -../../posts/blog-documentation.md \ No newline at end of file diff --git a/lists/dirty-haskell/002 b/lists/dirty-haskell/002 deleted file mode 120000 index ed24126..0000000 --- a/lists/dirty-haskell/002 +++ /dev/null @@ -1 +0,0 @@ -../../posts/blog-rss.md \ No newline at end of file diff --git a/lists/dirty-haskell/title b/lists/dirty-haskell/title deleted file mode 100644 index e40f49c..0000000 --- a/lists/dirty-haskell/title +++ /dev/null @@ -1 +0,0 @@ -Blog Software diff --git a/lists/zz_all/001 b/lists/zz_all/001 deleted file mode 120000 index 92c240d..0000000 --- a/lists/zz_all/001 +++ /dev/null @@ -1 +0,0 @@ -../../posts/blog-documentation.md \ No newline at end of file diff --git a/lists/zz_all/002 b/lists/zz_all/002 deleted file mode 120000 index ed24126..0000000 --- a/lists/zz_all/002 +++ /dev/null @@ -1 +0,0 @@ -../../posts/blog-rss.md \ No newline at end of file diff --git a/lists/zz_all/003 b/lists/zz_all/003 deleted file mode 120000 index 1057f2c..0000000 --- a/lists/zz_all/003 +++ /dev/null @@ -1 +0,0 @@ -../../posts/pwutil.md \ No newline at end of file diff --git a/lists/zz_all/title b/lists/zz_all/title deleted file mode 100644 index 73a5267..0000000 --- a/lists/zz_all/title +++ /dev/null @@ -1 +0,0 @@ -All Posts diff --git a/posts/blog-documentation.md b/posts/blog-documentation.md deleted file mode 100644 index 7db843d..0000000 --- a/posts/blog-documentation.md +++ /dev/null @@ -1,5 +0,0 @@ -% On the Origin of dirty-haskell.org - -The software used is a trivially modified version of the one powering [math.kleen.org](http://math.kleen.org/lists/blog.html). - -The title is without deeper meaning. \ No newline at end of file diff --git a/posts/blog-rss.md b/posts/blog-rss.md deleted file mode 100644 index 4e8cb24..0000000 --- a/posts/blog-rss.md +++ /dev/null @@ -1,39 +0,0 @@ -% dirty-haskell.org´s rss feeds - -I extended the software suite inherited from [math.kleen.org](http://math.kleen.org) to include support for rss feeds. -The heart of the issue is a ~80 line haskell script I chose to call, in a bout of creativity, "generate-rss.hs". -The script uses the [feed](http://hackage.haskell.org/package/feed-0.3.9.2) package. - -generate-rss.hs gets passed a title and a list of paths below ./lists to incorporate as items. -It generates an empty feed structure, adds title and a (hardcoded) base url for RSS metadata, and iterates over the given paths — generating for each path an item to be included in the finished feed. -This procedure makes use of a state monad (StateT (Feed, Maybe ClockTime) IO ()) to sequentially add items to the feed and keep track of the modification/change time of the newest path examined. -Each item carries a title, an url, a date, and contents as follows: - -- The date used is the modification/change time of the path supplied as a command line argument at the beginning of the program (usually a symbolic link in ./lists) — as such it is the time the post was linked into the particular list we´re generating a RSS feed for (this was not a deliberate design choice but a side effect of the canonical implementation — it was later decided that this behaviour was in fact the one expected all along). -- The url is generated by following, recursively, the trail of symbolic links starting in ./lists, assuming the final target is indeed in ./posts, and forming the filename of that target into a (hopefully) functional url in a hardcoded fashion. -- The title is extracted from the markdown file using a function shamelessly copied from extract-title.hs (The author wrote that one too, after all). -- The contents are read into Pandoc and rendered into [AsciiDoc](http://en.wikipedia.org/wiki/AsciiDoc) format (it seemed convenient at the time). - -Along the way two helper functions were introduced — if an implementation of those already exists in Prelude or somewhere else common please mail in a comment: - -~~~ {.haskell} -(<->) :: [(a -> b)] -> a -> [b] -[] <-> _ = [] -(f:fs) <-> x = (f x:fs <-> x) - -(<-->) :: [(a -> a)] -> a -> a -[] <--> x = x -(f:fs) <--> x = fs <--> (f x) -~~~ - -## Update ## - -~~~ {.haskell} -import Control.Applicative ((<*>), pure) - -(<->) fs = (<*>) fs . pure - -(<-->) = flip $ foldl (.) id -~~~ - -Thanks, viktor. diff --git a/posts/pwutil.md b/posts/pwutil.md deleted file mode 100644 index 176ffdc..0000000 --- a/posts/pwutil.md +++ /dev/null @@ -1,119 +0,0 @@ -% A Tool to Manage a Set of YAML Objects Representing Account Information — pwutil - -A long time ago I wrote a bunch of scripts (first in bash, then zsh, and later perl) to manage a, sometimes encrypted, file containing account information I get asked to create and remember on a daily basis—accounts for shopping websites spring to mind. - -[pwutil](git://git.yggdrasil.li/pwutil) is the newest iteration in this line of bunches of scripts. - -## Features - - * Support for embedding common operation in any kind of record keeping - - Thus support for almost any encryption known to man (with absolutely no online security), version control, and synchronisation - * [Human read- and writeable](https://en.wikipedia.org/wiki/YAML) backstore - * Machine parseable output - * [Command Line Interface](https://en.wikipedia.org/wiki/Command-line_interface)-only - * New accounts can be partially generated by user defined functions with out of the box support for [pwgen](http://sourceforge.net/projects/pwgen/) and SSH - -## Usage - -~~~ -pwget [ …] -Looks up and returns all accounts which contain any anywhere in their representation — case insensitive. - -pwadd [[--gen- [ …] …] --] [ …] -Adds an account to the store — does not overwrite. -~~~ - -## Documentation - -I shall document the project in a partial and file-wise fashion—amendments available on request. - -### Structure - -~~~ {#DirTree} -pwutil -├── default.nix -├── PWAdd.hs -├── PWGet.hs -├── PWUtil -│   ├── Extra -│   │   ├── PWGen.hs -│   │   └── SSHCmd.hs -│   ├── Types.hs -│   └── Util.hs -├── pwutil.hs -├── PWUtil.hs -└── pwutil.nix -~~~ - -### `pwutil.nix` -is a [nix](https://nixos.org/nix) expression allowing easy installation using the nix package manager. -A `~/.nixpkgs/config.nix` allowing one to do so might look thus: - -~~~ {.numberLines} -{ - packageOverrides = pkgs: { - pwutil = pkgs.callPackage /path/to/pwutil.nix {}; - }; -} -~~~ - -The derivation takes some arguments (write those in `{}` above): - -`main ? null` - ~ Overwrite `pwutil.hs` with a file path - -`with ? false` - ~ `` is one of Pwgen, or Ssh a the current time. - If `true` wraps executables to have `$PATH` include ``. - -### `Types.hs` - -Introducing `PW` (much as [xmonad](https://xmonad.org) did with `X`) is an easy way to keep track of the `PWConfig` without resorting to function arguments. -`BackStore` is our (new and improved) way of encapsulating store access in a totally customisable way—`plain`, which is essential `readFile` and `writeFile` as provided by `ByteString`, is provided for convenience in `Util.hs`. -`PWConfig` most importantly contains a definition of generators (called by passing `--gen-…` to `pwadd`). - -~~~ {#Types.hs .haskell .numberLines} -module PWUtil.Types ( - PW(..), - BackStore(..), - PWConfig(..), - Generator(..) - ) where - -import Control.Monad.State -import qualified Data.Map as M -import Data.Yaml -import Data.ByteString - -type PW = StateT PWConfig IO - -data BackStore = BackStore - { readContents :: PW ByteString - , writeContents :: ByteString -> PW () - } - -data PWConfig = PWConfig - { generators :: M.Map String Generator - , backstore :: BackStore - } - -type Generator = [String] -> PW Value -~~~ - - -### `pwutil.hs` - -is, in a [xmonad](http://xmonad.org) kind of way, the configuration file—the shipped default is reproduced below as a template for custom configs. - -~~~ {#pwutil.hs .haskell .numberLines} -import PWUtil - -import System.FilePath (()) -import System.Directory (getHomeDirectory) - -main :: IO () -main = do - h <- getHomeDirectory - runPW (emptyConfig { backstore = plain (h "accounts.yaml") }) pwutil -~~~ diff --git a/provider/css/default.css b/provider/css/default.css new file mode 100644 index 0000000..7b89107 --- /dev/null +++ b/provider/css/default.css @@ -0,0 +1,40 @@ +body { + margin: auto; + padding-right: 1em; + padding-left: 1em; + font: normal 1.1em monospace; + max-width: 60em; + text-align: justify; +} + +.display-math { + display: block; + margin-top: 0.2em; + margin-bottm: 0.2em; + text-align: center; +} + +.inline-math { + display: inline; +} + +a { + color: inherit; +} + +p { + margin-bottom: 0 +} + +p + p { + text-indent: 1.5em; + margin-top: 0; +} + +pre { + margin-left: 1.5em; +} + +p code { + font-style:italic; +} \ No newline at end of file diff --git a/provider/index.html b/provider/index.html new file mode 100644 index 0000000..8eb184f --- /dev/null +++ b/provider/index.html @@ -0,0 +1,8 @@ +$body$ +
    + $for(tags)$ +
  • + $body$ +
    • + $endfor$ +
diff --git a/provider/index.md b/provider/index.md new file mode 100644 index 0000000..53a06bc --- /dev/null +++ b/provider/index.md @@ -0,0 +1,3 @@ +This is a blog. +It contains things. +Send other things to if you so choose. diff --git a/provider/posts/blog-documentation.md b/provider/posts/blog-documentation.md new file mode 100644 index 0000000..b0d4af6 --- /dev/null +++ b/provider/posts/blog-documentation.md @@ -0,0 +1,9 @@ +--- +title: On the Origin of dirty-haskell.org +published: 2015-03-12 +tags: Blog Software +--- + +The software used is a trivially modified version of the one powering [math.kleen.org](http://math.kleen.org/lists/blog.html). + +The title is without deeper meaning. diff --git a/provider/posts/blog-rss.md b/provider/posts/blog-rss.md new file mode 100644 index 0000000..095ff56 --- /dev/null +++ b/provider/posts/blog-rss.md @@ -0,0 +1,43 @@ +--- +title: dirty-haskell.org´s rss feeds +published: 2015-03-29 +tags: Blog Software +--- + +I extended the software suite inherited from [math.kleen.org](http://math.kleen.org) to include support for rss feeds. +The heart of the issue is a ~80 line haskell script I chose to call, in a bout of creativity, "generate-rss.hs". +The script uses the [feed](http://hackage.haskell.org/package/feed-0.3.9.2) package. + +generate-rss.hs gets passed a title and a list of paths below ./lists to incorporate as items. +It generates an empty feed structure, adds title and a (hardcoded) base url for RSS metadata, and iterates over the given paths — generating for each path an item to be included in the finished feed. +This procedure makes use of a state monad (StateT (Feed, Maybe ClockTime) IO ()) to sequentially add items to the feed and keep track of the modification/change time of the newest path examined. +Each item carries a title, an url, a date, and contents as follows: + +- The date used is the modification/change time of the path supplied as a command line argument at the beginning of the program (usually a symbolic link in ./lists) — as such it is the time the post was linked into the particular list we´re generating a RSS feed for (this was not a deliberate design choice but a side effect of the canonical implementation — it was later decided that this behaviour was in fact the one expected all along). +- The url is generated by following, recursively, the trail of symbolic links starting in ./lists, assuming the final target is indeed in ./posts, and forming the filename of that target into a (hopefully) functional url in a hardcoded fashion. +- The title is extracted from the markdown file using a function shamelessly copied from extract-title.hs (The author wrote that one too, after all). +- The contents are read into Pandoc and rendered into [AsciiDoc](http://en.wikipedia.org/wiki/AsciiDoc) format (it seemed convenient at the time). + +Along the way two helper functions were introduced — if an implementation of those already exists in Prelude or somewhere else common please mail in a comment: + +~~~ {.haskell} +(<->) :: [(a -> b)] -> a -> [b] +[] <-> _ = [] +(f:fs) <-> x = (f x:fs <-> x) + +(<-->) :: [(a -> a)] -> a -> a +[] <--> x = x +(f:fs) <--> x = fs <--> (f x) +~~~ + +## Update ## + +~~~ {.haskell} +import Control.Applicative ((<*>), pure) + +(<->) fs = (<*>) fs . pure + +(<-->) = flip $ foldl (.) id +~~~ + +Thanks, viktor. diff --git a/provider/posts/pwutil.md b/provider/posts/pwutil.md new file mode 100644 index 0000000..a4b3757 --- /dev/null +++ b/provider/posts/pwutil.md @@ -0,0 +1,122 @@ +--- +title: A Tool to Manage a Set of YAML Objects Representing Account Information — pwutil +published: 2015-04-07 +--- + +A long time ago I wrote a bunch of scripts (first in bash, then zsh, and later perl) to manage a, sometimes encrypted, file containing account information I get asked to create and remember on a daily basis—accounts for shopping websites spring to mind. + +[pwutil](git://git.yggdrasil.li/pwutil) is the newest iteration in this line of bunches of scripts. + +## Features + + * Support for embedding common operation in any kind of record keeping + + Thus support for almost any encryption known to man (with absolutely no online security), version control, and synchronisation + * [Human read- and writeable](https://en.wikipedia.org/wiki/YAML) backstore + * Machine parseable output + * [Command Line Interface](https://en.wikipedia.org/wiki/Command-line_interface)-only + * New accounts can be partially generated by user defined functions with out of the box support for [pwgen](http://sourceforge.net/projects/pwgen/) and SSH + +## Usage + +~~~ +pwget [ …] +Looks up and returns all accounts which contain any anywhere in their representation — case insensitive. + +pwadd [[--gen- [ …] …] --] [ …] +Adds an account to the store — does not overwrite. +~~~ + +## Documentation + +I shall document the project in a partial and file-wise fashion—amendments available on request. + +### Structure + +~~~ {#DirTree} +pwutil +├── default.nix +├── PWAdd.hs +├── PWGet.hs +├── PWUtil +│   ├── Extra +│   │   ├── PWGen.hs +│   │   └── SSHCmd.hs +│   ├── Types.hs +│   └── Util.hs +├── pwutil.hs +├── PWUtil.hs +└── pwutil.nix +~~~ + +### `pwutil.nix` +is a [nix](https://nixos.org/nix) expression allowing easy installation using the nix package manager. +A `~/.nixpkgs/config.nix` allowing one to do so might look thus: + +~~~ {.numberLines} +{ + packageOverrides = pkgs: { + pwutil = pkgs.callPackage /path/to/pwutil.nix {}; + }; +} +~~~ + +The derivation takes some arguments (write those in `{}` above): + +`main ? null` + ~ Overwrite `pwutil.hs` with a file path + +`with ? false` + ~ `` is one of Pwgen, or Ssh a the current time. + If `true` wraps executables to have `$PATH` include ``. + +### `Types.hs` + +Introducing `PW` (much as [xmonad](https://xmonad.org) did with `X`) is an easy way to keep track of the `PWConfig` without resorting to function arguments. +`BackStore` is our (new and improved) way of encapsulating store access in a totally customisable way—`plain`, which is essential `readFile` and `writeFile` as provided by `ByteString`, is provided for convenience in `Util.hs`. +`PWConfig` most importantly contains a definition of generators (called by passing `--gen-…` to `pwadd`). + +~~~ {#Types.hs .haskell .numberLines} +module PWUtil.Types ( + PW(..), + BackStore(..), + PWConfig(..), + Generator(..) + ) where + +import Control.Monad.State +import qualified Data.Map as M +import Data.Yaml +import Data.ByteString + +type PW = StateT PWConfig IO + +data BackStore = BackStore + { readContents :: PW ByteString + , writeContents :: ByteString -> PW () + } + +data PWConfig = PWConfig + { generators :: M.Map String Generator + , backstore :: BackStore + } + +type Generator = [String] -> PW Value +~~~ + + +### `pwutil.hs` + +is, in a [xmonad](http://xmonad.org) kind of way, the configuration file—the shipped default is reproduced below as a template for custom configs. + +~~~ {#pwutil.hs .haskell .numberLines} +import PWUtil + +import System.FilePath (()) +import System.Directory (getHomeDirectory) + +main :: IO () +main = do + h <- getHomeDirectory + runPW (emptyConfig { backstore = plain (h "accounts.yaml") }) pwutil +~~~ diff --git a/provider/templates/default.html b/provider/templates/default.html new file mode 100644 index 0000000..14497b2 --- /dev/null +++ b/provider/templates/default.html @@ -0,0 +1,22 @@ + + + + + + + $if(title)$$title$$endif$ + + + + + +$if(title)$ +
+

dirty-haskell.org: $title$

+
+$endif$ +$body$ + + diff --git a/provider/templates/index.html b/provider/templates/index.html new file mode 100644 index 0000000..0eea806 --- /dev/null +++ b/provider/templates/index.html @@ -0,0 +1,9 @@ +$body$ + +
    + $for(tags)$ +
  • + $body$ +
    • + $endfor$ +
diff --git a/provider/templates/post-list.html b/provider/templates/post-list.html new file mode 100644 index 0000000..4d50d4d --- /dev/null +++ b/provider/templates/post-list.html @@ -0,0 +1,7 @@ +
    + $for(posts)$ +
  • + $if(ellipsis)$…$else$$title$$endif$ +
    • + $endfor$ +
diff --git a/provider/templates/tag.html b/provider/templates/tag.html new file mode 100644 index 0000000..8854cdd --- /dev/null +++ b/provider/templates/tag.html @@ -0,0 +1,2 @@ +$title$$if(rss)$ (RSS)$endif$ +$body$ diff --git a/src/Site.hs b/src/Site.hs index d1afbce..dde7047 100644 --- a/src/Site.hs +++ b/src/Site.hs @@ -1,16 +1,131 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, StandaloneDeriving, FlexibleInstances #-} import Hakyll +import Data.Monoid (Monoid(..), mconcat, (<>)) +import Control.Monad (liftM) +import Data.Char (toLower, isSpace, isAlphaNum) +import Data.Maybe (mapMaybe, fromMaybe) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.List (take, reverse) +import Data.Default +import Text.Pandoc.Options (WriterOptions(..), ObfuscationMethod(..)) +import Control.Applicative (Alternative(..), Applicative(..)) + +import System.FilePath (replaceExtension) + main :: IO () main = hakyllWith config $ do - match "/posts/*" $ do + match "templates/*" $ compile templateCompiler + + match "css/*" $ do + route idRoute + compile copyFileCompiler + + match "posts/*" $ do route $ setExtension ".html" compile $ do + getResourceBody >>= saveSnapshot "content" pandocCompiler - >>= saveSnapshot "content" >>= loadAndApplyTemplate "templates/default.html" defaultContext >>= relativizeUrls + tags <- buildTags "posts/*" tagTranslation' >>= addTag "All Posts" "posts/*" + + tagsRules tags $ \tag pattern -> do + route idRoute + compile $ do + let ctx = mconcat [ constField "title" tag + , listField "posts" defaultContext $ chronological =<< loadAll pattern + , defaultContext + ] + makeItem "" + >>= loadAndApplyTemplate "templates/post-list.html" ctx + >>= loadAndApplyTemplate "templates/default.html" ctx + >>= relativizeUrls + + let + tags' = tags { tagsMakeId = fromFilePath . (`replaceExtension` "rss") . toFilePath . tagsMakeId tags} + + tagsRules tags' $ \tag pattern -> do + route idRoute + compile $ do + let + feedCtx = mconcat [ bodyField "description" + , defaultContext + ] + renderRss (feedConfig tag) feedCtx =<< loadAllSnapshots pattern "content" + + match "index.md" $ do + route $ setExtension ".html" + compile $ do + let ctx = mconcat [ listField "tags" defaultContext $ mapM (\(k, _) -> renderTag k tags) $ tagsMap tags + , constField "title" "Index" + , defaultContext + ] + item <- getResourceBody + pandocCompilerWith def (def { writerEmailObfuscation = NoObfuscation }) + >>= loadAndApplyTemplate "templates/index.html" ctx + >>= loadAndApplyTemplate "templates/default.html" ctx + >>= relativizeUrls + +deriving instance Eq (Item String) + +feedConfig :: String -> FeedConfiguration +feedConfig tagName = FeedConfiguration { feedTitle = "dirty-haskell.org: " ++ tagName + , feedDescription = "dirty-haskell.org — A Blog." + , feedAuthorName = "G. Kleen" + , feedAuthorEmail = "blog@dirty-haskell.org" + , feedRoot = "https://dirty-haskell.org" + } + +renderTag :: String -- ^ Tag name + -> Tags + -> Compiler (Item String) +renderTag tag tags = do + ellipsisItem <- makeItem "" + let + ids = fromMaybe [] $ lookup tag $ tagsMap tags + postCtx = mconcat [ listField "posts" (ellipsisContext ellipsisItem) $ liftM (withEllipsis ellipsisItem) $ chronological =<< mapM load ids + , constField "title" tag + , constField "rss" ("tags/" ++ tagTranslation tag ++ ".rss") + , constField "url" ("tags/" ++ tagTranslation tag ++ ".html") + , defaultContext + ] + makeItem "" + >>= loadAndApplyTemplate "templates/post-list.html" postCtx + >>= loadAndApplyTemplate "templates/tag.html" postCtx + where + ellipsisContext item = mconcat [ boolField "ellipsis" (== item) + , defaultContext + ] + boolField name f = field name (\i -> if f i + then pure (error $ unwords ["no string value for bool field:",name]) + else empty) + withEllipsis ellipsisItem xs + | length xs > max = [ellipsisItem] ++ takeEnd (max - 1) xs + | otherwise = xs + takeEnd i = reverse . take i . reverse + max = 4 + +tagTranslation' :: String -> Identifier +tagTranslation' = fromCapture "tags/*.html" . tagTranslation + +tagTranslation :: String -> String +tagTranslation = mapMaybe charTrans + where + charTrans c + | isSpace c = Just $ '-' + | isAlphaNum c = Just $ toLower c + | otherwise = Nothing + +addTag :: MonadMetadata m => String -> Pattern -> Tags -> m Tags +addTag name pattern tags = do + ids <- getMatches pattern + return $ tags { tagsMap = tagsMap tags ++ [(name, ids)] } + config :: Configuration -config = defaultConfiguration +config = defaultConfiguration { providerDirectory = "provider" + , deployCommand = "rsync -av --progress -c --delete-delay -m _site/ gkleen@surtr.yggdrasil.li:/var/www/dirty-haskell.org/" + } diff --git a/templates/default.html b/templates/default.html deleted file mode 100644 index 970848f..0000000 --- a/templates/default.html +++ /dev/null @@ -1,55 +0,0 @@ - - - - - - -$for(author-meta)$ - -$endfor$ -$if(date-meta)$ - -$endif$ - $if(title-prefix)$$title-prefix$ - $endif$$pagetitle$ - - -$if(quotes)$ - -$endif$ -$if(highlighting-css)$ - -$endif$ -$for(css)$ - -$endfor$ -$if(math)$ - $math$ -$endif$ -$for(header-includes)$ - $header-includes$ -$endfor$ - - -$for(include-before)$ -$include-before$ -$endfor$ -$if(title)$ -
-

dirty-haskell.org: $title$

-
-$endif$ -$if(toc)$ - -$endif$ -$body$ -$for(include-after)$ -$include-after$ -$endfor$ - - -- cgit v1.2.3