-- |
-- Description: Rules for generating pages with generic articles.
-- Copyright: Copyright (C) 2024 Yoo Chung
-- License: All rights reserved
-- Maintainer: web@chungyc.org
--
-- Exports the rules for generic articles on the site.
module Web.Site.Rules.Article (rules, items) where

import Hakyll
import Text.Pandoc.Builder (setMeta)
import Web.Site.Compilers
import Web.Site.Routes

-- |
-- Rules related to generic articles.
--
-- I.e., articles that are not specifically updates about things related to me or this site.
-- In particular, they will usually not have content that is time-sensitive.
--
-- Articles have support for:
--
-- * Rendering math.
-- * Bibliographic references.
-- * Table of contents.
--
-- See the [guide on writing for the site](https://chungyc.org/article/technical/website/guide)
-- for how to enable these for individual pages.
rules :: Rules ()
rules :: Rules ()
rules = do
  -- Individual articles.
  Pattern -> Rules () -> Rules ()
match Pattern
articlePattern (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$
      Routes -> Routes -> Routes
composeRoutes Routes
dropExtensions (Routes -> Routes) -> Routes -> Routes
forall a b. (a -> b) -> a -> b
$
        -- Index pages have should URLs to the directory.
        String -> (String -> String) -> Routes
gsubRoute String
"/index$" (String -> String -> String
forall a b. a -> b -> a
const String
"/index.html")

    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
      Compiler (Item String)
articleCompiler
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
"articles"
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/article.html" Context String
siteContext
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
siteContext

  -- A curated index to the articles.
  Pattern -> Rules () -> Rules ()
match Pattern
"article/index.markdown" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Routes
constRoute String
"articles"
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$
      Compiler (Item String)
pandocCompiler
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
siteContext

  -- The archive page with links to all articles.
  Pattern -> Rules () -> Rules ()
match Pattern
"article/archive.html" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route (Routes -> Rules ()) -> Routes -> Rules ()
forall a b. (a -> b) -> a -> b
$ String -> Routes
constRoute String
"article/archive"
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
      [Item String]
articles <- [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots Pattern
articlePattern String
"articles"
      let context :: Context String
context =
            String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"articles" Context String
siteContext ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item String]
articles)
              Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext

      Compiler (Item String)
getResourceBody
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Context String -> Item String -> Compiler (Item String)
applyAsTemplate Context String
context
        Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Identifier
-> Context String -> Item String -> Compiler (Item String)
forall a.
Identifier -> Context a -> Item a -> Compiler (Item String)
loadAndApplyTemplate Identifier
"templates/default.html" Context String
context

  -- RSS feed for articles.
  [Identifier] -> Rules () -> Rules ()
create [Identifier
"articles.xml"] (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
idRoute
    Compiler (Item String) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile (Compiler (Item String) -> Rules ())
-> Compiler (Item String) -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
      let itemContext :: Context String
itemContext = Context String
forall a. Context a
metadataField Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> String -> Context String
bodyField String
"description" Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext
      [Item String]
articles <- ([Item String] -> [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall a b. (a -> b) -> Compiler a -> Compiler b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Item String] -> [Item String]
forall a. Int -> [a] -> [a]
take Int
10) (Compiler [Item String] -> Compiler [Item String])
-> ([Item String] -> Compiler [Item String])
-> [Item String]
-> Compiler [Item String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item String] -> Compiler [Item String]
forall (m :: * -> *) a.
(MonadMetadata m, MonadFail m) =>
[Item a] -> m [Item a]
recentFirst ([Item String] -> Compiler [Item String])
-> Compiler [Item String] -> Compiler [Item String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pattern -> String -> Compiler [Item String]
forall a.
(Binary a, Typeable a) =>
Pattern -> String -> Compiler [Item a]
loadAllSnapshots Pattern
articlePattern String
"articles"
      FeedConfiguration
-> Context String -> [Item String] -> Compiler (Item String)
renderRss FeedConfiguration
updateFeedConfiguration Context String
itemContext [Item String]
articles

  Pattern -> Rules () -> Rules ()
match Pattern
"article/bibliography/references.bib" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item Biblio) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item Biblio)
biblioCompiler
  Pattern -> Rules () -> Rules ()
match Pattern
"article/bibliography/acm.csl" (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ Compiler (Item CSL) -> Rules ()
forall a.
(Binary a, Typeable a, Writable a) =>
Compiler (Item a) -> Rules ()
compile Compiler (Item CSL)
cslCompiler

-- |
-- Pattern for files which are individual articles.
--
-- Does not include the overall index for the articles.
articlePattern :: Pattern
articlePattern :: Pattern
articlePattern =
  Pattern
"article/**"
    Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/archive.html"
    Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/index.markdown"
    Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/bibliography/**"
    Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"article/**.metadata"

-- |
-- Pattern for files matched or created in this module.
--
-- These will be used to generate the sitemap.
items :: Pattern
items :: Pattern
items =
  Pattern
articlePattern
    Pattern -> Pattern -> Pattern
.||. Pattern
"article/index.markdown"
    Pattern -> Pattern -> Pattern
.||. Pattern
"article/archive.html"

-- |
-- The Pandoc compiler, but with support for:
--
-- * rendering math
-- * bibliographic references
-- * table of contents
articleCompiler :: Compiler (Item String)
articleCompiler :: Compiler (Item String)
articleCompiler = do
  let readerOptions :: ReaderOptions
readerOptions = ReaderOptions -> ReaderOptions
mathReaderWith ReaderOptions
defaultHakyllReaderOptions
  WriterOptions
writerOptions <- WriterOptions -> Compiler WriterOptions
getTocOptionsWith (WriterOptions -> Compiler WriterOptions)
-> WriterOptions -> Compiler WriterOptions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> WriterOptions
mathWriterWith WriterOptions
defaultHakyllWriterOptions
  Item Biblio
bibFile <- Identifier -> Compiler (Item Biblio)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load Identifier
"article/bibliography/references.bib"
  Item CSL
cslFile <- Identifier -> Compiler (Item CSL)
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load Identifier
"article/bibliography/acm.csl"
  Compiler (Item String)
getResourceBody
    Compiler (Item String)
-> (Item String -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
readerOptions
    Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item Pandoc -> Compiler (Item Pandoc)
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item Pandoc -> Compiler (Item Pandoc))
-> (Item Pandoc -> Item Pandoc)
-> Item Pandoc
-> Compiler (Item Pandoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pandoc -> Pandoc) -> Item Pandoc -> Item Pandoc
forall a b. (a -> b) -> Item a -> Item b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Bool -> Pandoc -> Pandoc
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Pandoc -> Pandoc
setMeta Text
"link-citations" Bool
True)
    Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item CSL -> Item Biblio -> Item Pandoc -> Compiler (Item Pandoc)
processPandocBiblio Item CSL
cslFile Item Biblio
bibFile
    Compiler (Item Pandoc)
-> (Item Pandoc -> Compiler (Item String))
-> Compiler (Item String)
forall a b. Compiler a -> (a -> Compiler b) -> Compiler b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Item String -> Compiler (Item String)
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Item String -> Compiler (Item String))
-> (Item Pandoc -> Item String)
-> Item Pandoc
-> Compiler (Item String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
writerOptions

-- |
-- Feed configuration for updates.
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration =
  FeedConfiguration
    { feedTitle :: String
feedTitle = String
"Articles by Yoo Chung",
      feedDescription :: String
feedDescription = String
"Articles written by Yoo Chung and posted on their personal web site.",
      feedAuthorName :: String
feedAuthorName = String
"Yoo Chung",
      feedAuthorEmail :: String
feedAuthorEmail = String
"web@chungyc.org",
      feedRoot :: String
feedRoot = String
"https://chungyc.org"
    }