add rss [fixes #1]

make-pages/RSS.hs

@@ -0,0 +1,80 @@
+module RSS (make, make') where
+
+import Info
+import BuilderQQ
+import Records ()
+
+import Data.List (sortOn)
+import Data.Ord (Down (..))
+import qualified Data.Text as Strict
+import qualified Data.Text.Lazy as Lazy
+import qualified Data.Time as Time
+import System.FilePath (takeDirectory)
+
+
+make :: Strict.Text    -- ^ website root e.g. @https://gallery.niss.website@
+     -> Strict.Text    -- ^ title
+     -> Strict.Text    -- ^ description
+     -> FilePath       -- ^ gallery prefix e.g. @main@
+     -> Maybe FilePath -- ^ output filename for self link
+     -> [(FilePath, Info)]
+     -> Lazy.Text
+make root title desc prefix output infos =
+  toLazyText $ make' root title desc prefix output infos
+
+make' :: Strict.Text -> Strict.Text -> Strict.Text
+      -> FilePath -> Maybe FilePath -> [(FilePath, Info)] -> Builder
+make' root title desc prefix output infos = [b|@0
+    <?xml version="1.0" encoding="UTF-8"?>
+    <rss version="2.0"
+         xmlns:atom="http://www.w3.org/2005/Atom">
+      <channel>
+        <title>$*title</title>
+        <link>$link</link>
+        <description>$*desc</description>
+        $selflink
+
+        $4.items
+      </channel>
+    </rss>
+  |]
+ where
+  link = [b|$*root/$@prefix|]
+  items = map (uncurry $ makeItem root prefix) $ sortOn (Down . #second) infos
+  selflink = case output of
+    Nothing -> ""
+    Just o  -> [b|@4
+        <atom:link href="$link/$@o" rel="self" />
+      |]
+
+makeItem :: Strict.Text -> FilePath -> FilePath -> Info -> Builder
+makeItem root prefix path (Info {title, description, date}) = [b|@4
+    <item>
+      <title>$*title</title>
+      <link>$link</link>
+      <guid>$link</guid>
+      $description'
+      <pubDate>$date'</pubDate>
+    </item>
+  |]
+ where
+  dir  = takeDirectory path
+  link = [b|$*root/$@prefix/$@dir|]
+  description' =
+    case description of
+      Nothing -> ""
+      Just d  -> [b|@6
+        <description>
+          <![CDATA[
+            $10*d
+          ]]>
+        </description>
+      |]
+  date' = formatDate date
+
+formatDate :: Day -> Builder
+formatDate d =
+  fromString $ Time.formatTime Time.defaultTimeLocale format $
+  Time.UTCTime d 15669
+ where
+  format = "%a, %d %b %_Y %T GMT"