By | fr33domlover |
At | 2016-01-20 |
Title | Add fields for global and per-channel location maps |
Description |
Edit file src/FunBot/Types.hs 33188 → 33188
18 18 19 19 module FunBot.Types
20 20 ( RepoName (..)
21 21 , RepoSpace (..)
22 22 , BranchName (..)
- 23 --, DevUsername (..)
24 23 , DevHostLabel (..)
25 24 , DevHost (..)
26 25 , FeedLabel (..)
27 26 , ShortcutLabel (..)
+ 27 , LocationLabel (..)
+ 28 , Location (..)
28 29 , Filter (..)
29 30 , BranchFilter
30 31 , RepoAnnSpec (..)
31 32 , NewsItemFields (..)
32 33 , NewsAnnSpec (..)
… … … … 81 82 82 83 -- | A version control repository branch name
83 84 newtype BranchName = BranchName { unBranchName :: Text }
84 85 deriving (Eq, FromJSON, ToJSON)
85 86 - 86 -- | A repo hosting service user account name
- 87 --newtype DevUsername = DevUsername { unDevUsername :: Text }
- 88 89 87 -- | A repo hosting service host label
90 88 newtype DevHostLabel = DevHostLabel { unDevHostLabel :: Text }
91 89 deriving (Eq, Hashable)
92 90 93 91 -- | A repo hosting service DNS name
… … … … 99 97 100 98 -- | TODO
101 99 newtype ShortcutLabel = ShortcutLabel { unShortcutLabel :: CI Text }
102 100 deriving (Eq, Hashable)
103 101 + 102 -- | TODO
+ 103 newtype LocationLabel = LocationLabel { unLocationLabel :: CI Text }
+ 104 deriving (Eq, Hashable)
+ 105 + 106 -- | TODO
+ 107 newtype Location = Location { unLocation :: Text }
+ 108 104 109 -- | Generic item filter
105 110 data Filter a = Accept [a] | Reject [a]
106 111 107 112 -- | Chooser for repo branches whose commits should be announced to IRC
108 113 type BranchFilter = Filter BranchName
… … … … 206 211 , csWelcome :: Bool
207 212 -- | Nicks to mention in the welcome message.
208 213 , csFolks :: [Nickname]
209 214 -- | Email address for async discussions.
210 215 , csEmail :: Text
+ 216 -- | Generic key-value mapping intended to refer to URLs by short labels.
+ 217 , csLocations :: HashMap LocationLabel Location
211 218 }
212 219 213 220 -- | User-modifiable bot behavior settings
214 221 data Settings = Settings
215 222 { -- | Maps a host label to Git repo space+name to annoucement details
… … … … 222 229 , stShortcuts :: HashMap ShortcutLabel Shortcut
223 230 -- | Per-channel settings
224 231 , stChannels :: HashMap Channel ChanSettings
225 232 -- | Maps host names to host labels
226 233 , stDevHosts :: HashMap DevHost DevHostLabel
+ 234 -- | A generic key-value mapping intended to refer to URLs by short
+ 235 -- labels. This is a global mapping, and there are also per-channel
+ 236 -- mappings in 'ChanSettings'.
+ 237 , stLocations :: HashMap LocationLabel Location
227 238 }
228 239 229 240 -- | Alias for the settings option type
230 241 type SettingsOption = Option BotSession
231 242 … … … … Edit file src/FunBot/Settings/Instances.hs 33188 → 33188
231 231 instance ToJSON a => ToJSON (M.HashMap ShortcutLabel a) where
232 232 toJSON m =
233 233 let f (ShortcutLabel l, x) = (l, x)
234 234 in toJSON $ M.fromList $ map f $ M.toList m
235 235 + 236 instance FromJSON a => FromJSON (M.HashMap LocationLabel a) where
+ 237 parseJSON v =
+ 238 let f (l, x) = (LocationLabel l, x)
+ 239 in M.fromList . map f . M.toList <$> parseJSON v
+ 240 + 241 instance ToJSON a => ToJSON (M.HashMap LocationLabel a) where
+ 242 toJSON m =
+ 243 let f (LocationLabel l, x) = (l, x)
+ 244 in toJSON $ M.fromList $ map f $ M.toList m
+ 245 236 246 instance FromJSON Shortcut where
237 247 parseJSON (Object o) =
238 248 Shortcut <$>
239 249 o .: "prefix" <*>
240 250 o .: "before" <*>
… … … … 251 261 ]
252 262 253 263 instance FromJSON ChanSettings where
254 264 parseJSON (Object o) =
255 265 ChanSettings <$>
- 256 o .: "say-titles" <*>
- 257 o .: "welcome" <*>
+ 266 o .: "say-titles" <*>
+ 267 o .: "welcome" <*>
258 268 (map Nickname <$> o .: "folks") <*>
- 259 o .: "email"
+ 269 o .: "email" <*>
+ 270 (M.map Location <$> o .: "locations")
260 271 parseJSON v = typeMismatch "ChanSettings" v
261 272 262 273 instance ToJSON ChanSettings where
- 263 toJSON (ChanSettings sayTitles welcome folks email) = object
+ 274 toJSON (ChanSettings sayTitles welcome folks email locs) = object
264 275 [ "say-titles" .= sayTitles
265 276 , "welcome" .= welcome
266 277 , "folks" .= map unNickname folks
267 278 , "email" .= email
+ 279 , "locations" .= M.map unLocation locs
268 280 ]
269 281 270 282 instance FromJSON Settings where
271 283 parseJSON (Object o) =
272 284 Settings <$>
- 273 o .: "repos" <*>
- 274 o .: "feeds" <*>
- 275 o .: "shortcuts" <*>
- 276 o .: "channels" <*>
- 277 (M.map DevHostLabel <$> o .: "dev-hosts")
+ 285 o .: "repos" <*>
+ 286 o .: "feeds" <*>
+ 287 o .: "shortcuts" <*>
+ 288 o .: "channels" <*>
+ 289 (M.map DevHostLabel <$> o .: "dev-hosts") <*>
+ 290 (M.map Location <$> o .: "locations")
278 291 parseJSON v = typeMismatch "Settings" v
279 292 280 293 instance ToJSON Settings where
- 281 toJSON (Settings repos feeds shortcuts channels hosts) = object
+ 294 toJSON (Settings repos feeds shortcuts channels hosts locs) = object
282 295 [ "repos" .= repos
283 296 , "feeds" .= feeds
284 297 , "shortcuts" .= shortcuts
285 298 , "channels" .= channels
286 299 , "dev-hosts" .= M.map unDevHostLabel hosts
+ 300 , "locations" .= M.map unLocation locs
287 301 ]
… … … … Edit file src/FunBot/Settings/Sections/Channels.hs 33188 → 33188
96 96 )
97 97 ]
98 98 , secSubs = M.empty
99 99 }
100 100 where
- 101 defChan = ChanSettings True False [] "(?)"
+ 101 defChan = ChanSettings True False [] "(?)" M.empty
102 102 getf e f = maybe e f . M.lookup chan . stChannels
103 103 setf f v s =
104 104 let chans = stChannels s
105 105 cs = M.lookupDefault defChan chan chans
106 106 cs' = f cs v
… … … …