mystem (empty) → 0.1.0.0

raw patch · 8 files changed

+361/−0 lines, 8 filesdep +attoparsecdep +basedep +data-defaultsetup-changed

Dependencies added: attoparsec, base, data-default, directory, mystem, process, text

Files

LICENSE +21/−0
Setup.hs +2/−0
app/Main.hs +12/−0
mystem.cabal +43/−0
src/NLP/Mystem.hs +7/−0
src/NLP/Mystem/IO.hs +60/−0
src/NLP/Mystem/Parser.hs +69/−0
src/NLP/Mystem/Types.hs +147/−0

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)
+
+Copyright (c) 2016 wapxmas
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ app/Main.hs view

@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import NLP.Mystem.IO+import qualified Data.Text as T+import Control.Monad (forM_)++main :: IO ()+main = do+  res <- getStems $ T.words "Съешь ещё этих мягких французских булок"+  forM_ res printMSRes -- sample output

+ mystem.cabal view

@@ -0,0 +1,43 @@+name:                mystem+version:             0.1.0.0+synopsis:            Bindings for Mystem morphological analyzer executabe+description:         Bindings for Mystem morphological analyzer executabe+homepage:            https://github.com/wapxmas/mystem#readme+license:             MIT+license-file:        LICENSE+author:              Sergey N. Yashin+maintainer:          yashin.sergey@gmail.com+copyright:           2016 Sergey N. Yashin+category:            Natural Language Processing+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     NLP.Mystem.Types+                     , NLP.Mystem.Parser+                     , NLP.Mystem.IO+                     , NLP.Mystem+  build-depends:       base >= 4.7 && < 5+                     , text >= 1.2 && < 1.4+                     , data-default >= 0.5 && < 0.7+                     , attoparsec >= 0.13 && < 0.15+                     , directory >= 1.2 && < 1.4+                     , process >= 1.2 && < 1.4+  default-language:    Haskell2010+  if os(windows)+    cpp-options: -DWindows++executable mystem-test-exe+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , mystem+                     , text >= 1.2 && < 1.4+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/wapxmas/mystem

+ src/NLP/Mystem.hs view

@@ -0,0 +1,7 @@+module NLP.Mystem (
+                module Ex
+              ) where
+
+  import NLP.Mystem.Types as Ex
+  import NLP.Mystem.Parser as Ex
+  import NLP.Mystem.IO as Ex

+ src/NLP/Mystem/IO.hs view

@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}
+
+module NLP.Mystem.IO where
+
+  import qualified Data.Attoparsec.Text as P
+  import qualified Data.Text            as T
+  import qualified Data.Text.IO         as TIO
+  import           Control.Monad
+  import           System.Directory
+  import           System.IO
+  import           System.Process
+  import           Text.Printf
+
+  import qualified NLP.Mystem.Parser        as MP
+  import           NLP.Mystem.Types
+
+  printMSRes :: MSRes -> IO ()
+  printMSRes (MSRes sw rw) = do
+    TIO.putStrLn sw
+    forM_ rw $ \w -> do
+      TIO.putStrLn (rword w)
+      print $ pos w
+      flip (maybe (return ())) (grams w) $ \gms ->
+        print gms
+      forM_ (cases w) $ \gr ->
+        print gr
+
+  mystemExecutabe :: FilePath
+#ifdef Windows
+  mystemExecutabe = "mystem.exe"
+#else
+  mystemExecutabe = "mystem"
+#endif
+
+  mystemParams :: [String]
+  mystemParams = ["-nig", "--eng-gr"]
+
+  getStems :: [T.Text] -> IO [MSRes]
+  getStems stemWords = do
+    res <- runMystem stemWords
+    case P.parseOnly MP.parserMystems res of
+      Left s -> error $ "Error: " ++ s
+      Right r -> return r
+
+  runMystem :: [T.Text] -> IO T.Text
+  runMystem stemWords = do
+    exists <- doesFileExist mystemExecutabe
+    if not exists
+      then error $ printf "Mystem executable %s doesn`t exists." mystemExecutabe
+      else do
+        (i, o, _, ph) <- createProcess (proc mystemExecutabe mystemParams) { std_in = CreatePipe, std_out = CreatePipe }
+        res <- flip (maybe (return T.empty)) i $ \hIn ->
+                  flip (maybe (return T.empty)) o $ \hOut -> do
+                    hSetEncoding hIn utf8
+                    hSetBuffering hIn NoBuffering
+                    hSetEncoding hOut utf8
+                    TIO.hPutStrLn hIn $ T.unlines stemWords
+                    TIO.hGetContents hOut
+        void $ waitForProcess ph
+        return res

