merge feeds

1 files changed, 62 insertions, 13 deletions

diff --git a/app/Main.hs b/app/Main.hs
index 35e675a..99daa6e 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,37 +1,86 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Main where
 
 import Conduit
+import Control.Exception
 import Data.Maybe
+import Data.Text qualified as T
 import Data.XML.Types
 import Network.HTTP.Conduit
 import Text.Atom.Conduit.Parse
 import Text.Atom.Conduit.Render
+import Text.Atom.Types
 import Text.XML.Stream.Parse
 import Text.XML.Stream.Render
 import Text.XML.Unresolved (elementToEvents)
 
+env_FEED_TITLE :: T.Text
+env_FEED_TITLE = "code.nomath.org"
+
+env_FEED_ID :: T.Text
+env_FEED_ID = "code.nomath.org"
+
+env_FEED_URLS :: [String]
+env_FEED_URLS =
+  [ "https://code.nomath.org/anissue/atom",
+    "https://code.nomath.org/apaperless/atom",
+    "https://code.nomath.org/abuilder/atom",
+    "https://code.nomath.org/infra/atom",
+    "https://code.nomath.org/json2sql/atom",
+    "https://code.nomath.org/nomath-org/atom",
+    "https://code.nomath.org/static-nomath-org/atom"
+  ]
+
 main :: IO ()
 main = do
-  request <- parseRequest "https://code.nomath.org/abuilder/atom"
   manager <- newManager tlsManagerSettings
   runResourceT do
-    response <- http request manager
-    runConduit $
-      ( \feed ->
-          renderAtomFeed feed
-            .| renderBytes def
-            .| printC
-      )
-        . fromJust
-        =<< responseBody response
-          .| parseBytes def
-          .| massage
-          .| atomFeed
+    feeds <- mapM (getFeed manager) env_FEED_URLS
+    let feed = merge feeds
+    runConduit do
+      renderAtomFeed feed
+        .| renderBytes def
+        .| sinkFile "output.atom"
+
+merge :: [AtomFeed] -> AtomFeed
+merge feeds =
+  AtomFeed
+    { feedAuthors = concatMap (.feedAuthors) feeds,
+      feedCategories = concatMap (.feedCategories) feeds,
+      feedContributors = concatMap (.feedContributors) feeds,
+      feedEntries = concatMap (.feedEntries) feeds,
+      feedGenerator = Nothing,
+      feedIcon = Nothing,
+      feedId = env_FEED_ID,
+      feedLinks = concatMap (.feedLinks) feeds,
+      feedLogo = Nothing,
+      feedRights = Nothing,
+      feedSubtitle = Nothing,
+      feedTitle = AtomPlainText TypeText env_FEED_TITLE,
+      feedUpdated = minimum (map (.feedUpdated) feeds)
+    }
+
+data ParserError = ParserError String
+  deriving (Show)
+
+instance Exception ParserError
+
+getFeed :: Manager -> String -> ResourceT IO AtomFeed
+getFeed manager url = do
+  request <- parseRequest url
+  response <- http request manager
+  fromMaybe (throw (ParserError url))
+    <$> runConduit do
+      responseBody response
+        .| parseBytes def
+        .| massage
+        .| atomFeed
 
 massage :: ConduitT Event Event (ResourceT IO) ()
 massage = do