drama 0.1.0.1 → 0.1.0.2
raw patch · 8 files changed
+224/−110 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +45/−0
- LICENSE +29/−0
- README.md +6/−0
- drama.cabal +27/−5
- examples/SharedResource.hs +64/−0
- examples/Workers.hs +50/−0
- src/Drama/Demo.hs +0/−102
- src/Drama/Internal.hs +3/−3
+ CHANGELOG.md view
@@ -0,0 +1,45 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog][changelog], and this project adheres+to the [Haskell Package Versioning Policy][pvp].++## [Unreleased]++## [0.1.0.2] - 2021-02-20++### Added++- Added examples (only compiled when `examples` flag is enabled)+- Added `CHANGELOG.md`, `LICENSE`, and `README.md` to `extra-source-files`++### Changed++- Applied suggestions from HLint++### Removed++- Removed `Drama.Demo` module++## [0.1.0.1] - 2021-02-19++### Fixed++- Fixed build failing on GHC 8.6.5 due to missing `MonadFail` type class++### Changed++- Relaxed upper bound on `transformers` library++## [0.1.0.0] - 2021-02-19++Initial release++[Unreleased]: https://github.com/evanrelf/drama/compare/v0.1.0.2...HEAD+[0.1.0.1]: https://github.com/evanrelf/drama/releases/tag/v0.1.0.2+[0.1.0.1]: https://github.com/evanrelf/drama/releases/tag/v0.1.0.1+[0.1.0.0]: https://github.com/evanrelf/drama/releases/tag/v0.1.0.0++[changelog]: https://keepachangelog.com/en/1.0.0/+[pvp]: https://pvp.haskell.org/
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2021, Evan Relf+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++* Redistributions of source code must retain the above copyright notice,+ this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++* Neither the name of the <copyright holder> nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER>+BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF+THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+# drama++[](https://hackage.haskell.org/package/drama)+[](https://github.com/evanrelf/drama/actions/workflows/ci.yml)++💃 Simple actor library for Haskell
drama.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: drama-version: 0.1.0.1+version: 0.1.0.2 synopsis: Simple actor library for Haskell description: Simple actor library for Haskell category: Concurrency@@ -12,7 +12,13 @@ copyright: 2021 Evan Relf tested-with: GHC == 8.6.5, GHC == 8.10.3 +license-file: LICENSE+extra-source-files:+ CHANGELOG.md+ LICENSE+ README.md + common common build-depends: base >= 4.12 && < 5.0 default-language: Haskell2010@@ -29,8 +35,21 @@ -fshow-warning-groups +common stan+ if impl(ghc >= 8.8)+ ghc-options:+ -fwrite-ide-info+ -hiedir=.hie+++flag examples+ description: Build examples+ default: False+ manual: True++ library- import: common+ import: common, stan hs-source-dirs: src build-depends: , ki ^>= 0.2.0.1@@ -39,12 +58,15 @@ exposed-modules: , Drama , Drama.Internal- other-modules:- , Drama.Demo+ if flag(examples)+ hs-source-dirs: examples+ exposed-modules:+ , SharedResource+ , Workers benchmark bench- import: common+ import: common, stan type: exitcode-stdio-1.0 hs-source-dirs: bench main-is: Main.hs
@@ -0,0 +1,64 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE NumericUnderscores #-}++module SharedResource (main) where++import Control.Concurrent (threadDelay)+import Control.Monad (forever)+import Control.Monad.IO.Class (MonadIO (..))+import Drama+import Prelude hiding (log)+++main :: IO ()+main = run do+ -- Spawn `logger` actor, which starts waiting for requests.+ loggerAddress <- spawn logger++ -- Spawn two noisy actors, `fizzBuzz` and `navi`, which want to constantly+ -- print to the console. Instead of running `putStrLn`, they will send+ -- messages to `logger`.+ _ <- spawn (fizzBuzz loggerAddress)+ _ <- spawn (navi loggerAddress)++ -- Block `main` thread forever.+ wait+++-- | Actor which encapsulates access to the console (a shared resource). By+-- sending log messages to `logger`, instead of running `putStrLn` directly, we+-- can avoid interleaving logs from actors running in parallel.+logger :: Actor String ()+logger = forever do+ string <- receive+ liftIO $ putStrLn string+++-- | Silly example actor which wants to print to the console+fizzBuzz :: Address String -> Actor () ()+fizzBuzz loggerAddress = do+ let log = send loggerAddress++ loop (0 :: Int) \n -> do+ if | n `mod` 15 == 0 -> log "FizzBuzz"+ | n `mod` 3 == 0 -> log "Fizz"+ | n `mod` 5 == 0 -> log "Buzz"+ | otherwise -> log (show n)++ -- Delay included for nicer (slow) output+ liftIO $ threadDelay 500_000++ continue (n + 1)+++-- | Silly example actor which wants to print to the console+navi :: Address String -> Actor () ()+navi loggerAddress = do+ let log = send loggerAddress++ forever do+ log "Hey, listen!"++ -- Delay included for nicer (slow) output+ liftIO $ threadDelay 1_000_000
+ examples/Workers.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE BlockArguments #-}++module Workers (main) where++import Control.Monad (replicateM, when)+import Control.Monad.IO.Class (MonadIO (..))+import Data.Function ((&))+import Drama+++main :: IO ()+main = run do+ -- Spawn `fib` actor, which starts waiting for requests.+ fibAddress <- spawn fib++ -- Request fibonacci numbers from `fib`. `fib` will spawn three `fibWorker`s+ -- to do all the work in the background, and then send `main` their results+ -- once they finish.+ myAddress <- here+ [200, 400, 600] & mapM_ \n -> send fibAddress (myAddress, n)++ -- Receive results sent back from the `fibWorker`s, and print them to the+ -- console.+ replicateM 3 receive >>= mapM_ \(n, f) ->+ liftIO $ putStrLn ("Fibonacci number " <> show n <> " is " <> show f)++ -- Tell `fib` to stop.+ send fibAddress (myAddress, -1)++ -- Wait for `fib` to stop before exiting.+ wait+++-- | Actor which immediately spawns and delegates to "worker" actors.+fib :: Actor (Address (Int, Integer), Int) ()+fib = do+ (responseAddress, n) <- receive+ when (n >= 0) do+ _ <- spawn (fibWorker responseAddress n)+ fib+++-- | "Worker" actor responsible for doing the real, time-consuming work.+fibWorker :: Address (Int, Integer) -> Int -> Actor () ()+fibWorker responseAddress n = send responseAddress (n, fibs !! n)+++-- | Infinite list of fibonacci numbers.+fibs :: [Integer]+fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
− src/Drama/Demo.hs
@@ -1,102 +0,0 @@-{-# LANGUAGE BlockArguments #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE RankNTypes #-}--module Drama.Demo where--import Control.Concurrent (threadDelay)-import Control.Monad (forever)-import Control.Monad.IO.Class (MonadIO (..))-import Drama-import Prelude hiding (log)---main2 :: IO ()-main2 = run do- loggerAddress <- spawn logger- _ <- spawn (fizzBuzz loggerAddress)- wait---logger :: Actor String ()-logger = forever do- string <- receive- liftIO $ putStrLn string---fizzBuzz :: Address String -> Actor () ()-fizzBuzz loggerAddress = do- let log = send loggerAddress-- loop (1 :: Int) \n -> do- if | n `mod` 15 == 0 -> log "FizzBuzz"- | n `mod` 3 == 0 -> log "Fizz"- | n `mod` 5 == 0 -> log "Buzz"- | otherwise -> log (show n)-- liftIO $ threadDelay 500_000-- continue (n + 1)---counter :: Actor msg Int-counter = loop 10 \count -> do- liftIO $ print count- if count > 0- then continue (count - 1)- else exit count---echo :: (forall msg. String -> Actor msg ()) -> Actor () ()-echo log = forever do- line <- liftIO getLine- if line == "ping" then- log "pong"- else- log line---add1 :: (forall msg. String -> Actor msg ()) -> Actor (Address Int, Int) ()-add1 log = forever do- log "[add1] Waiting for request"- (returnAddress, number) <- receive- log "[add1] Received request"- log "[add1] Spawning worker"- spawn (add1Worker log number returnAddress)---add1Worker :: (forall msg. String -> Actor msg ()) -> Int -> Address Int -> Actor () ()-add1Worker log number returnAddress = do- log "[add1Worker] Started"- send returnAddress (number + 1)- log "[add1Worker] Replied"---program :: Actor Int ()-program = do- liftIO $ putStrLn "[main] START"-- liftIO $ putStrLn "[main] Spawning logger"- loggerAddress <- spawn logger-- let log = send loggerAddress-- liftIO $ putStrLn "[main] Spawning echo"- _ <- spawn (echo log)-- log "[main] Spawning add1"- add1Address <- spawn (add1 log)-- log "[main] Sending number to add1"- address <- here- send add1Address (address, 1)- two <- receive- log ("[main] Received response from add1: " <> show two)-- log "[main] FINISH"- wait---main :: IO ()-main = run program
src/Drama/Internal.hs view
@@ -84,7 +84,7 @@ -- | @since 0.1.0.0-newtype Scope = Scope (Ki.Scope)+newtype Scope = Scope Ki.Scope -- | Spawn a new actor. Returns the spawned actor's address.@@ -96,7 +96,7 @@ -- @since 0.1.0.0 spawn :: Actor childMsg () -> Actor msg (Address childMsg) spawn actor = do- (inChan, outChan) <- liftIO $ Unagi.newChan+ (inChan, outChan) <- liftIO Unagi.newChan let address = Address inChan let mailbox = Mailbox outChan @@ -185,7 +185,7 @@ -- @since 0.1.0.0 run :: MonadIO m => Actor msg a -> m a run actor = do- (inChan, outChan) <- liftIO $ Unagi.newChan+ (inChan, outChan) <- liftIO Unagi.newChan let address = Address inChan let mailbox = Mailbox outChan