added Atom feed

README.md

@@ -1,10 +1,8 @@
 ## todo
 
-- RSS feed(s)
 - dark theme
 - faster thumbnail generation with openCV
 - better gallery (albums, webzines, media types, layouts, etc)
 - tag/category/search system
 - parallelization
 - draft builds + live server
-- font subsetting?

content/assets/favicon.svg

@@ -0,0 +1,9 @@
+<svg width="16" height="16" xmlns="http://www.w3.org/2000/svg">
+  <style>
+    circle { stroke: #000000; fill: none; stroke-width: 2 }
+    @media (prefers-color-scheme: dark) {
+      circle { stroke: #ffffff; }
+    }
+  </style>
+  <circle cx="8" cy="8" r="5" />
+</svg>

content/index.rst

@@ -0,0 +1 @@
+  Oh god why

content/posts/2020-09-26-syndication.rst

@@ -0,0 +1,28 @@
+---
+title: Syndication for the greater good
+description: Where I setup an Atom feed
+---
+
+I stumbled upon Matt Webb's `About Feeds <https://aboutfeeds.com/>`_ and
+realized I've been missing out on the power of web syndication for quite some
+time. Turns out most sites still make their feed available in one way or
+another. This allows anyone to subscribe to the content they are interested in
+without having to rely on a centralized platform. No more checking out one's
+twitter feed to see if they published a new piece, you get notified in due time
+automatically.
+
+One reason I never used RSS feeds before was that I never quite found the
+right newsreader app, one able to sync between devices, open-sourced and
+self-hostable. But then I discovered `miniflux
+<https://https://miniflux.app/>`_. I've now setup an instance over at
+`miniflux.acatalepsie.fr <https://miniflux.acatalepsie.fr>`_, running on the
+same RPi that hosts my site. There's even `an Android app
+<https://github.com/ConstantinCezB/Microflux>`_. What a world.
+
+The next logical step was to setup a feed for my site itself, which I did *just
+now*. You can find the link in the footer of this site. It's only the bare
+minimum as it only shows blog entries --- more to come.
+
+The takeaway is: do take the time to download a newsreader app and subscribe to
+feeds, it will be worth your while. Now, onto making blog posts which are not
+about the blog itself.

site.cabal

@@ -11,7 +11,6 @@ executable site
   other-modules:       Templates
                      , Types
                      , Page
-                     , Feed
                      , Posts
                      , Projects
                      , Common

src/Common.hs

@@ -5,12 +5,20 @@ module Common
     , module System.FilePath
     , module Achille
     , module Achille.Recipe.Pandoc
+    , module Text.Blaze.Html
+    , module Data.Text
+    , module Control.Monad
+    , module Data.Maybe
     ) where
 
 import Achille
 import Achille.Recipe.Pandoc
 
 import Data.Functor    ((<&>))
+import Control.Monad   (forM_, when)
 import Data.Sort       (sort)
 import Data.String     (fromString)
+import Data.Text       (Text)
+import Data.Maybe      (fromMaybe, mapMaybe)
 import System.FilePath
+import Text.Blaze.Html (Html)

src/Feed.hs

@@ -7,13 +7,13 @@
 
 module Feed where
 
-import Data.String (fromString)
 import Data.Text hiding (map)
 import Data.XML.Types as XML
 import qualified Data.Text.Lazy as Lazy
-import qualified Text.Atom.Feed as Atom
+import Text.Atom.Feed as Atom
 import qualified Text.Atom.Feed.Export as Export (textFeed)
 
+import Common
 import Types
 
 class Reifiable a where
@@ -22,13 +22,6 @@ class Reifiable a where
 instance Reifiable Project where
     toEntry :: Project -> Atom.Entry
     toEntry (Project {title, subtitle}) =
-        ( Atom.nullEntry
-            "https://acatalepsie.fr/"
-            (Atom.TextString $ fromString title)
-            "2020-09-02"
-        )
-        { Atom.entryContent = Just (Atom.TextContent $ fromString subtitle)
-        }
 
 toFeed :: Reifiable a => [a] -> Atom.Feed
 toFeed items =

src/Main.hs

@@ -1,6 +1,7 @@
 module Main where
 
 import qualified Data.Yaml as Yaml
+import Text.Blaze
 
 import Common
 import Templates
@@ -17,7 +18,9 @@ main = achilleWith config do
 
     -- quid page
     match_ "./quid.rst" $
-        compilePandoc <&> outerWith def {Config.title = "quid"}
+        compilePandoc 
+        <&> preEscapedText
+        <&> outerWith def {Config.title = "quid"}
         >>= saveFileAs (-<.> "html")
 
     Visual.build

src/Posts.hs

@@ -1,39 +1,112 @@
-{-# LANGUAGE DuplicateRecordFields    #-}
+{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DisambiguateRecordFields #-}
-{-# LANGUAGE NamedFieldPuns           #-}
 
 module Posts (build) where
 
-import Data.Maybe (fromMaybe, mapMaybe)
+import Text.Blaze.Internal         as I
+import Text.Blaze.Html5            as H
+import Text.Blaze.Html5.Attributes as A
+import Data.Aeson.Types (FromJSON)
+import Data.Binary      (Binary, put, get)
+import Data.Time        (UTCTime, defaultTimeLocale)
+import Data.Time.Clock  (getCurrentTime)
+import Data.Time.Format (rfc822DateFormat, formatTime)
+import GHC.Generics
+
+import Text.Atom.Feed   as Atom
+import Text.Feed.Types  (Feed(..))
+import Text.Feed.Export (textFeed)
 
 import Common
-import Page
+import Config (ropts, wopts)
-import Config
+import qualified Config
 import Templates
 
+--  metadata used for parsing YAML headers
+data PostMeta = PostMeta
+    { title       :: Text
+    , draft       :: Maybe Bool
+    , description :: Maybe Text
+    } deriving (Generic, Eq, Show)
+
+data Post = Post
+    { postTitle       :: Text
+    , postDate        :: UTCTime
+    , postDraft       :: Bool
+    , postDescription :: Maybe Text
+    , postContent     :: Text
+    , postPath        :: FilePath
+    } deriving (Generic, Eq, Show)
+
+instance FromJSON PostMeta
+instance IsTimestamped Post where timestamp = postDate
+instance Binary Post where
+    put (Post t d dr desc content path) =
+        put t >> put d >> put dr >> put desc >> put content >> put path
+    get = Post <$> get <*> get <*> get <*> get <*> get <*> get
+
+
+buildPost :: Recipe IO FilePath Post
+buildPost = do
+    src <- copyFile
+    (PostMeta title draft desc, pandoc) <- readPandocMetadataWith ropts
+    content <- renderPandocWith wopts pandoc
+
+    pure (renderPost title src content)
+        >>= saveFileAs (-<.> "html")
+        <&> Post title (timestamp src) (fromMaybe False draft) Nothing content
+
+toDate :: UTCTime -> String
+toDate = formatTime defaultTimeLocale rfc822DateFormat
 
 build :: Task IO ()
 build = do
-    posts <- reverse <$> sort <$> match "posts/*" do
+    posts <- match "posts/*" buildPost
-        src <- copyFile
+             <&> filter (not . postDraft)
-        (Page title d, pdc) <- readPandocMetadataWith ropts
+             <&> recentFirst
 
-        renderPandocWith wopts pdc
+    watch posts $ match_ "index.rst" do
-            <&> renderPost title src
-            >>= saveFileAs (-<.> "html")
-            <&> (d,) . (title,)
-            <&> timestampedWith (timestamp . snd . snd)
-
-    let visible = mapMaybe
-            (\(Timestamped d (dr, p)) ->
-                 if fromMaybe False dr then Nothing
-                                       else Just $ Timestamped d p) posts
-
-    watch visible $ match_ "index.rst" do
-        -- render index
         compilePandoc
-            <&> renderIndex visible
+            <&> renderIndex posts
             >>= saveFileAs (-<.> "html")
 
-        -- build atom feed
+        now <- liftIO getCurrentTime
-        --
+        let (Just feed) = textFeed (AtomFeed $ postsToFeed now posts)
+        write "atom.xml" feed
+
+    where
+        postsToFeed now posts =
+            ( Atom.nullFeed
+                "https://acatalepsie.fr/atom.xml"
+                (Atom.TextString "acatalepsie")
+                "2017-08-01")
+            { Atom.feedEntries = postToEntry <$> posts
+            , Atom.feedUpdated = fromString $ toDate now
+            }
+
+        postToEntry :: Post -> Atom.Entry
+        postToEntry post =
+            ( Atom.nullEntry (fromString $ postPath post)
+                             (Atom.TextString $ postTitle post)
+                             (fromString $ toDate $ postDate post))
+            { Atom.entryContent = Just $ Atom.HTMLContent $ postContent post
+            , Atom.entrySummary = Atom.HTMLString <$> postDescription post
+            }
+
+
+renderPost :: Text -> FilePath -> Text -> Html
+renderPost title source content =
+    outerWith def { Config.title = title } do
+        H.h1 $ toHtml title
+        toLink source "View source"
+        preEscapedText content
+
+
+renderIndex :: [Post] -> Text -> Html
+renderIndex posts content = 
+    outer do
+        preEscapedText content
+        H.h2 "Latest posts"
+        H.ul ! A.id "pidx" $ forM_ posts \post ->
+            H.li do
+                H.span $ fromString $ showDate (postDate post)
+                toLink (postPath post) (toHtml $ postTitle post)

src/Projects.hs

@@ -2,6 +2,7 @@ module Projects (build) where
 
 import Data.Char        (digitToInt)
 
+import Text.Blaze
 import Common
 import Types
 import Page
@@ -38,6 +39,7 @@ buildProject = do
             let (key, file) = getKey $ takeFileName filepath
             (TitledPage title _, doc) <- readPandocMetadataWith ropts
             renderPandocWith wopts doc
+                <&> preEscapedText
                 <&> outerWith (def {Config.title = fromString title})
                 >>= saveFileAs (const $ file -<.> "html")
                 <&> (title,)

src/Templates.hs

@@ -5,12 +5,11 @@
 
 module Templates where
 
-import Control.Monad (forM_, when)
 
 import Text.Blaze.Internal         as I
 import Text.Blaze.Html5            as H
 import Text.Blaze.Html5.Attributes as A
-import Data.Dates.Types (DateTime(..), months, capitalize)
+import Data.Time (UTCTime)
 import Data.Time.Format (formatTime, defaultTimeLocale)
 import Data.Time.LocalTime (zonedTimeToUTC)
 
@@ -19,9 +18,8 @@ import Common
 import Config
 import qualified Data.Map.Strict as Map
 
-showDate :: DateTime -> String
+showDate :: UTCTime -> String
-showDate (DateTime y m d _ _ _) = month <> " " <> show d <> ", " <> show y
+showDate = formatTime defaultTimeLocale "%b %d, %_Y"
-    where month = take 3 $ capitalize (months !! (m - 1))
 
 loading :: AttributeValue -> Attribute
 loading = I.customAttribute "loading"
@@ -32,34 +30,16 @@ property = I.customAttribute "property"
 toLink :: FilePath -> Html -> Html
 toLink url = H.a ! A.href (fromString $ "/" <> url)
 
-
+renderVisual :: Text -> [Timestamped FilePath] -> Html
-renderIndex :: [Timestamped (String, FilePath)] -> Html -> Html
-renderIndex posts content = 
-    outer do
-        content
-        H.h2 "Latest notes"
-        H.ul ! A.id "pidx" $ forM_ posts \(Timestamped d (title, src)) ->
-            H.li do
-                H.span $ fromString $ showDate d
-                toLink src (fromString title)
-
-renderPost :: String -> FilePath -> Html -> Html
-renderPost title source content =
-    outerWith def { Config.title = fromString title } do
-        H.h1 $ fromString title
-        toLink source "View source"
-        content
-
-renderVisual :: Html -> [Timestamped FilePath] -> Html
 renderVisual txt imgs =
     outer do
-        txt
+        preEscapedText txt
         H.hr
         H.section $ forM_ imgs \ (Timestamped _ p) ->
             H.figure $ H.img ! A.src    (fromString p)
                              ! loading "lazy"
 
-renderProject :: Project -> [(String, FilePath)] -> Html -> Html
+renderProject :: Project -> [(String, FilePath)] -> Text -> Html
 renderProject (project@Project{title,..}) children content =
     outerWith def { Config.title       = fromString title
                   , Config.description = fromString subtitle
@@ -78,7 +58,7 @@ renderProject (project@Project{title,..}) children content =
         when (length children > 0) $
             H.ol ! A.class_ "pages" $ forM_ children \(t,l) ->
                 H.li $ H.a ! A.href (fromString l) $ (fromString t)
-        content
+        preEscapedText content
 
 renderReadings :: [Book] -> Html
 renderReadings books =
@@ -98,10 +78,10 @@ renderReadings books =
                                    $ zonedTimeToUTC d
                         Nothing -> "·"
 
-renderProjects :: Html -> [(Project, FilePath)] -> Html
+renderProjects :: Text -> [(Project, FilePath)] -> Html
 renderProjects txt paths =
     outer do
-        txt
+        preEscapedText txt
         H.ul ! A.class_ "projects" $ do
             forM_ paths \(Project {title,..}, link) -> H.li $ H.a ! A.href (fromString link) $ do
                 H.div $ H.img ! A.src (fromString $ link </> "logo.svg")
@@ -126,20 +106,20 @@ outerWith SiteConfig{title,..} content = H.docTypeHtml do
         H.meta ! A.name "robots" ! A.content "index, follow"
         H.meta ! charset "utf-8"
         H.link ! A.rel "stylesheet" ! A.href "/assets/theme.css"
-
+        H.link ! A.rel   "shortcut icon"
-        -- OpenGraph
+               ! A.type_ "image/svg"
+               ! A.href  "/assets/favicon.svg"
+        H.link ! A.rel   "alternate"
+               ! A.type_ "application/atom+xml"
+               ! A.href  "/atom.xml"
         H.meta ! property "og:title"
                ! A.content (textValue title)
-
         H.meta ! property "og:type"
                ! A.content "website"
-
         H.meta ! property "og:image"
                ! A.content (textValue image)
-
         H.meta ! property "og:description"
                ! A.content (textValue description)
-
         H.title $ toHtml title
 
     H.body do
@@ -150,6 +130,7 @@ outerWith SiteConfig{title,..} content = H.docTypeHtml do
                 H.a ! A.href "/visual.html"   $ "Visual"
                 H.a ! A.href "/readings.html" $ "Readings"
                 H.a ! A.href "/quid.html"     $ "Quid"
+                H.a ! A.href "/atom.xml"      $ "Feed"
 
         H.main content
 
@@ -158,4 +139,6 @@ outerWith SiteConfig{title,..} content = H.docTypeHtml do
             H.a ! A.href "https://creativecommons.org/licenses/by-nc/2.0/" $ "CC BY-NC 2.0"
             " · "
             H.a ! A.href "https://instagram.com/ba.bou.m/" $ "instagram"
+            " · "
+            H.a ! A.href "/atom.xml" $ "feed"