An IRC bot for learning, fun and collaboration in the Freepost community.

[[ 🗃 ^VvM9v funbot ]] :: [📥 Inbox] [📤 Outbox] [🐤 Followers] [🤝 Collaborators] [🛠 Commits]

Clone

HTTPS: git clone https://vervis.peers.community/repos/VvM9v

SSH: git clone USERNAME@vervis.peers.community:VvM9v

Branches

Tags

master :: src / FunBot / Sources /

FeedWatcher.hs

{- This file is part of funbot.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

module FunBot.Sources.FeedWatcher
    ( feedWatcherSource
    )
where

import Data.Maybe (fromMaybe)
import Data.Default.Class (def)
import Data.Time.Interval (time)
import FunBot.Config (feedVisitInterval, feedDebug)
import FunBot.ExtEvents (ExtEvent (NewsEvent), NewsItem (..))
import FunBot.Types
import Network.IRC.Fun.Bot.Logger
import Text.Feed.Query
import Text.Feed.Types (Feed, Item)
import Web.Feed.Collect

import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T
import qualified Data.HashMap.Lazy as M

makeItem :: Label -> String -> Item -> ExtEvent
makeItem label ftitle item = NewsEvent NewsItem
    { itemFeedLabel = T.pack label
    , itemFeedTitle = Just $ T.pack ftitle
    , itemTitle     = fromMaybe "(no title)" $ fmap T.pack $ getItemTitle item
    , itemAuthor    = fmap T.pack $ getItemAuthor item
    , itemUrl       = fmap T.pack $ getItemLink item
    }

collect :: (ExtEvent -> IO ()) -> Label -> Url -> Feed -> Item -> IO ()
collect push label _url feed item =
    push $ makeItem label (getFeedTitle feed) item

logError :: Logger -> Label -> Error -> IO ()
logError logger label err = logLine logger $ label ++ " : " ++ show err

feedWatcherSource :: FilePath -> BotState -> ExtEventSource
feedWatcherSource file state _config env push _pushMany mkLogger = do
    logger <- mkLogger file
    let cq = feedCmdQueue env
        pairs = M.toList $ stWatchedFeeds $ bsSettings state
        mkfeed (label, nf) = def
            { fcLabel  = T.unpack $ CI.original$ unFeedLabel $ label
            , fcUrl    = T.unpack $ nfUrl nf
            , fcActive = nfActive nf
            , fcDebug  = feedDebug
            }
        feeds = map mkfeed pairs
    putStrLn "Bot: Feed watcher source loop running"
    run def
        { wcCollect       = collect push
        , wcLogError      = logError logger
        , wcCommandQueue  = Just cq
        , wcVisitInterval = time feedVisitInterval
        , wcMaxItems      = 3
        , wcFeeds         = feeds
        , wcDebug         = def
            { dcDebugCycle = feedDebug
            }
        }
[See repo JSON]