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 / Settings / Sections /

Feeds.hs

{- This file is part of funbot.
 -
 - Written in 2015, 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ 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.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
[See repo JSON]