corenlp-parser 0.2.0.0 → 0.3.0.0
raw patch · 3 files changed
+140/−32 lines, 3 filesdep +cryptonitedep +data-defaultdep +rocksdb-haskell
Dependencies added: cryptonite, data-default, rocksdb-haskell, safe-exceptions, store
Files
- README.md +2/−1
- corenlp-parser.cabal +7/−2
- src/NLP/CoreNLP.hs +131/−29
README.md view
@@ -1,4 +1,4 @@-# corenlp-parser+# corenlp-parser [](https://travis-ci.org/k-bx/corenlp-parser) Launches CoreNLP and parses the JSON output. See `NLP.CoreNLP` haddocks for the documentation (or read the source) http://hackage.haskell.org/package/corenlp-parser@@ -6,6 +6,7 @@ Building via: ```+sudo apt install librocksdb-dev # "brew install rocksdb" on macOS stack build ```
corenlp-parser.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e8a7cb9abd37d5caa6e148ad4d63629e9f60c0f297c21244bf1fff026e90c24c+-- hash: 951be5b6ce053014c505b53854ecea04601503a1e77d11bef3189384163fb53f name: corenlp-parser-version: 0.2.0.0+version: 0.3.0.0 synopsis: Launches CoreNLP and parses the JSON output description: Launches CoreNLP and parses the JSON output category: Natural Language Processing@@ -28,9 +28,14 @@ build-depends: aeson , base >=4.7 && <5+ , cryptonite+ , data-default , directory , process , raw-strings-qq+ , rocksdb-haskell+ , safe-exceptions+ , store , string-class , temporary , text
src/NLP/CoreNLP.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} -- | Module provides a handy wrapper around the CoreNLP project\'s -- command-line utility https://nlp.stanford.edu/software/corenlp.html@@ -20,21 +21,32 @@ , Corefs , Document(..) , NamedEntity(..)+ , ParsedDocument(..)+ , LaunchOptions(..) -- * Internal+ , extractSuccessDocs , test ) where import Control.Applicative+import Control.Exception.Safe import Control.Monad (forM, when)+import qualified Crypto.Hash as Crypto import qualified Data.Aeson as J import Data.Aeson (FromJSON, ToJSON)+import Data.Default+import Data.Either import Data.HashMap.Strict (HashMap)+import Data.Maybe import Data.Semigroup+import qualified Data.Store as Store import Data.String.Class as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T+import qualified Database.RocksDB.Base as Rocks import GHC.Generics (Generic)+import System.Directory import System.Exit import System.IO (hFlush) import System.IO.Temp@@ -58,6 +70,8 @@ , dependentGloss :: Text } deriving (Show, Eq, Generic) +instance Store.Store Dependency+ instance FromJSON Dependency where parseJSON = J.genericParseJSON jsonOpts @@ -76,6 +90,8 @@ , normalizedNER :: Maybe Text } deriving (Show, Eq, Generic) +instance Store.Store Entitymention+ instance FromJSON Entitymention where parseJSON = J.genericParseJSON jsonOpts @@ -124,6 +140,8 @@ | PosPunctuation Text -- ^ anyOf ".:,''$#$,", sometimes few together deriving (Show, Eq, Generic) +instance Store.Store PennPOS+ instance FromJSON PennPOS where parseJSON (J.String "WP$") = pure WPDollar parseJSON (J.String "PRP$") = pure PRPDollar@@ -170,6 +188,8 @@ | O -- ^ Not a named entity? TODO: check somehow deriving (Show, Eq, Generic) +instance Store.Store NamedEntity+ instance FromJSON NamedEntity where parseJSON = J.genericParseJSON jsonOpts @@ -190,6 +210,8 @@ , after :: Text } deriving (Show, Eq, Generic) +instance Store.Store Token+ instance FromJSON Token where parseJSON = J.genericParseJSON jsonOpts @@ -206,6 +228,8 @@ , tokens :: [Token] } deriving (Show, Eq, Generic) +instance Store.Store Sentence+ instance FromJSON Sentence where parseJSON = J.genericParseJSON jsonOpts @@ -227,6 +251,8 @@ , isRepresentativeMention :: Bool } deriving (Show, Eq, Generic) +instance Store.Store Coref+ instance FromJSON Coref where parseJSON = J.genericParseJSON jsonOpts @@ -243,6 +269,8 @@ , corefs :: Corefs } deriving (Show, Eq, Generic) +instance Store.Store Document+ instance FromJSON Document where parseJSON = J.genericParseJSON jsonOpts @@ -253,39 +281,113 @@ parseJsonDoc :: Text -> Either String Document parseJsonDoc = J.eitherDecode . S.fromText +-- | Additional options+data LaunchOptions = LaunchOptions+ { cacheDb :: Maybe FilePath -- ^ Optional path to a RocksDB file which will be used as a cache+ } deriving (Show, Eq)++instance Default LaunchOptions where+ def = LaunchOptions Nothing+ -- | Launch CoreNLP with your inputs. This function will put every piece of 'Text' in a separate file, launch CoreNLP subprocess, and parse the results launchCoreNLP :: FilePath -- ^ Path to the directory where you extracted the CoreNLP project+ -> LaunchOptions -> [Text] -- ^ List of inputs- -> IO [Either String Document] -- ^ List of parsed results-launchCoreNLP fp texts =- withSystemTempDirectory "corenlp-parser" $ \tempDir -> do- Prelude.putStrLn $ "Temp dir used is is: " <> tempDir- tmpFileNames <-- forM (zip [1 ..] texts) $ \(i :: Integer, txt) -> do- let fname = ("text-" ++ show i ++ ".txt")- T.writeFile (tempDir ++ "/" ++ fname) txt- return fname- withSystemTempFile "filelist.txt" $ \filelistTxt hfilelistTxt -> do- Prelude.putStrLn $ "Filelist.txt: " ++ show filelistTxt- Prelude.putStrLn $ "Temporary files: " ++ show tmpFileNames- let filesList =- T.unlines (map (\x -> S.toText (tempDir <> "/" <> x)) tmpFileNames)- Prelude.putStrLn $ "Filelist.txt filesList: " ++ show filesList- T.hPutStrLn hfilelistTxt (T.strip filesList)- hFlush hfilelistTxt- let spec =- shell- ("java --add-modules java.se.ee -cp \"" ++- fp ++- "*\" -Xmx2g edu.stanford.nlp.pipeline.StanfordCoreNLP -annotators tokenize,ssplit,pos,lemma,ner,parse,dcoref -outputFormat json -filelist " <>- filelistTxt)- (_, _, _, processHandle) <- createProcess spec- code <- waitForProcess processHandle- when (code /= ExitSuccess) (error (show code))- let tmpFileNamesJson = map (<> ".json") tmpFileNames- results <- forM tmpFileNamesJson $ \fname -> T.readFile fname- return (map parseJsonDoc results)+ -> IO [ParsedDocument] -- ^ List of parsed results+launchCoreNLP fp' LaunchOptions {..} texts' = do+ let fp = ensureEndSlash fp'+ case cacheDb of+ Nothing -> go Nothing fp texts'+ Just cacheFp ->+ bracket+ (Rocks.open cacheFp def {Rocks.createIfMissing = True})+ Rocks.close+ (\db -> go (Just db) fp texts')+ where+ ensureEndSlash :: String -> String+ ensureEndSlash t =+ if t !! (Prelude.length t - 1) == '/'+ then t+ else t <> "/"+ go mcacheDb fp texts'' = do+ (cachedDocs, texts) <- getCachedDocs mcacheDb texts''+ Prelude.putStrLn $+ "Got documents out of cache: " ++ show (Prelude.length cachedDocs)+ if (Prelude.length texts <= 0)+ then return cachedDocs+ else do+ withSystemTempDirectory "corenlp-parser" $ \tempDir -> do+ withCurrentDirectory tempDir $ do+ Prelude.putStrLn $ "Temp dir used is is: " <> tempDir+ tmpFileNames <-+ forM (zip [1 ..] texts) $ \(i :: Integer, txt) -> do+ let fname = ("text-" ++ show i ++ ".txt")+ T.writeFile (tempDir ++ "/" ++ fname) txt+ return fname+ withSystemTempFile "filelist.txt" $ \filelistTxt hfilelistTxt -> do+ Prelude.putStrLn $ "Filelist.txt: " ++ show filelistTxt+ let filesList =+ T.unlines+ (map (\x -> S.toText (tempDir <> "/" <> x)) tmpFileNames)+ T.hPutStrLn hfilelistTxt (T.strip filesList)+ hFlush hfilelistTxt+ let cmd =+ "java --add-modules java.se.ee -cp \"" +++ fp +++ "*\" -Xmx4g edu.stanford.nlp.pipeline.StanfordCoreNLP -annotators tokenize,ssplit,pos,lemma,ner,parse,dcoref -outputFormat json -filelist " <>+ filelistTxt+ Prelude.putStrLn $ "Running a command: " ++ cmd+ let spec = shell cmd+ (_, _, _, processHandle) <- createProcess spec+ code <- waitForProcess processHandle+ when (code /= ExitSuccess) (error (show code))+ let tmpFileNamesJson = map (<> ".json") tmpFileNames+ results <- forM tmpFileNamesJson $ \fname -> T.readFile fname+ rv <- extractSuccessDocs (zip texts (map parseJsonDoc results))+ cacheResults mcacheDb rv+ return (cachedDocs ++ rv)+ getCachedDocs :: Maybe Rocks.DB -> [Text] -> IO ([ParsedDocument], [Text])+ getCachedDocs Nothing texts = return ([], texts)+ getCachedDocs (Just rocks) texts = do+ (rv :: [Either ParsedDocument Text]) <-+ forM texts $ \t -> do+ res <- Rocks.get rocks def (hash t)+ case res of+ Nothing -> return (Right t)+ Just bs ->+ case Store.decode bs of+ Left _e -> return (Right t)+ Right x -> return (Left x)+ return (partitionEithers rv)+ cacheResults Nothing _ = return ()+ cacheResults (Just rocks) results = do+ let batch = map resultToOp results+ Rocks.write rocks def batch+ return ()+ resultToOp pd@ParsedDocument {..} =+ Rocks.Put (hash origText) (Store.encode pd)+ hash t =+ S.fromString+ (show+ (Crypto.hash (S.toStrictByteString t) :: Crypto.Digest Crypto.SHA256))++-- | Datatype holding original text and a parsed 'Document'+data ParsedDocument = ParsedDocument+ { origText :: Text+ , doc :: Document+ } deriving (Show, Eq, Generic)++instance Store.Store ParsedDocument++-- | Simple function to extract success results and print out errors+extractSuccessDocs :: [(Text, Either String Document)] -> IO [ParsedDocument]+extractSuccessDocs = fmap catMaybes . mapM f+ where+ f (_t, Left err) =+ Prelude.putStrLn ("Error parsing CoreNLP result: " ++ err) >>+ return Nothing+ f (t, Right r') = return (Just (ParsedDocument t r')) headlines :: Text headlines =