By | fr33domlover |
At | 2016-01-21 |
Title | Fill dev-hosts section and add tree functions |
Description |
Edit file funbot.cabal 33188 → 33188
68 68 , FunBot.Settings.Help
69 69 , FunBot.Settings.Instances
70 70 , FunBot.Settings.MkOption
71 71 , FunBot.Settings.Sections
72 72 , FunBot.Settings.Sections.Channels
+ 73 , FunBot.Settings.Sections.DevHosts
73 74 , FunBot.Settings.Sections.Feeds
74 75 , FunBot.Settings.Sections.Locations
75 76 , FunBot.Settings.Sections.Repos
76 77 , FunBot.Settings.Sections.Shortcuts
77 78 , FunBot.Settings.Persist
… … … … Edit file src/FunBot/Settings/Sections.hs 33188 → 33188
26 26 import Data.Settings.Section
27 27 import Data.Settings.Types
28 28 import FunBot.Settings.MkOption
29 29 import FunBot.Settings.Persist
30 30 import FunBot.Settings.Sections.Channels
+ 31 import FunBot.Settings.Sections.DevHosts
31 32 import FunBot.Settings.Sections.Feeds
32 33 import FunBot.Settings.Sections.Locations
33 34 import FunBot.Settings.Sections.Repos
34 35 import FunBot.Settings.Sections.Shortcuts
35 36 import FunBot.Types
… … … … 86 87 $ stShortcuts sets
87 88 }
88 89 )
89 90 , ( "dev-hosts"
90 91 , Section
- 91 { secOpts = M.empty
+ 92 { secOpts = map' devHostOption $ stDevHosts sets
92 93 , secSubs = M.empty
93 94 }
94 95 )
95 96 , ( "locations"
96 97 , Section
… … … … Add file src/FunBot/Settings/Sections/DevHosts.hs 33188
+ 1 {- This file is part of funbot. + 2 - + 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>. + 4 - + 5 - ♡ Copying is an act of love. Please copy, reuse and share. + 6 - + 7 - The author(s) have dedicated all copyright and related and neighboring + 8 - rights to this software to the public domain worldwide. This software is + 9 - distributed without any warranty. + 10 - + 11 - You should have received a copy of the CC0 Public Domain Dedication along + 12 - with this software. If not, see + 13 - <http://creativecommons.org/publicdomain/zero/1.0/>. + 14 -} + 15 + 16 {-# LANGUAGE OverloadedStrings #-} + 17 + 18 module FunBot.Settings.Sections.DevHosts + 19 ( devHostOption + 20 , addDevHost + 21 , removeDevHost + 22 ) + 23 where + 24 + 25 import Control.Monad (unless, void) + 26 import Data.Bool (bool) + 27 import Data.Maybe (fromMaybe) + 28 import Data.Monoid ((<>)) + 29 import Data.Sequence (Seq, (|>), (><), ViewL (..)) + 30 import Data.Settings.Section + 31 import Data.Settings.Types + 32 import FunBot.Settings.MkOption + 33 import FunBot.Settings.Persist + 34 import FunBot.Types + 35 import Network.IRC.Fun.Bot.IrcLog + 36 import Network.IRC.Fun.Bot.MsgCount + 37 import Network.IRC.Fun.Bot.Nicks + 38 import Network.IRC.Fun.Bot.State + 39 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..)) + 40 + 41 import qualified Data.CaseInsensitive as CI + 42 import qualified Data.HashMap.Lazy as M + 43 import qualified Data.Sequence as Q + 44 import qualified Data.Text as T + 45 + 46 devHostOption h@(DevHost t) = + 47 let defl = "(?)" + 48 getl = maybe defl unDevHostLabel . M.lookup h . stDevHosts + 49 setl v sets = + 50 let hosts = stDevHosts sets + 51 hosts' = M.insert h (DevHostLabel v) hosts + 52 in sets { stDevHosts = hosts' } + 53 in (CI.original t, mkOptionF getl setl defl) + 54 + 55 -- | Add a new dev host to settings and tree. Return whether success, i.e. + 56 -- whether the dev host didn't exist and indeed a new one has been created. + 57 addDevHost :: DevHost -> DevHostLabel -> BotSession Bool + 58 addDevHost host label = do + 59 hosts <- fmap stDevHosts getSettings + 60 case M.lookup host hosts of + 61 Just _ -> return False + 62 Nothing -> do + 63 let hosts' = M.insert host label hosts + 64 modifySettings $ \ s -> s { stDevHosts = hosts' } + 65 saveBotSettings + 66 let (t, opt) = devHostOption host + 67 ins = insertOpt ["dev-hosts", t] opt + 68 modifyState $ \ s -> s { bsSTree = ins $ bsSTree s } + 69 return True + 70 + 71 -- | Remove a dev host from settings and tree. Return whether success, i.e. + 72 -- whether the dev host did exist and indeed has been deleted. + 73 removeDevHost :: DevHost -> BotSession Bool + 74 removeDevHost host = do + 75 hosts <- fmap stDevHosts getSettings + 76 if M.member host hosts + 77 then do + 78 let hosts' = M.delete host hosts + 79 modifySettings $ \ s -> s { stDevHosts = hosts' } + 80 saveBotSettings + 81 let path = ["dev-hosts", CI.original $ unDevHost host] + 82 del = deleteOpt path + 83 modifyState $ \ s -> s { bsSTree = del $ bsSTree s } + 84 return True + 85 else return False