theatre (empty) → 1

raw patch · 5 files changed

+226/−0 lines, 5 filesdep +basedep +base-preludedep +contravariantsetup-changed

Dependencies added: base, base-prelude, contravariant, semigroups, slave-thread, unagi-chan

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• library/Theatre.hs +125/−0
• library/Theatre/Prelude.hs +23/−0
• theatre.cabal +54/−0

@@ -0,0 +1,22 @@+Copyright (c) 2017, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,125 @@+{-|+Minimalistic actor library.+-}+module Theatre+(+  Actor,+  -- * Construction+  graceful,+  disgraceful,+  suicidal,+  -- * Usage+  tell,+  kill,+)+where++import Theatre.Prelude+import qualified Control.Concurrent.Chan.Unagi as E+import qualified SlaveThread as F+++{-|+Actor, which processes the messages of type @message@.++An abstraction over the message channel, thread-forking and killing.+-}+data Actor message =+  Actor {+    {-| Send a message to the actor -}+    tell :: message -> IO (),+    {-| Kill the actor -}+    kill :: IO ()+  }++instance Semigroup (Actor message) where+  (<>) (Actor leftTell leftKill) (Actor rightTell rightKill) =+    Actor tell kill+    where+      tell message =+        leftTell message >> rightTell message+      kill =+        leftKill >> rightKill++instance Monoid (Actor message) where+  mempty =+    Actor (const (return ())) (return ())+  mappend =+    (<>)++instance Contravariant Actor where+  contramap fn (Actor tell kill) =+    Actor (tell . fn) kill++instance Divisible Actor where+  conquer =+    mempty+  divide divisor (Actor leftTell leftKill) (Actor rightTell rightKill) =+    Actor tell kill+    where+      tell message =+        case divisor message of+          (leftMessage, rightMessage) -> leftTell leftMessage >> rightTell rightMessage+      kill =+        leftKill >> rightKill++instance Decidable Actor where+  lose fn =+    Actor (const (return ()) . absurd . fn) (return ())+  choose choice (Actor leftTell leftKill) (Actor rightTell rightKill) =+    Actor tell kill+    where+      tell =+        either leftTell rightTell . choice+      kill =+        leftKill >> rightKill++{-|+An actor which cannot die by itself unless explicitly killed.++Given an interpreter of messages,+forks a thread to run the computation on and +produces a handle to address that actor.++Killing that actor will make it process all the messages in the queue first.+All the messages sent to it after killing won't be processed.+-}+graceful :: (message -> IO ()) {-^ Interpreter of a message -} -> IO (Actor message)+graceful interpretMessage =+  do+    (inChan, outChan) <- E.newChan+    F.fork $ fix $ \loop -> {-# SCC "graceful/loop" #-} do+      message <- E.readChan outChan+      case message of+        Just payload ->+          do+            interpretMessage payload+            loop+        Nothing ->+          return ()+    return (Actor (E.writeChan inChan . Just) (E.writeChan inChan Nothing))++{-|+An actor which cannot die by itself unless explicitly killed.++Given an interpreter of messages,+forks a thread to run the computation on and +produces a handle to address that actor.+-}+disgraceful :: (message -> IO ()) {-^ Interpreter of a message -} -> IO (Actor message)+disgraceful receiver =+  suicidal (\producer -> forever (producer >>= receiver))++{-|+An actor, whose interpreter can decide that the actor should die.++Given an implementation of a receiver loop of messages,+forks a thread to run that receiver on and+produces a handle to address that actor.+-}+suicidal :: (IO message -> IO ()) {-^ A message receiver loop. When the loop exits, the actor dies -} -> IO (Actor message)+suicidal receiver =+  do+    (inChan, outChan) <- E.newChan+    threadId <- F.fork (receiver (E.readChan outChan))+    return (Actor (E.writeChan inChan) (killThread threadId))

@@ -0,0 +1,23 @@+module Theatre.Prelude+(+  module Exports,+)+where+++-- base+-------------------------+import Data.Void as Exports++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, (<>), First(..), Last(..))++-- contravariant+-------------------------+import Data.Functor.Contravariant as Exports+import Data.Functor.Contravariant.Divisible as Exports++-- semigroups+-------------------------+import Data.Semigroup as Exports

@@ -0,0 +1,54 @@+name:+  theatre+version:+  1+category:+  Concurrency+synopsis:+  Minimalistic actor library+homepage:+  https://github.com/nikita-volkov/theatre +bug-reports:+  https://github.com/nikita-volkov/theatre/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2017, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/theatre.git++library+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010+  exposed-modules:+    Theatre+  other-modules:+    Theatre.Prelude+  build-depends:+    -- concurrency:+    unagi-chan == 0.4.*,+    slave-thread == 1.*,+    -- control:+    contravariant >= 1.3 && < 2,+    semigroups >= 0.18 && < 0.20,+    -- general:+    base-prelude >= 0.1.19 && < 2,+    base >= 4.8 && < 5