<html><head><meta http-equiv="content-type" content="text/html; charset=us-ascii"><style>body { line-height: 1.5; }body { font-size: 10.5pt; font-family: 'Microsoft YaHei UI'; color: rgb(0, 0, 0); line-height: 1.5; }</style></head><body>
<div>Hello everyone:</div><div>I write a server use GHC.Event module, </div><div><div>Refer to this article <a href="https://wiki.haskell.org/Simple_Servers" style="font-size: 10.5pt; line-height: 1.5; background-color: transparent;">https://wiki.haskell.org/Simple_Servers</a></div></div><div><br></div><div><pre style="margin-top: 0px; margin-bottom: 0px; margin-left: 1em; padding: 0.3em; border: 1px solid rgb(221, 221, 221); white-space: pre-wrap; line-height: 1.3em; overflow: auto; tab-size: 4; font-variant-ligatures: normal; orphans: 2; widows: 2; background: rgb(240, 240, 240);"><span class="cm" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">{-# LANGUAGE OverloadedStrings #-}</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- A simple example of an epoll based http server in Haskell.</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">--</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- Uses two libraries:</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- * network-bytestring, bytestring-based socket IO.</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- - cabal install network-bytestring: </span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">--</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- * haskell-event, epoll-based scalable IO events</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- - git clone git://github.com/tibbe/event.git</span>
<span class="c1" style="margin: 0px; padding: 0px; color: rgb(64, 128, 128); font-style: italic;">-- - autoreconf ; then cabal install</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">Network</span> <span class="k" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">hiding</span> <span class="p" style="margin: 0px; padding: 0px;">(</span><span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">accept</span><span class="p" style="margin: 0px; padding: 0px;">)</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">Network.Socket</span> <span class="p" style="margin: 0px; padding: 0px;">(</span><span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">fdSocket</span><span class="p" style="margin: 0px; padding: 0px;">,</span> <span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">accept</span><span class="p" style="margin: 0px; padding: 0px;">)</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">Network.Socket.ByteString</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">Data.ByteString.Char8</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">System.Event</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">System.Posix</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">import</span> <span class="nn" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255); font-weight: bold;">System.Posix.IO</span>
<span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">main</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;">=</span> <span class="n" style="margin: 0px; padding: 0px;">withSocketsDo</span> <span class="o" style="margin: 0px; padding: 0px; color: rgb(102, 102, 102);">$</span> <span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">do</span>
<span class="n" style="margin: 0px; padding: 0px;">sock</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;"><-</span> <span class="n" style="margin: 0px; padding: 0px;">listenOn</span> <span class="o" style="margin: 0px; padding: 0px; color: rgb(102, 102, 102);">$</span> <span class="kt" style="margin: 0px; padding: 0px; color: rgb(176, 0, 64);">PortNumber</span> <span class="mi" style="margin: 0px; padding: 0px; color: rgb(102, 102, 102);">5002</span>
<span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">let</span> <span class="n" style="margin: 0px; padding: 0px;">fd</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;">=</span> <span class="n" style="margin: 0px; padding: 0px;">fromIntegral</span> <span class="p" style="margin: 0px; padding: 0px;">(</span><span class="n" style="margin: 0px; padding: 0px;">fdSocket</span> <span class="n" style="margin: 0px; padding: 0px;">sock</span><span class="p" style="margin: 0px; padding: 0px;">)</span>
<span class="n" style="margin: 0px; padding: 0px;">mgr</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;"><-</span> <span class="n" style="margin: 0px; padding: 0px;">new</span>
<span class="n" style="margin: 0px; padding: 0px;">registerFd</span> <span class="n" style="margin: 0px; padding: 0px;">mgr</span> <span class="p" style="margin: 0px; padding: 0px;">(</span><span class="n" style="margin: 0px; padding: 0px;">client</span> <span class="n" style="margin: 0px; padding: 0px;">sock</span><span class="p" style="margin: 0px; padding: 0px;">)</span> <span class="n" style="margin: 0px; padding: 0px;">fd</span> <span class="n" style="margin: 0px; padding: 0px;">evtRead</span>
<span class="n" style="margin: 0px; padding: 0px;">loop</span> <span class="n" style="margin: 0px; padding: 0px;">mgr</span>
<span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">client</span> <span class="n" style="margin: 0px; padding: 0px;">sock</span> <span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">_</span> <span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">_</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;">=</span> <span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">do</span>
<span class="p" style="margin: 0px; padding: 0px;">(</span><span class="n" style="margin: 0px; padding: 0px;">c</span><span class="p" style="margin: 0px; padding: 0px;">,</span><span class="kr" style="margin: 0px; padding: 0px; color: rgb(0, 128, 0); font-weight: bold;">_</span><span class="p" style="margin: 0px; padding: 0px;">)</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;"><-</span> <span class="n" style="margin: 0px; padding: 0px;">accept</span> <span class="n" style="margin: 0px; padding: 0px;">sock</span>
<span class="n" style="margin: 0px; padding: 0px;">sendAll</span> <span class="n" style="margin: 0px; padding: 0px;">c</span> <span class="n" style="margin: 0px; padding: 0px;">msg</span>
<span class="n" style="margin: 0px; padding: 0px;">sClose</span> <span class="n" style="margin: 0px; padding: 0px;">c</span>
<span class="nf" style="margin: 0px; padding: 0px; color: rgb(0, 0, 255);">msg</span> <span class="ow" style="margin: 0px; padding: 0px; color: rgb(170, 34, 255); font-weight: bold;">=</span> <span class="s" style="margin: 0px; padding: 0px; color: rgb(186, 33, 33);">"HTTP/1.0 200 OK</span><span class="se" style="margin: 0px; padding: 0px; color: rgb(187, 102, 34); font-weight: bold;">\r\n</span><span class="s" style="margin: 0px; padding: 0px; color: rgb(186, 33, 33);">Content-Length: 5</span><span class="se" style="margin: 0px; padding: 0px; color: rgb(187, 102, 34); font-weight: bold;">\r\n\r\n</span><span class="s" style="margin: 0px; padding: 0px; color: rgb(186, 33, 33);">Pong!</span><span class="se" style="margin: 0px; padding: 0px; color: rgb(187, 102, 34); font-weight: bold;">\r\n</span><span class="s" style="margin: 0px; padding: 0px; color: rgb(186, 33, 33);">"</span></pre></div><div><br></div><div>but I not find the definition of 'loop' function: loop mgr</div><div><br></div><div>the after is my program:</div><div><div>btnz@vmubuntuserver:~/work/code/echo-server-event-model$ cat Main.hs</div><div>module Main where</div><div><br></div><div>import Network.Socket</div><div>import Network.Socket.ByteString (recv, sendAll)</div><div>import GHC.Event as Event</div><div>import qualified Control.Exception as E (bracket)</div><div>import Data.ByteString.Internal (packChars)</div><div><br></div><div>hints = defaultHints {addrFlags = [AI_PASSIVE], addrSocketType = Stream}</div><div>msg = "HTTP/1.0 200 OK\r\nContent-Length: 5\r\n\r\nPong!\r\n"</div><div><br></div><div>main :: IO ()</div><div>main = do</div><div> putStrLn "Hello, Haskell!"</div><div> addr <- head <$> getAddrInfo (Just hints) Nothing (Just "3000")</div><div> E.bracket (sock addr) close eventServer</div><div> return ()</div><div> where</div><div> sock addr = do</div><div> s <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)</div><div> setSocketOption s ReuseAddr 1</div><div> withFdSocket s setCloseOnExecIfNeeded</div><div> bind s $ addrAddress addr</div><div> listen s 1024</div><div> return s</div><div> eventServer s = do</div><div> fd <- withFdSocket s (\ci -> return (fromIntegral ci))</div><div> mgr <- Event.new</div><div> Event.registerFd mgr (service s) fd Event.evtRead Event.OneShot</div><div>-- loop mgr</div><div><br></div><div>service :: Socket -> FdKey -> Event -> IO ()</div><div>service s _ _ = do</div><div> (c, _) <- accept s</div><div> sendAll c $ packChars msg</div><div> close c</div></div><div><br></div><div><div>btnz@vmubuntuserver:~/work/code/echo-server-event-model$ cabal run</div><div>Up to date</div><div>Hello, Haskell!</div></div><div><br></div><div>when I run cabal run the program exit directly.</div><div><br></div><hr style="width: 210px; height: 1px;" color="#b5c4df" size="1" align="left">
<div><span><div style="MARGIN: 10px; FONT-FAMILY: verdana; FONT-SIZE: 10pt"><div>BalterNotz@foxmail.com</div></div></span></div>
</body></html>