Commit 06477f7b authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[conduit] parsers length works so full progress report should work as well

parent 8cdbff09
......@@ -286,7 +286,7 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
Right decoded -> decoded
eDocsC <- liftBase $ parseC ff data'
case eDocsC of
Right docsC -> do
Right (mCount, docsC) -> do
-- TODO Add progress (jobStatus) update for docs - this is a
-- long action
......@@ -315,9 +315,9 @@ addToCorpusWithForm user cid (NewWithForm ft ff d l _n) logStatus jobLog = do
(Multi $ fromMaybe EN l)
Nothing
--(Just $ fromIntegral $ length docs, docsC')
(Just 0, transPipe liftBase docsC') -- TODO fix number of docs
(mCount, transPipe liftBase docsC') -- TODO fix number of docs
--(map (map toHyperdataDocument) docs)
(logStatus)
logStatus
printDebug "Extraction finished : " cid
printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
......
......@@ -85,20 +85,20 @@ parseFormatC :: MonadBaseControl IO m
-> DB.ByteString
-> m (Either Prelude.String (Maybe Integer, ConduitT () HyperdataDocument IO ()))
parseFormatC CsvGargV3 Plain bs = do
eParsedC <- parseCsvC $ DBL.fromStrict bs
let eParsedC = parseCsvC $ DBL.fromStrict bs
case eParsedC of
Left err -> pure $ Left err
Right (mLen, parsedC) -> pure $ (mLen, transPipe (pure . runIdentity) parsedC)
Right (mLen, parsedC) -> pure $ Right (mLen, transPipe (pure . runIdentity) parsedC)
parseFormatC CsvHal Plain bs = do
eParsedC <- parseCsvC $ DBL.fromStrict bs
let eParsedC = parseCsvC $ DBL.fromStrict bs
case eParsedC of
Left err -> pure $ Left err
Right (mLen, parsedC) -> pure $ (mLen, transPipe (pure . runIdentity) parsedC)
Right (mLen, parsedC) -> pure $ Right (mLen, transPipe (pure . runIdentity) parsedC)
parseFormatC RisPresse Plain bs = do
--docs <- enrichWith RisPresse
let eDocs = runParser' RisPresse bs
pure $ (\docs ->
( Just $ length docs
( Just $ fromIntegral $ length docs
, yieldMany docs
.| mapC presseEnrich
.| mapC (map $ both decodeUtf8)
......@@ -106,7 +106,7 @@ parseFormatC RisPresse Plain bs = do
parseFormatC WOS Plain bs = do
let eDocs = runParser' WOS bs
pure $ (\docs ->
( Just $ length docs
( Just $ fromIntegral $ length docs
, yieldMany docs
.| mapC (map $ first WOS.keys)
.| mapC (map $ both decodeUtf8)
......@@ -130,8 +130,8 @@ parseFormatC ft ZIP bs = do
let lenghts = fst <$> contents
let contents' = snd <$> contents
let totalLength = sum $ sum <$> lenghts -- Trick: sum (Just 1) = 1, sum Nothing = 0
pure $ Right $ ( Just totalLength
, sequenceConduits contents' >> pure () ) -- .| mapM_C (printDebug "[parseFormatC] doc")
pure $ Right ( Just totalLength
, sequenceConduits contents' >> pure () ) -- .| mapM_C (printDebug "[parseFormatC] doc")
_ -> pure $ Left $ unpack $ intercalate "\n" $ pack <$> errs
parseFormatC _ _ _ = undefined
......
......@@ -472,7 +472,7 @@ parseCsvC bs = do
Right res -> Right res
case result of
Left err -> Left err
Right r -> Right $ (Just $ length snd r, (yieldMany $ snd r) .| mapC csv2doc)
Right r -> Right $ (Just $ Prelude.fromIntegral $ Prelude.length $ snd r, (yieldMany $ snd r) .| mapC csv2doc)
------------------------------------------------------------------------
-- Csv v3 weighted for phylo
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment