marvin 0.1.5 → 0.2.0

raw patch · 10 files changed

+196/−16 lines, 10 filesdep +conduitdep +irc-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: conduit, irc-conduit

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +10/−1
• marvin.cabal +12/−6
• src/Marvin/Adapter/IRC.hs +124/−0
• src/Marvin/Adapter/Slack/Types.hs +6/−1
• src/Marvin/Adapter/Telegram/Common.hs +8/−4
• src/Marvin/Adapter/Telegram/Poll.hs +6/−0
• src/Marvin/Adapter/Telegram/Push.hs +7/−0
• src/Marvin/Internal/Types.hs +14/−3
• src/Marvin/Types.hs +4/−1

@@ -1,3 +1,8 @@+# 0.2.0 - 25.02.2017++- Implemented an adapter for IRC+- Added manual lens class instances to expose the datatyes and instances using them.+ # 0.1.2, 0.1.3, 0.1.4, 0.1.5 - 17.02.2017  - Added manual version bounds to be compatible with stackage and the hackage build (sorry for the version spam)

@@ -1,4 +1,4 @@-# Marvin, the paranoid bot (⍺ stage)+# Marvin, the paranoid bot (β stage)  [![Travis](https://travis-ci.org/JustusAdam/marvin.svg?branch=master)](https://travis-ci.org/JustusAdam/marvin) [![Hackage](https://img.shields.io/hackage/v/marvin.svg)](http://hackage.haskell.org/package/marvin)@@ -19,7 +19,10 @@ - [Repository](https://github.com/JustusAdam/marvin) - [Bugtracker](https://github.com/JustusAdam/marvin/issues) - [Documentation repository](https://github.com/JustusAdam/marvin-docs) and [bugtracker](https://github.com/JustusAdam/marvin-docs/issues)+- [Slack channel][slack-channel] ([signup instructions](#testing-and-talking)) +[slack-channel]: https://marvin-bot.slack.com+ ## A teaser  ```Haskell@@ -53,6 +56,12 @@          send $(isL "Hello #{username} welcome to the random channel!") ```++## Testing and Talking++There's a [slack channel][slack-channel] where you can ask questions or play around with a [test instance of marvin](https://github.com/JustusAdam/marvin/blob/master/test/integration/slack/Script1.hs).++It's currently invite-only, so [send me an email](mailto:dev@justus.science) if you would like to join.  ## Contributing 

@@ -1,15 +1,18 @@ name:                marvin-version:             0.1.5-synopsis:            A modular chat bot-description:         A framework for writing portable chat bots. Inspired by hubot. The documentation is on readthedocs: <https://marvin.readthedocs.io>+version:             0.2.0+synopsis:            A framework for modular, portable chat bots.+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: <https://marvin.readthedocs.io> homepage:            https://marvin.readthedocs.io+bug-reports:         https://github.com/JustusAdam/marvin/issues license:             BSD3 license-file:        LICENSE-author:              JustusAdam+author:              Justus Adam maintainer:          dev@justus.science-copyright:           Copyright: (c) 2016 Justus Adam+copyright:           © 2016, 2017 Justus Adam category:            Development-stability:           Beta+stability:           experimental build-type:          Simple extra-source-files:  README.md                    , CHANGELOG.md@@ -33,6 +36,7 @@                      , Marvin.Util.HTTP                      , Marvin.Adapter                      , Marvin.Adapter.Shell+                     , Marvin.Adapter.IRC                      , Marvin.Adapter.Slack.RTM                      , Marvin.Adapter.Slack.EventsAPI                      , Marvin.Adapter.Telegram.Push@@ -79,6 +83,8 @@                      , http-client-tls >= 0.2 && < 0.4                      , optparse-applicative >= 0.11 && < 1                      , transformers >= 0.4+                     , conduit >= 1.2+                     , irc-conduit >= 0.2   default-language:    Haskell2010   default-extensions:  OverloadedStrings                      , TypeFamilies

