Skip to content

Commit db12dd2

Browse files
LaurentRDCLaurentRDC
committed
Merge branch 'monorepo-structure' of https://github.com/haskell-distributed/distributed-process-execution into monorepo-structure
2 parents 0ac771d + 9d2f3ad commit db12dd2

File tree

16 files changed

+2656
-2
lines changed

16 files changed

+2656
-2
lines changed

‎packages/distributed-process-execution/ChangeLog

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
2015-06-15 Facundo Domínguez <[email protected]> 0.1.2
2+
3+
* Add compatibility with ghc-7.10.
4+
* Fix dependency bounds.
5+
* Reuse test modules from distributed-proces-tests.
6+
7+
# HEAD
8+
9+
* Added initial GenServer module
10+
* Added Timer Module
11+
* Moved time functions into Time.hs
12+
* Added Async API
13+
* Added GenProcess API (subsumes lower level GenServer API)
14+

‎packages/distributed-process-execution/LICENCE

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
Copyright Tim Watson, 2012-2013.
2+
3+
All rights reserved.
4+
5+
Redistribution and use in source and binary forms, with or without
6+
modification, are permitted provided that the following conditions are met:
7+
8+
* Redistributions of source code must retain the above copyright
9+
notice, this list of conditions and the following disclaimer.
10+
11+
* Redistributions in binary form must reproduce the above
12+
copyright notice, this list of conditions and the following
13+
disclaimer in the documentation and/or other materials provided
14+
with the distribution.
15+
16+
* Neither the name of the author nor the names of other
17+
contributors may be used to endorse or promote products derived
18+
from this software without specific prior written permission.
19+
20+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

‎packages/distributed-process-execution/Setup.lhs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
#!/usr/bin/env runhaskell
2+
> import Distribution.Simple
3+
> main = defaultMain

‎packages/distributed-process-execution/distributed-process-execution.cabal

