{- This file is part of funbot. - - Written in 2015, 2016 by fr33domlover . - - ♡ 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 - . -} {-# LANGUAGE OverloadedStrings #-} module FunBot.Settings.Sections.Channels ( chanSec , addChannel , addLocalLocation , removeLocalLocation ) 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.HashSet as S import qualified Data.Sequence as Q import qualified Data.Text as T defChan = ChanSettings True False [] "(?)" M.empty S.empty Nothing locationOption chan l@(LocationLabel t) = let defl = "(?)" getl l sets = fromMaybe defl $ do cs <- M.lookup chan $ stChannels sets loc <- M.lookup l $ csLocations cs return $ unLocation loc setl l v sets = let chans = stChannels sets cs = M.lookupDefault defChan chan chans locs = csLocations cs locs' = M.insert l (Location v) locs cs' = cs { csLocations = locs' } chans' = M.insert chan cs' chans in sets { stChannels = chans' } f l = mkOptionF (getl l) (setl l) defl in (CI.original t, f l) -- | Create a section for a channel. chanSec :: Channel -> [LocationLabel] -> SettingsTree chanSec chan lls = Section { secOpts = M.fromList [ ( "track" , mkOptionB (channelIsTracked chan) (bool (stopTrackingChannel chan) (startTrackingChannel chan)) False ) , ( "count" , mkOptionB (chanIsCounted chan) (bool (stopCountingChan chan) (startCountingChan chan)) False ) , ( "log" , mkOptionB (channelIsLogged chan) (bool (stopLoggingChannel chan) (startLoggingChannel chan)) False ) , ( "def-response" , mkOptionB (defRespEnabled chan) (void . setDefResp chan) True ) , ( "say-titles" , mkOptionF (getf True csSayTitles) (setf $ \ cs say -> cs { csSayTitles = say }) True ) , ( "welcome" , mkOptionF (getf False csWelcome) (setf $ \ cs w -> cs { csWelcome = w }) False ) , ( "folks" , mkOptionF (getf [] $ map unNickname . csFolks) (setf $ \ cs fs -> cs { csFolks = map Nickname fs }) [] ) , ( "email" , mkOptionF (getf "(?)" csEmail) (setf $ \ cs s -> cs { csEmail = s }) "(?)" ) , ( "browse" , mkOptionF (getf "" $ fromMaybe "" . csBrowse) (setf $ \ cs url -> if T.null url then cs { csBrowse = Nothing } else cs { csBrowse = Just url } ) "" ) ] , secSubs = M.fromList [ ( "locations" , Section { secOpts = M.fromList $ map (locationOption chan) lls , secSubs = M.empty } ) ] } where getf e f = maybe e f . M.lookup chan . stChannels setf f v s = let chans = stChannels s cs = M.lookupDefault defChan chan chans cs' = f cs v chans' = M.insert chan cs' chans in s { stChannels = chans' } -- | Add a new channel to state and tree and to be joined from now on. If -- already exists, nothing happens. addChannel :: Channel -> BotSession () addChannel chan = do selectChannel chan addChannelState chan sets <- getSTree let route = ["channels", unChannel chan] unless (route `memberSub` sets) $ do let sec = chanSec chan [] ins = insertSub route sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } -- | Add a new location item to a channel's settings and tree. Return 'Nothing' -- on success. Otherwise return whether the channel isn't selected ('False') or -- the location label already exists ('True'). addLocalLocation :: Channel -> LocationLabel -> Location -> BotSession (Maybe Bool) addLocalLocation chan label location = do sel <- channelSelected chan if sel then do chans <- fmap stChannels getSettings let cs = M.lookupDefault defChan chan chans locs = csLocations cs case M.lookup label locs of Just _ -> return $ Just True Nothing -> do let locs' = M.insert label location locs cs' = cs { csLocations = locs' } chans' = M.insert chan cs' chans modifySettings $ \ s -> s { stChannels = chans' } saveBotSettings let (t, opt) = locationOption chan label path = ["channels", unChannel chan, "locations", t] ins = insertOpt path opt modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } return Nothing else return $ Just False -- | Remove a channel-specific location from settings and tree. Return whether -- success, i.e. whether the location did exist and indeed has been deleted. removeLocalLocation :: Channel -> LocationLabel -> BotSession Bool removeLocalLocation chan label = do chans <- fmap stChannels getSettings case M.lookup chan chans of Nothing -> return False Just cs -> let locs = csLocations cs in if M.member label locs then do let locs' = M.delete label locs cs' = cs { csLocations = locs' } chans' = M.insert chan cs' chans modifySettings $ \ s -> s { stChannels = chans' } saveBotSettings let t = CI.original $ unLocationLabel label path = ["channels", unChannel chan, "locations", t] del = deleteOpt path modifyState $ \ s -> s { bsSTree = del $ bsSTree s } return True else return False