module NLP.Concraft.Croatian.Request
(
Request (..)
, TagWork (..)
, short
) where
import Control.Applicative ((<$>))
import qualified Data.Binary as B
import NLP.Concraft.Croatian
import NLP.Concraft.Croatian.Morphosyntax
import NLP.Concraft.Morphosyntax hiding (Word, orth)
import qualified Data.Tagset.Positional as P
import qualified Data.Set as S
import qualified Data.Text as T
import NLP.Morphosyntax.Analyzer
newtype Request t = Request {
rqBody :: t
}
instance B.Binary t => B.Binary (Request t) where
put Request{..} = B.put rqBody
get = Request <$> B.get
data TagWork
= Marginal [Sent Word P.Tag]
| PlainTag [Sent Word P.Tag]
| MarginalA [Sent Word P.Tag]
| PlainTagA [Sent Word P.Tag]
instance B.Binary TagWork where
put (Marginal x) = B.putWord8 0 >> B.put x
put (PlainTag x) = B.putWord8 1 >> B.put x
put (MarginalA x) = B.putWord8 2 >> B.put x
put (PlainTagA x) = B.putWord8 3 >> B.put x
get =
B.getWord8 >>= \x -> case x of
0 -> Marginal <$> B.get
1 -> PlainTag <$> B.get
2 -> MarginalA <$> B.get
_ -> PlainTagA <$> B.get
short :: Analyzer
-> Concraft
-> Request TagWork
-> IO (Either [Sent Word P.Tag] [[(S.Set P.Tag, P.Tag)]])
short analyzer concraft Request{..} = do
let anaf = getTags analyzer
return $ case rqBody of
Marginal x -> Left $ map (marginals concraft) x
PlainTag x -> Right $ map (tag concraft) x
MarginalA x -> Left $ map (marginals concraft) (addAna anaf x)
PlainTagA x -> Right $ map (tag concraft) (addAna anaf x)
addAna :: (T.Text -> S.Set P.Tag)
-> [Sent Word P.Tag]
-> [Sent Word P.Tag]
addAna ana x = zipWith addAnalysis x (map (map (ana . orth . word)) x)