Lines changed: 143 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,143 @@
1+
name: distributed-process-execution
2+
version: 0.1.2.2
3+
cabal-version: >=1.8
4+
build-type: Simple
5+
license: BSD3
6+
license-file: LICENCE
7+
stability: experimental
8+
Copyright: Tim Watson 2012 - 2013
9+
Author: Tim Watson
10+
Maintainer: Tim Watson <[email protected]>
11+
Stability: experimental
12+
Homepage: http://github.com/haskell-distributed/distributed-process-execution
13+
Bug-Reports: http://github.com/haskell-distributed/distributed-process-execution/issues
14+
synopsis: Execution Framework for The Cloud Haskell Application Platform
15+
description:
16+
The Execution Framework provides tools for load regulation, workload shedding and remote hand-off.
17+
The currently implementation provides only a subset of the plumbing required, comprising tools
18+
for event management, mailbox buffering and message routing.
19+
category: Control
20+
tested-with: GHC == 7.4.2 GHC == 7.6.2
21+
data-dir: ""
22+
extra-source-files: ChangeLog
23+
24+
source-repository head
25+
type: git
26+
location: https://github.com/haskell-distributed/distributed-process-execution
27+
28+
library
29+
build-depends:
30+
base >= 4.4 && < 5,
31+
data-accessor >= 0.2.2.3,
32+
distributed-process >= 0.6.6 && < 0.7,
33+
distributed-process-extras >= 0.3.1 && < 0.4,
34+
distributed-process-supervisor >= 0.2.0 && < 0.3,
35+
distributed-process-client-server >= 0.2.0 && < 0.3,
36+
binary >= 0.6.3.0 && < 0.9,
37+
deepseq >= 1.3.0.1 && < 1.5,
38+
mtl,
39+
containers >= 0.4 && < 0.6,
40+
hashable >= 1.2.0.5 && < 1.3,
41+
unordered-containers >= 0.2.3.0 && < 0.3,
42+
fingertree < 0.2,
43+
stm >= 2.4 && < 2.5,
44+
time,
45+
transformers
46+
if impl(ghc <= 7.5)
47+
Build-Depends: template-haskell == 2.7.0.0,
48+
derive == 2.5.5,
49+
uniplate == 1.6.12,
50+
ghc-prim
51+
extensions: CPP
52+
hs-source-dirs: src
53+
ghc-options: -Wall
54+
exposed-modules:
55+
Control.Distributed.Process.Execution,
56+
Control.Distributed.Process.Execution.EventManager,
57+
Control.Distributed.Process.Execution.Exchange,
58+
Control.Distributed.Process.Execution.Mailbox
59+
other-modules:
60+
Control.Distributed.Process.Execution.Exchange.Broadcast,
61+
Control.Distributed.Process.Execution.Exchange.Internal,
62+
Control.Distributed.Process.Execution.Exchange.Router
63+
64+
65+
test-suite ExchangeTests
66+
type: exitcode-stdio-1.0
67+
-- x-uses-tf: true
68+
build-depends:
69+
base >= 4.4 && < 5,
70+
ansi-terminal >= 0.5 && < 0.7,
71+
containers,
72+
hashable,
73+
unordered-containers >= 0.2.3.0 && < 0.3,
74+
distributed-process >= 0.5.3 && < 0.7,
75+
distributed-process-execution,
76+
distributed-process-extras >= 0.3.1 && < 0.4,
77+
distributed-process-systest >= 0.1.1 && < 0.2,
78+
distributed-static,
79+
bytestring,
80+
data-accessor,
81+
fingertree < 0.2,
82+
network-transport >= 0.4 && < 0.5,
83+
deepseq >= 1.3.0.1 && < 1.5,
84+
mtl,
85+
network-transport-tcp >= 0.4 && < 0.6,
86+
binary >= 0.6.3.0 && < 0.9,
87+
network >= 2.3 && < 2.7,
88+
HUnit >= 1.2 && < 2,
89+
stm >= 2.3 && < 2.5,
90+
time,
91+
test-framework >= 0.6 && < 0.9,
92+
test-framework-hunit,
93+
QuickCheck >= 2.4,
94+
test-framework-quickcheck2,
95+
transformers,
96+
rematch >= 0.2.0.0,
97+
ghc-prim
98+
hs-source-dirs:
99+
tests
100+
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind -eventlog
101+
extensions: CPP
102+
main-is: TestExchange.hs
103+
104+
105+
test-suite MailboxTests
106+
type: exitcode-stdio-1.0
107+
-- x-uses-tf: true
108+
build-depends:
109+
base >= 4.4 && < 5,
110+
ansi-terminal >= 0.5 && < 0.7,
111+
containers,
112+
hashable,
113+
unordered-containers >= 0.2.3.0 && < 0.3,
114+
distributed-process >= 0.6.6 && < 0.7,
115+
distributed-process-execution,
116+
distributed-process-extras >= 0.3.1 && < 0.4,
117+
distributed-process-systest >= 0.1.1 && < 0.2,
118+
distributed-static,
119+
bytestring,
120+
data-accessor,
121+
fingertree < 0.2,
122+
network-transport >= 0.4 && < 0.5,
123+
deepseq >= 1.3.0.1 && < 1.5,
124+
mtl,
125+
network-transport-tcp >= 0.4 && < 0.6,
126+
binary >= 0.6.3.0 && < 0.9,
127+
network >= 2.3 && < 2.7,
128+
HUnit >= 1.2 && < 2,
129+
stm >= 2.3 && < 2.5,
130+
time,
131+
test-framework >= 0.6 && < 0.9,
132+
test-framework-hunit,
133+
QuickCheck >= 2.4,
134+
test-framework-quickcheck2,
135+
transformers,
136+
rematch >= 0.2.0.0,
137+
ghc-prim
138+
hs-source-dirs:
139+
tests
140+
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind -eventlog
141+
extensions: CPP
142+
main-is: TestMailbox.hs
143+
other-modules: MailboxTestFilters