+ src/NLP/Mystem/Parser.hs view

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module NLP.Mystem.Parser where
+
+  import           Control.Applicative
+  import           Control.Monad
+  import           Data.Attoparsec.Text ((<?>))
+  import qualified Data.Attoparsec.Text as P
+  import           Data.Default
+  import qualified Data.Text            as T
+
+  import           NLP.Mystem.Types
+
+  parserMystems :: P.Parser [MSRes]
+  parserMystems = P.sepBy parserMystem P.endOfLine
+
+  parserMystem :: P.Parser MSRes
+  parserMystem = do
+    P.skipMany P.endOfLine
+    sw <- getSWord
+    P.skipMany1 (P.char '{') <?> "open sym"
+    rws <- P.sepBy1 getRWord (P.char '|') <?> "words"
+    P.skipMany1 (P.char '}') <?> "closing sym"
+    return $ MSRes sw rws
+
+  getRWord :: P.Parser RWord
+  getRWord = do
+    rw <- getResultWord
+    P.skipMany $ P.char '?'
+    gs <- optional $ P.char '='
+    flip (maybe (return $ RWord rw (Pos Nothing) def [])) gs $ \_ -> do
+      rPos <- getPos
+      rGramm <- optional getGramm
+      void (P.char '=' <?> "gramm end")
+      cs <- P.char '(' *> P.sepBy1 getGramm (P.char '|') <* P.char ')'
+              <|> flip (:) [] <$> getGramm
+                <|> pure []
+      return $ RWord rw rPos rGramm cs
+
+  getGramm :: P.Parser Grams
+  getGramm = do
+    l <- gsList
+    case l of
+      [] -> fail "no gramms"
+      xs -> return $ fillGrams def xs
+
+  getPos :: P.Parser Pos
+  getPos = do
+    p <- P.many1 msWChar <?> "pos"
+    P.skipMany $ P.char ','
+    return $ Pos . readG $ p
+
+  getResultWord :: P.Parser WordT
+  getResultWord = T.pack <$> (P.many1 msWChar <?> "rword")
+
+  getSWord :: P.Parser SWord
+  getSWord = T.pack <$> (P.many1 msWChar <?> "sword")
+
+  gsList :: P.Parser [String]
+  gsList = P.sepBy gsWString (P.char ',')
+
+  gsWString :: P.Parser String
+  gsWString = P.many1 (P.letter <|> P.digit)
+
+  gsWChar :: P.Parser Char
+  gsWChar = P.letter <|> P.digit
+
+  msWChar :: P.Parser Char
+  msWChar = P.letter <|> P.digit <|> P.char '-'

+ src/NLP/Mystem/Types.hs view

