funbot-0.5: 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