diff --git a/FeedMonad-demo/FeedMonad-demo.cabal b/FeedMonad-demo/FeedMonad-demo.cabal index dd3612e..cdf9b01 100644 --- a/FeedMonad-demo/FeedMonad-demo.cabal +++ b/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 diff --git a/FeedMonad-demo/app/Main.hs b/FeedMonad-demo/app/Main.hs index f53c6df..a97641a 100644 --- a/FeedMonad-demo/app/Main.hs +++ b/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 } diff --git a/FeedMonad-demo/default.nix b/FeedMonad-demo/default.nix index bffdefd..f907130 100644 --- a/FeedMonad-demo/default.nix +++ b/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; } diff --git a/FeedMonad/src/FeedMonad.hs b/FeedMonad/src/FeedMonad.hs index 9ce18f4..0378a79 100644 --- a/FeedMonad/src/FeedMonad.hs +++ b/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" diff --git a/FeedMonad/src/Middleware.hs b/FeedMonad/src/Middleware.hs index ea793c4..279f9c6 100644 --- a/FeedMonad/src/Middleware.hs +++ b/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