diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,16 @@ ## [Unreleased] +## [0.1.0.3] - 2021-02-20 + +### Added + +- Examples now have their own executable components, separate from the library + +### Removed + +- Removed `SharedResource` and `Workers` modules from library + ## [0.1.0.2] - 2021-02-20 ### Added @@ -36,8 +46,9 @@ 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 +[Unreleased]: https://github.com/evanrelf/drama/compare/v0.1.0.3...HEAD +[0.1.0.3]: https://github.com/evanrelf/drama/releases/tag/v0.1.0.3 +[0.1.0.2]: 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 diff --git a/drama.cabal b/drama.cabal --- a/drama.cabal +++ b/drama.cabal @@ -1,7 +1,7 @@ cabal-version: 3.0 name: drama -version: 0.1.0.2 +version: 0.1.0.3 synopsis: Simple actor library for Haskell description: Simple actor library for Haskell category: Concurrency @@ -17,6 +17,7 @@ CHANGELOG.md LICENSE README.md + examples/*.hs common common @@ -35,6 +36,13 @@ -fshow-warning-groups +common executable + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + + common stan if impl(ghc >= 8.8) ghc-options: @@ -42,12 +50,6 @@ -hiedir=.hie -flag examples - description: Build examples - default: False - manual: True - - library import: common, stan hs-source-dirs: src @@ -58,11 +60,6 @@ exposed-modules: , Drama , Drama.Internal - if flag(examples) - hs-source-dirs: examples - exposed-modules: - , SharedResource - , Workers benchmark bench @@ -73,3 +70,15 @@ build-depends: , criterion ^>= 1.5.9.0 , drama + + +executable example-shared-resource + import: common, executable, stan + main-is: examples/shared-resource.hs + build-depends: drama + + +executable example-workers + import: common, executable, stan + main-is: examples/workers.hs + build-depends: drama diff --git a/examples/SharedResource.hs b/examples/SharedResource.hs deleted file mode 100644 --- a/examples/SharedResource.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# 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 diff --git a/examples/Workers.hs b/examples/Workers.hs deleted file mode 100644 --- a/examples/Workers.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# 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) diff --git a/examples/shared-resource.hs b/examples/shared-resource.hs new file mode 100644 --- /dev/null +++ b/examples/shared-resource.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NumericUnderscores #-} + +module Main (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 diff --git a/examples/workers.hs b/examples/workers.hs new file mode 100644 --- /dev/null +++ b/examples/workers.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE BlockArguments #-} + +module Main (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)