-- |
-- Description: Rules for generating pages with recent updates.
-- Copyright: Copyright (C) 2024 Yoo Chung
-- License: All rights reserved
-- Maintainer: web@chungyc.org
--
-- Exports rules generating updates about me or the web site.
module Web.Site.Rules.Update (rules, items, withLatest) where

import Hakyll
import Web.Site.Compilers
import Web.Site.Routes

-- |
-- Rules related to recent updates about me or the web site.
rules :: Rules ()
rules :: Rules ()
rules = do
  -- The overview page.
  Pattern -> Rules () -> Rules ()
match Pattern
"update/index.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
"updates"
    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]
updates <- [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
updatePattern String
"updates"
      let updatesContext :: Context String
updatesContext =
            String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"updates" Context String
siteContext ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return [Item String]
updates)
              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
updatesContext
        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
updatesContext

  -- Individual update page.
  Pattern -> Rules () -> Rules ()
match Pattern
updatePattern (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
    Routes -> Rules ()
route Routes
dropExtensions
    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
>>= String -> Item String -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Item a -> Compiler (Item a)
saveSnapshot String
"updates"
        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/update.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

  -- RSS feed for updates.
  [Identifier] -> Rules () -> Rules ()
create [Identifier
"updates.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 feedContext :: Context String
feedContext = String -> Context String
bodyField String
"description" Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext
      [Item String]
posts <- ([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
updatePattern String
"updates"
      FeedConfiguration
-> Context String -> [Item String] -> Compiler (Item String)
renderRss FeedConfiguration
updateFeedConfiguration Context String
feedContext [Item String]
posts

-- |
-- Pattern for files which are individual updates.
--
-- Does not include the overall index for updates.
updatePattern :: Pattern
updatePattern :: Pattern
updatePattern = Pattern
"update/**" Pattern -> Pattern -> Pattern
.&&. Pattern -> Pattern
complement Pattern
"update/index.html"

-- |
-- Pattern for files matched or created in this module.
--
-- These will be used to generate the sitemap.
items :: Pattern
items :: Pattern
items = Pattern
"update/**"

-- |
-- Apply a context with the latest update in the list field @latest-update@ to the given rule.
--
-- In particular, this is used by the front page to include the latest update.
-- The latest update will have a @latest-update@ metadata field with a true value
-- and a @teaser@ metadata field with the teaser if it exists.
withLatest :: (Context String -> Compiler (Item String)) -> Compiler (Item String)
withLatest :: (Context String -> Compiler (Item String))
-> Compiler (Item String)
withLatest Context String -> Compiler (Item String)
f = do
  [Item String]
updates <- ([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
1) (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
updatePattern String
"updates"
  let indexContext :: Context String
indexContext
        | [] <- [Item String]
updates = Context String
siteContext
        | Bool
otherwise = String
-> Context String -> Compiler [Item String] -> Context String
forall a b. String -> Context a -> Compiler [Item a] -> Context b
listField String
"latest-update" Context String
updateContext ([Item String] -> Compiler [Item String]
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item String]
updates) Context String -> Context String -> Context String
forall a. Semigroup a => a -> a -> a
<> Context String
siteContext
  Context String -> Compiler (Item String)
f Context String
indexContext
  where
    updateContext :: Context String
updateContext =
      [Context String] -> Context String
forall a. Monoid a => [a] -> a
mconcat
        [ String -> (Item String -> Bool) -> Context String
forall a. String -> (Item a -> Bool) -> Context a
boolField String
"latest-update" (Bool -> Item String -> Bool
forall a b. a -> b -> a
const Bool
True),
          String -> String -> Context String
teaserField String
"teaser" String
"updates",
          Context String
siteContext
        ]

-- | Feed configuration for updates.
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration :: FeedConfiguration
updateFeedConfiguration =
  FeedConfiguration
    { feedTitle :: String
feedTitle = String
"Updates for Yoo Chung",
      feedDescription :: String
feedDescription = String
"Occasional personal updates from Yoo Chung.",
      feedAuthorName :: String
feedAuthorName = String
"Yoo Chung",
      feedAuthorEmail :: String
feedAuthorEmail = String
"web@chungyc.org",
      feedRoot :: String
feedRoot = String
"https://chungyc.org"
    }