162 lines
5.4 KiB
Haskell
162 lines
5.4 KiB
Haskell
{-# LANGUAGE GHC2021 #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
-- | Commonplace book: loads data/commonplace.yaml and renders
|
|
-- themed and chronological HTML views for /commonplace.
|
|
module Commonplace
|
|
( commonplaceCtx
|
|
) where
|
|
|
|
import Data.Aeson (FromJSON (..), withObject, (.:), (.:?), (.!=))
|
|
import Data.List (nub, sortBy)
|
|
import Data.Ord (comparing, Down (..))
|
|
import qualified Data.ByteString.Char8 as BS
|
|
import qualified Data.Yaml as Y
|
|
import Hakyll hiding (escapeHtml, renderTags)
|
|
import Contexts (siteCtx)
|
|
import Utils (escapeHtml)
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Entry type
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
data CPEntry = CPEntry
|
|
{ cpText :: String
|
|
, cpAttribution :: String
|
|
, cpSource :: Maybe String
|
|
, cpSourceUrl :: Maybe String
|
|
, cpTags :: [String]
|
|
, cpCommentary :: Maybe String
|
|
, cpDateAdded :: String
|
|
}
|
|
|
|
instance FromJSON CPEntry where
|
|
parseJSON = withObject "CPEntry" $ \o -> CPEntry
|
|
<$> o .: "text"
|
|
<*> o .: "attribution"
|
|
<*> o .:? "source"
|
|
<*> o .:? "source-url"
|
|
<*> o .:? "tags" .!= []
|
|
<*> o .:? "commentary"
|
|
<*> o .:? "date-added" .!= ""
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- HTML rendering
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | Escape HTML, then replace newlines with <br> for multi-line verse.
|
|
renderText :: String -> String
|
|
renderText = concatMap tr . escapeHtml . stripTrailingNL
|
|
where
|
|
tr '\n' = "<br>\n"
|
|
tr c = [c]
|
|
stripTrailingNL = reverse . dropWhile (== '\n') . reverse
|
|
|
|
renderAttribution :: CPEntry -> String
|
|
renderAttribution e =
|
|
"<p class=\"cp-attribution\">\x2014\x202f"
|
|
++ escapeHtml (cpAttribution e)
|
|
++ maybe "" renderSource (cpSource e)
|
|
++ "</p>"
|
|
where
|
|
renderSource src = case cpSourceUrl e of
|
|
Just url -> ", <a href=\"" ++ escapeHtml url ++ "\">"
|
|
++ escapeHtml src ++ "</a>"
|
|
Nothing -> ", " ++ escapeHtml src
|
|
|
|
renderTags :: [String] -> String
|
|
renderTags [] = ""
|
|
renderTags ts =
|
|
"<div class=\"cp-tags\">"
|
|
++ concatMap (\t -> "<span class=\"cp-tag\">" ++ escapeHtml t ++ "</span>") ts
|
|
++ "</div>"
|
|
|
|
renderEntry :: CPEntry -> String
|
|
renderEntry e = concat
|
|
[ "<article class=\"cp-entry\">"
|
|
, "<blockquote class=\"cp-quote\"><p>"
|
|
, renderText (cpText e)
|
|
, "</p></blockquote>"
|
|
, renderAttribution e
|
|
, maybe "" renderCommentary (cpCommentary e)
|
|
, renderTags (cpTags e)
|
|
, "</article>"
|
|
]
|
|
where
|
|
renderCommentary c =
|
|
"<p class=\"cp-commentary\">" ++ escapeHtml c ++ "</p>"
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Themed view
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
-- | All distinct tags in first-occurrence order (preserves YAML ordering).
|
|
allTags :: [CPEntry] -> [String]
|
|
allTags = nub . concatMap cpTags
|
|
|
|
renderTagSection :: String -> [CPEntry] -> String
|
|
renderTagSection tag entries = concat
|
|
[ "<section class=\"cp-theme-section\">"
|
|
, "<h2 class=\"cp-theme-heading\">" ++ escapeHtml tag ++ "</h2>"
|
|
, concatMap renderEntry entries
|
|
, "</section>"
|
|
]
|
|
|
|
renderThemedView :: [CPEntry] -> String
|
|
renderThemedView [] =
|
|
"<div class=\"cp-themed\" id=\"cp-themed\">"
|
|
++ "<p class=\"cp-empty\">No entries yet.</p>"
|
|
++ "</div>"
|
|
renderThemedView entries =
|
|
"<div class=\"cp-themed\" id=\"cp-themed\">"
|
|
++ concatMap renderSection (allTags entries)
|
|
++ (if null untagged then ""
|
|
else renderTagSection "miscellany" untagged)
|
|
++ "</div>"
|
|
where
|
|
renderSection t =
|
|
let es = filter (elem t . cpTags) entries
|
|
in if null es then "" else renderTagSection t es
|
|
untagged = filter (null . cpTags) entries
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Chronological view
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
renderChronoView :: [CPEntry] -> String
|
|
renderChronoView entries =
|
|
"<div class=\"cp-chrono\" id=\"cp-chrono\" hidden>"
|
|
++ if null sorted
|
|
then "<p class=\"cp-empty\">No entries yet.</p>"
|
|
else concatMap renderEntry sorted
|
|
++ "</div>"
|
|
where
|
|
sorted = sortBy (comparing (Down . cpDateAdded)) entries
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Load entries from data/commonplace.yaml
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
loadCommonplace :: Compiler [CPEntry]
|
|
loadCommonplace = do
|
|
rawItem <- load (fromFilePath "data/commonplace.yaml") :: Compiler (Item String)
|
|
let raw = itemBody rawItem
|
|
case Y.decodeEither' (BS.pack raw) of
|
|
Left err -> fail ("commonplace.yaml: " ++ show err)
|
|
Right entries -> return entries
|
|
|
|
-- ---------------------------------------------------------------------------
|
|
-- Context
|
|
-- ---------------------------------------------------------------------------
|
|
|
|
commonplaceCtx :: Context String
|
|
commonplaceCtx =
|
|
constField "commonplace" "true"
|
|
<> themedField
|
|
<> chronoField
|
|
<> siteCtx
|
|
where
|
|
themedField = field "cp-themed-html" $ \_ ->
|
|
renderThemedView <$> loadCommonplace
|
|
chronoField = field "cp-chrono-html" $ \_ ->
|
|
renderChronoView <$> loadCommonplace
|