By | fr33domlover |
At | 2016-01-25 |
Title | Add first puppet command |
Description |
Edit file funbot.cabal 33188 → 33188
53 53 , FunBot.Commands.History
54 54 , FunBot.Commands.Info
55 55 , FunBot.Commands.Locations
56 56 , FunBot.Commands.Memos
57 57 , FunBot.Commands.Misc
+ 58 , FunBot.Commands.Puppet
58 59 , FunBot.Commands.Repos
59 60 , FunBot.Commands.Settings
60 61 , FunBot.Commands.Shortcuts
61 62 , FunBot.Commands.UserOptions
62 63 , FunBot.Config
… … … … Edit file src/FunBot/Commands.hs 33188 → 33188
25 25 import FunBot.Commands.History
26 26 import FunBot.Commands.Info
27 27 import FunBot.Commands.Locations
28 28 import FunBot.Commands.Memos
29 29 import FunBot.Commands.Misc
+ 30 import FunBot.Commands.Puppet
30 31 import FunBot.Commands.Repos
31 32 import FunBot.Commands.Settings
32 33 import FunBot.Commands.Shortcuts
33 34 import FunBot.Commands.UserOptions
34 35 import FunBot.Types
… … … … 71 72 , cmdWhereGlobal
72 73 , cmdAddWhereLocal
73 74 , cmdRemoveWhereLocal
74 75 , cmdAddWhereGlobal
75 76 , cmdRemoveWhereGlobal
+ 77 , cmdPuppetStart
76 78 ]
77 79 }
… … … … Edit file src/FunBot/Puppet.hs 33188 → 33188
25 25 , puppetCheck
26 26 , puppetCheckChannel
27 27 )
28 28 where
29 29 + 30 import Control.Monad (when)
+ 31 import Data.Maybe
+ 32 import Data.Monoid ((<>))
+ 33 import Data.Foldable (traverse_)
30 34 import Formatting ((%))
31 35 import FunBot.Types
+ 36 import Network.IRC.Fun.Bot.Chat
32 37 import Network.IRC.Fun.Bot.State
- 33 import Network.IRC.Color.Format (formatMsg)
- 34 import Network.IRC.Color.Format.Long
+ 38 import Network.IRC.Fun.Color.Format (formatMsg)
+ 39 import Network.IRC.Fun.Color.Format.Long
35 40 import Network.IRC.Fun.Types.Base
36 41 37 42 import qualified Data.HashMap.Lazy as M
38 43 import qualified Data.HashSet as S
39 44 … … … … 51 56 mcs <- getStateS $ M.lookup chan . stChannels . bsSettings
52 57 let lpts = fromMaybe S.empty $ fmap csPuppeteers mcs
53 58 if nick `S.member` gpts || nick `S.member` lpts
54 59 then do
55 60 let puppet' = M.insert chan nick puppet
- 56 modifyStateS $ \ s -> s { bsPuppet = puppet' }
+ 61 modifyState $ \ s -> s { bsPuppet = puppet' }
57 62 return Nothing
58 63 else return $ Just True
59 64 60 65 -- | Start private puppet mode by the given nickname. Return 'Nothing' on
61 66 -- success. Otherwise 'False' means private puppet mode is already on, and
… … … … 67 72 then return $ Just False
68 73 else do
69 74 gpts <- getStateS $ stPuppeteers . bsSettings
70 75 if nick `S.member` gpts
71 76 then do
- 72 modifyStateS $ \ s -> s { bsPrivPuppet = Just nick }
+ 77 modifyState $ \ s -> s { bsPrivPuppet = Just nick }
73 78 return Nothing
74 79 else return $ Just True
75 80 76 81 -- | Stop puppet mode in a channel. Return 'Nothing' on success. Otherwise
77 82 -- 'False' means the channel isn't in puppet mode, and 'True' means it is, but
… … … … 89 94 mcs <- getStateS $ M.lookup chan . stChannels . bsSettings
90 95 let lpts = fromMaybe S.empty $ fmap csPuppeteers mcs
91 96 if nick `S.member` gpts || nick `S.member` lpts
92 97 then do
93 98 let puppet' = M.delete chan puppet
- 94 modifyStateS $ \ s -> s { bsPuppet = puppet' }
+ 99 modifyState $ \ s -> s { bsPuppet = puppet' }
95 100 return Nothing
96 101 else return $ Just True
97 102 else return $ Just False
98 103 99 104 -- | Stop private puppet mode. Return 'Nothing' on success. Otherwise
… … … … 109 114 if isJust mpteer
110 115 then do
111 116 gpts <- getStateS $ stPuppeteers . bsSettings
112 117 if nick `S.member` gpts
113 118 then do
- 114 modifyStateS $ \ s -> s { bsPrivPuppet = Nothing }
+ 119 modifyState $ \ s -> s { bsPrivPuppet = Nothing }
115 120 return Nothing
116 121 else return $ Just True
117 122 else return $ Just False
118 123 119 124 -- | While in puppet mode, ask the bot to send a message into the channel.
… … … … 126 131 -> MsgContent
127 132 -> Bool -- ^ Whether to reveal the message comes from the puppeteer
128 133 -> BotSession (Maybe Bool)
129 134 puppetSay chan nick msg reveal = do
130 135 puppet <- getStateS bsPuppet
- 131 case M.lookup chan puppet
+ 136 case M.lookup chan puppet of
132 137 Nothing -> return $ Just False
133 138 Just pteer ->
134 139 if nick == pteer
- 135 then
+ 140 then do
136 141 let msg' =
137 142 if reveal
138 143 then formatMsg
139 144 ("[" % nickname % "] " % message)
140 145 nick msg
141 146 else msg
- 142 in sendToChannel chan msg'
+ 147 sendToChannel chan msg'
+ 148 return Nothing
143 149 else return $ Just True
144 150 145 151 -- | While in private puppet mode, ask the bot to send a message to a user.
146 152 -- Return 'Nothing' on success (i.e. the message is sent to the IRC server).
147 153 -- Otherwise, 'False' means private puppet mode is off, and 'True' means
… … … … 156 162 mpteer <- getStateS bsPrivPuppet
157 163 case mpteer of
158 164 Nothing -> return $ Just False
159 165 Just pteer ->
160 166 if nick == pteer
- 161 then
+ 167 then do
162 168 let msg' =
163 169 if reveal
164 170 then formatMsg
165 171 ("[" % nickname % "] " % message)
166 172 nick msg'
167 173 else msg
- 168 in sendToUser recip msg'
+ 174 sendToUser recip msg'
+ 175 return Nothing
169 176 else return $ Just True
170 177 171 178 -- | Finish puppet mode in all channels. This can be useful for emergency etc.
172 179 -- Return whether succeeded, i.e. whether user is a global puppeteer.
173 180 puppetReset
… … … … 178 185 gpteers <- getStateS $ stPuppeteers . bsSettings
179 186 if nick `S.member` gpteers
180 187 then do
181 188 puppetChans <- getStateS $ M.keys . bsPuppet
182 189 muser <- getStateS bsPrivPuppet
- 183 modifyStateS $
+ 190 modifyState $
184 191 \ s -> s { bsPuppet = M.empty, bsPrivPuppet = Nothing }
185 192 when ann $ do
186 193 let msg =
187 194 MsgContent $ "Puppet mode reset by " <> unNickname nick
188 195 traverse_ (flip sendToChannel msg) puppetChans
… … … … 190 197 return True
191 198 else return False
192 199 193 200 -- | Check in which channels puppet mode is enabled, and whether private puppet
194 201 -- mode is enabled.
- 195 puppetCheck :: BotSesssion ([Channel], Bool)
+ 202 puppetCheck :: BotSession ([Channel], Bool)
196 203 puppetCheck = do
197 204 chans <- getStateS $ M.keys . bsPuppet
198 205 priv <- getStateS $ isJust . bsPrivPuppet
199 206 return (chans, priv)
200 207 … … … … Edit file src/FunBot/Types.hs 33188 → 33188
43 43 , UserOptions (..)
44 44 , BotState (..)
45 45 , BotSession
46 46 , ExtEventSource
47 47 , ExtEventHandler
+ 48 , Respond
+ 49 , BotCmd
48 50 )
49 51 where
50 52 51 53 import Control.Concurrent.Chan (Chan)
52 54 import Data.Aeson (FromJSON (..), ToJSON (..))
… … … … 58 60 import Data.Sequence (Seq)
59 61 import Data.Settings.Types (Section (..), Option (..))
60 62 import Data.Text (Text)
61 63 import Data.Time.Clock (UTCTime)
62 64 import FunBot.ExtEvents (ExtEvent)
- 63 import Network.IRC.Fun.Bot.Types (Session, EventSource, EventHandler)
+ 65 import Network.IRC.Fun.Bot.Types (Session, EventSource, EventHandler, Command)
64 66 import Network.IRC.Fun.Types.Base (Nickname, Channel, MsgContent)
65 67 import Web.Feed.Collect (CommandQueue)
66 68 67 69 import qualified Data.CaseInsensitive as CI
68 70 … … … … 301 303 -- | Shortcut alias for event source function type
302 304 type ExtEventSource = EventSource BotEnv BotState ExtEvent
303 305 304 306 -- | Shortcut alias for event handler function type
305 307 type ExtEventHandler = EventHandler BotEnv BotState ExtEvent
+ 308 + 309 -- | The type of command response functions
+ 310 type Respond
+ 311 = Maybe Channel
+ 312 -> Nickname
+ 313 -> [Text]
+ 314 -> (MsgContent -> BotSession ())
+ 315 -> BotSession ()
+ 316 + 317 -- | Bot command type
+ 318 type BotCmd = Command BotEnv BotState
… … … … Add file src/FunBot/Commands/Puppet.hs 33188
+ 1 {- This file is part of funbot. + 2 - + 3 - Written in 2015, 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.Commands.Puppet + 19 ( cmdPuppetStart + 20 --, cmdPuppetEnd + 21 --, cmdPuppetStatus + 22 --, cmdPuppetSay + 23 ) + 24 where + 25 + 26 import Formatting ((%)) + 27 import FunBot.Puppet + 28 import FunBot.Types + 29 import FunBot.Util + 30 import Network.IRC.Fun.Bot.Chat + 31 import Network.IRC.Fun.Bot.Types + 32 import Network.IRC.Fun.Color.Format (formatMsg) + 33 import Network.IRC.Fun.Color.Format.Long + 34 import Network.IRC.Fun.Types (Channel (..)) + 35 + 36 start chan nick send = do + 37 result <- puppetStart chan nick + 38 send $ case result of + 39 Just False -> + 40 formatMsg + 41 (nickname % ", I already have " % channel % " in puppet mode.") + 42 nick chan + 43 Just True -> + 44 formatMsg + 45 ( nickname + 46 % ", you aren’t listed as a puppeteer for " + 47 % channel + 48 ) + 49 nick chan + 50 Nothing -> + 51 formatMsg + 52 (nickname % ", puppet mode started for " % channel) + 53 nick chan + 54 + 55 respondPuppetStart :: Respond + 56 respondPuppetStart Nothing _nick [] send = + 57 send "Please specify a channel, or use this command in a channel." + 58 respondPuppetStart (Just chan) nick [] send = start chan nick send + 59 respondPuppetStart _mchan nick [chant] send = + 60 let chan = Channel chant + 61 in if looksLikeChan chan + 62 then start chan nick send + 63 else send $ notchan chan + 64 respondPuppetStart mchan nick args _send = + 65 failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing + 66 + 67 cmdPuppetStart :: BotCmd + 68 cmdPuppetStart = Command + 69 { cmdNames = cmds ["puppet-start"] + 70 , cmdRespond = respondPuppetStart + 71 , cmdHelp = + 72 "‘puppet-start’ - enable puppet mode in the current \ + 73 \channel\n\ + 74 \‘puppet-start <channel>’ - enable puppet mode in the given channel" + 75 , cmdExamples = + 76 [ "puppet-start" + 77 , "puppet-start #freepost-bot" + 78 ] + 79 }