marvin 0.2.0 → 0.2.1

raw patch · 12 files changed

+180/−31 lines, 12 filesdep +extradep +hspecdep +lens-aesondep ~lensdep ~marvindep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: extra, hspec, lens-aeson, process, temporary, yaml

Dependency ranges changed: lens, marvin, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• LICENSE +1/−1
• initializer/Main.hs +13/−5
• marvin.cabal +40/−14
• preprocessor/Main.hs +1/−0
• resources/initializer/MyScript.hs.mustache +6/−2
• resources/initializer/bot.cabal.mustache +3/−1
• src/Marvin/Adapter/IRC.hs +6/−5
• src/Marvin/Util/Mutable.hs +3/−2
• src/Marvin/Util/Regex.hs +1/−1
• test/IntegrationSpec.hs +92/−0
• test/Spec.hs +8/−0

@@ -1,3 +1,9 @@+# 0.2.1 - 04.03.2017++- Fixed the templates for the initializer+- added tests to ensure integration test bot and project created by initializer actually compile+- Fixed the travis configurations+ # 0.2.0 - 25.02.2017  - Implemented an adapter for IRC

@@ -1,4 +1,4 @@-Copyright JustusAdam (c) 2016+Copyright JustusAdam (c) 2016, 2017  All rights reserved. 

@@ -1,7 +1,7 @@ {-# LANGUAGE RecordWildCards #-} module Main where -import           Control.Arrow         (second)+import           Control.Arrow         (second, (***)) import           Control.Monad import           Data.Foldable         (for_) import           Data.Maybe            (isJust)@@ -44,9 +44,15 @@     ]  -adType :: [(String, String)]+adType :: [(String, (String, String))] adType =-    [ ("slack-rtm", "SlackRTMAdapter") ]+    [ ("slack-rtm", ("Marvin.Adapter.Slack.RTM", "(SlackAdapter RTM)"))+    , ("slack-events", ("Marvin.Adapter.Slack.EventsAPI", "(SlackAdapter EventsAPI)"))+    , ("telegram-poll", ("Marvin.Adapter.Telegram.Poll", "(TelegramAdapter Poll)"))+    , ("telegram-push", ("Marvin.Adapter.Telegram.Push", "(TelegramAdapter Push)"))+    , ("shell", ("Marvin.Adapter.Shell", "ShellAdapter"))+    , ("irc", ("Marvin.Adapter.IRC", "IRCAdapter"))+    ]   main :: IO ()@@ -55,8 +61,10 @@     d <- (</> "initializer") <$> getDataDir     unless (isJust $ lookup adapter adType) $ hPutStrLn stderr "Unrecognized adapter" -    let subsData = object [ "name" ~> botname-                          , "scriptsig" ~> maybe "IsAdapter a => ScriptInit a" ("ScriptInit " <>) (lookup adapter adType)+    let (adModule, adSig) = maybe ("IsAdapter a => ScriptInit a", "") (("import " <>) *** ("ScriptInit " <>)) (lookup adapter adType)+        subsData = object [ "name" ~> botname+                          , "scriptsig" ~> adSig+                          , "adaptermod" ~> adModule                           , "adapter" ~> adapter                           ] 

@@ -1,5 +1,5 @@ name:                marvin-version:             0.2.0+version:             0.2.1 synopsis:            A framework for modular, portable chat bots. description:         A framework for writing portable chat bots. Inspired by hubot.                       . @@ -134,19 +134,45 @@                      , 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+test-suite marvin-unit-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base >= 4.7 && < 5+                     , marvin+                     , hspec >= 2.2+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+                     , TypeFamilies+                     , MultiParamTypeClasses+                     , TupleSections+                     , GADTs++test-suite marvin-integration-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             IntegrationSpec.hs+  build-depends:       base >= 4.7 && < 5+                     , marvin+                     , hspec >= 2.2+                     , temporary >= 1.2+                     , process >= 1.2+                     , filepath >= 1.4+                     , directory >= 1.2+                     , monad-loops >= 0.4+                     , extra >= 1.4+                     , yaml+                     , lens-aeson+                     , lens+                     , text+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings+                     , TypeFamilies+                     , MultiParamTypeClasses+                     , TupleSections+                     , GADTs  source-repository head   type:     git

@@ -38,6 +38,7 @@     , ("telegram-poll", ("Marvin.Adapter.Telegram.Poll", "(TelegramAdapter Poll)"))     , ("telegram-push", ("Marvin.Adapter.Telegram.Push", "(TelegramAdapter Push)"))     , ("shell", ("Marvin.Adapter.Shell", "ShellAdapter"))+    , ("irc", ("Marvin.Adapter.IRC", "IRCAdapter"))     ]  

