Skip to content

Commit 5eacc3a

Browse files
nwolversonnwolverson
authored
Merge pull request #11 from id3as/master
receive type class and show instances
2 parents 27299ea + 0038a2c commit 5eacc3a

File tree

5 files changed

+96
-54
lines changed

5 files changed

+96
-54
lines changed

‎src/Erl/Process.purs‎

Lines changed: 15 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@ module Erl.Process
1313
, spawnLink
1414
, sendExitSignal
1515
, class HasProcess
16-
, class ReceivesMessage
1716
, class HasSelf
17+
, class HasReceive
1818
, trapExit
1919
, receiveWithTrap
2020
, receiveWithTrapAndTimeout
@@ -41,6 +41,9 @@ toPid (Process pid) = pid
4141
instance eqProcess :: Eq (Process a) where
4242
eq a b = eq (toPid a) (toPid b)
4343

44+
instance Show (Process pid) where
45+
show (Process pid) = "(Process " <> show pid <> ")"
46+
4447
newtype ProcessM (a :: Type) b
4548
= ProcessM (Effect b)
4649
derive newtype instance functorProcessM :: Functor (ProcessM a)
@@ -55,12 +58,6 @@ unsafeRunProcessM (ProcessM b) = b
5558
instance monadEffectProcessM :: MonadEffect (ProcessM a) where
5659
liftEffect = ProcessM
5760

58-
receive :: forall a. ProcessM a a
59-
receive = ProcessM Raw.receive
60-
61-
receiveWithTimeout :: forall a. Milliseconds -> a -> ProcessM a a
62-
receiveWithTimeout n a = ProcessM $ Raw.receiveWithTimeout n a
63-
6461
newtype ProcessTrapM (a :: Type) b
6562
= ProcessTrapM (Effect b)
6663
derive newtype instance functorProcessTrapM :: Functor (ProcessTrapM a)
@@ -118,9 +115,16 @@ instance selfProcessM :: HasSelf (ProcessM a) a where
118115
self :: forall a. ProcessM a (Process a)
119116
self = ProcessM $ Process <$> Raw.self
120117

121-
class ReceivesMessage :: forall k. k -> Type -> Constraint
122-
class ReceivesMessage a msg | a -> msg
118+
class HasReceive :: (Type -> Type) -> Type -> Type -> Constraint
119+
class HasReceive a msg r | a -> msg r where
120+
receive :: a r
121+
122+
receiveWithTimeout :: Milliseconds -> msg -> a r
123123

124-
instance messageTypeProcessM :: ReceivesMessage (ProcessM msg) msg
124+
instance HasReceive (ProcessM msg) msg msg where
125+
receive = ProcessM Raw.receive
126+
receiveWithTimeout t d = ProcessM $ Raw.receiveWithTimeout t d
125127

126-
instance messageTypeProcessTrapM :: ReceivesMessage (ProcessTrapM msg) msg
128+
instance HasReceive (ProcessTrapM msg) msg (Either ExitReason msg) where
129+
receive = ProcessTrapM Raw.receiveWithTrap
130+
receiveWithTimeout t d = ProcessTrapM $ Raw.receiveWithTrapAndTimeout t d

‎src/Erl/Process/Raw.erl‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,8 @@
1212
setProcessFlagTrapExit/1,
1313
exit/1,
1414
sendExitSignal/2,
15-
unlink/1
15+
unlink/1,
16+
show_/1
1617
]).
1718

1819
eqNative(X, Y) -> X == Y.
@@ -62,7 +63,7 @@ receiveWithTrapAndTimeout_(Timeout, Msg) ->
6263
{'EXIT', Pid, Other } -> {left, {exitMsg, Pid, {other, Other}}};
6364
X -> {right, X}
6465
after
65-
Timeout -> Msg
66+
Timeout -> {right, Msg}
6667
end
6768
end.
6869

@@ -77,3 +78,6 @@ exit(Term) -> fun () -> erlang:exit(Term) end.
7778
sendExitSignal(Term, Pid) -> fun () -> erlang:exit(Pid, Term) end.
7879

7980
unlink(Pid) -> fun() -> erlang:unlink(Pid) end.
81+
82+
show_(Pid) ->
83+
list_to_binary(erlang:pid_to_list(Pid)).

‎src/Erl/Process/Raw.purs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,11 @@ foreign import data Pid :: Type
3030
instance eqPid :: Eq Pid where
3131
eq = eqNative
3232

33+
instance Show Pid where
34+
show = show_
35+
36+
foreign import show_ :: Pid -> String
37+
3338
foreign import eqNative :: forall a. a -> a -> Boolean
3439

3540
foreign import spawn :: (Effect Unit) -> Effect Pid
@@ -54,6 +59,7 @@ instance pidHasPid :: HasPid Pid where
5459

5560
data ExitReason
5661
= ExitReason Pid ExitMsg
62+
5763
data ExitMsg
5864
= Normal
5965
| Killed

‎test.dhall‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,5 +2,5 @@ let conf = ./spago.dhall
22

33
in conf
44
⫽ { sources = conf.sources # [ "test/**/*.purs" ]
5-
, dependencies = conf.dependencies # [ "console", "assert", "erl-test-eunit", "exceptions", "free", "unsafe-coerce"]
5+
, dependencies = conf.dependencies # [ "console", "assert", "erl-test-eunit", "exceptions", "free", "unsafe-coerce"]
66
}

‎test/Process.purs‎

Lines changed: 68 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1,82 +1,110 @@
11
module Test.Process where
22

