{- This file is part of funbot. - - Written in 2015, 2016 by fr33domlover . - - ♡ 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 - . -} {-# LANGUAGE OverloadedStrings #-} module FunBot.Settings.Sections.Feeds ( feedSec , addFeed , deleteFeed ) where import Control.Monad (unless) import Control.Monad.IO.Class (liftIO) import Data.Bool (bool) import Data.Default.Class (def) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Sequence (Seq, (|>), (><), ViewL (..)) import Data.Settings.Section import Data.Settings.Types import FunBot.Settings.MkOption import FunBot.Settings.Persist import FunBot.Types import Network.IRC.Fun.Bot.IrcLog import Network.IRC.Fun.Bot.MsgCount import Network.IRC.Fun.Bot.Nicks import Network.IRC.Fun.Bot.State import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..)) import Web.Feed.Collect hiding (addFeed) import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Lazy as M import qualified Data.Sequence as Q import qualified Data.Text as T import qualified Web.Feed.Collect as F (addFeed) -- | Create a settings section for a news feed, given its label string feedSec :: FeedLabel -> SettingsTree feedSec label = Section { secOpts = M.fromList [ ( "url" , mkOptionF' getUrl (\ url s -> let feeds = stWatchedFeeds s feed = getFeed s feed' = feed { nfUrl = url } in s { stWatchedFeeds = M.insert label feed' feeds } ) defUrl (\ url -> do cq <- askEnvS feedCmdQueue active <- fmap getActive getSettings liftIO $ do sendCommand cq $ removeFeed labelt sendCommand cq $ F.addFeed def { fcLabel = labelt , fcUrl = T.unpack url , fcActive = active } ) ) , ( "active" , mkOptionF' getActive (\ b s -> let feeds = stWatchedFeeds s feed = getFeed s feed' = feed { nfActive = b } in s { stWatchedFeeds = M.insert label feed' feeds } ) defActive (\ b -> do cq <- askEnvS feedCmdQueue liftIO $ sendCommand cq $ setFeedActive labelt b ) ) , ( "channels" , mkOptionF (map unChannel . getChans) (\ chans s -> let feeds = stWatchedFeeds s feed@NewsFeed { nfAnnSpec = spec } = getFeed s feed' = feed { nfAnnSpec = spec { nAnnChannels = map Channel chans } } in s { stWatchedFeeds = M.insert label feed' feeds } ) defChans ) ] , secSubs = M.fromList [ ( "show" , Section { secOpts = M.fromList [ ( "feed-title" , mkOptionF (dispFeedTitle . getFields) (\ b s -> let feed@NewsFeed { nfAnnSpec = spec } = getFeed s fieldsOld = nAnnFields spec fields = fieldsOld { dispFeedTitle = b } feed' = feed { nfAnnSpec = spec { nAnnFields = fields } } in s { stWatchedFeeds = M.insert label feed' $ stWatchedFeeds s } ) (dispFeedTitle defFields) ) , ( "author" , mkOptionF (dispAuthor . getFields) (\ b s -> let feed@NewsFeed { nfAnnSpec = spec } = getFeed s fieldsOld = nAnnFields spec fields = fieldsOld { dispAuthor = b } feed' = feed { nfAnnSpec = spec { nAnnFields = fields } } in s { stWatchedFeeds = M.insert label feed' $ stWatchedFeeds s } ) (dispAuthor defFields) ) , ( "url" , mkOptionF (dispUrl . getFields) (\ b s -> let feed@NewsFeed { nfAnnSpec = spec } = getFeed s fieldsOld = nAnnFields spec fields = fieldsOld { dispUrl = b } feed' = feed { nfAnnSpec = spec { nAnnFields = fields } } in s { stWatchedFeeds = M.insert label feed' $ stWatchedFeeds s } ) (dispUrl defFields) ) ] , secSubs = M.empty } ) ] } where labelt = T.unpack $ CI.original $ unFeedLabel label defChans = [] defFields = NewsItemFields True True True defSpec = NewsAnnSpec defChans defFields defUrl = "" defActive = False defFeed = NewsFeed defUrl defActive defSpec getFeed = M.lookupDefault defFeed label . stWatchedFeeds getUrl = maybe defUrl nfUrl . M.lookup label . stWatchedFeeds getActive = maybe defActive nfActive . M.lookup label . stWatchedFeeds getSpec = maybe defSpec nfAnnSpec . M.lookup label . stWatchedFeeds getChans = nAnnChannels . getSpec getFields = nAnnFields . getSpec -- | Add a new feed to settings and tree. Return whether success, i.e. whether -- the feed didn't exist and indeed a new one has been created. addFeed :: FeedLabel -> T.Text -> BotSession Bool addFeed label url = do feeds <- fmap stWatchedFeeds getSettings case M.lookup label feeds of Just _ -> return False Nothing -> do -- Update and save settings let feed = NewsFeed { nfUrl = url , nfActive = True , nfAnnSpec = defSpec } feeds' = M.insert label feed feeds modifySettings $ \ s -> s { stWatchedFeeds = feeds' } saveBotSettings -- Update settings UI tree let sec = feedSec label ins = insertSub ["feeds", CI.original $ unFeedLabel label] sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } -- Send command to update the feed watcher cq <- askEnvS feedCmdQueue liftIO $ sendCommand cq $ F.addFeed $ mkFeed (T.unpack $ CI.original $ unFeedLabel label) (T.unpack url) return True where defChans = [] defFields = NewsItemFields True True True defSpec = NewsAnnSpec defChans defFields -- | Remove a feed from settings and tree. Return whether success, i.e. whether -- the feed did exist and indeed has been deleted. deleteFeed :: FeedLabel -> BotSession Bool deleteFeed label = do feeds <- fmap stWatchedFeeds getSettings if M.member label feeds then do -- Update and save settings let feeds' = M.delete label feeds modifySettings $ \ s -> s { stWatchedFeeds = feeds' } saveBotSettings -- Update settings UI tree let del = deleteSub ["feeds", CI.original $ unFeedLabel label] modifyState $ \ s -> s { bsSTree = del $ bsSTree s } -- Send command to update the feed watcher cq <- askEnvS feedCmdQueue liftIO $ sendCommand cq $ removeFeed $ T.unpack $ CI.original $ unFeedLabel label return True else return False