@@ -2,13 +2,17 @@   import Marvin.Prelude+{{ adaptermod }}+import Control.Monad.Logger -- imported for logging   script :: {{ scriptsig }} script = defineScript "my-script" $ do     hear (r [CaseInsensitive] "ping") $ do -- react to any message         msg <- getMessage -- read the message contents-        infoM (content msg) -- logging+        $logInfo $(isT "Got message with content: #{msg}") -- logging         send "Pong" -- sending messages back     respond "hello" $ do -- react to direct commands-        reply "Hello to you too"+        user <- getUser+        username <- getUsername user+        reply $(isL "Hello to you too, #{username}")

@@ -9,10 +9,12 @@ executable {{ name }}-bot   hs-source-dirs:      bot   main-is:             Main.hs+  other-modules:       MyScript   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   build-depends:       base                      , marvin+                     , monad-logger   default-language:    Haskell2010   default-extensions:  OverloadedStrings                      , MultiParamTypeClasses-                     , NoImplicitPrelude+                     , TemplateHaskell

@@ -11,7 +11,7 @@ -} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE Rank2Types     #-}-module Marvin.Adapter.IRC +module Marvin.Adapter.IRC     ( IRCAdapter, IRCChannel     ) where @@ -60,6 +60,8 @@ consumer = awaitForever . writeChan  +-- NOTE: Maybe we can add some verification of how the server was coping with a message of ours.+-- Perhaps save queries to the server in a queue and associate incoming numerics and such with them? processor :: Chan (Either ByteString IrcEvent) -> EventHandler IRCAdapter -> AdapterM IRCAdapter () processor inChan handler = do     IRCAdapter{msgOutChan} <- getAdapter@@ -91,7 +93,6 @@     runHandler = void . async . liftIO . handler  - instance IsAdapter IRCAdapter where     -- | Stores the username     type User IRCAdapter = L.Text@@ -106,12 +107,12 @@         msgType = case chan of                       Direct n -> Privmsg n                       RealChannel c -> Notice c-    -- | Just returns the value again-    getUsername = return +    -- TODO Perhaps these resolving funtions should be changed such that+    -- they return Nothing if the user doesn't exist.+    getUsername = return     getChannelName = return . chanName     resolveChannel = return . Just . RealChannel-     -- | Just returns the value again     resolveUser = return . Just     initAdapter = IRCAdapter <$> newChan

@@ -49,15 +49,16 @@ -- 'readSynchronized' does not empty it and also blocks if the 'Synchronized' is empty. -- -- Should you just use it as a thread safe mutable variable, mutations typically follow the pattern:+-- -- @ --   val <- takeSynchronized -- obtain the value and leave it empty to block concurrent reads---   let mod = modify val -- modify the value+--   mod <- modifyWithIO val -- modify the value, typically involves IO --   writeSynchronized mod -- write back the result -- @ -- -- Another use for this type is as a message channel, where we have a producer and a consumer, -- the producer tries to write values into the 'Synchronized' ('writeSynchronized') and the consumer--- waits for the 'Synchronized' to be filled and takes the value 'takeSynchronized' for procesing.+-- waits for the 'Synchronized' to be filled and takes the value ('takeSynchronized') for procesing. -- -- It works generally best if any 'Synchronized' is only used for one of these two applications at the same time. --

