module NLP.GenI.Morphology.Types where
import Control.Applicative ((<$>),(<*>))
import Control.DeepSeq
import Data.Text ( Text )
import NLP.GenI.GeniVal ( GeniVal )
import NLP.GenI.FeatureStructure ( Flist )
import NLP.GenI.Parser ( geniFeats, Parser, runParser )
import NLP.GenI.Pretty
import NLP.GenI.Semantics
import Text.JSON
type MorphInputFn = Literal GeniVal -> Maybe (Flist GeniVal)
type MorphRealiser = [LemmaPlusSentence] -> [MorphOutput]
data MorphOutput = MorphOutput { moWarnings :: [Text]
, moRealisations :: [Text]
}
deriving (Ord, Eq)
instance JSON MorphOutput where
readJSON j =
case fromJSObject `fmap` readJSON j of
Error _ -> MorphOutput [] <$> readJSON j
Ok jo -> do
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
warnings = maybe (return []) readJSON (lookup "warnings" jo)
MorphOutput <$> warnings
<*> field "realisations"
showJSON _ = error "Don't know how to render MorphOutput"
data LemmaPlus = LemmaPlus
{ lpLemma :: Text
, lpFeats :: Flist GeniVal
}
deriving (Eq, Ord)
type LemmaPlusSentence = [LemmaPlus]
instance JSON LemmaPlus where
readJSON j =
do jo <- fromJSObject `fmap` readJSON j
let field x = maybe (fail $ "Could not find: " ++ x) readJSON
$ lookup x jo
LemmaPlus <$> field "lemma"
<*> (parsecToJSON "lemma-features" geniFeats =<< field "lemma-features")
showJSON (LemmaPlus l fs) =
JSObject . toJSObject $ [ ("lemma", showJSON l)
, ("lemma-features", showJSON $ prettyStr fs)
]
parsecToJSON :: Monad m => String -> Parser b -> String -> m b
parsecToJSON description p str =
case runParser p () "" str of
Left err -> fail $ "Couldn't parse " ++ description ++ " because " ++ show err
Right res -> return res
instance NFData MorphOutput where
rnf (MorphOutput x1 x2) = rnf x1 `seq` rnf x2 `seq` ()
instance NFData LemmaPlus where
rnf (LemmaPlus x1 x2) = rnf x1 `seq` rnf x2 `seq` ()