‎packages/distributed-process-execution/src/Control/Distributed/Process/Execution.hs

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
-----------------------------------------------------------------------------
2+
-- |
3+
-- Module : Control.Distributed.Process.Execution
4+
-- Copyright : (c) Tim Watson 2013 - 2014
5+
-- License : BSD3 (see the file LICENSE)
6+
--
7+
-- Maintainer : Tim Watson <[email protected]>
8+
-- Stability : experimental
9+
-- Portability : non-portable (requires concurrency)
10+
--
11+
-- [Inter-Process Traffic Management]
12+
--
13+
-- The /Execution Framework/ provides tools for load regulation, workload
14+
-- shedding and remote hand-off. The currently implementation provides only
15+
-- a subset of the plumbing required, comprising tools for event management,
16+
-- mailbox buffering and message routing.
17+
--
18+
-----------------------------------------------------------------------------
19+
20+
module Control.Distributed.Process.Execution
21+
( -- * Mailbox Buffering
22+
module Control.Distributed.Process.Execution.Mailbox
23+
-- * Message Exchanges
24+
, module Control.Distributed.Process.Execution.Exchange
25+
) where
26+
27+
import Control.Distributed.Process.Execution.Exchange hiding (startSupervised)
28+
import Control.Distributed.Process.Execution.Mailbox hiding (startSupervised, post)
29+
30+
{-
31+
32+
Load regulation requires that we apply limits to various parts of the system.
33+
The manner in which they're applied may vary, but the mechanisms are limited
34+
to:
35+
36+
1. rejecting the activity/request
37+
2. accepting the activity immediately
38+
3. blocking some or all requestors
39+
4. blocking some (or all) activities
40+
5. terminiating some (or all) activities
41+
42+
-}
43+
44+

‎packages/distributed-process-execution/src/Control/Distributed/Process/Execution/EventManager.hs

