An IRC bot for learning, fun and collaboration in the Freepost community.
Clone
HTTPS:
git clone https://vervis.peers.community/repos/VvM9v
SSH:
git clone USERNAME@vervis.peers.community:VvM9v
Branches
Tags
Feeds.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 | {- 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
|