@@ -25,7 +25,7 @@ instance NFData Regex where     rnf (Regex a) = a `seq` () --- Warning: This exposes the underlying repreentation of a 'Regex' and under no curcumstances should be considered stable.+-- Warning: This exposes the underlying representation of a 'Regex' and under no curcumstances should be considered stable. unwrapRegex :: Regex -> Re.Regex unwrapRegex (Regex r) = r 

@@ -0,0 +1,92 @@+import           Control.Lens+import           Control.Monad.Extra+import           Data.Aeson.Lens+import           Data.Maybe+import           Data.Text           (Text)+import           Data.Yaml+import           System.Directory+import           System.Environment+import           System.FilePath+import           System.Info.Extra+import           System.IO.Temp+import           System.Process+import           Test.Hspec++stackBuildArgs :: [String]+stackBuildArgs+    | isMac = ["--extra-lib-dirs=/usr/local/opt/icu4c/lib", "--extra-include-dirs=/usr/local/opt/icu4c/include"]+    | otherwise = []++copyDirectory :: FilePath -> FilePath -> IO ()+copyDirectory source target = do+    createDirectoryIfMissing True target+    (dirs, files) <- getDirectoryContents source >>=+        partitionM (doesDirectoryExist . (source </>))+        . filter (\a -> not $ a == "." || a == "..")+    mapM_ (copyFile <$> (source </>) <*> (target </>)) files+    mapM_ (copyDirectory <$> (source </>) <*> (target </>)) dirs+++-- | In the .travis.yml file I pass the stack yaml as STACK_YAML env variable.+-- This is necessary as the extra-deps are different for some lts versions+-- However the yaml file in STACK_YAML cannot be used by the integration tests,+-- as they require both marvins source directory as well as their own to be+-- recorded in the `packages` key.+-- This function reads the stack.yaml, modifies the `packages` section and+-- writes a new stack.yaml to the target path which the tests pass to stack via+-- then `--stack-yaml` command line parameter+getAndModifyStackYaml :: FilePath -> IO ()+getAndModifyStackYaml targetPath = do+    path <- fromMaybe "test/resources/stack.yaml" <$> lookupEnv "STACK_YAML"+    Just yamlFile <- decodeFile path+    encodeFile targetPath $ (yamlFile :: Value) & key "packages" .~ packageObject+  where+    packageObject = toJSON [".", ".." :: Text]+++getResolver :: IO String+getResolver = fromMaybe "lts" <$> lookupEnv "STACK_RESOLVER"+++-- | This test is used to make sure the initializer produces a compileable project+runInitAndCompileResult :: IO ()+runInitAndCompileResult =+    withTempDirectory "." ".test" $ \dir -> do+        getAndModifyStackYaml (dir </> "stack.yaml")+        withCurrentDirectory dir $ do+            resolver <- getResolver+            callProcess "stack"+                [ "exec"+                , "--resolver", resolver+                , "--stack-yaml", "stack.yaml"+                , "--", "marvin-init"+                    , "-a", "shell"+                    , "testbot"]+            callProcess "stack" $+                [ "build"+                , "--stack-yaml", "stack.yaml"+                , "--resolver", resolver+                ] ++ stackBuildArgs+++compileIntegration :: IO ()+compileIntegration =+    withTempDirectory "." ".test" $ \dir -> do+        resolver <- getResolver+        copyDirectory "test/integration" dir+        getAndModifyStackYaml (dir </> "stack.yaml")+        withCurrentDirectory dir $ callProcess "stack" $+            [ "build"+            , "--stack-yaml", "stack.yaml"+            , "--resolver", resolver+            ] ++ stackBuildArgs+++main :: IO ()+main = hspec $ do+    describe "the integration test" $+        it "compiles the integration test suite" $+            compileIntegration `shouldReturn` ()+    describe "initializer" $+        it "produces a compileable project" $+            runInitAndCompileResult `shouldReturn` ()

@@ -0,0 +1,8 @@++import           Test.Hspec++-- TODO add tests. I'm not really sure what to test unfortunately.+-- A lot of the code in this repo is just about interacting with external API's++main :: IO ()+main = hspec $ return ()