module NLP.Concraft.Polish.Request
(
Request (..)
, Config (..)
, Short (..)
, short
, Long (..)
, long
) where
import Control.Applicative ((<$>), (<*>))
import qualified Control.Monad.LazyIO as LazyIO
import qualified Data.Char as Char
import qualified Data.List.Split as Split
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import qualified Data.Binary as B
import NLP.Concraft.Polish
import NLP.Concraft.Polish.Maca
import NLP.Concraft.Polish.Morphosyntax hiding (tag)
data Request t = Request {
rqBody :: t
, rqConf :: Config }
instance B.Binary t => B.Binary (Request t) where
put Request{..} = B.put rqBody >> B.put rqConf
get = Request <$> B.get <*> B.get
newtype Config = Config {
tagProbs :: Bool
} deriving (B.Binary)
data Short
= Short T.Text
| Par [Sent Tag]
instance B.Binary Short where
put (Short x) = B.putWord8 0 >> B.put x
put (Par x) = B.putWord8 1 >> B.put x
get = B.getWord8 >>= \x -> case x of
0 -> Short <$> B.get
_ -> Par <$> B.get
short :: MacaPool -> Concraft -> Request Short -> IO [Sent Tag]
short pool concraft Request{..} = case rqBody of
Short x -> map (tagit concraft) <$> macaPar pool x
Par x -> return $ map (tagit concraft) x
where
tagit = if tagProbs rqConf then marginals else tag
data Long
= Long L.Text
| Doc [[Sent Tag]]
instance B.Binary Long where
put (Long x) = B.putWord8 0 >> B.put x
put (Doc x) = B.putWord8 1 >> B.put x
get = B.getWord8 >>= \x -> case x of
0 -> Long <$> B.get
_ -> Doc <$> B.get
long :: (Request Short -> IO a) -> Request Long -> IO [a]
long handler Request{..} = case rqBody of
Long inp ->
LazyIO.mapM f . map L.unlines
. Split.splitWhen (L.all Char.isSpace)
. L.lines $ inp
Doc inp -> LazyIO.mapM g inp
where
f x = handler . r $ Short $ L.toStrict x
g x = handler . r $ Par x
r x = Request {rqBody = x, rqConf = rqConf}