diff --git a/marvin.cabal b/marvin.cabal --- a/marvin.cabal +++ b/marvin.cabal @@ -1,124 +1,111 @@ -name: marvin -version: 0.0.3 -synopsis: A modular bot for slack -description: Please see README.md -homepage: https://github.com/JustusAdam/marvin#readme -license: BSD3 -license-file: LICENSE -author: JustusAdam -maintainer: dev@justus.science -copyright: Copyright: (c) 2016 Justus Adam -category: Development -build-type: Simple -extra-source-files: README.md - , preprocessor/Main.mustache -data-dir: resources -data-files: initializer/*.hs.mustache - initializer/config.cfg.mustache - initializer/bot.cabal.mustache -cabal-version: >=1.10 +name: marvin +version: 0.0.4 +cabal-version: >=1.10 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: Copyright: (c) 2016 Justus Adam +maintainer: dev@justus.science +homepage: https://github.com/JustusAdam/marvin#readme +synopsis: A modular bot for slack +description: + Please see README.md +category: Development +author: JustusAdam +data-files: + initializer/*.hs.mustache + initializer/config.cfg.mustache + initializer/bot.cabal.mustache +data-dir: resources +extra-source-files: + README.md + preprocessor/Main.mustache +source-repository head + type: git + location: https://github.com/JustusAdam/marvin + library - hs-source-dirs: src - exposed-modules: Marvin - , Marvin.Prelude - , Marvin.Types - , Marvin.Run - , Marvin.Util.Mutable - , Marvin.Util.Regex - , Marvin.Util.Random - , Marvin.Util.Logging - , Marvin.Util.JSON - , Marvin.Util.HTTP - , Marvin.Adapter - , Marvin.Adapter.Slack - other-modules: Marvin.Internal - , Marvin.Internal.Types - build-depends: base >= 4.7 && < 5 - , wreq - , aeson - , mtl - , lens - , pcre-light - , vector - , optparse-generic - , configurator - , template-haskell - , bytestring - , async - , hslogger - , text-format - , websockets - , network-uri - , wuss - , random - , hashable - , text - , mtl - , unordered-containers - , mono-traversable - default-language: Haskell2010 - default-extensions: OverloadedStrings - , TypeFamilies - , MultiParamTypeClasses - , TupleSections - , GADTs + exposed-modules: + Marvin + Marvin.Prelude + Marvin.Types + Marvin.Run + Marvin.Util.Mutable + Marvin.Util.Regex + Marvin.Util.Random + Marvin.Util.Logging + Marvin.Util.JSON + Marvin.Util.HTTP + Marvin.Adapter + Marvin.Adapter.Slack + build-depends: + base >=4.7 && <5, + wreq >=0.4.1.0 && <0.5, + aeson >=0.11.2.1 && <0.12, + mtl >=2.2.1 && <2.3, + lens ==4.14.*, + pcre-light >=0.4.0.4 && <0.5, + vector >=0.11.0.0 && <0.12, + optparse-generic >=1.1.1 && <1.2, + configurator >=0.3.0.0 && <0.4, + template-haskell >=2.11.0.0 && <2.12, + bytestring >=0.10.8.1 && <0.11, + async >=2.1.0 && <2.2, + hslogger >=1.2.10 && <1.3, + text-format >=0.3.1.1 && <0.4, + websockets >=0.9.7.0 && <0.10, + network-uri >=2.6.1.0 && <2.7, + wuss >=1.1.1 && <1.2, + random ==1.1.*, + hashable >=1.2.4.0 && <1.3, + text >=1.2.2.1 && <1.3, + mtl >=2.2.1 && <2.3, + unordered-containers >=0.2.7.1 && <0.3, + mono-traversable >=1.0.0.1 && <1.1 + default-language: Haskell2010 + default-extensions: OverloadedStrings TypeFamilies + MultiParamTypeClasses TupleSections GADTs + hs-source-dirs: src + other-modules: + Marvin.Internal + Marvin.Internal.Types executable marvin-pp - hs-source-dirs: preprocessor - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , mustache - , directory - , filepath - , marvin - , configurator - , optparse-applicative - , bytestring - , mono-traversable - , text - , aeson - default-language: Haskell2010 - default-extensions: OverloadedStrings - , TypeFamilies - , MultiParamTypeClasses - , TupleSections - , GADTs + main-is: Main.hs + build-depends: + base >=4.9.0.0 && <4.10, + mustache ==2.1.*, + directory >=1.2.6.2 && <1.3, + filepath >=1.4.1.0 && <1.5, + marvin >=0.0.4 && <0.1, + configurator >=0.3.0.0 && <0.4, + optparse-applicative >=0.12.1.0 && <0.13, + bytestring >=0.10.8.1 && <0.11, + mono-traversable >=1.0.0.1 && <1.1, + text >=1.2.2.1 && <1.3, + aeson >=0.11.2.1 && <0.12 + default-language: Haskell2010 + default-extensions: OverloadedStrings TypeFamilies + MultiParamTypeClasses TupleSections GADTs + hs-source-dirs: preprocessor + ghc-options: -threaded -rtsopts -with-rtsopts=-N executable marvin-init - hs-source-dirs: initializer - main-is: Main.hs - other-modules: Paths_marvin - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , mustache - , directory - , filepath - , optparse-applicative - , mono-traversable - , text - default-language: Haskell2010 - default-extensions: OverloadedStrings - , TypeFamilies - , MultiParamTypeClasses - , TupleSections - , GADTs - --- test-suite slackbot-framework-test --- type: exitcode-stdio-1.0 --- hs-source-dirs: test --- main-is: Spec.hs --- build-depends: base --- , marvin --- ghc-options: -threaded -rtsopts -with-rtsopts=-N --- default-language: Haskell2010 --- default-extensions: OverloadedStrings --- , TypeFamilies --- , MultiParamTypeClasses --- , TupleSections --- , GADTs + main-is: Main.hs + build-depends: + base >=4.9.0.0 && <4.10, + mustache ==2.1.*, + directory >=1.2.6.2 && <1.3, + filepath >=1.4.1.0 && <1.5, + optparse-applicative >=0.12.1.0 && <0.13, + mono-traversable >=1.0.0.1 && <1.1, + text >=1.2.2.1 && <1.3 + default-language: Haskell2010 + default-extensions: OverloadedStrings TypeFamilies + MultiParamTypeClasses TupleSections GADTs + hs-source-dirs: initializer + other-modules: + Paths_marvin + ghc-options: -threaded -rtsopts -with-rtsopts=-N -source-repository head - type: git - location: https://github.com/JustusAdam/marvin diff --git a/src/Marvin.hs b/src/Marvin.hs --- a/src/Marvin.hs +++ b/src/Marvin.hs @@ -15,8 +15,8 @@ , ScriptDefinition , IsAdapter -- * Reacting - , hear, respond, send, reply, messageChannel - , getMessage, getMatch, getUsername, getChannelName + , hear, respond, customTrigger, send, reply, messageChannel + , getData, getMessage, getMatch, getUsername, getChannelName , Message(..), User, Channel , getConfigVal, requireConfigVal , BotReacting, HasMessage(messageLens), HasMatch(matchLens) diff --git a/src/Marvin/Internal.hs b/src/Marvin/Internal.hs --- a/src/Marvin/Internal.hs +++ b/src/Marvin/Internal.hs @@ -57,10 +57,16 @@ data WrappedAction a = forall d. WrappedAction (ActionData d) (BotReacting a d ()) --- | Monad for reacting in the bot. Allows use of functions like 'send', 'reply' and 'messageChannel' as well as any arbitrary 'IO' action. +-- | Monad for reacting in the bot. Allows use of functions like 'send', 'reply' and 'messageChannel' as well as any arbitrary 'IO' action using 'liftIO'. -- --- The type parameter @d@ is the accessible data provided by the trigger for this action. +-- The type parameter @d@ is the accessible data provided by the trigger for this action and can be obtained with 'getData' or other custom functions like 'getMessage' and 'getMatch' which typically depend on a particular type of data in @d@. -- For message handlers like 'hear' and 'respond' this would be a regex 'Match' and a 'Message' for instance. +-- +-- For completeness: @a@ is the adapter type and @r@ is the return type of the monadic computation. +-- +-- This is also a 'MonadReader' instance, there you can inspect the entire state of this reaction. +-- This is typically only used in internal or utility functions and not necessary for the user. +-- To inspect particular pieces of this state refer to the *Lenses* section. newtype BotReacting a d r = BotReacting { runReaction :: ReaderT (BotActionState a d) IO r } deriving (Monad, MonadIO, Applicative, Functor, MonadReader (BotActionState a d)) -- | An abstract type describing a marvin script. @@ -150,6 +156,15 @@ respond !re = addReaction (Respond re) +-- | Extension point for the user +-- +-- Allows you to handle the raw event yourself. +-- Returning 'Nothing' from the trigger function means you dont want to react to the event. +-- The value returned inside the 'Just' is available in the handler later using 'getData'. +customTrigger :: (A.Event -> Maybe d) -> BotReacting a d () -> ScriptDefinition a () +customTrigger tr = addReaction (Custom tr) + + -- | Send a message to the channel the triggering message came from. -- -- Equivalent to "robot.send" in hubot @@ -218,7 +233,11 @@ runDefinitions sid definitions ada cfg = execStateT (runScript definitions) (Script mempty sid cfg ada) --- | Obtain the reaction dependent data from the bot. +-- | Obtain the event reaction data. +-- +-- The type of this data depends on the reacion function used. +-- For instance 'hear' and 'respond' will contain 'MessageReactionData'. +-- The actual contents comes from the event itself and was put together by the trigger. getData :: BotReacting a d d getData = view variable diff --git a/src/Marvin/Run.hs b/src/Marvin/Run.hs --- a/src/Marvin/Run.hs +++ b/src/Marvin/Run.hs @@ -98,6 +98,7 @@ lDispatches <- doIfMatch allListens text botname <- fromMaybe defaultBotName <$> lookupFromAppConfig cfg "name" let (trimmed, remainder) = splitAt (fromIntegral $ length botname) $ dropWhile isSpace text + -- TODO At some point this needs to support derivations of the name. Maybe make that configurable? rDispatches <- if toLower trimmed == toLower botname then doIfMatch allReactions remainder else return mempty