| By | fr33domlover |
| At | 2016-01-21 |
| Title | Add location (a.k.a Where) system and move to irc-fun-types |
| Description |
Edit file NEWS.md 33188 → 33188
38 38 39 39 * Add case-insensitive >= 1
40 40 formatting >= 6.2
41 41 hashable
42 42 irc-fun-client >= 0.5
- 43 irc-fun-messages >= 0.3
+ 43 irc-fun-types <0.2
44 44 * Require funbot-ext-events >= 0.3
45 45 irc-fun-bot >= 0.6
46 46 irc-fun-color >= 0.2
47 47 settings >= 0.3
48 48 vcs-web-hook-parse >= 0.2
… … … … Edit file funbot.cabal 33188 → 33188
50 50 other-modules: FunBot.Commands
51 51 , FunBot.Commands.Channels
52 52 , FunBot.Commands.Feeds
53 53 , FunBot.Commands.History
54 54 , FunBot.Commands.Info
+ 55 , FunBot.Commands.Locations
55 56 , FunBot.Commands.Memos
56 57 , FunBot.Commands.Misc
57 58 , FunBot.Commands.Repos
58 59 , FunBot.Commands.Settings
59 60 , FunBot.Commands.Shortcuts
… … … … 61 62 , FunBot.Config
62 63 , FunBot.ExtHandlers
63 64 , FunBot.History
64 65 , FunBot.IrcHandlers
65 66 , FunBot.KnownNicks
+ 67 , FunBot.Locations
66 68 , FunBot.Memos
67 69 , FunBot.Settings
68 70 , FunBot.Settings.Help
69 71 , FunBot.Settings.Instances
70 72 , FunBot.Settings.MkOption
… … … … 105 107 , http-client >=0.4.19
106 108 , http-client-tls >=0.2.2
107 109 , http-listen
108 110 , irc-fun-bot >=0.6 && <0.7
109 111 , irc-fun-client >=0.5 && <0.6
- 110 , irc-fun-color >=0.2
- 111 , irc-fun-messages >=0.3 && <0.4
+ 112 , irc-fun-color >=0.2 && <0.3
+ 113 , irc-fun-types <0.2
112 114 , json-state
113 115 , network-uri
114 116 , settings >=0.3
115 117 , tagsoup >=0.13
116 118 , text
… … … … Edit file src/Main.hs 33188 → 33188
87 87 ]
88 88 where
89 89 privCmds = cmds
90 90 [ "help", "info", "echo", "tell", "get", "show-opts", "enable-history"
91 91 , "disable-history", "set-history-lines", "erase-opts", "show-history"
+ 92 , "where", "lwhere", "gwhere"
92 93 ]
93 94 94 95 95 96 -- | Bot behavior definition
96 97 behavior :: Behavior BotEnv BotState
… … … … Edit file src/FunBot/Commands.hs 33188 → 33188
22 22 23 23 import FunBot.Commands.Channels
24 24 import FunBot.Commands.Feeds
25 25 import FunBot.Commands.History
26 26 import FunBot.Commands.Info
+ 27 import FunBot.Commands.Locations
27 28 import FunBot.Commands.Memos
28 29 import FunBot.Commands.Misc
29 30 import FunBot.Commands.Repos
30 31 import FunBot.Commands.Settings
31 32 import FunBot.Commands.Shortcuts
… … … … 63 64 , cmdAddShortcut
64 65 , cmdDeleteShortcut
65 66 , cmdShowHistory
66 67 , cmdAddFeed
67 68 , cmdDeleteFeed
+ 69 , cmdWhere
+ 70 , cmdWhereLocal
+ 71 , cmdWhereGlobal
+ 72 , cmdAddWhereLocal
+ 73 , cmdRemoveWhereLocal
+ 74 , cmdAddWhereGlobal
+ 75 , cmdRemoveWhereGlobal
68 76 ]
69 77 }
… … … … Edit file src/FunBot/Config.hs 33188 → 33188
35 35 import Data.Text (Text)
36 36 import Data.Time.Interval (time)
37 37 import Data.Time.Units
38 38 import Network.IRC.Fun.Bot.Types
39 39 import Network.IRC.Fun.Client.IO
- 40 import Network.IRC.Fun.Messages.Types
+ 40 import Network.IRC.Fun.Types.Base
41 41 42 42 stateSaveInterval = 3 :: Second
43 43 44 44 configuration = def
45 45 { cfgConnection = def… … … … Edit file src/FunBot/ExtHandlers.hs 33188 → 33188
36 36 import Network.HTTP (Request (..), RequestMethod (..))
37 37 import Network.IRC.Fun.Bot.Chat (sendToChannel)
38 38 import Network.IRC.Fun.Bot.Nicks (channelIsTracked, isInChannel)
39 39 import Network.IRC.Fun.Bot.State
40 40 import Network.IRC.Fun.Color
- 41 import Network.IRC.Fun.Messages.Types
+ 41 import Network.IRC.Fun.Types.Base
42 42 import Prelude hiding (mapM_)
43 43 44 44 import qualified Data.CaseInsensitive as CI
45 45 import qualified Data.HashMap.Lazy as M
46 46 import qualified Data.Text as T
… … … … Edit file src/FunBot/History.hs 33188 → 33188
36 36 import Network.IRC.Fun.Bot.Chat
37 37 import Network.IRC.Fun.Bot.MsgCount
38 38 import Network.IRC.Fun.Bot.State
39 39 import Network.IRC.Fun.Bot.Types (HistoryLine (..))
40 40 import Network.IRC.Fun.Color
- 41 import Network.IRC.Fun.Messages.Types
+ 41 import Network.IRC.Fun.Types.Base
42 42 import Prelude hiding (mapM_)
43 43 import System.IO
44 44 import Text.Printf (printf)
45 45 46 46 import qualified Data.HashMap.Lazy as M
… … … … Edit file src/FunBot/IrcHandlers.hs 33188 → 33188
45 45 import FunBot.Util (unsnoc)
46 46 import Network.HTTP.Client
47 47 import Network.HTTP.Client.TLS (tlsManagerSettings)
48 48 import Network.IRC.Fun.Bot.Chat (sendToChannel)
49 49 import Network.IRC.Fun.Bot.State
- 50 import Network.IRC.Fun.Messages.Types
+ 50 import Network.IRC.Fun.Types.Base
51 51 import Text.HTML.TagSoup
52 52 53 53 import qualified Data.ByteString as B
54 54 import qualified Data.ByteString.Lazy.UTF8 as BU
55 55 import qualified Data.HashMap.Lazy as M
… … … … Edit file src/FunBot/KnownNicks.hs 33188 → 33188
31 31 import Data.JsonState
32 32 import FunBot.Config (stateSaveInterval, configuration, nicksFilename)
33 33 import FunBot.Types
34 34 import Network.IRC.Fun.Bot.State
35 35 import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
- 36 import Network.IRC.Fun.Messages.Types (Channel, Nickname (..))
+ 36 import Network.IRC.Fun.Types.Base (Channel, Nickname (..))
37 37 38 38 import qualified Data.HashMap.Lazy as M
39 39 import qualified Data.HashSet as S
40 40 41 41 -- | Consider this nick known in the given channel from now on.
… … … … Edit file src/FunBot/Memos.hs 33188 → 33188
43 43 import Network.IRC.Fun.Bot.Chat (sendToChannel, sendToUser)
44 44 import Network.IRC.Fun.Bot.Nicks (channelIsTracked, isInChannel, presence)
45 45 import Network.IRC.Fun.Bot.State
46 46 import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
47 47 import Network.IRC.Fun.Color
- 48 import Network.IRC.Fun.Messages.Types
+ 48 import Network.IRC.Fun.Types.Base
49 49 50 50 import qualified Data.HashMap.Lazy as M
51 51 import qualified Data.Text as T
52 52 53 53 -------------------------------------------------------------------------------
… … … … Edit file src/FunBot/Settings.hs 33188 → 33188
52 52 import Network.IRC.Fun.Bot.MsgCount
53 53 import Network.IRC.Fun.Bot.Nicks
54 54 import Network.IRC.Fun.Bot.State
55 55 import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
56 56 import Network.IRC.Fun.Color
- 57 import Network.IRC.Fun.Messages.Types (MsgContent (..))
+ 57 import Network.IRC.Fun.Types.Base (MsgContent (..))
58 58 import Web.Feed.Collect hiding (addFeed)
59 59 60 60 import qualified Data.HashMap.Lazy as M
61 61 import qualified Data.Text as T
62 62 import qualified Web.Feed.Collect as F (addFeed)
… … … … Edit file src/FunBot/Types.hs 33188 → 33188
59 59 import Data.Settings.Types (Section (..), Option (..))
60 60 import Data.Text (Text)
61 61 import Data.Time.Clock (UTCTime)
62 62 import FunBot.ExtEvents (ExtEvent)
63 63 import Network.IRC.Fun.Bot.Types (Session, EventSource, EventHandler)
- 64 import Network.IRC.Fun.Messages.Types (Nickname, Channel, MsgContent)
+ 64 import Network.IRC.Fun.Types.Base (Nickname, Channel, MsgContent)
65 65 import Web.Feed.Collect (CommandQueue)
66 66 67 67 import qualified Data.CaseInsensitive as CI
68 68 69 69 instance (FromJSON s, CI.FoldCase s) => FromJSON (CI s) where
… … … … Edit file src/FunBot/UserOptions.hs 33188 → 33188
43 43 import FunBot.Types
44 44 import FunBot.Util (getHistoryLines)
45 45 import Network.IRC.Fun.Bot.Chat (sendToUser)
46 46 import Network.IRC.Fun.Bot.State
47 47 import Network.IRC.Fun.Bot.Types (Config (cfgStateRepo))
- 48 import Network.IRC.Fun.Messages.Types
+ 48 import Network.IRC.Fun.Types.Base
49 49 50 50 import qualified Data.HashMap.Lazy as M
51 51 52 52 -------------------------------------------------------------------------------
53 53 -- Utilities
… … … … Edit file src/FunBot/Util.hs 33188 → 33188
38 38 import Data.Monoid ((<>))
39 39 import Data.Text (Text)
40 40 import FunBot.Types
41 41 import Network.IRC.Fun.Bot.State (askTimeGetter, getChanInfo)
42 42 import Network.IRC.Fun.Bot.Types (ChanInfo (ciHistoryLines), CommandName (..))
- 43 import Network.IRC.Fun.Messages.Types
+ 43 import Network.IRC.Fun.Types.Base
44 44 45 45 import qualified Data.CaseInsensitive as CI (mk)
46 46 import qualified Data.HashMap.Lazy as M (lookup)
47 47 import qualified Data.Text as T
48 48 … … … … Edit file src/FunBot/Settings/Instances.hs 33188 → 33188
30 30 import Data.Maybe (catMaybes)
31 31 import Data.Monoid ((<>))
32 32 import Data.Settings.Types
33 33 import FunBot.Types
34 34 import Network.IRC.Fun.Bot.State
- 35 import Network.IRC.Fun.Messages.Types (Nickname (..))
+ 35 import Network.IRC.Fun.Types.Base (Nickname (..))
36 36 37 37 import qualified Data.CaseInsensitive as CI
38 38 import qualified Data.HashMap.Lazy as M
39 39 import qualified Data.Text as T
40 40 … … … … Edit file src/FunBot/Settings/Sections.hs 33188 → 33188
33 33 import FunBot.Settings.Sections.Locations
34 34 import FunBot.Settings.Sections.Repos
35 35 import FunBot.Settings.Sections.Shortcuts
36 36 import FunBot.Types
37 37 import Network.IRC.Fun.Bot.State
- 38 import Network.IRC.Fun.Messages.Types (Channel (..))
+ 38 import Network.IRC.Fun.Types.Base (Channel (..))
39 39 40 40 import qualified Data.CaseInsensitive as CI
41 41 import qualified Data.HashMap.Lazy as M
42 42 import qualified Data.Sequence as Q
43 43 import qualified Data.Text as T
… … … … Edit file src/FunBot/Settings/Sections/Channels.hs 33188 → 33188
35 35 import FunBot.Types
36 36 import Network.IRC.Fun.Bot.IrcLog
37 37 import Network.IRC.Fun.Bot.MsgCount
38 38 import Network.IRC.Fun.Bot.Nicks
39 39 import Network.IRC.Fun.Bot.State
- 40 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..))
+ 40 import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..))
41 41 42 42 import qualified Data.CaseInsensitive as CI
43 43 import qualified Data.HashMap.Lazy as M
44 44 import qualified Data.Sequence as Q
45 45 import qualified Data.Text as T
… … … … Edit file src/FunBot/Settings/Sections/DevHosts.hs 33188 → 33188
34 34 import FunBot.Types
35 35 import Network.IRC.Fun.Bot.IrcLog
36 36 import Network.IRC.Fun.Bot.MsgCount
37 37 import Network.IRC.Fun.Bot.Nicks
38 38 import Network.IRC.Fun.Bot.State
- 39 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..))
+ 39 import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..))
40 40 41 41 import qualified Data.CaseInsensitive as CI
42 42 import qualified Data.HashMap.Lazy as M
43 43 import qualified Data.Sequence as Q
44 44 import qualified Data.Text as T
… … … … Edit file src/FunBot/Settings/Sections/Feeds.hs 33188 → 33188
36 36 import FunBot.Types
37 37 import Network.IRC.Fun.Bot.IrcLog
38 38 import Network.IRC.Fun.Bot.MsgCount
39 39 import Network.IRC.Fun.Bot.Nicks
40 40 import Network.IRC.Fun.Bot.State
- 41 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..))
+ 41 import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..))
42 42 import Web.Feed.Collect hiding (addFeed)
43 43 44 44 import qualified Data.CaseInsensitive as CI
45 45 import qualified Data.HashMap.Lazy as M
46 46 import qualified Data.Sequence as Q
… … … … Edit file src/FunBot/Settings/Sections/Locations.hs 33188 → 33188
34 34 import FunBot.Types
35 35 import Network.IRC.Fun.Bot.IrcLog
36 36 import Network.IRC.Fun.Bot.MsgCount
37 37 import Network.IRC.Fun.Bot.Nicks
38 38 import Network.IRC.Fun.Bot.State
- 39 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..))
+ 39 import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..))
40 40 41 41 import qualified Data.CaseInsensitive as CI
42 42 import qualified Data.HashMap.Lazy as M
43 43 import qualified Data.Sequence as Q
44 44 import qualified Data.Text as T
… … … … Edit file src/FunBot/Settings/Sections/Repos.hs 33188 → 33188
31 31 import Data.Settings.Types
32 32 import FunBot.Settings.MkOption
33 33 import FunBot.Settings.Persist
34 34 import FunBot.Types
35 35 import Network.IRC.Fun.Bot.State (modifyState)
- 36 import Network.IRC.Fun.Messages.Types (Channel (..))
+ 36 import Network.IRC.Fun.Types.Base (Channel (..))
37 37 38 38 import qualified Data.CaseInsensitive as CI
39 39 import qualified Data.HashMap.Lazy as M
40 40 import qualified Data.Sequence as Q
41 41 import qualified Data.Text as T
… … … … Edit file src/FunBot/Settings/Sections/Shortcuts.hs 33188 → 33188
34 34 import FunBot.Types
35 35 import Network.IRC.Fun.Bot.IrcLog
36 36 import Network.IRC.Fun.Bot.MsgCount
37 37 import Network.IRC.Fun.Bot.Nicks
38 38 import Network.IRC.Fun.Bot.State
- 39 import Network.IRC.Fun.Messages.Types (Channel (..), Nickname (..))
+ 39 import Network.IRC.Fun.Types.Base (Channel (..), Nickname (..))
40 40 41 41 import qualified Data.CaseInsensitive as CI
42 42 import qualified Data.HashMap.Lazy as M
43 43 import qualified Data.Sequence as Q
44 44 import qualified Data.Text as T
… … … … Edit file src/FunBot/Commands/Channels.hs 33188 → 33188
43 43 import Network.IRC.Fun.Bot.Behavior
44 44 import Network.IRC.Fun.Bot.Chat
45 45 import Network.IRC.Fun.Bot.State
46 46 import Network.IRC.Fun.Bot.Types
47 47 import Text.Read (readMaybe)
- 48 import Network.IRC.Fun.Messages.Types
+ 48 import Network.IRC.Fun.Types.Base
49 49 50 50 import qualified Data.CaseInsensitive as CI
51 51 import qualified Data.Text as T
52 52 import qualified Data.Text.Read as TR
53 53 … … … … Edit file src/FunBot/Commands/Feeds.hs 33188 → 33188
42 42 import Network.IRC.Fun.Bot.Behavior
43 43 import Network.IRC.Fun.Bot.Chat
44 44 import Network.IRC.Fun.Bot.State
45 45 import Network.IRC.Fun.Bot.Types
46 46 import Text.Read (readMaybe)
- 47 import Network.IRC.Fun.Messages.Types
+ 47 import Network.IRC.Fun.Types.Base
48 48 49 49 import qualified Data.CaseInsensitive as CI
50 50 import qualified Data.Text as T
51 51 import qualified Data.Text.Read as TR
52 52 … … … … Edit file src/FunBot/Commands/History.hs 33188 → 33188
41 41 import Network.IRC.Fun.Bot.Behavior
42 42 import Network.IRC.Fun.Bot.Chat
43 43 import Network.IRC.Fun.Bot.State
44 44 import Network.IRC.Fun.Bot.Types
45 45 import Text.Read (readMaybe)
- 46 import Network.IRC.Fun.Messages.Types
+ 46 import Network.IRC.Fun.Types.Base
47 47 48 48 import qualified Data.CaseInsensitive as CI
49 49 import qualified Data.Text as T
50 50 import qualified Data.Text.Read as TR
51 51 … … … … Edit file src/FunBot/Commands/Info.hs 33188 → 33188
43 43 import Network.IRC.Fun.Bot.Behavior
44 44 import Network.IRC.Fun.Bot.Chat
45 45 import Network.IRC.Fun.Bot.State
46 46 import Network.IRC.Fun.Bot.Types
47 47 import Text.Read (readMaybe)
- 48 import Network.IRC.Fun.Messages.Types
+ 48 import Network.IRC.Fun.Types.Base
49 49 50 50 import qualified Data.CaseInsensitive as CI
51 51 import qualified Data.Text as T
52 52 import qualified Data.Text.Read as TR
53 53 … … … … 223 223 \surrounding it, thus expanding the shortcut. For example, if \
224 224 \<prefix>=BUG <before>=http://bug.org/ <after>=.html, then if you \
225 225 \send a message containing BUG142, I will send \
226 226 \http://bug.org/142.html into the channel. See the !add-shortcut and \
227 227 \!delete-shortcut commands, and relevant settings."
+ 228 )
+ 229 , ( "locations"
+ 230 , "TODO ask fr33domlover to write this!"
228 231 )
229 232 ]
230 233 231 234 respondInfo
232 235 :: Maybe Channel
… … … … Edit file src/FunBot/Commands/Memos.hs 33188 → 33188
42 42 import Network.IRC.Fun.Bot.Behavior
43 43 import Network.IRC.Fun.Bot.Chat
44 44 import Network.IRC.Fun.Bot.State
45 45 import Network.IRC.Fun.Bot.Types
46 46 import Text.Read (readMaybe)
- 47 import Network.IRC.Fun.Messages.Types
+ 47 import Network.IRC.Fun.Types.Base
48 48 49 49 import qualified Data.CaseInsensitive as CI
50 50 import qualified Data.Text as T
51 51 import qualified Data.Text.Read as TR
52 52 … … … … Edit file src/FunBot/Commands/Misc.hs 33188 → 33188
39 39 import Network.IRC.Fun.Bot.Behavior
40 40 import Network.IRC.Fun.Bot.Chat
41 41 import Network.IRC.Fun.Bot.State
42 42 import Network.IRC.Fun.Bot.Types
43 43 import Text.Read (readMaybe)
- 44 import Network.IRC.Fun.Messages.Types
+ 44 import Network.IRC.Fun.Types.Base
45 45 46 46 import qualified Data.CaseInsensitive as CI
47 47 import qualified Data.Text as T
48 48 import qualified Data.Text.Read as TR
49 49 … … … … Edit file src/FunBot/Commands/Repos.hs 33188 → 33188
44 44 import Network.IRC.Fun.Bot.Behavior
45 45 import Network.IRC.Fun.Bot.Chat
46 46 import Network.IRC.Fun.Bot.State
47 47 import Network.IRC.Fun.Bot.Types
48 48 import Text.Read (readMaybe)
- 49 import Network.IRC.Fun.Messages.Types
+ 49 import Network.IRC.Fun.Types.Base
50 50 51 51 import qualified Data.CaseInsensitive as CI
52 52 import qualified Data.Text as T
53 53 import qualified Data.Text.Read as TR
54 54 … … … … Edit file src/FunBot/Commands/Settings.hs 33188 → 33188
45 45 import Network.IRC.Fun.Bot.Behavior
46 46 import Network.IRC.Fun.Bot.Chat
47 47 import Network.IRC.Fun.Bot.State
48 48 import Network.IRC.Fun.Bot.Types
49 49 import Text.Read (readMaybe)
- 50 import Network.IRC.Fun.Messages.Types
+ 50 import Network.IRC.Fun.Types.Base
51 51 52 52 import qualified Data.CaseInsensitive as CI
53 53 import qualified Data.Text as T
54 54 import qualified Data.Text.Read as TR
55 55 … … … … Edit file src/FunBot/Commands/Shortcuts.hs 33188 → 33188
42 42 import Network.IRC.Fun.Bot.Behavior
43 43 import Network.IRC.Fun.Bot.Chat
44 44 import Network.IRC.Fun.Bot.State
45 45 import Network.IRC.Fun.Bot.Types
46 46 import Text.Read (readMaybe)
- 47 import Network.IRC.Fun.Messages.Types
+ 47 import Network.IRC.Fun.Types.Base
48 48 49 49 import qualified Data.CaseInsensitive as CI
50 50 import qualified Data.Text as T
51 51 import qualified Data.Text.Read as TR
52 52 … … … … Edit file src/FunBot/Commands/UserOptions.hs 33188 → 33188
46 46 import Network.IRC.Fun.Bot.Behavior
47 47 import Network.IRC.Fun.Bot.Chat
48 48 import Network.IRC.Fun.Bot.State
49 49 import Network.IRC.Fun.Bot.Types
50 50 import Text.Read (readMaybe)
- 51 import Network.IRC.Fun.Messages.Types
+ 51 import Network.IRC.Fun.Types.Base
52 52 53 53 import qualified Data.CaseInsensitive as CI
54 54 import qualified Data.Text as T
55 55 import qualified Data.Text.Read as TR
56 56 … … … … Add file src/FunBot/Locations.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 module FunBot.Locations + 17 ( lookupLocal + 18 , lookupGlobal + 19 , lookupBoth + 20 ) + 21 where + 22 + 23 import FunBot.Types + 24 import Network.IRC.Fun.Bot.State (getStateS) + 25 import Network.IRC.Fun.Types (Channel) + 26 + 27 import qualified Data.HashMap.Lazy as M (lookup) + 28 + 29 lookupLocal :: Channel -> LocationLabel -> BotSession (Maybe Location) + 30 lookupLocal chan label = do + 31 chans <- getStateS $ stChannels . bsSettings + 32 return $ M.lookup chan chans >>= M.lookup label . csLocations + 33 + 34 lookupGlobal :: LocationLabel -> BotSession (Maybe Location) + 35 lookupGlobal label = do + 36 locs <- getStateS $ stLocations . bsSettings + 37 return $ M.lookup label locs + 38 + 39 lookupBoth :: Channel -> LocationLabel -> BotSession (Maybe Location) + 40 lookupBoth chan label = do + 41 mloc <- lookupLocal chan label + 42 maybe (lookupGlobal label) (return . Just) mloc Add file src/FunBot/Commands/Locations.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 -- | Where, lwhere, gwhere, lwhere+, lwhere-, gwhere+, gwhere- commands + 19 -- + 20 -- Manage and query locations + 21 module FunBot.Commands.Locations + 22 ( cmdWhere + 23 , cmdWhereLocal + 24 , cmdWhereGlobal + 25 , cmdAddWhereLocal + 26 , cmdRemoveWhereLocal + 27 , cmdAddWhereGlobal + 28 , cmdRemoveWhereGlobal + 29 ) + 30 where + 31 + 32 import Control.Monad (unless, when) + 33 import Data.List (find, intercalate) + 34 import Data.Monoid ((<>)) + 35 import Data.Settings.Types (showOption) + 36 import Data.Text (Text) + 37 import Formatting ((%)) + 38 import FunBot.History (quote, reportHistory') + 39 import FunBot.Locations + 40 import FunBot.Memos (submitMemo) + 41 import FunBot.Settings + 42 import FunBot.Settings.Sections.Channels + 43 import FunBot.Settings.Sections.Locations + 44 import FunBot.Types + 45 import FunBot.UserOptions + 46 import FunBot.Util + 47 import Network.IRC.Fun.Bot.Behavior + 48 import Network.IRC.Fun.Bot.Chat + 49 import Network.IRC.Fun.Bot.State + 50 import Network.IRC.Fun.Bot.Types + 51 import Network.IRC.Fun.Color.Format (formatMsg) + 52 import Network.IRC.Fun.Color.Format.Long + 53 import Network.IRC.Fun.Types.Base + 54 import Text.Read (readMaybe) + 55 + 56 import qualified Data.CaseInsensitive as CI + 57 import qualified Data.Text as T + 58 import qualified Data.Text.Read as TR + 59 --import qualified Network.IRC.Fun.Color.Format.Short as F + 60 + 61 respondLookup + 62 :: (LocationLabel -> BotSession (Maybe Location)) + 63 -> Nickname + 64 -> Text + 65 -> (MsgContent -> BotSession ()) + 66 -> BotSession () + 67 respondLookup flookup nick labelt send = do + 68 let label = LocationLabel $ CI.mk labelt + 69 mloc <- flookup label + 70 case mloc of + 71 Nothing -> send $ formatMsg + 72 (nickname % ", location ‘" % text % "’ not found.") + 73 nick labelt + 74 Just loc -> send $ MsgContent $ labelt <> " : " <> unLocation loc + 75 + 76 respondLookupBoth + 77 :: Channel + 78 -> Nickname + 79 -> Text + 80 -> (MsgContent -> BotSession ()) + 81 -> BotSession () + 82 respondLookupBoth chan = respondLookup $ lookupBoth chan + 83 + 84 respondLookupLocal + 85 :: Channel + 86 -> Nickname + 87 -> Text + 88 -> (MsgContent -> BotSession ()) + 89 -> BotSession () + 90 respondLookupLocal chan = respondLookup $ lookupLocal chan + 91 + 92 respondLookupGlobal + 93 :: Nickname + 94 -> Text + 95 -> (MsgContent -> BotSession ()) + 96 -> BotSession () + 97 respondLookupGlobal = respondLookup lookupGlobal + 98 + 99 respondWhere + 100 :: Maybe Channel + 101 -> Nickname + 102 -> [Text] + 103 -> (MsgContent -> BotSession ()) + 104 -> BotSession () + 105 respondWhere mchan nick [labelt] send = + 106 let respond = maybe respondLookupGlobal respondLookupBoth mchan + 107 in respond nick labelt send + 108 respondWhere mchan nick [labelt, chant] send = + 109 let chan = Channel chant + 110 in if looksLikeChan chan + 111 then respondLookupBoth chan nick labelt send + 112 else send $ notchan chan + 113 respondWhere mchan nick args _send = + 114 failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing + 115 + 116 cmdWhere = Command + 117 { cmdNames = cmds ["where"] + 118 , cmdRespond = respondWhere + 119 , cmdHelp = + 120 "‘where <label>’ - get the location stored for the given \ + 121 \label. This checks in the per-channel location map first. If the \ + 122 \label isn’t found there, then the global map is checked. If used in \ + 123 \private chat with me, only the global map is used.\n\ + 124 \‘where <label> <channel>’ - the same idea, except now the \ + 125 \per-channel map used isn’t picked by the channel in which the command \ + 126 \was sent, but the channel is explicitly specified. This allows the \ + 127 \per-channel maps to be used in privately sent commands too." + 128 , cmdExamples = + 129 [ "where code" + 130 , "where mumble #freepost" + 131 ] + 132 } + 133 + 134 respondWhereLocal + 135 :: Maybe Channel + 136 -> Nickname + 137 -> [Text] + 138 -> (MsgContent -> BotSession ()) + 139 -> BotSession () + 140 respondWhereLocal (Just chan) nick [labelt] send = + 141 respondLookupLocal chan nick labelt send + 142 respondWhereLocal Nothing nick [labelt] send = + 143 send $ MsgContent $ + 144 unNickname nick <> + 145 ": please specify a channel, or use this command in a channel" + 146 respondWhereLocal mchan nick [labelt, chant] send = + 147 let chan = Channel chant + 148 in if looksLikeChan chan + 149 then respondLookupLocal chan nick labelt send + 150 else send $ notchan chan + 151 respondWhereLocal mchan nick args _send = + 152 failBack mchan nick $ WrongNumArgsN (Just $ length args) Nothing + 153 + 154 cmdWhereLocal = Command + 155 { cmdNames = cmds ["lwhere", "where-local"] + 156 , cmdRespond = respondWhereLocal + 157 , cmdHelp = + 158 "‘lwhere <label>’ - get the location stored for the given \ + 159 \label. This checks only the per-channel location map, according to \ + 160 \the channel in which the command is sent.\n\ + 161 \‘lwhere <label> <channel>’ - the same idea, except now the \ + 162 \per-channel map of the specified channel is used. This allows the \ + 163 \per-channel maps to be used in privately sent commands too." + 164 , cmdExamples = + 165 [ "lwhere code" + 166 , "lwhere mumble #freepost" + 167 ] + 168 } + 169 + 170 respondWhereGlobal + 171 :: Maybe Channel + 172 -> Nickname + 173 -> [Text] + 174 -> (MsgContent -> BotSession ()) + 175 -> BotSession () + 176 respondWhereGlobal _mchan nick [labelt] send = + 177 respondLookupGlobal nick labelt send + 178 respondWhereGlobal mchan nick args _send = + 179 failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1) + 180 + 181 cmdWhereGlobal = Command + 182 { cmdNames = cmds ["gwhere", "where-global"] + 183 , cmdRespond = respondWhereGlobal + 184 , cmdHelp = + 185 "‘gwhere <label>’ - get the location stored for the given label. This \ + 186 \checks only the global location map." + 187 , cmdExamples = + 188 [ "gwhere issues" + 189 ] + 190 } + 191 + 192 respondAddWhereLocal + 193 :: Maybe Channel + 194 -> Nickname + 195 -> [Text] + 196 -> (MsgContent -> BotSession ()) + 197 -> BotSession () + 198 respondAddWhereLocal Nothing nick (_labelt : _locw@(_:_)) send = + 199 send $ MsgContent $ + 200 unNickname nick <> ", this command works only in a channel" + 201 respondAddWhereLocal (Just chan) nick (labelt : locw@(_:_)) send = do + 202 let label = LocationLabel $ CI.mk labelt + 203 loc = Location $ T.unwords locw + 204 res <- addLocalLocation chan label loc + 205 case res of + 206 Nothing -> + 207 send $ formatMsg + 208 ("Location ‘" % text % "’ registered for " % channel) + 209 labelt chan + 210 Just False -> + 211 send $ formatMsg + 212 ( nickname % ", I’m not holding settings for " % channel % + 213 ". If that’s unexpected, please talk to my maintainer." + 214 ) + 215 nick chan + 216 Just True -> send $ formatMsg + 217 ( nickname % ", location ‘" % text % "’ is already registered \ + 218 \for " % channel % ". You can use ‘!set’ to modify it." + 219 ) + 220 nick labelt chan + 221 respondAddWhereLocal mchan nick args _send = + 222 failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2) + 223 + 224 cmdAddWhereLocal = Command + 225 { cmdNames = + 226 cmds ["lwhere+", "where-local+", "add-lwhere", "add-where-local"] + 227 , cmdRespond = respondAddWhereLocal + 228 , cmdHelp = + 229 "‘lwhere+ <label> <location>’ - add a new location with the given \ + 230 \label to the per-channel location map of the channel in which the \ + 231 \command is sent." + 232 , cmdExamples = + 233 [ "lwhere+ fsf https://fsf.org" + 234 , "lwhere+ Jane Climbing a mountain, back next week" + 235 ] + 236 } + 237 + 238 respondRemoveWhereLocal + 239 :: Maybe Channel + 240 -> Nickname + 241 -> [Text] + 242 -> (MsgContent -> BotSession ()) + 243 -> BotSession () + 244 respondRemoveWhereLocal Nothing nick [_labelt] send = + 245 send $ MsgContent $ + 246 unNickname nick <> ", this command works only in a channel" + 247 respondRemoveWhereLocal (Just chan) nick [labelt] send = do + 248 let label = LocationLabel $ CI.mk labelt + 249 succ <- removeLocalLocation chan label + 250 if succ + 251 then send $ formatMsg + 252 ("Location ‘" % text % "’ removed for " % channel) + 253 labelt chan + 254 else send $ formatMsg + 255 ( nickname % ", can’t delete: there is no location ‘" % text + 256 % "’ registered for " % channel + 257 ) + 258 nick labelt chan + 259 respondRemoveWhereLocal mchan nick args _send = + 260 failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1) + 261 + 262 cmdRemoveWhereLocal = Command + 263 { cmdNames = + 264 cmds ["lwhere-", "where-local-", "delete-lwhere", "delete-where-local"] + 265 , cmdRespond = respondRemoveWhereLocal + 266 , cmdHelp = + 267 "‘lwhere- <label>’ - remove the location with the given label from \ + 268 \the per-channel location map of the channel in which the command is \ + 269 \sent." + 270 , cmdExamples = + 271 [ "lwhere- website" + 272 ] + 273 } + 274 + 275 respondAddWhereGlobal + 276 :: Maybe Channel + 277 -> Nickname + 278 -> [Text] + 279 -> (MsgContent -> BotSession ()) + 280 -> BotSession () + 281 respondAddWhereGlobal _mchan nick (labelt : locw@(_:_)) send = do + 282 let label = LocationLabel $ CI.mk labelt + 283 loc = Location $ T.unwords locw + 284 success <- addLocation label loc + 285 send $ if success + 286 then MsgContent $ "Global location ‘" <> labelt <> "’ registered" + 287 else formatMsg + 288 ( nickname % ", global location ‘" % text % "’ is already \ + 289 \registered. You can use ‘!set’ to modify it." + 290 ) + 291 nick labelt + 292 respondAddWhereGlobal mchan nick args _send = + 293 failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 2) + 294 + 295 cmdAddWhereGlobal = Command + 296 { cmdNames = + 297 cmds ["gwhere+", "where-global+", "add-gwhere", "add-where-global"] + 298 , cmdRespond = respondAddWhereGlobal + 299 , cmdHelp = + 300 "‘gwhere+ <label> <location>’ - add a new location with the given \ + 301 \label to the global location map." + 302 , cmdExamples = + 303 [ "gwhere+ fsf https://fsf.org" + 304 , "gwhere+ John Took a flight to the moon, back next week" + 305 ] + 306 } + 307 + 308 respondRemoveWhereGlobal + 309 :: Maybe Channel + 310 -> Nickname + 311 -> [Text] + 312 -> (MsgContent -> BotSession ()) + 313 -> BotSession () + 314 respondRemoveWhereGlobal _mchan nick [labelt] send = do + 315 let label = LocationLabel $ CI.mk labelt + 316 success <- removeLocation label + 317 send $ if success + 318 then MsgContent $ "Global location ‘" <> labelt <> "’ removed" + 319 else formatMsg + 320 ( nickname % ", can’t delete: there is no global location ‘" + 321 % text % "’ registered" + 322 ) + 323 nick labelt + 324 respondRemoveWhereGlobal mchan nick args _send = + 325 failBack mchan nick $ WrongNumArgsN (Just $ length args) (Just 1) + 326 + 327 cmdRemoveWhereGlobal = Command + 328 { cmdNames = cmds + 329 ["gwhere-", "where-global-", "delete-gwhere", "delete-where-global"] + 330 , cmdRespond = respondRemoveWhereGlobal + 331 , cmdHelp = + 332 "‘gwhere- <label>’ - remove the location with the given label from \ + 333 \the global location map." + 334 , cmdExamples = + 335 [ "gwhere- githu8" + 336 ] + 337 }