{- This file is part of funbot. - - Written in 2015 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 - . -} -- For the 'MonadSettings' instance {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} -- For JSON field names and irc-fun-color StyledString {-# LANGUAGE OverloadedStrings #-} module FunBot.Settings ( respondGet' , respondSet' , respondReset' , respondSettingsHelp , initTree , addPushAnnSpec , deletePushAnnSpec , addRepo , deleteRepo , addChannel , addShortcut , deleteShortcut , addFeed , deleteFeed , loadBotSettings , mkSaveBotSettings ) where import Control.Applicative import Control.Monad (liftM, mzero, unless) import Control.Monad.IO.Class (liftIO) import Data.Aeson hiding (encode) import Data.Bool (bool) import Data.Char (toLower) import Data.Default.Class (def) import Data.JsonState import Data.List (intercalate, intersperse, isSuffixOf) import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid import Data.Settings.Interface import Data.Settings.Option import Data.Settings.Route import Data.Settings.Section (deleteSub, insertSub, memberSub) import Data.Settings.Types import Data.Time.Units (Second) import FunBot.Config (stateSaveInterval, configuration, settingsFilename) import FunBot.Types import FunBot.Util import Network.IRC.Fun.Bot.Chat 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.Bot.Types (Config (cfgStateRepo)) import Network.IRC.Fun.Color import Web.Feed.Collect hiding (addFeed) import qualified Data.HashMap.Lazy as M import qualified Web.Feed.Collect as F (addFeed) instance MonadSettings BotSession Settings where getSettings = getStateS bsSettings putSettings s = modifyState $ \ st -> st { bsSettings = s } modifySettings f = modifyState $ \ st -> st { bsSettings = f $ bsSettings st } getSTree = getStateS bsSTree instance OptionValue Bool where readOption s | s' `elem` ["off", "false", "no", "n", "0", "[_]"] = Just False | s' `elem` ["on", "true", "yes", "y", "1", "[x]"] = Just True | otherwise = Nothing where s' = map toLower s showOption = show typeName = const "Boolean" instance OptionValue String where readOption = Just showOption = id typeName = const "String" parseList :: String -> Maybe [String] parseList s = case break (== ',') s of ("", _) -> Nothing (p, "") -> Just [p] (p, (c:cs)) -> case parseList cs of Nothing -> Nothing Just ps -> Just $ p : ps instance OptionValue [String] where readOption s = parseList s >>= mapM readOption showOption = intercalate "," . map showOption typeName = const "List" instance FromJSON a => FromJSON (Filter a) where parseJSON (Object o) = Accept <$> o .: "accept" <|> Reject <$> o .: "reject" parseJSON _ = mzero instance ToJSON a => ToJSON (Filter a) where toJSON (Accept l) = object [ "accept" .= l ] toJSON (Reject l) = object [ "reject" .= l ] instance FromJSON PushAnnSpec where parseJSON (Object o) = PushAnnSpec <$> o .: "channel" <*> o .: "branches" <*> o .: "all-commits" parseJSON _ = mzero instance ToJSON PushAnnSpec where toJSON (PushAnnSpec chan branches allc) = object [ "channel" .= chan , "branches" .= branches , "all-commits" .= allc ] instance FromJSON NewsItemFields where parseJSON (Object o) = NewsItemFields <$> o .: "show-feed-title" <*> o .: "show-author" <*> o .: "show-url" parseJSON _ = mzero instance ToJSON NewsItemFields where toJSON (NewsItemFields ftitle author url) = object [ "show-feed-title" .= ftitle , "show-author" .= author , "show-url" .= url ] instance FromJSON NewsAnnSpec where parseJSON (Object o) = NewsAnnSpec <$> o .: "channels" <*> o .: "fields" parseJSON _ = mzero instance ToJSON NewsAnnSpec where toJSON (NewsAnnSpec channels fields) = object [ "channels" .= channels , "fields" .= fields ] instance FromJSON NewsFeed where parseJSON (Object o) = NewsFeed <$> o .: "url" <*> o .: "active" <*> o .: "ann-spec" parseJSON _ = mzero instance ToJSON NewsFeed where toJSON (NewsFeed url active spec) = object [ "url" .= url , "active" .= active , "ann-spec" .= spec ] instance FromJSON (M.HashMap (String, String) [PushAnnSpec]) where parseJSON v = let mkpair (s, l) = case break (== '/') s of (repo, _:owner) -> if not (null repo || null owner) && '/' `notElem` owner then Just ((repo, owner), l) else Nothing _ -> Nothing in M.fromList . catMaybes . map mkpair . M.toList <$> parseJSON v instance ToJSON (M.HashMap (String, String) [PushAnnSpec]) where toJSON m = let unpair ((repo, owner), l) = (repo ++ '/' : owner, l) in toJSON $ M.fromList $ map unpair $ M.toList m instance FromJSON Shortcut where parseJSON (Object o) = Shortcut <$> o .: "prefix" <*> o .: "before" <*> o .: "after" <*> o .: "channels" parseJSON _ = mzero instance ToJSON Shortcut where toJSON (Shortcut prefix before after chans) = object [ "prefix" .= prefix , "before" .= before , "after" .= after , "channels" .= chans ] instance FromJSON ChanSettings where parseJSON (Object o) = ChanSettings <$> o .: "say-titles" <*> o .: "welcome" <*> o .: "folks" <*> o .: "email" parseJSON _ = mzero instance ToJSON ChanSettings where toJSON (ChanSettings sayTitles welcome folks email) = object [ "say-titles" .= sayTitles , "welcome" .= welcome , "folks" .= folks , "email" .= email ] instance FromJSON Settings where parseJSON (Object o) = Settings <$> o .: "repos" <*> o .: "feeds" <*> o .: "shortcuts" <*> o .: "channels" parseJSON _ = mzero instance ToJSON Settings where toJSON (Settings repos feeds shortcuts channels) = object [ "repos" .= repos , "feeds" .= feeds , "shortcuts" .= shortcuts , "channels" .= channels ] -- An option whose value is held by funbot's 'Settings' and saved into its -- settings file mkOptionF :: OptionValue v => (Settings -> v) -- Get -> (v -> Settings -> Settings) -- Set which never fails -> v -- Default value for reset -> SettingsOption mkOptionF get set defval = mkOptionS get set' reset cb where set' v s = Just $ set v s reset s = (Just defval, set defval s) cb = const saveBotSettings -- A variant of 'mkOptionF' which accepts a callback to run after the default -- one. mkOptionF' :: OptionValue v => (Settings -> v) -- Get -> (v -> Settings -> Settings) -- Set which never fails -> v -- Default value for reset -> (v -> BotSession ()) -- Additional callback -> SettingsOption mkOptionF' get set defval cbx = mkOptionS get set' reset cb where set' v s = Just $ set v s reset s = (Just defval, set defval s) cb v = saveBotSettings >> cbx v -- An option whose value is held by irc-fun-bot's 'BotState' and saved into its -- state file mkOptionB :: OptionValue v => BotSession v -- Get -> (v -> BotSession ()) -- Set which never fails -> v -- Default value for reset -> SettingsOption mkOptionB get set defval = mkOptionV get set' reset where setTo val = set val >> cb val set' val = setTo val >> return True reset = setTo defval cb = const saveBotState -- Create a setting section for a spec, given its position in the spec list and -- repo/owner as matched by the web listener. pushAnnSpecSec :: String -> String -> Int -> SettingsTree pushAnnSpecSec repo owner pos = Section { secOpts = M.fromList [ ( "channel" , mkOptionF getChan (\ chan s -> let chans = stGitAnnChans s oldspecs = getSpecs s oldspec = getSpec s spec = oldspec { pAnnChannel = chan } specs = fromMaybe oldspecs $ replaceMaybe oldspecs pos spec in s { stGitAnnChans = M.insert (repo, owner) specs chans } ) defChan ) , ( "branches" , mkOptionF getBranches (\ branches s -> let chans = stGitAnnChans s oldspecs = getSpecs s oldspec = getSpec s bs = case pAnnBranches oldspec of Accept _ -> Accept branches Reject _ -> Reject branches spec = oldspec { pAnnBranches = bs } specs = fromMaybe oldspecs $ replaceMaybe oldspecs pos spec in s { stGitAnnChans = M.insert (repo, owner) specs chans } ) defBranches ) , ( "accept" , mkOptionF getAccept (\ b s -> let chans = stGitAnnChans s oldspecs = getSpecs s oldspec = getSpec s ctor = filt b bs = case pAnnBranches oldspec of Accept l -> ctor l Reject l -> ctor l spec = oldspec { pAnnBranches = bs } specs = fromMaybe oldspecs $ replaceMaybe oldspecs pos spec in s { stGitAnnChans = M.insert (repo, owner) specs chans } ) defAccept ) , ( "all-commits" , mkOptionF getAll (\ b s -> let chans = stGitAnnChans s oldspecs = getSpecs s oldspec = getSpec s spec = oldspec { pAnnAllCommits = b } specs = fromMaybe oldspecs $ replaceMaybe oldspecs pos spec in s { stGitAnnChans = M.insert (repo, owner) specs chans } ) defAll ) ] , secSubs = M.empty } where defChan = "set-channel-here" defBranches = [] defAccept = False filt b = if b then Accept else Reject defFilter = filt defAccept defBranches defAll = False defSpec = PushAnnSpec defChan defFilter defAll getSpecs = M.lookupDefault [] (repo, owner) . stGitAnnChans getSpec = fromMaybe defSpec . (!? pos) . getSpecs getChan = pAnnChannel . getSpec getFilter = pAnnBranches . getSpec getBranches = f . getFilter where f (Accept l) = l f (Reject l) = l getAccept = f . getFilter where f (Accept _) = True f (Reject _) = False getAll = pAnnAllCommits . getSpec -- Create a settings section for a git repo, given its name and owner as -- matched with the details sent to the web listener. repoSec :: (String, String) -> [PushAnnSpec] -> (String, SettingsTree) repoSec (repo, owner) specs = ( repo ++ '/' : owner , Section { secOpts = M.empty , secSubs = M.fromList $ map mksub [1 .. length specs] } ) where mksub i = (show i, pushAnnSpecSec repo owner (i - 1)) -- Create a settings section for a news feed, given its label string feedSec :: String -> 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 <- liftM getActive getSettings liftIO $ do sendCommand cq $ removeFeed label sendCommand cq $ F.addFeed def { fcLabel = label , fcUrl = 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 label b ) ) , ( "channels" , mkOptionF getChans (\ chans s -> let feeds = stWatchedFeeds s feed@NewsFeed { nfAnnSpec = spec } = getFeed s feed' = feed { nfAnnSpec = spec { nAnnChannels = 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 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 -- Create a section for a channel chanSec :: String -> SettingsTree chanSec chan = 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 ) , ( "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 [] csFolks) (setf $ \ cs fs -> cs { csFolks = fs }) [] ) , ( "email" , mkOptionF (getf "(?)" csEmail) (setf $ \ cs s -> cs { csEmail = s }) "(?)" ) ] , secSubs = M.empty } where defChan = ChanSettings True False [] "(?)" 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' } -- Create a settings section for a shortcut, given its label string shortcutSec :: String -> SettingsTree shortcutSec label = Section { secOpts = M.fromList [ ( "prefix" , mkOptionF (getf shPrefix) (setf $ \ cut prefix -> cut { shPrefix = prefix }) "" ) , ( "before" , mkOptionF (getf shBefore) (setf $ \ cut before -> cut { shBefore = before }) "" ) , ( "after" , mkOptionF (getf shAfter) (setf $ \ cut after -> cut { shAfter = after }) "" ) , ( "channels" , mkOptionF (getl shChannels) (setf $ \ cut chans -> cut { shChannels = chans }) [] ) ] , secSubs = M.empty } where err = "ERROR not found" getf f = maybe err f . M.lookup label . stShortcuts getl f = maybe [] f . M.lookup label . stShortcuts setf f v s = let cuts = stShortcuts s in case M.lookup label cuts of Nothing -> s Just cut -> let cut' = f cut v cuts' = M.insert label cut' cuts in s { stShortcuts = cuts' } -- | Build initial settings tree, already inside the session initTree :: BotSession () initTree = do cstates <- getChanInfo sets <- getSettings let mapKey f = M.mapWithKey $ \ key _val -> f key tree = Section { secOpts = M.empty , secSubs = M.fromList [ ( "channels" , Section { secOpts = M.empty , secSubs = mapKey chanSec cstates } ) , ( "repos" , Section { secOpts = M.empty , secSubs = M.fromList $ map (uncurry repoSec) $ M.toList $ stGitAnnChans sets } ) , ( "feeds" , Section { secOpts = M.empty , secSubs = mapKey feedSec $ stWatchedFeeds sets } ) , ( "shortcuts" , Section { secOpts = M.empty , secSubs = mapKey shortcutSec $ stShortcuts sets } ) ] } modifyState $ \ s -> s { bsSTree = tree } -- | Append a new push ann spec to the settings and a matching tree under the -- repo section. Return whether succeeded. addPushAnnSpec :: String -> String -> String -> BotSession Bool addPushAnnSpec repo owner chan = do repos <- liftM stGitAnnChans getSettings case M.lookup (repo, owner) repos of Just specs -> do let specs' = specs ++ [defSpec] repos' = M.insert (repo, owner) specs' repos modifySettings $ \ s -> s { stGitAnnChans = repos' } saveBotSettings let (name, sec) = repoSec (repo, owner) specs' ins = insertSub ["repos", name] sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } return True Nothing -> return False where defSpec = PushAnnSpec chan (Reject []) False -- | Remove a spec from a repo. Return 'Nothing' on success. Otherwise return -- whether the error was repo not found ('False') or index too big ('True'). -- The position given is 0-based. deletePushAnnSpec :: String -> String -> Int -> BotSession (Maybe Bool) deletePushAnnSpec repo owner pos = do repos <- liftM stGitAnnChans getSettings case M.lookup (repo, owner) repos of Just specs -> case splitAt pos specs of (l, []) -> return $ Just True (l, s:r) -> do let specs' = l ++ r repos' = M.insert (repo, owner) specs' repos modifySettings $ \ s -> s { stGitAnnChans = repos' } saveBotSettings let (name, sec) = repoSec (repo, owner) specs' ins = insertSub ["repos", name] sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } return Nothing Nothing -> return $ Just False -- | Add a new repo to settings and tree. Return whether success, i.e. whether -- the repo didn't exist and indeed a new one has been created. addRepo :: String -> String -> String -> BotSession Bool addRepo repo owner chan = do repos <- liftM stGitAnnChans getSettings case M.lookup (repo, owner) repos of Just _ -> return False Nothing -> do let repos' = M.insert (repo, owner) [defSpec] repos modifySettings $ \ s -> s { stGitAnnChans = repos' } saveBotSettings let (name, sec) = repoSec (repo, owner) [defSpec] ins = insertSub ["repos", name] sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } return True where defSpec = PushAnnSpec chan (Reject []) False -- | Remove a repo from settings and tree. Return whether success, i.e. whether -- the repo did exist and indeed has been deleted. deleteRepo :: String -> String -> BotSession Bool deleteRepo repo owner = do repos <- liftM stGitAnnChans getSettings if M.member (repo, owner) repos then do let repos' = M.delete (repo, owner) repos modifySettings $ \ s -> s { stGitAnnChans = repos' } saveBotSettings let name = repo ++ '/' : owner del = deleteSub ["repos", name] modifyState $ \ s -> s { bsSTree = del $ bsSTree s } return True else return False -- | Add a new shortcut to settings and tree. Return whether success, i.e. -- whether the shortcut didn't exist and indeed a new one has been created. addShortcut :: String -> String -> BotSession Bool addShortcut label chan = do cuts <- liftM stShortcuts getSettings case M.lookup label cuts of Just _ -> return False Nothing -> do let cuts' = M.insert label defCut cuts modifySettings $ \ s -> s { stShortcuts = cuts' } saveBotSettings let sec = shortcutSec label ins = insertSub ["shortcuts", label] sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } return True where defCut = Shortcut "PrEfIx" "http://BeFoRe.org/" "/AfTeR.html" [chan] -- | Remove a shortcut from settings and tree. Return whether success, i.e. -- whether the shortcut did exist and indeed has been deleted. deleteShortcut :: String -> BotSession Bool deleteShortcut label = do cuts <- liftM stShortcuts getSettings if M.member label cuts then do let cuts' = M.delete label cuts modifySettings $ \ s -> s { stShortcuts = cuts' } saveBotSettings let del = deleteSub ["shortcuts", label] modifyState $ \ s -> s { bsSTree = del $ bsSTree s } return True else return False -- | Add a new channel to state and tree and to be joined from now on. If -- already exists, nothing happens. addChannel :: String -> BotSession () addChannel chan = do selectChannel chan addChannelState chan sets <- getSTree let route = ["channels", chan] unless (route `memberSub` sets) $ do let sec = chanSec chan ins = insertSub route sec modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } -- | 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 :: String -> String -> BotSession Bool addFeed label url = do feeds <- liftM 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", 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 label 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 :: String -> BotSession Bool deleteFeed label = do feeds <- liftM 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", label] modifyState $ \ s -> s { bsSTree = del $ bsSTree s } -- Send command to update the feed watcher cq <- askEnvS feedCmdQueue liftIO $ sendCommand cq $ removeFeed label return True else return False showError :: SettingsError -> String showError (InvalidPath s) = s ++ " : Invalid path" showError (NoSuchNode r) = showRoute r ++ " : No such option/section" showError (NoSuchOption r) = showRoute r ++ " : No such option" showError (NoSuchSection r) = showRoute r ++ " : No such section" showError (InvalidValueForType s) = s ++ " : Invalid value for option type" showError (InvalidValue s) = s ++ " : Invalid value" showOptLine :: String -> String -> String -> String showOptLine opt op val = encode $ Yellow #> Pure opt <> Teal #> Pure op <> Maroon #> Pure val showGet :: String -> String -> String showGet opt val = showOptLine opt " = " val showSec :: String -> [String] -> [String] -> String showSec path subs opts = let showSub = Pure . ('‣' :) showOpt = Pure . ('•' :) showList = mconcat . intersperse " " pathF = Yellow #> Pure path subsF = Green #> (showList $ map showSub subs) optsF = Purple #> (showList $ map showOpt opts) in encode $ case (null subs, null opts) of (False, False) -> pathF <> " : " <> subsF <> " | " <> optsF (False, True) -> pathF <> " : " <> subsF (True, False) -> pathF <> " : " <> optsF (True, True) -> pathF <> " : Empty section" -- Remove user-friendliness parts and determine whether given string refers to -- a potential section (otherwise it could also be an potential option). stripPath :: String -> (String, Bool) stripPath opt | opt == "*" = ("", True) | ".*" `isSuffixOf` opt = (take (length opt - 2) opt, True) | otherwise = (opt, False) respondGet' :: String -> (String -> BotSession ()) -> BotSession () respondGet' opt send = resp path where (path, sec) = stripPath opt resp = if sec then respSec else respAny respAny path = do result <- query path send $ case result of Left err -> showError err Right (Left (subs, opts)) -> showSec path subs opts Right (Right val) -> showGet path val respSec path = do result <- querySection path send $ case result of Left err -> showError err Right (subs, opts) -> showSec path subs opts showSet :: String -> String -> String showSet opt val = showOptLine opt " ← " val respondSet' :: String -> String -> (String -> BotSession ()) -> BotSession () respondSet' opt val send = do merr <- updateOption opt val case merr of Just err -> send $ showError err Nothing -> send $ showSet opt val showReset :: String -> String -> String showReset opt val = showOptLine opt " ↩ " val showResetStrange :: String -> String showResetStrange opt = opt ++ " : got reset, but I can't find it now" respondReset' :: String -> (String -> BotSession ()) -> BotSession () respondReset' opt send = do merr <- resetOption opt case merr of Just err -> send $ showError err Nothing -> do me <- queryOption opt send $ case me of Left _ -> showResetStrange opt Right val -> showReset opt val help :: OptRoute -> String help r = case r of [] -> "Top level of the settings tree." ["channels"] -> "Basic per-channel settings." ["channels", _] -> "Basic settings for the channel." ["channels", _, "log"] -> "Whether events in the channel are logged by the bot locally into a \ \log file. Currently nothing is done with these logs. In the future \ \they can be used to send people activity they missed (or selected \ \parts of it), generate public logs as web pages and record meetings." ["channels", _, "track"] -> "Whether user joins and parts in the channel \ \are tracked internally. This is useful for various other features, \ \such as memos (see !tell) and listing these events in channel logs. \ \Tracking isn't enabled by default, to save bot server hardware \ \resources (in particular RAM), especially for cases of many, crowded \ \or busy channels." ["channels", _, "count"] -> "Whether channel message logs are maintained (in memory) for this \ \channel. If yes, channel history reports (which you can get when you \ \join a channel) will also specify how many messages you missed. For \ \to work, you must also enable the 'track' option." ["channels", _, "say-titles"] -> "Whether I should detect URLs sent into this channel and send their \ \titles." ["channels", _, "welcome"] -> "Whether I should send a welcome message when a new nickname unknown \ \to me joins the channel, and the channel is quiet for some time." ["channels", _, "folks"] -> "List of main people (nicknames) in the channel. This is used in the \ \welcome messages, and possibly other places." ["channels", _, "email"] -> "Email address (possibly of a mailing list) for async discussions. If \ \you ask a question and nobody responds for a while, you can send \ \your question there. Also good for long, documented discussions and \ \generally the things email is better suited for than IRC." ["repos"] -> "Git repo event announcement details." ["repos", _] -> "Event announcement details for a Git repo, specified by its name and \ \its \"owner\", (a username or an organization name). The name and \ \owner match the ones used by the dev platform which hosts the repo. \ \Announcment details are given as a set of specifications, one for \ \each IRC channel where you want the events to be announced." ["repos", _, _] -> "A Git repo event announcement specification for a specific channel. \ \It specifies the channel and defines filters to determine which \ \events should be announced." ["repos", _, _, "branches"] -> "A list of zero or more git branch names to filter by. If the \ \\"accept\" option is True, this is whitelist of branches whose \ \commits to announce (and the rest won't be announced). Otherwise, \ \it's a blacklist of branches not to announce (and all the rest will \ \be announced). By default the list is empty, and you can reset it to \ \empty using !reset." ["repos", _, _, "channel"] -> "IRC channel into which to announce the repo events." ["repos", _, _, "all-commits"] -> "Whether to announce all commits into the channel, or shorten long \ \pushes to avoid filling the channel with very long announcements. \ \For example, if you push 20 commits at once, you may prefer to see \ \just a summary or a partial report, and not have the channel filled \ \with a very long sequence of messages. The default is False, i.e. do \ \shorten long announcements." ["repos", _, _, "accept"] -> "Whether the branch list specified by the \"branches\" option is a \ \whitelist of branches whose commits to announce (True), or a \ \blacklist of branches not to announce (False). By default it's \ \False, and the branch list is empty, which together mean \"reject no \ \branches\", or in other words announce commits of *all* branches." ["feeds"] -> "News feed item announcement details." ["feeds", _] -> "Details for announcing new feed items for this feed." ["feeds", _, "url"] -> "URL of the feed." ["feeds", _, "active"] -> "Whether the feed is being watched." ["feeds", _, "channels"] -> "List of IRC channels into which to announce new items from the feed." ["feeds", _, "show"] -> "Determines which information about the new feed items should be \ \specified in the announcements." ["feeds", _, "show", "author"] -> "Whether to specify the news item author when announcing the new item." ["feeds", _, "show", "feed-title"] -> "Whether to specify the feed title when announcing a new item." ["feeds", _, "show", "url"] -> "Whether to specify the item URL when announcing the new item." ["shortcuts"] -> "List of available shortcuts." ["shortcuts", _] -> "Details of this shortcut." ["shortcuts", _, "prefix"] -> "A string by which the shortcut is identified. For example, if you'd \ \like “TKT-258” to refer to ticket #258, set the prefix to “TKT-”." ["shortcuts", _, "before"] -> "In the full form into which the shortcut is expanded, this is the \ \beginning of the string. For example, “http://funbot.org/tickets/”." ["shortcuts", _, "after"] -> "In the full form into which the shortcut is expanded, this is the \ \end of the string. For example, “.html”." ["shortcuts", _, "channels"] -> "List of IRC channels in which this shortcut applies." _ -> "No help for this item." respondSettingsHelp :: String -> (String -> BotSession ()) -> BotSession Bool respondSettingsHelp path send = let p = fst $ stripPath path in case parseRoute p of Just r -> do send $ p ++ " : " ++ help r return True Nothing -> return False saveInterval = 3 :: Second loadBotSettings :: IO Settings loadBotSettings = do r <- loadState $ stateFilePath settingsFilename (cfgStateRepo configuration) case r of Left (False, e) -> error $ "Failed to read settings file: " ++ e Left (True, e) -> error $ "Failed to parse settings file: " ++ e Right s -> return s mkSaveBotSettings :: IO (Settings -> IO ()) mkSaveBotSettings = mkSaveStateChoose stateSaveInterval settingsFilename (cfgStateRepo configuration) "auto commit by funbot" saveBotSettings :: BotSession () saveBotSettings = do sets <- getSettings save <- askEnvS saveSettings liftIO $ save sets