33
import Prelude
4-
54
import Control.Monad.Free (Free)
65
import Data.Either (Either(..), isLeft)
6+
import Data.Time.Duration (Milliseconds(..))
77
import Effect.Class (liftEffect)
88
import Effect.Exception (throw)
9-
import Erl.Process (ExitReason, ProcessM, receive, receiveWithTrap, self, spawn, spawnLink, trapExit, (!))
9+
import Erl.Process (ExitReason, ProcessM, receive, receiveWithTimeout, self, spawn, spawnLink, trapExit, (!))
1010
import Erl.Process.Raw as Raw
1111
import Erl.Test.EUnit (TestF, suite, test)
1212
import Foreign as Foreign
1313
import Test.Assert (assertTrue)
1414
import Unsafe.Coerce (unsafeCoerce)
1515

16-
data Foo = Foo Int | Blah String | Whatever Boolean Number
16+
data Foo
17+
= Foo Int
18+
| Blah String
19+
| Whatever Boolean Number
1720
derive instance eqFoo :: Eq Foo
1821

1922
tests :: Free TestF Unit
20-
tests =
23+
tests =
2124
suite "process tests" do
2225
-- Use raw process communication to talk to the test process as it is not a typed Process
2326
test "send stuff to spawned process" do
2427
parent <- Raw.self
2528
-- We can also do this inline or infer the types
26-
let proc :: ProcessM Int Unit
27-
proc = do
28-
a :: Int <- receive
29-
b :: Int <- receive
30-
liftEffect $ parent `Raw.send` (a == 1 && b == 2)
29+
let
30+
proc :: ProcessM Int Unit
31+
proc = do
32+
a :: Int <- receive
33+
b :: Int <- receive
34+
liftEffect $ parent `Raw.send` (a == 1 && b == 2)
3135
p <- spawn proc
3236
p ! 1
3337
p ! 2
3438
Raw.receive >>= assertTrue
35-
3639
test "send stuff to spawned process, another type" do
3740
parent <- Raw.self
38-
p <- spawn do
39-
a <- receive
40-
b <- receive
41-
liftEffect $ parent `Raw.send` (a == Foo 42 && b == Whatever true 1.0)
41+
p <-
42+
spawn do
43+
a <- receive
44+
b <- receive
45+
liftEffect $ parent `Raw.send` (a == Foo 42 && b == Whatever true 1.0)
4246
p ! Foo 42
4347
p ! Whatever true 1.0
4448
Raw.receive >>= assertTrue
45-
4649
test "sending tospawnLinked" do
4750
parent <- Raw.self
48-
p <- spawnLink do
49-
a <- receive
50-
b <- receive
51-
liftEffect $ parent `Raw.send` (a == Foo 42 && b == Whatever true 1.0)
51+
p <-
52+
spawnLink do
53+
a <- receive
54+
b <- receive
55+
liftEffect $ parent `Raw.send` (a == Foo 42 && b == Whatever true 1.0)
5256
p ! Foo 42
5357
p ! Whatever true 1.0
5458
Raw.receive >>= assertTrue
55-
59+
test "receive timeout" do
60+
parent <- Raw.self
61+
_p <-
62+
spawnLink do
63+
a <- receiveWithTimeout (Milliseconds 10.0) "default"
64+
liftEffect $ parent `Raw.send` (a == "default")
65+
Raw.receive >>= assertTrue
5666
test "self eq" do
5767
parent <- Raw.self
58-
p <- spawnLink do
59-
child <- self
60-
liftEffect $ parent `Raw.send` child
68+
p <-
69+
spawnLink do
70+
child <- self
71+
liftEffect $ parent `Raw.send` child
6172
p' <- Raw.receive
6273
assertTrue $ p == p'
63-
6474
test "trapExit" do
6575
testPid <- Raw.self
66-
void $ spawnLink do
67-
parent <- self
68-
69-
trapExit do
70-
_ <- liftEffect $ spawnLink do
71-
liftEffect $ parent ! 1
72-
liftEffect $ Raw.exit (Foreign.unsafeToForeign true)
73-
pure unit
74-
75-
first <- receiveWithTrap
76-
liftEffect $ case (unsafeCoerce first) :: Either ExitReason Int of
77-
Right 1 -> pure unit
78-
_other -> do
79-
throw "failed recv"
80-
second <- receiveWithTrap
81-
liftEffect $ testPid `Raw.send` (isLeft second)
76+
void
77+
$ spawnLink do
78+
parent <- self
79+
trapExit do
80+
_ <-
81+
liftEffect
82+
$ spawnLink do
83+
liftEffect $ parent ! 1
84+
liftEffect $ Raw.exit (Foreign.unsafeToForeign true)
85+
pure unit
86+
first <- receive
87+
liftEffect
88+
$ case (unsafeCoerce first) :: Either ExitReason Int of
89+
Right 1 -> pure unit
90+
_other -> do
91+
throw "failed recv"
92+
second <- receive
93+
liftEffect $ testPid `Raw.send` (isLeft second)
94+
Raw.receive >>= assertTrue
95+
test "receive with trap timeout" do
96+
testPid <- Raw.self
97+
void
98+
$ spawnLink do
99+
trapExit do
100+
_ <-
101+
liftEffect
102+
$ spawnLink do
103+
_ <- receive
104+
pure unit
105+
a <- receiveWithTimeout (Milliseconds 100.0) "default"
106+
liftEffect
107+
$ case a of
108+
Right "default" -> testPid `Raw.send` true
109+
_ -> testPid `Raw.send` false
82110
Raw.receive >>= assertTrue

0 commit comments

Comments
 (0)