FeedMonad/FeedMonad/src/FeedMonad.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFunctor #-}
module FeedMonad where

import Data.Text (Text)
import Middleware (Middleware)
import Numeric.Natural (Natural)
import Data.Category (Category)
import Data.Acid (openLocalState, AcidState (closeAcidState))
import Control.Exception (bracket)
import Database (emptyFeedMonadState)
import Network.HTTP.Client.TLS (newTlsManager)
import Control.Monad.App (runApp)
import Data.Environment
import Control.Monad.Trans (liftIO)
import Data.URL (URL)
import Data.Foldable (for_)
import Control.Monad.HTTP (fetch, execute)
import Text.Feed.Import (parseFeedSource)


newtype Minutes = Minutes Natural

data FeedMonad = FeedMonad
  { feeds :: [Category URL]
    -- ^ The forest of urls for the feeds. It's a forest because of the categories
  , filters :: Middleware
    -- ^ The middleware. Modifies the scoring, tags and content
  , refreshTime :: Minutes
    -- ^ How often to refresh the feeds
  , secretToken :: Text
    -- ^ Used for authenticating the UI. This is a single user app
    -- served over http, so we can get around with hardcoded
    -- authentication token
  }

defaultConfig :: FeedMonad
defaultConfig = FeedMonad
  { feeds = []
  , filters = id
  , refreshTime = Minutes 30
  , secretToken = "i am a secret"
  }

defaultMain :: FeedMonad -> IO ()
defaultMain f =
  bracket (openLocalState emptyFeedMonadState) closeAcidState $ \st -> do
    mgr <- newTlsManager
    runApp (Environment mgr st) $
      for_ (feeds f) $ \c -> for_ c $ \url -> do
        feed <- parseFeedSource <$> liftIO (execute mgr (fetch url))
        liftIO $ print feed