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