module NLP.Concraft.Croatian.Server
(
runConcraftServer
, submit
) where
import Control.Applicative ((<$>))
import Control.Monad (forever, void)
import Control.Concurrent (forkIO)
import System.IO (Handle, hFlush)
import qualified Network as N
import qualified Data.Binary as B
import qualified Data.ByteString.Lazy as BS
import qualified Data.Set as S
import qualified NLP.Concraft.Morphosyntax as X
import NLP.Concraft.Croatian.Morphosyntax
import qualified NLP.Concraft.Croatian as C
import qualified NLP.Concraft.Croatian.Request as R
import qualified Data.Tagset.Positional as P
import qualified NLP.Morphosyntax.Analyzer as A
runConcraftServer :: A.Analyzer -> C.Concraft -> N.PortID -> IO ()
runConcraftServer analyzer concraft port = N.withSocketsDo $ do
sock <- N.listenOn port
forever $ sockHandler analyzer concraft sock
sockHandler :: A.Analyzer -> C.Concraft -> N.Socket -> IO ()
sockHandler analyzer concraft sock = do
(handle, _, _) <- N.accept sock
void $ forkIO $ do
inp <- recvMsg handle
out <- R.short analyzer concraft inp
sendMsg handle out
submit :: N.HostName -> N.PortID -> R.Request R.TagWork -> IO (Either [X.Sent Word P.Tag] [[(S.Set P.Tag, P.Tag)]])
submit 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