git.iko.soy/streamly
on master help sign in
Add intersperseWithQuotes fold
88c041bHarendra Kumar
core/src/Streamly/Internal/Data/Fold.hs+85
compare with master
unifiedsplit
@@ -287,6 +287,7 @@ module Streamly.Internal.Data.Fold
287 , chunksBetween
287 , chunksBetween
288 , refoldMany
288 , refoldMany
289 , refoldMany1
289 , refoldMany1
290+ , intersperseWithQuotes
290
291
291 -- ** Nesting
292 -- ** Nesting
292 , unfoldMany
293 , unfoldMany
@@ -2527,3 +2528,87 @@ top = bottomBy $ flip compare
2527{-# INLINE bottom #-}
2528{-# INLINE bottom #-}
2528bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MA.Array a)
2529bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MA.Array a)
2529bottom = bottomBy compare
2530bottom = bottomBy compare
2531+
2532+------------------------------------------------------------------------------
2533+-- Interspersed parsing
2534+------------------------------------------------------------------------------
2535+
2536+data IntersperseQState fs ps =
2537+ IntersperseQUnquoted !fs !ps
2538+ | IntersperseQQuoted !fs !ps
2539+ | IntersperseQQuotedEsc !fs !ps
2540+
2541+-- Useful for parsing CSV with quoting and escaping
2542+{-# INLINE intersperseWithQuotes #-}
2543+intersperseWithQuotes :: (Monad m, Eq a) =>
2544+ a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c
2545+intersperseWithQuotes
2546+ quote
2547+ esc
2548+ separator
2549+ (Fold stepL initialL extractL)
2550+ (Fold stepR initialR extractR) = Fold step initial extract
2551+
2552+ where
2553+
2554+ errMsg p status =
2555+ error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "
2556+ ++ status ++ " without input"
2557+
2558+ {-# INLINE initL #-}
2559+ initL mkState = do
2560+ resL <- initialL
2561+ case resL of
2562+ Partial sL ->
2563+ return $ Partial $ mkState sL
2564+ Done _ ->
2565+ errMsg "content" "succeed"
2566+
2567+ initial = do
2568+ res <- initialR
2569+ case res of
2570+ Partial sR -> initL (IntersperseQUnquoted sR)
2571+ Done b -> return $ Done b
2572+
2573+ {-# INLINE collect #-}
2574+ collect nextS sR b = do
2575+ res <- stepR sR b
2576+ case res of
2577+ Partial s ->
2578+ initL (nextS s)
2579+ Done c -> return (Done c)
2580+
2581+ {-# INLINE process #-}
2582+ process a sL sR nextState = do
2583+ r <- stepL sL a
2584+ case r of
2585+ Partial s -> return $ Partial (nextState sR s)
2586+ Done b -> collect nextState sR b
2587+
2588+ {-# INLINE processQuoted #-}
2589+ processQuoted a sL sR nextState = do
2590+ r <- stepL sL a
2591+ case r of
2592+ Partial s -> return $ Partial (nextState sR s)
2593+ Done _ -> error "Collecting fold finished inside quote"
2594+
2595+ step (IntersperseQUnquoted sR sL) a
2596+ | a == separator = do
2597+ b <- extractL sL
2598+ collect IntersperseQUnquoted sR b
2599+ | a == quote = processQuoted a sL sR IntersperseQQuoted
2600+ | otherwise = process a sL sR IntersperseQUnquoted
2601+
2602+ step (IntersperseQQuoted sR sL) a
2603+ | a == esc = processQuoted a sL sR IntersperseQQuotedEsc
2604+ | a == quote = process a sL sR IntersperseQUnquoted
2605+ | otherwise = processQuoted a sL sR IntersperseQQuoted
2606+
2607+ step (IntersperseQQuotedEsc sR sL) a =
2608+ processQuoted a sL sR IntersperseQQuoted
2609+
2610+ extract (IntersperseQUnquoted sR _) = extractR sR
2611+ extract (IntersperseQQuoted _ _) =
2612+ error "intersperseWithQuotes: finished inside quote"
2613+ extract (IntersperseQQuotedEsc _ _) =
2614+ error "intersperseWithQuotes: finished inside quote, at escape char"