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 /

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
[See repo JSON]