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
DevHosts.hs
{- This file is part of funbot.
-
- Written in 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.DevHosts
( devHostOption
, addDevHost
, removeDevHost
)
where
import Control.Monad (unless, void)
import Data.Bool (bool)
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 qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Lazy as M
import qualified Data.Sequence as Q
import qualified Data.Text as T
devHostOption h@(DevHost t) =
let defl = "(?)"
getl = maybe defl unDevHostLabel . M.lookup h . stDevHosts
setl v sets =
let hosts = stDevHosts sets
hosts' = M.insert h (DevHostLabel v) hosts
in sets { stDevHosts = hosts' }
in (CI.original t, mkOptionF getl setl defl)
-- | Add a new dev host to settings and tree. Return whether success, i.e.
-- whether the dev host didn't exist and indeed a new one has been created.
addDevHost :: DevHost -> DevHostLabel -> BotSession Bool
addDevHost host label = do
hosts <- fmap stDevHosts getSettings
case M.lookup host hosts of
Just _ -> return False
Nothing -> do
let hosts' = M.insert host label hosts
modifySettings $ \ s -> s { stDevHosts = hosts' }
saveBotSettings
let (t, opt) = devHostOption host
ins = insertOpt ["dev-hosts", t] opt
modifyState $ \ s -> s { bsSTree = ins $ bsSTree s }
return True
-- | Remove a dev host from settings and tree. Return whether success, i.e.
-- whether the dev host did exist and indeed has been deleted.
removeDevHost :: DevHost -> BotSession Bool
removeDevHost host = do
hosts <- fmap stDevHosts getSettings
if M.member host hosts
then do
let hosts' = M.delete host hosts
modifySettings $ \ s -> s { stDevHosts = hosts' }
saveBotSettings
let path = ["dev-hosts", CI.original $ unDevHost host]
del = deleteOpt path
modifyState $ \ s -> s { bsSTree = del $ bsSTree s }
return True
else return False
|