fix: maybe this is faster?
This commit is contained in:
parent
f3d9ea8c11
commit
d6638ead1d
@ -7,11 +7,11 @@ import Control.Alternative (guard)
|
|||||||
import Control.Monad.Error.Class (liftEither)
|
import Control.Monad.Error.Class (liftEither)
|
||||||
import Control.Monad.Except (runExcept)
|
import Control.Monad.Except (runExcept)
|
||||||
import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
|
import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
|
||||||
import Control.Monad.Rec.Class (class MonadRec, whileJust)
|
import Control.Monad.Rec.Class (class MonadRec, untilJust, whileJust)
|
||||||
import Control.Monad.ST.Global as ST
|
import Control.Monad.ST.Class (liftST)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.MonadPlus (class Alternative)
|
import Control.MonadPlus (class Alternative)
|
||||||
import Control.Parallel (class Parallel, parTraverse_)
|
import Control.Parallel (class Parallel, parSequence_)
|
||||||
import Data.Array as Array
|
import Data.Array as Array
|
||||||
import Data.Array.ST as Array.ST
|
import Data.Array.ST as Array.ST
|
||||||
import Data.Bifunctor (lmap)
|
import Data.Bifunctor (lmap)
|
||||||
@ -123,29 +123,53 @@ foreach
|
|||||||
-> ({ | r } -> m Unit)
|
-> ({ | r } -> m Unit)
|
||||||
-> m Unit
|
-> m Unit
|
||||||
foreach stream cb =
|
foreach stream cb =
|
||||||
whileJust
|
do
|
||||||
$ runMaybeT
|
q <- liftEffect $ liftST $ Array.ST.new
|
||||||
$ do
|
|
||||||
liftAff $ delay $ wrap 0.0
|
|
||||||
|
|
||||||
guard =<< not <$> liftEffect (Stream.closed stream)
|
let
|
||||||
|
deque = liftEffect $ liftST $ Array.ST.shift q
|
||||||
|
enque a = liftEffect $ liftST $ Array.ST.push a q
|
||||||
|
|
||||||
isReadable <- liftEffect $ Stream.readable stream
|
waitReadable =
|
||||||
liftAff $ when (not isReadable) $ makeAff \res -> do
|
makeAff \res -> do
|
||||||
stop <- flip (Event.once Stream.readableH) stream $ res $ Right unit
|
stop <- flip (Event.once Stream.readableH) stream $ res $ Right unit
|
||||||
pure $ Canceler $ const $ liftEffect stop
|
pure $ Canceler $ const $ liftEffect stop
|
||||||
|
|
||||||
recordsST <- liftEffect $ ST.toEffect $ Array.ST.new
|
processQ =
|
||||||
liftEffect $ Effect.untilE do
|
untilJust
|
||||||
r <- read @r stream
|
$ runMaybeT
|
||||||
void $ for r $ ST.toEffect <<< flip Array.ST.push recordsST
|
$ do
|
||||||
pure $ isNothing r
|
liftAff $ delay $ wrap 0.0
|
||||||
records <- liftEffect $ ST.toEffect $ Array.ST.unsafeFreeze recordsST
|
r <- deque
|
||||||
|
isClosed <- liftEffect $ Stream.closed stream
|
||||||
|
if isClosed && isNothing r then
|
||||||
|
pure unit
|
||||||
|
else if isNothing r then
|
||||||
|
liftAff $ delay $ wrap 10.0
|
||||||
|
else do
|
||||||
|
r' <- MaybeT $ pure r
|
||||||
|
lift $ cb r'
|
||||||
|
guard $ isClosed
|
||||||
|
pure unit
|
||||||
|
|
||||||
lift $ parTraverse_ cb records
|
readToQ =
|
||||||
guard =<< not <$> liftEffect (Stream.closed stream)
|
whileJust
|
||||||
pure unit
|
$ runMaybeT
|
||||||
|
$ do
|
||||||
|
liftAff $ delay $ wrap 0.0
|
||||||
|
guard =<< not <$> liftEffect (Stream.closed stream)
|
||||||
|
isReadable <- liftEffect $ Stream.readable stream
|
||||||
|
liftAff $ when (not isReadable) waitReadable
|
||||||
|
|
||||||
|
liftEffect $ Effect.untilE do
|
||||||
|
r <- read @r stream
|
||||||
|
void $ for r enque
|
||||||
|
pure $ isNothing r
|
||||||
|
guard =<< not <$> liftEffect (Stream.closed stream)
|
||||||
|
pure unit
|
||||||
|
|
||||||
|
parSequence_ [readToQ, processQ]
|
||||||
|
|
||||||
-- | Reads a parsed record from the stream.
|
-- | Reads a parsed record from the stream.
|
||||||
-- |
|
-- |
|
||||||
-- | Returns `Nothing` when either:
|
-- | Returns `Nothing` when either:
|
||||||
@ -174,9 +198,9 @@ readAll
|
|||||||
=> CSVParser r a
|
=> CSVParser r a
|
||||||
-> m (Array { | r })
|
-> m (Array { | r })
|
||||||
readAll stream = do
|
readAll stream = do
|
||||||
records <- liftEffect $ ST.toEffect $ Array.ST.new
|
records <- liftEffect $ liftST $ Array.ST.new
|
||||||
foreach stream $ void <<< liftEffect <<< ST.toEffect <<< flip Array.ST.push records
|
foreach stream $ void <<< liftEffect <<< liftST <<< flip Array.ST.push records
|
||||||
liftEffect $ ST.toEffect $ Array.ST.unsafeFreeze records
|
liftEffect $ liftST $ Array.ST.unsafeFreeze records
|
||||||
|
|
||||||
-- | `data` event. Emitted when a CSV record has been parsed.
|
-- | `data` event. Emitted when a CSV record has been parsed.
|
||||||
dataH :: forall r a. EventHandle1 (CSVParser r a) { | r }
|
dataH :: forall r a. EventHandle1 (CSVParser r a) { | r }
|
||||||
|
Loading…
Reference in New Issue
Block a user