@@ -0,0 +1,124 @@+{-|+Module      : $Header$+Description : Adapter for communicating with IRC.+Copyright   : (c) Justus Adam, 2017+License     : BSD3+Maintainer  : dev@justus.science+Stability   : experimental+Portability : POSIX++See caveats and potential issues with this adapter here <https://marvin.readthedocs.io/en/latest/adapters.html#irc>.+-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE Rank2Types     #-}+module Marvin.Adapter.IRC +    ( IRCAdapter, IRCChannel+    ) where+++import           Control.Concurrent.Async.Lifted+import           Control.Concurrent.Chan.Lifted+import           Control.Exception.Lifted+import           Control.Lens+import           Control.Monad+import           Control.Monad.IO.Class+import           Control.Monad.Logger+import           Data.ByteString                 (ByteString)+import           Data.Conduit+import           Data.Maybe+import qualified Data.Text                       as T+import qualified Data.Text.Encoding              as T+import qualified Data.Text.Lazy                  as L+import qualified Data.Text.Lazy.Encoding         as L+import           Data.Time.Clock                 (getCurrentTime)+import           Marvin.Adapter+import           Marvin.Interpolate.All+import           Marvin.Types                    as MT+import           Network.IRC.Conduit             as IRC+++type MarvinIRCMsg = IRC.Message L.Text+++-- Im not happy with this yet, we need to distinguish users and channels somehow+data IRCChannel+    = RealChannel { chanName :: L.Text }+    | Direct      { chanName :: L.Text }+++data IRCAdapter = IRCAdapter+    { msgOutChan :: Chan MarvinIRCMsg+    }+++producer :: Chan MarvinIRCMsg -> Producer IO IrcMessage+producer chan = forever $ do+    msg <- readChan chan+    yield $ T.encodeUtf8 . L.toStrict <$> msg+++consumer = awaitForever . writeChan+++processor :: Chan (Either ByteString IrcEvent) -> EventHandler IRCAdapter -> AdapterM IRCAdapter ()+processor inChan handler = do+    IRCAdapter{msgOutChan} <- getAdapter+    let handleOneMessage = readChan inChan >>= \case+            Left bs -> logInfoN $(isT "Undecodable message: #{T.decodeUtf8 bs}")+            Right rawEv -> do+                let ev = fmap (L.fromStrict . T.decodeUtf8) rawEv+                ts <- liftIO $ TimeStamp <$> getCurrentTime+                let (user, channel) = case _source ev of+                                        User nick -> (nick, Direct nick)+                                        Channel chan user -> (user, RealChannel chan)+                case _message ev of+                    Privmsg _ (Right msg) ->+                        runHandler $ CommandEvent user channel msg ts+                    Notice target (Right msg) -> do+                        botname <- getBotname+                        -- Check if bot is addressed+                        runHandler $ (if target == botname then CommandEvent else MessageEvent) user channel msg ts+                    Join channel' -> runHandler $ ChannelJoinEvent user (RealChannel channel') ts+                    Part channel' _ -> runHandler $ ChannelLeaveEvent user (RealChannel channel') ts+                    Kick channel' nick _ -> runHandler $ ChannelLeaveEvent nick (RealChannel channel') ts+                    Topic channel' t -> runHandler $ TopicChangeEvent user (RealChannel channel') t ts+                    Ping a b -> writeChan msgOutChan $ Pong $ fromMaybe a b+                    Invite chan _ -> writeChan msgOutChan $ Join chan+                    _ -> logDebugN $(isT "Unhadeled event #{rawEv}")+    forever $+        handleOneMessage `catch` (\e -> logErrorN $(isT "UserError: #{e :: ErrorCall}"))+  where+    runHandler = void . async . liftIO . handler++++instance IsAdapter IRCAdapter where+    -- | Stores the username+    type User IRCAdapter = L.Text+    -- | Stores channel name+    type Channel IRCAdapter = IRCChannel++    adapterId = "irc"+    messageChannel chan msg = do+        IRCAdapter{msgOutChan} <- getAdapter+        writeChan msgOutChan $ msgType $ Right msg+      where+        msgType = case chan of+                      Direct n -> Privmsg n+                      RealChannel c -> Notice c+    -- | Just returns the value again+    getUsername = return++    getChannelName = return . chanName+    resolveChannel = return . Just . RealChannel++    -- | Just returns the value again+    resolveUser = return . Just+    initAdapter = IRCAdapter <$> newChan+    runWithAdapter handler = do+        port <- fromMaybe 7000 <$> lookupFromAdapterConfig "port"+        host <- requireFromAdapterConfig "host"+        IRCAdapter{msgOutChan} <- getAdapter+        inChan <- newChan+        async $ processor inChan handler+        liftIO $ ircClient port host (return ()) (consumer inChan) (producer msgOutChan)

@@ -42,7 +42,12 @@ deriveJSON defaultOptions { unwrapUnaryRecords = True } ''SlackUserId deriveJSON defaultOptions { unwrapUnaryRecords = True } ''SlackChannelId -+class HasTopic s a | s -> a where topic :: Lens' s a+class HasName s a | s -> a where name :: Lens' s a+class HasIdValue s a | s -> a where idValue :: Lens' s a+class HasUsername s a | s -> a where username :: Lens' s a+class HasNameResolver s a | s -> a where nameResolver :: Lens' s a+class HasInfoCache s a | s -> a where infoCache :: Lens' s a  declareFields [d|     data LimitedChannelInfo = LimitedChannelInfo

@@ -28,8 +28,8 @@ import           Control.Exception.Lifted  data APIResponse a-    = Success { description :: Maybe T.Text, result :: a}-    | Error { errorCode :: Int, errDescription :: T.Text}+    = Success { description :: Maybe T.Text, result :: a }+    | Error { errorCode :: Int, errDescription :: T.Text }   -- | The telegram adapter type for a particular update type. Either 'Push' or 'Poll'@@ -50,6 +50,12 @@     | ChannelChat  +class HasUsername s a | s -> a where username :: Lens' s a+class HasLastName s a | s -> a where lastName :: Lens' s a+class HasId_ s a | s -> a where id_ :: Lens' s a+class HasFirstName s a | s -> a where firstName :: Lens' s a+class HasType_ s a | s -> a where type_ :: Lens' s a+ -- | A user object as contained in the telegram update objects declareFields [d|     data TelegramUser = TelegramUser@@ -213,11 +219,9 @@     runWithAdapter = runnerImpl     getUsername = getUsernameImpl     getChannelName = getChannelNameImpl-    -- | Not supported in this adapter and always returns 'Nothing'     resolveChannel _ = do         logErrorN "Channel resolving not supported"         return Nothing-    -- | Not supported in this adapter and always returns 'Nothing'     resolveUser _ = do         logErrorN "User resolving not supported"         return Nothing

@@ -6,6 +6,11 @@ Maintainer  : dev@justus.science Stability   : experimental Portability : POSIX+++=== Caveats:++'resolveUser' and 'resolveChannel' resolving are not yet supported in this adapter and always returns 'Nothing'. See <https://github.com/JustusAdam/marvin/issues/10 #10>. -} {-# LANGUAGE CPP #-} module Marvin.Adapter.Telegram.Poll@@ -13,6 +18,7 @@     , TelegramChat(..), ChatType(..)     , TelegramUser(..)     , MkTelegram+    , HasUsername(username), HasLastName(lastName), HasId_(id_), HasFirstName(firstName), HasType_(type_)     ) where  

@@ -6,6 +6,12 @@ Maintainer  : dev@justus.science Stability   : experimental Portability : POSIX+++=== Caveats:++'resolveUser' and 'resolveChannel' resolving are not yet supported in this adapter and always returns 'Nothing'. See <https://github.com/JustusAdam/marvin/issues/10 #10>.+ -} {-# LANGUAGE NamedFieldPuns #-} module Marvin.Adapter.Telegram.Push@@ -13,6 +19,7 @@     , TelegramChat(..), ChatType(..)     , TelegramUser(..)     , MkTelegram+    , HasUsername(username), HasLastName(lastName), HasId_(id_), HasFirstName(firstName), HasType_(type_)     ) where  

@@ -98,9 +98,20 @@ newtype AdapterId a = AdapterId { unwrapAdapterId :: T.Text } deriving (Show, Eq)  -class HasScriptId s a | s -> a where-    scriptId :: Lens' s a-+class HasScriptId s a | s -> a where scriptId :: Lens' s a+class HasConfig s a | s -> a where config :: Lens' s a+class HasAdapter s a | s -> a where adapter :: Lens' s a+class HasPayload s a | s -> a where payload :: Lens' s a+class HasTopicChangeIn s a | s -> a where topicChangeIn :: Lens' s a+class HasTopicChange s a | s -> a where topicChange :: Lens' s a+class HasResponds s a | s -> a where responds :: Lens' s a+class HasLeavesFrom s a | s -> a where leavesFrom :: Lens' s a+class HasLeaves s a | s -> a where leaves :: Lens' s a+class HasJoinsIn s a | s -> a where joinsIn :: Lens' s a+class HasJoins s a | s -> a where joins :: Lens' s a+class HasHears s a | s -> a where hears :: Lens' s a+class HasCustoms s a | s -> a where customs :: Lens' s a+class HasActions s a | s -> a where actions :: Lens' s a  -- | Read only data available to a handler when the bot reacts to an event. declareFields [d|

@@ -9,7 +9,7 @@ Portability : POSIX -} module Marvin.Types-    ( User(..), Channel(..), Message(..), Script(..)+    ( User(..), Channel(..), Message(..), Script     , ScriptId, mkScriptId, unwrapScriptId     , applicationScriptId, IsScript, getScriptId     , HasConfigAccess, TimeStamp(..)@@ -17,6 +17,9 @@     , User'(..), Channel'(..)     , Get(getLens)     , Event(..), RunnerM+    , BotActionState+    , HasScriptId(scriptId), HasAdapter(adapter), HasPayload(..)+    , HasActions(actions)     ) where