@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}
+
+module NLP.Mystem.Types where
+
+  import           Control.Monad (forM_)
+  import qualified Data.Char     as C
+  import           Data.Default
+  import qualified Data.Text     as T
+  import qualified Data.Text.IO  as TIO
+  import           Text.Read
+
+  type WordT = T.Text
+  type SWord = WordT
+  type RWords = [RWord]
+
+  data MSRes = MSRes SWord RWords deriving Show
+
+  data RWord = RWord { rword :: WordT, pos :: Pos, grams :: Maybe Grams, cases :: [Grams] } deriving Show
+
+  data Grams = Grams VerbsTime Case Spf RIVerb FAdj DComp PVerb GG VAspect APVoice IAN TIVerb OG deriving Show
+
+  newtype Pos = Pos (Maybe PosValue) deriving Show
+  data PosValue = A | ADV | ADVPRO | ANUM | APRO | COM | CONJ |
+    INTJ | NUM | PART | PR | S | SPRO | V deriving (Show, Read)
+
+  newtype VerbsTime = VerbsTime (Maybe VerbsTimeValue) deriving Show
+  data VerbsTimeValue = PRAES | INPRAES | PRAET deriving (Show, Read)
+
+  newtype Case = Case (Maybe CaseValue) deriving Show
+  data CaseValue = NOM | GEN | DAT | ACC | INS |
+    ABL | PARTC | LOC | VOC deriving (Show, Read)
+
+  newtype Spf = Spf (Maybe SpfValue) deriving Show
+  data SpfValue = SG | PL deriving (Show, Read)
+
+  newtype RIVerb = RIVerb (Maybe RIVerbValue) deriving Show
+  data RIVerbValue = GER | INF | PARTCP | INDIC | IMPER deriving (Show, Read)
+
+  newtype FAdj = FAdj (Maybe FAdjValue) deriving Show
+  data FAdjValue = BREV | PLEN | POSS deriving (Show, Read)
+
+  newtype DComp = DComp (Maybe DCompValue) deriving Show
+  data DCompValue = SUPR | COMP deriving (Show, Read)
+
+  newtype PVerb = PVerb (Maybe PVerbValue) deriving Show
+  data PVerbValue = P1 | P2 | P3 deriving (Show, Read)
+
+  newtype GG = GG (Maybe GGValue) deriving Show
+  data GGValue = M | F | N deriving (Show, Read)
+
+  newtype VAspect = VAspect (Maybe VAspectValue) deriving Show
+  data VAspectValue = IPF | PF deriving (Show, Read)
+
+  newtype APVoice = APVoice (Maybe APVoiceValue) deriving Show
+  data APVoiceValue = ACT | PASS deriving (Show, Read)
+
+  newtype IAN = IAN (Maybe IANValue) deriving Show
+  data IANValue = ANIM | INAN deriving (Show, Read)
+
+  newtype TIVerb = TIVerb (Maybe TIVerbValue) deriving Show
+  data TIVerbValue = TRAN | INTR deriving (Show, Read)
+
+  newtype OG = OG (Maybe OGValue) deriving Show
+  data OGValue = PARENTH | GEO | AWKW | PERSN | DIST | MF | OBSC | PATRN |
+    PRAED | INFORM | RARE | ABBR | OBSOL | FAMN deriving (Show, Read)
+
+  instance Default Grams where
+    def = Grams (VerbsTime Nothing) (Case Nothing) (Spf Nothing) (RIVerb Nothing)
+      (FAdj Nothing) (DComp Nothing) (PVerb Nothing) (GG Nothing) (VAspect Nothing)
+      (APVoice Nothing) (IAN Nothing) (TIVerb Nothing) (OG Nothing)
+
+  fillGrams :: Grams -> [String] -> Grams
+  fillGrams g [] = g
+  fillGrams (Grams vt cs sp ri fa dc pv gg va ap ia ti og) (s:xs) =
+    fillGrams (Grams (fill vt s) (fill cs s) (fill sp s) (fill ri s) (fill fa s)
+      (fill dc s) (fill pv s) (fill gg s) (fill va s) (fill ap s) (fill ia s)
+      (fill ti s) (fill og s)) xs
+
+  fill :: FillGramm a => a -> String -> a
+  fill g = fillGramm g . map C.toUpper
+
+  class (Read a) => Grammeme a where
+    readG :: String -> Maybe a
+    readG = readMaybe
+
+  class FillGramm a where
+    fillGramm :: a -> String -> a
+
+  instance Grammeme PosValue
+  instance Grammeme VerbsTimeValue
+  instance Grammeme CaseValue where
+    readG "PART" = readG "PARTC"
+    readG s = readMaybe s
+  instance Grammeme SpfValue
+  instance Grammeme RIVerbValue
+  instance Grammeme FAdjValue
+  instance Grammeme DCompValue
+  instance Grammeme PVerbValue
+  instance Grammeme GGValue
+  instance Grammeme VAspectValue
+  instance Grammeme APVoiceValue
+  instance Grammeme IANValue
+  instance Grammeme TIVerbValue
+  instance Grammeme OGValue
+
+  instance FillGramm Pos where
+    fillGramm (Pos Nothing) s = Pos . readG $ s
+    fillGramm g _ = g
+  instance FillGramm VerbsTime where
+    fillGramm (VerbsTime Nothing) s = VerbsTime . readG $ s
+    fillGramm g _ = g
+  instance FillGramm Case where
+    fillGramm (Case Nothing) s = Case . readG $ s
+    fillGramm g _ = g
+  instance FillGramm Spf where
+    fillGramm (Spf Nothing) s = Spf . readG $ s
+    fillGramm g _ = g
+  instance FillGramm RIVerb where
+    fillGramm (RIVerb Nothing) s = RIVerb . readG $ s
+    fillGramm g _ = g
+  instance FillGramm FAdj where
+    fillGramm (FAdj Nothing) s = FAdj . readG $ s
+    fillGramm g _ = g
+  instance FillGramm DComp where
+    fillGramm (DComp Nothing) s = DComp . readG $ s
+    fillGramm g _ = g
+  instance FillGramm PVerb where
+    fillGramm (PVerb Nothing) s = PVerb . readG $ s
+    fillGramm g _ = g
+  instance FillGramm GG where
+    fillGramm (GG Nothing) s = GG . readG $ s
+    fillGramm g _ = g
+  instance FillGramm VAspect where
+    fillGramm (VAspect Nothing) s = VAspect . readG $ s
+    fillGramm g _ = g
+  instance FillGramm APVoice where
+    fillGramm (APVoice Nothing) s = APVoice . readG $ s
+    fillGramm g _ = g
+  instance FillGramm IAN where
+    fillGramm (IAN Nothing) s = IAN . readG $ s
+    fillGramm g _ = g
+  instance FillGramm TIVerb where
+    fillGramm (TIVerb Nothing) s = TIVerb . readG $ s
+    fillGramm g _ = g
+  instance FillGramm OG where
+    fillGramm (OG Nothing) s = OG . readG $ s
+    fillGramm g _ = g