Lines changed: 153 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
{-# LANGUAGE DeriveDataTypeable #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE ExistentialQuantification #-}
4+
{-# LANGUAGE RankNTypes #-}
5+
{-# LANGUAGE RecordWildCards #-}
6+
{-# LANGUAGE ScopedTypeVariables #-}
7+
{-# LANGUAGE TemplateHaskell #-}
8+
{-# LANGUAGE ImpredicativeTypes #-}
9+
10+
-----------------------------------------------------------------------------
11+
-- |
12+
-- Module : Control.Distributed.Process.Execution.EventManager
13+
-- Copyright : (c) Well-Typed / Tim Watson
14+
-- License : BSD3 (see the file LICENSE)
15+
--
16+
-- Maintainer : Tim Watson <[email protected]>
17+
-- Stability : experimental
18+
-- Portability : non-portable (requires concurrency)
19+
--
20+
-- [Overview]
21+
--
22+
-- The /EventManager/ is a parallel/concurrent event handling tool, built on
23+
-- top of the /Exchange API/. Arbitrary events are published to the event
24+
-- manager using 'notify', and are broadcast simulataneously to a set of
25+
-- registered /event handlers/.
26+
--
27+
-- [Defining and Registering Event Handlers]
28+
--
29+
-- Event handlers are defined as @Serializable m => s -> m -> Process s@,
30+
-- i.e., an expression taking an initial state, an arbitrary @Serializable@
31+
-- event/message and performing an action in the @Process@ monad that evaluates
32+
-- to a new state.
33+
--
34+
-- See "Control.Distributed.Process.Execution.Exchange".
35+
--
36+
-----------------------------------------------------------------------------
37+
38+
module Control.Distributed.Process.Execution.EventManager
39+
( EventManager
40+
, start
41+
, startSupervised
42+
, startSupervisedRef
43+
, notify
44+
, addHandler
45+
, addMessageHandler
46+
) where
47+
48+
import Control.Distributed.Process hiding (Message, link)
49+
import qualified Control.Distributed.Process as P (Message)
50+
import Control.Distributed.Process.Execution.Exchange
51+
( Exchange
52+
, Message(..)
53+
, post
54+
, broadcastExchange
55+
, broadcastExchangeT
56+
, broadcastClient
57+
)
58+
import qualified Control.Distributed.Process.Execution.Exchange as Exchange
59+
( startSupervised
60+
)
61+
import Control.Distributed.Process.Extras.Internal.Primitives
62+
import Control.Distributed.Process.Extras.Internal.Unsafe
63+
( InputStream
64+
, matchInputStream
65+
)
66+
import Control.Distributed.Process.Supervisor (SupervisorPid)
67+
import Control.Distributed.Process.Serializable hiding (SerializableDict)
68+
import Data.Binary
69+
import Data.Typeable (Typeable)
70+
import GHC.Generics
71+
72+
{- notes
73+
74+
Event manager is implemented over a simple BroadcastExchange. We eschew the
75+
complexities of identifying handlers and allowing them to be removed/deleted
76+
or monitored, since we avoid running them in the exchange process. Instead,
77+
each handler runs as an independent process, leaving handler management up
78+
to the user and allowing all the usual process managemnet techniques (e.g.,
79+
registration, supervision, etc) to be utilised instead.
80+
81+
-}
82+
83+
-- | Opaque handle to an Event Manager.
84+
--
85+
newtype EventManager = EventManager { ex :: Exchange }
86+
deriving (Typeable, Generic)
87+
instance Binary EventManager where
88+
89+
instance Resolvable EventManager where
90+
resolve = resolve . ex
91+
92+
-- | Start a new /Event Manager/ process and return an opaque handle
93+
-- to it.
94+
start :: Process EventManager
95+
start = broadcastExchange >>= return . EventManager
96+
97+
startSupervised :: SupervisorPid -> Process EventManager
98+
startSupervised sPid = do
99+
ex <- broadcastExchangeT >>= \t -> Exchange.startSupervised t sPid
100+
return $ EventManager ex
101+
102+
startSupervisedRef :: SupervisorPid -> Process (ProcessId, P.Message)
103+
startSupervisedRef sPid = do
104+
ex <- startSupervised sPid
105+
Just pid <- resolve ex
106+
return (pid, unsafeWrapMessage ex)
107+
108+
-- | Broadcast an event to all registered handlers.
109+
notify :: Serializable a => EventManager -> a -> Process ()
110+
notify em msg = post (ex em) msg
111+
112+
-- | Add a new event handler. The handler runs in its own process,
113+
-- which is spawned locally on behalf of the caller.
114+
addHandler :: forall s a. Serializable a
115+
=> EventManager
116+
-> (s -> a -> Process s)
117+
-> Process s
118+
-> Process ProcessId
119+
addHandler m h s =
120+
spawnLocal $ newHandler (ex m) (\s' m' -> handleMessage m' (h s')) s
121+
122+
-- | As 'addHandler', but operates over a raw @Control.Distributed.Process.Message@.
123+
addMessageHandler :: forall s.
124+
EventManager
125+
-> (s -> P.Message -> Process (Maybe s))
126+
-> Process s
127+
-> Process ProcessId
128+
addMessageHandler m h s = spawnLocal $ newHandler (ex m) h s
129+
130+
newHandler :: forall s .
131+
Exchange
132+
-> (s -> P.Message -> Process (Maybe s))
133+
-> Process s
134+
-> Process ()
135+
newHandler ex handler initState = do
136+
linkTo ex
137+
is <- broadcastClient ex
138+
listen is handler =<< initState
139+
140+
listen :: forall s . InputStream Message
141+
-> (s -> P.Message -> Process (Maybe s))
142+
-> s
143+
-> Process ()
144+
listen inStream handler state = do
145+
receiveWait [ matchInputStream inStream ] >>= handleEvent inStream handler state
146+
where
147+
handleEvent is h s p = do
148+
r <- h s (payload p)
149+
let s2 = case r of
150+
Nothing -> s
151+
Just s' -> s'
152+
listen is h s2
153+

0 commit comments

Comments
 (0)