diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +# 0.2.4 - 23.09.2017 + +- Fixed an old bug when getting information about unnamed channels + # 0.2.3 - 05.03.2017 - A big thanks to @lubomir for testing the IRC adapter and contributing the following changes diff --git a/marvin.cabal b/marvin.cabal --- a/marvin.cabal +++ b/marvin.cabal @@ -1,8 +1,8 @@ name: marvin -version: 0.2.3 +version: 0.2.4 synopsis: A framework for modular, portable chat bots. -description: A framework for writing portable chat bots. Inspired by hubot. - . +description: A framework for writing portable chat bots. Inspired by hubot. + . The best way to get started with this library is with the documentation on readthedocs: homepage: https://marvin.readthedocs.io bug-reports: https://github.com/JustusAdam/marvin/issues @@ -103,7 +103,7 @@ , mustache >= 2.0 , directory >= 1.2 , filepath >= 1.4 - , marvin >= 0.1 + , marvin , configurator >= 0.3 , optparse-applicative >= 0.11 && < 1 , bytestring >= 0.10 diff --git a/src/Marvin/Adapter/IRC.hs b/src/Marvin/Adapter/IRC.hs --- a/src/Marvin/Adapter/IRC.hs +++ b/src/Marvin/Adapter/IRC.hs @@ -157,7 +157,8 @@ channels <- requireFromAdapterConfig "channels" IRCAdapter{msgOutChan} <- getAdapter inChan <- newChan - async $ processor inChan handler + a <- async $ processor inChan handler + link a liftIO $ do setUp msgOutChan user channels ircClient port host (return ()) (consumer inChan) (producer msgOutChan) diff --git a/src/Marvin/Adapter/Slack/Common.hs b/src/Marvin/Adapter/Slack/Common.hs --- a/src/Marvin/Adapter/Slack/Common.hs +++ b/src/Marvin/Adapter/Slack/Common.hs @@ -1,11 +1,12 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE NamedFieldPuns #-} module Marvin.Adapter.Slack.Common where import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) -import Control.Concurrent.Async.Lifted (async) +import Control.Concurrent.Async.Lifted (async, link) import Control.Concurrent.Chan.Lifted (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar.Lifted (modifyMVar, modifyMVar_, newMVar, readMVar) import Control.Lens hiding ((.=)) @@ -39,12 +40,16 @@ eventParser :: Value -> Parser (InternalType a) -eventParser v@(Object o) = isErrParser <|> hasTypeParser +eventParser v@(Object o) = isErrParser <|> isOkParser <|> hasTypeParser where isErrParser = do e <- o .: "error" flip (withObject "expected object") e $ \eo -> Error <$> eo .: "code" <*> eo .: "msg" + isOkParser = do + ok :: Bool <- o .: "ok" + msg <- o .: "text" + if ok then return $ OkResponseEvent msg else fail "expected ok response" hasTypeParser = do t <- o .: "type" @@ -115,6 +120,8 @@ Error code msg -> logErrorN $(isT "Error from remote code: #{code} msg: #{msg}") Ignored -> return () + OkResponseEvent msg_ -> + logDebugN $(isT "Message successfully sent: #{msg_}") ChannelArchiveStatusChange _ _ -> -- TODO implement once we track the archiving status return () @@ -128,7 +135,8 @@ runnerImpl :: MkSlack a => RunWithAdapter (SlackAdapter a) runnerImpl handler = do messageChan <- newChan - void $ async $ initIOConnections messageChan + a <- async $ initIOConnections messageChan + link a runHandlerLoop messageChan handler @@ -187,6 +195,7 @@ resolveChannelImpl :: MkSlack a => L.Text -> AdapterM (SlackAdapter a) (Maybe SlackChannelId) +resolveChannelImpl "" = return Nothing resolveChannelImpl name' = do adapter <- getAdapter modifyMVar (channelCache adapter) $ \cc -> @@ -291,4 +300,3 @@ getChannelName = getChannelNameImpl resolveChannel = resolveChannelImpl resolveUser = resolveUserImpl - diff --git a/src/Marvin/Adapter/Slack/EventsAPI.hs b/src/Marvin/Adapter/Slack/EventsAPI.hs --- a/src/Marvin/Adapter/Slack/EventsAPI.hs +++ b/src/Marvin/Adapter/Slack/EventsAPI.hs @@ -102,12 +102,13 @@ Right () -> return () --- | Recieve events as a server via HTTP webhook (not implemented yet) +-- | Recieve events as a server via HTTP webhook data EventsAPI instance MkSlack EventsAPI where mkAdapterId = "slack-events" initIOConnections inChan = do - void $ async $ runEventReceiver inChan + a <- async $ runEventReceiver inChan + link a sendMessageLoop diff --git a/src/Marvin/Adapter/Slack/RTM.hs b/src/Marvin/Adapter/Slack/RTM.hs --- a/src/Marvin/Adapter/Slack/RTM.hs +++ b/src/Marvin/Adapter/Slack/RTM.hs @@ -15,7 +15,7 @@ ) where -import Control.Concurrent.Async.Lifted (async) +import Control.Concurrent.Async.Lifted (async, link) import Control.Concurrent.Chan.Lifted import Control.Concurrent.MVar.Lifted import Control.Concurrent.STM (atomically, newTMVar, putTMVar, takeTMVar) @@ -120,6 +120,7 @@ mkAdapterId = "slack-rtm" initIOConnections inChan = do connTracker <- newEmptyMVar - async $ runConnectionLoop inChan connTracker + a <- async $ runConnectionLoop inChan connTracker + link a senderLoop connTracker diff --git a/src/Marvin/Adapter/Slack/Types.hs b/src/Marvin/Adapter/Slack/Types.hs --- a/src/Marvin/Adapter/Slack/Types.hs +++ b/src/Marvin/Adapter/Slack/Types.hs @@ -95,6 +95,7 @@ | ChannelDeleted SlackChannelId | ChannelRename LimitedChannelInfo | UserChange UserInfo + | OkResponseEvent T.Text -- | Adapter for interacting with Slack API\'s. Polymorphic over the method for retrieving events. @@ -141,9 +142,8 @@ lciParser = withObject "expected object" $ \o -> LimitedChannelInfo <$> o .: "id" - <*> o .: "name" - <*> (o .: "topic" >>= withObject "object" (.: "value")) + <*> o .:? "name" .!= "" + <*> (o .:? "topic" >>= maybe (return "") (withObject "object" (.: "value"))) lciListParser :: Value -> Parser [LimitedChannelInfo] lciListParser = withArray "array" $ fmap toList . mapM lciParser - diff --git a/src/Marvin/Adapter/Telegram/Common.hs b/src/Marvin/Adapter/Telegram/Common.hs --- a/src/Marvin/Adapter/Telegram/Common.hs +++ b/src/Marvin/Adapter/Telegram/Common.hs @@ -183,9 +183,8 @@ runnerImpl handler = do msgChan <- newChan let eventGetter = mkEventGetter msgChan - async $ eventGetter `catch` \e -> do - logErrorN $(isT "Unexpected exception in event getter: #{e :: SomeException}") - throw e + a <- async eventGetter + link a forever $ do logDebugN "Starting to read"