module NLP.Nerf.Server
(
runNerfServer
, ner
) where
import Control.Applicative ((<$>))
import Control.Monad (forever, void)
import Control.Concurrent (forkIO)
import System.IO (Handle, hFlush)
import qualified Data.Binary as B
import qualified Data.ByteString.Lazy as BS
import qualified Network as N
import Data.Named.Tree (NeForest)
import NLP.Nerf.Types
import NLP.Nerf (Nerf)
import qualified NLP.Nerf as Nerf
runNerfServer :: Nerf -> N.PortID -> IO ()
runNerfServer nerf port = N.withSocketsDo $ do
sock <- N.listenOn port
forever $ sockHandler nerf sock
sockHandler :: Nerf -> N.Socket -> IO ()
sockHandler nerf sock = do
(handle, _, _) <- N.accept sock
void $ forkIO $ do
inp <- recvMsg handle
let out = Nerf.ner nerf inp
sendMsg handle out
ner :: N.HostName -> N.PortID -> String -> IO (NeForest NE Word)
ner host port inp = do
handle <- N.connectTo host port
sendMsg handle inp
recvMsg handle
sendMsg :: B.Binary a => Handle -> a -> IO ()
sendMsg h msg = do
let x = B.encode msg
n = fromIntegral $ BS.length x
sendInt h n
BS.hPut h x
hFlush h
recvMsg :: B.Binary a => Handle -> IO a
recvMsg h = do
n <- recvInt h
B.decode <$> BS.hGet h n
sendInt :: Handle -> Int -> IO ()
sendInt h x = BS.hPut h (B.encode x)
recvInt :: Handle -> IO Int
recvInt h = B.decode <$> BS.hGet h 8