Parsing atom feeds and running middleware on them

FeedMonad-demo/FeedMonad-demo.cabal

@@ -32,7 +32,9 @@ executable FeedMonad-demo
     build-depends:
         base ^>=4.14.3.0,
         FeedMonad,
-        containers
+        containers,
+        lens,
+        regex-tdfa
 
     hs-source-dirs:   app
     default-language: Haskell2010

FeedMonad-demo/app/Main.hs

@@ -3,8 +3,13 @@ module Main where
 
 import FeedMonad
 import Data.Category
-import Data.URL (URL(..))
+import Data.URL (URL(..), _URL)
 import Database (FeedId(..))
+import Middleware
+import qualified Data.Set as S
+import Data.Entry
+import Data.List.Lens (prefixed)
+import Control.Lens
 
 myFeeds :: [ Category FeedId ]
 myFeeds =
@@ -12,6 +17,13 @@ myFeeds =
     [Leaf (FeedId (URL "https://github.com/feediron/feediron-recipes/commits/master.atom"))]
   ]
 
+myFilters :: Middleware
+myFilters =
+  modifyScore (has (tags . ix (Tag "github"))) (+10) .
+  modifyScore (has (tags . ix (Tag "haskell"))) (+20) .
+  modifyTags (has (url . _URL . prefixed "tag:github.com")) (S.insert (Tag "github"))
+
+
 main :: IO ()
 main = do
-  defaultMain defaultConfig{feeds = myFeeds }
+  defaultMain defaultConfig{feeds = myFeeds, filters = myFilters }

FeedMonad-demo/default.nix

@@ -1,11 +1,14 @@
-{ mkDerivation, base, FeedMonad, lib }:
+{ mkDerivation, base, containers, FeedMonad, lens, lib, regex-tdfa
+}:
 mkDerivation {
   pname = "FeedMonad-demo";
   version = "0.1.0.0";
   src = ./.;
   isLibrary = false;
   isExecutable = true;
-  executableHaskellDepends = [ base FeedMonad ];
+  executableHaskellDepends = [
+    base containers FeedMonad lens regex-tdfa
+  ];
   license = "unknown";
   hydraPlatforms = lib.platforms.none;
 }

FeedMonad/src/FeedMonad.hs

@@ -13,7 +13,7 @@ import Network.HTTP.Client.TLS (newTlsManager)
 import Control.Monad.App (runApp)
 import Data.Environment
 import Control.Monad.Trans (liftIO)
-import Data.Foldable (for_)
+import Data.Foldable (for_, traverse_)
 import Control.Monad.HTTP (fetch, execute)
 import Text.Feed.Import (parseFeedSource)
 import Text.Feed.Types
@@ -77,7 +77,7 @@ defaultMain f =
         feed <- parseFeedSource <$> liftIO (execute mgr (fetch u))
         case feed of
           Nothing -> pure ()
-          Just (AtomFeed atom) -> liftIO $ print $ parseAtom atom
+          Just (AtomFeed atom) -> liftIO (traverse (execute mgr . filters f pure) (parseAtom atom) >>= traverse_ print)
           Just (RSSFeed _rssFeed) -> liftIO $ putStrLn "rssFeed"
           Just (RSS1Feed _rss1Feed) -> liftIO $ putStrLn "rss1Feed"
           Just (XMLFeed _xmlFeed) -> liftIO $ putStrLn "xmlFeed"

FeedMonad/src/Middleware.hs

@@ -26,8 +26,7 @@ import Control.Monad.HTTP (FetchM)
 --       modifyScoreOnTag "crypto" (\x -> x - 100)
 -- @
 
--- XXX The IO should probably be restricted?
-type Middleware = (URL -> FetchM Entry) -> (URL -> FetchM Entry)
+type Middleware = (Entry -> FetchM Entry) -> (Entry -> FetchM Entry)
 
 -- * Low-level interface for the middlewares