io.servers: refactored words for adding & removing servers
parent
20656f0db8
commit
7874f5a547
|
@ -1,7 +1,6 @@
|
||||||
USING: accessors arrays calendar concurrency.promises fry io
|
USING: accessors arrays concurrency.flags fry io io.encodings.ascii
|
||||||
io.encodings.ascii io.encodings.utf8 io.servers
|
io.encodings.utf8 io.servers.private io.sockets kernel namespaces
|
||||||
io.servers.private io.sockets kernel namespaces scratchpad
|
sequences sets threads tools.test ;
|
||||||
sequences threads tools.test ;
|
|
||||||
IN: io.servers
|
IN: io.servers
|
||||||
|
|
||||||
{ t } [ ascii <threaded-server> listen-on empty? ] unit-test
|
{ t } [ ascii <threaded-server> listen-on empty? ] unit-test
|
||||||
|
@ -69,4 +68,16 @@ TUPLE: my-threaded-server < threaded-server ;
|
||||||
2array >>secure
|
2array >>secure
|
||||||
|
|
||||||
start-server stop-server
|
start-server stop-server
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! add-running-server
|
||||||
|
[
|
||||||
|
ascii <threaded-server> HS{ } clone 2dup adjoin
|
||||||
|
add-running-server
|
||||||
|
] [ server-already-running? ] must-fail-with
|
||||||
|
|
||||||
|
! stop-server
|
||||||
|
[
|
||||||
|
ascii <threaded-server> <flag> >>server-stopped
|
||||||
|
stop-server
|
||||||
|
] [ server-not-running? ] must-fail-with
|
||||||
|
|
|
@ -33,19 +33,11 @@ ERROR: server-already-running threaded-server ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: must-be-running ( threaded-server -- threaded-server )
|
: add-running-server ( threaded-server running-servers -- )
|
||||||
dup running-servers get in? [ server-not-running ] unless ;
|
2dup in? [ server-already-running ] [ adjoin ] if ;
|
||||||
|
|
||||||
: must-not-be-running ( threaded-server -- threaded-server )
|
: remove-running-server ( threaded-server running-servers -- )
|
||||||
dup running-servers get in? [ server-already-running ] when ;
|
2dup in? [ delete ] [ drop server-not-running ] if ;
|
||||||
|
|
||||||
: add-running-server ( threaded-server -- )
|
|
||||||
must-not-be-running
|
|
||||||
running-servers get adjoin ;
|
|
||||||
|
|
||||||
: remove-running-server ( threaded-server -- )
|
|
||||||
must-be-running
|
|
||||||
running-servers get delete ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -181,7 +173,7 @@ PRIVATE>
|
||||||
[ ] [ name>> ] bi
|
[ ] [ name>> ] bi
|
||||||
[
|
[
|
||||||
set-servers
|
set-servers
|
||||||
dup add-running-server
|
dup running-servers get add-running-server
|
||||||
dup servers>>
|
dup servers>>
|
||||||
[
|
[
|
||||||
[ '[ _ _ [ start-accept-loop ] with-disposal ] ]
|
[ '[ _ _ [ start-accept-loop ] with-disposal ] ]
|
||||||
|
@ -196,7 +188,7 @@ PRIVATE>
|
||||||
|
|
||||||
: stop-server ( threaded-server -- )
|
: stop-server ( threaded-server -- )
|
||||||
dup server-running? [
|
dup server-running? [
|
||||||
[ remove-running-server ]
|
[ running-servers get remove-running-server ]
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
[ secure-context>> [ &dispose drop ] when* ]
|
[ secure-context>> [ &dispose drop ] when* ]
|
||||||
|
|
Loading…
Reference in New Issue