butter 0.1.0.4 → 0.1.0.6
raw patch · 6 files changed
+47/−35 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +1/−0
- butter.cabal +20/−18
- src/Distrib/Butter/Lang.hs +6/−11
- test/Butter/HUnit.hs +11/−0
- test/first/Main.hs +5/−3
- test/protocol/Main.hs +4/−3
README.md view
@@ -1,3 +1,4 @@+[](https://travis-ci.org/System-Indystress/Butter) # Butter For easily spreading around monadic computation ## Examples
butter.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5c8f5cbc96e75b8bf01618fe9593403025515dede675734bb6442aa2e1db81f3+-- hash: 89c071b259693bb86fd512808910cfe7a02c198c9dfd0fd8e3ee921de023be0c name: butter-version: 0.1.0.4+version: 0.1.0.6 synopsis: Monad Transformer for Asyncronous Message Passing description: Please see the README on Github at <https://github.com/System-Indystress/Butter#readme> category: Distributed Computing, Concurrency@@ -27,6 +27,14 @@ location: https://github.com/System-Indystress/Butter library+ exposed-modules:+ Distrib.Butter+ Distrib.Butter.Lang+ Distrib.Butter.Lib+ Distrib.Butter.Lib.K+ Distrib.Butter.Lib.Protocol+ other-modules:+ Paths_butter hs-source-dirs: src build-depends:@@ -42,21 +50,16 @@ , template-haskell , text , transformers- exposed-modules:- Distrib.Butter- Distrib.Butter.Lang- Distrib.Butter.Lib- Distrib.Butter.Lib.K- Distrib.Butter.Lib.Protocol- other-modules:- Paths_butter default-language: Haskell2010 test-suite Lang-test type: exitcode-stdio-1.0- main-is: Main.hs+ main-is: first/Main.hs+ other-modules:+ Butter.HUnit+ Paths_butter hs-source-dirs:- test/first+ test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit@@ -72,15 +75,16 @@ , template-haskell , text , transformers- other-modules:- Paths_butter default-language: Haskell2010 test-suite Protocol-test type: exitcode-stdio-1.0- main-is: Main.hs+ main-is: protocol/Main.hs+ other-modules:+ Butter.HUnit+ Paths_butter hs-source-dirs:- test/protocol+ test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit@@ -96,6 +100,4 @@ , template-haskell , text , transformers- other-modules:- Paths_butter default-language: Haskell2010
src/Distrib/Butter/Lang.hs view
@@ -10,8 +10,7 @@ import Control.Monad.IO.Class (liftIO, MonadIO(..)) import qualified Data.Map as M import Data.Map (Map(..))-import Control.Exception-import System.IO.Error (isDoesNotExistError)+import Control.Exception (catch, SomeException) import Control.Monad.Free import Network.Simple.TCP as N import Control.Concurrent.Forkable@@ -200,15 +199,11 @@ }) <- liftIO $ readTVarIO stateVar eval me stateVar $ returnFriends $ M.keys fs eval me stateVar (Free (Connect name host port rest)) = do- conn <- liftIO $ tryJust (guard . isDoesNotExistError) $ connectSock (unpack host) (show port)- case conn of- Left _ -> do- liftIO yield- eval me stateVar (Free (Connect name host port rest))- Right (sock,addr) -> do- liftIO $ atomically $ modifyTVar stateVar $ (\s ->- s {friends = M.insert name sock $ friends s})- eval me stateVar rest+ let untilM f = do {x <- f; (case x of Nothing -> untilM f ; Just x -> return x)}+ (sock,addr) <- untilM $ liftIO $ (Just <$> connectSock (unpack host) (show port)) `catch` (\e -> let _ = e :: SomeException in return Nothing)+ liftIO $ atomically $ modifyTVar stateVar $ (\s ->+ s {friends = M.insert name sock $ friends s})+ eval me stateVar rest eval me stateVar (Free (Spawn body returnPID)) = do (h,f) <-
+ test/Butter/HUnit.hs view
@@ -0,0 +1,11 @@+module Butter.HUnit+ ( module Test.HUnit+ , checkFailure+ ) where+import Test.HUnit+import System.Exit (exitWith, ExitCode(..), exitSuccess)++checkFailure results+ | errors results + failures results == 0 = exitSuccess+ | otherwise = exitWith (ExitFailure 1)+
test/first/Main.hs view
@@ -1,8 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Main where +import Butter.HUnit+ import Distrib.Butter.Lang-import Test.HUnit import Data.Text import Control.Concurrent (forkIO) import Debug.Trace@@ -75,7 +76,7 @@ main :: IO () main = do- runTestTT $+ results <- runTestTT $ TestList [ TestLabel "self,send,receive" $ TestCase $ spreadLocal butter1 , TestLabel "self,send,receive,spawn" $@@ -87,4 +88,5 @@ , TestLabel "sending an name over and replying" $ TestCase distr2 ]- return ()+ checkFailure results+
test/protocol/Main.hs view
@@ -3,7 +3,7 @@ import Distrib.Butter.Lang import Distrib.Butter.Lib.Protocol-import Test.HUnit+import Butter.HUnit import Control.Monad.IO.Class (liftIO) import Control.Concurrent (threadDelay)@@ -32,7 +32,7 @@ main :: IO () main = do- runTestTT $ TestCase $+ results <- runTestTT $ TestCase $ spreadLocal $ do node <- start Reset b1 <- alive node@@ -65,4 +65,5 @@ lift $ assertEqual "cast reset" 0 i5 lift $ assertEqual "node is dead" False b2 return ()- return ()+ checkFailure results+