corenlp-parser 0.3.0.0 → 0.3.0.1
raw patch · 2 files changed
+70/−41 lines, 2 filesdep +asyncdep +split
Dependencies added: async, split
Files
- corenlp-parser.cabal +6/−2
- src/NLP/CoreNLP.hs +64/−39
corenlp-parser.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 951be5b6ce053014c505b53854ecea04601503a1e77d11bef3189384163fb53f+-- hash: f543ec5c7d7cc3d366a63cb8df782d521cd7dc1a76f423f3fbb4aa43a2b84153 name: corenlp-parser-version: 0.3.0.0+version: 0.3.0.1 synopsis: Launches CoreNLP and parses the JSON output description: Launches CoreNLP and parses the JSON output category: Natural Language Processing@@ -25,8 +25,11 @@ hs-source-dirs: src ghc-options: -Wall+ extra-libraries:+ rocksdb build-depends: aeson+ , async , base >=4.7 && <5 , cryptonite , data-default@@ -35,6 +38,7 @@ , raw-strings-qq , rocksdb-haskell , safe-exceptions+ , split , store , string-class , temporary
src/NLP/CoreNLP.hs view
@@ -29,6 +29,8 @@ ) where import Control.Applicative+import Control.Concurrent+import Control.Concurrent.Async import Control.Exception.Safe import Control.Monad (forM, when) import qualified Crypto.Hash as Crypto@@ -37,6 +39,7 @@ import Data.Default import Data.Either import Data.HashMap.Strict (HashMap)+import Data.List.Split (chunksOf) import Data.Maybe import Data.Semigroup import qualified Data.Store as Store@@ -137,7 +140,7 @@ | WRB -- ^ Wh-adverb | LRB -- ^ "-LRB-"? No idea what's this | RRB -- ^ "-RRB-"? No idea what's this- | PosPunctuation Text -- ^ anyOf ".:,''$#$,", sometimes few together+ | PosPunctuation -- ^ anyOf ".:,''$#$,", sometimes few together deriving (Show, Eq, Generic) instance Store.Store PennPOS@@ -149,13 +152,13 @@ parseJSON (J.String "-RRB-") = pure RRB parseJSON x = J.genericParseJSON jsonOpts x <|> parsePunctuation x where- parsePunctuation (J.String y) = pure (PosPunctuation y)+ parsePunctuation (J.String _) = pure PosPunctuation parsePunctuation _ = fail "Expecting POS to be a String" instance ToJSON PennPOS where toJSON WPDollar = J.String "WP$" toJSON PRPDollar = J.String "PRP$"- toJSON (PosPunctuation t) = J.String t+ toJSON PosPunctuation = J.String "." toJSON LRB = J.String "-LRB-" toJSON RRB = J.String "-RRB-" toJSON x = J.genericToJSON jsonOpts x@@ -284,11 +287,21 @@ -- | Additional options data LaunchOptions = LaunchOptions { cacheDb :: Maybe FilePath -- ^ Optional path to a RocksDB file which will be used as a cache+ , memSizeMb :: Int -- ^ The "-Xmx" Java parameter+ , chunkSize :: Int -- ^ Number of elements by which to split the input. Good for caching upon a failure+ , numWorkers :: Int -- ^ Number of CoreNLP workers to launch in parallel } deriving (Show, Eq) instance Default LaunchOptions where- def = LaunchOptions Nothing+ def = LaunchOptions Nothing 8096 1000 2 +-- | Got this from https:\/\/stackoverflow.com\/questions\/29155068\/running-parallel-url-downloads-with-a-worker-pool-in-haskell+traverseThrottled :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)+traverseThrottled concLevel action taskContainer = do+ sem <- newQSem concLevel+ let throttledAction = bracket_ (waitQSem sem) (signalQSem sem) . action+ runConcurrently (traverse (Concurrently . throttledAction) taskContainer)+ -- | 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@@ -310,43 +323,55 @@ if t !! (Prelude.length t - 1) == '/' then t else t <> "/"+ go :: Maybe Rocks.DB -> FilePath -> [Text] -> IO [ParsedDocument] 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+ withSystemTempDirectory "corenlp-parser" $ \tempDir ->+ withCurrentDirectory tempDir $ do+ (cachedDocs, texts) <- getCachedDocs mcacheDb texts''+ Prelude.putStrLn $+ "Got documents out of cache: " ++ show (Prelude.length cachedDocs)+ res <-+ Prelude.concat <$>+ traverseThrottled+ numWorkers+ (goByChunk tempDir mcacheDb fp)+ (zip ([1 ..] :: [Integer]) (chunksOf chunkSize texts))+ return (cachedDocs ++ res)+ goByChunk tempDir mcacheDb fp (chunkId, texts) = do+ Prelude.putStrLn "> goByChunk started"+ if Prelude.length texts <= 0+ then return [] 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)+ Prelude.putStrLn $ "Temp dir used is: " <> tempDir+ tmpFileNames <-+ forM (zip [1 ..] texts) $ \(i :: Integer, txt) -> do+ let fname = "text-" ++ show chunkId ++ "-" ++ 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 +++ "*\" -Xmx" +++ show memSizeMb +++ "m 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 rv getCachedDocs :: Maybe Rocks.DB -> [Text] -> IO ([ParsedDocument], [Text]) getCachedDocs Nothing texts = return ([], texts) getCachedDocs (Just rocks) texts = do