git.iko.soy/streamly
on master help sign in
Implement takeEndByEsc
commit424765d72fcccb19fc3ba1b45c47d1858dccd2e2 authorHarendra Kumar <harendra@composewell.com> dateSat 7 May 2022, 16:33 (4 years ago) parent8ae687f
3 files changed+65−11
compare with master
unifiedsplit
core/src/Streamly/Internal/Data/Parser.hs+9−6 core/src/Streamly/Internal/Data/Parser/ParserD.hs+34−5 core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+22
core/src/Streamly/Internal/Data/Parser.hs+9−6
@@ -729,14 +729,17 @@ takeStartBy cond = D.toParserK . D.takeStartBy cond
729729-------------------------------------------------------------------------------
730730
731731-- | Like 'takeEndBy' but the separator elements can be escaped using an
732−-- escape char determined by the second predicate.
732+-- escape char determined by the first predicate. The escape characters are
733+-- removed.
733734--
734−-- /Unimplemented/
735+-- >>> takeEndBy = Parser.takeEndByEsc (const False)
736+--
737+-- /pre-release/
735738{-# INLINE takeEndByEsc #-}
736−takeEndByEsc :: -- MonadCatch m =>
737− (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser m a b
738−takeEndByEsc _cond _esc = undefined
739− -- D.toParserK . D.takeEndByEsc cond esc
739+takeEndByEsc :: MonadCatch m =>
740+ (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
741+takeEndByEsc isEsc isSep p =
742+ D.toParserK $ D.takeEndByEsc isEsc isSep (D.fromParserK p)
740743
741744-- | @takeFramedByEsc begin end escape@ parses a string framed using @begin@ and
742745-- @end@ as the frame begin and end marker elements and @escape@ as an escaping
core/src/Streamly/Internal/Data/Parser/ParserD.hs+34−5
@@ -74,6 +74,7 @@ module Streamly.Internal.Data.Parser.ParserD
7474 -- Separators
7575 , takeEndBy
7676 , takeEndBy_
77+ , takeEndByEsc
7778 , takeStartBy
7879
7980 -- Words and grouping
@@ -190,6 +191,7 @@ where
190191import Control.Exception (assert, Exception)
191192import Control.Monad (when)
192193import Control.Monad.Catch (MonadCatch, MonadThrow(..))
194+import Data.Bifunctor (first)
193195import Fusion.Plugin.Types (Fuse(..))
194196import Streamly.Internal.Data.Fold.Type (Fold(..))
195197import Streamly.Internal.Data.SVar.Type (defState)
@@ -687,12 +689,39 @@ takeEndBy cond (Parser pstep pinitial pextract) =
687689 res <- pstep s a
688690 if not (cond a)
689691 then return res
692+ else extractStep pextract res
693+
694+-- | See 'Streamly.Internal.Data.Parser.takeEndByEsc'.
695+--
696+-- /Pre-release/
697+--
698+{-# INLINE takeEndByEsc #-}
699+takeEndByEsc :: MonadCatch m =>
700+ (a -> Bool) -> (a -> Bool) -> Parser m a b -> Parser m a b
701+takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =
702+
703+ Parser step initial extract
704+
705+ where
706+
707+ initial = first Left <$> pinitial
708+
709+ step (Left s) a = do
710+ if isEsc a
711+ then return $ Partial 0 $ Right s
690712 else do
691− case res of
692− Partial n s1 -> Done n <$> pextract s1
693− Done n b -> return $ Done n b
694− Continue n s1 -> Done n <$> pextract s1
695− Error _ -> return res
713+ res <- pstep s a
714+ if not (isSep a)
715+ then return $ mapStateStep Left res
716+ else extractStep pextract res
717+
718+ step (Right s) a = do
719+ res <- pstep s a
720+ return $ mapStateStep Left res
721+
722+ extract (Left s) = pextract s
723+ extract (Right _) =
724+ throwM $ ParseError "takeEndByEsc: trailing escape, end of input"
696725
697726-- | See 'Streamly.Internal.Data.Parser.takeEndBy_'.
698727--
core/src/Streamly/Internal/Data/Parser/ParserD/Type.hs+22
@@ -169,6 +169,8 @@ module Streamly.Internal.Data.Parser.ParserD.Type
169169 -- * Types
170170 Initial (..)
171171 , Step (..)
172+ , mapStateStep
173+ , extractStep
172174 , Parser (..)
173175 , ParseError (..)
174176 , rmapM
@@ -367,6 +369,26 @@ instance Functor (Step s) where
367369 fmap f (Done n b) = Done n (f b)
368370 fmap _ (Error err) = Error err
369371
372+-- | Map an extract function over the state of Step
373+--
374+{-# INLINE extractStep #-}
375+extractStep :: Monad m => (s -> m b) -> Step s b -> m (Step s1 b)
376+extractStep f res =
377+ case res of
378+ Partial n s1 -> Done n <$> f s1
379+ Done n b -> return $ Done n b
380+ Continue n s1 -> Done n <$> f s1
381+ Error err -> return $ Error err
382+
383+{-# INLINE mapStateStep #-}
384+mapStateStep :: (s -> s1) -> Step s b -> (Step s1 b)
385+mapStateStep f res =
386+ case res of
387+ Partial n s1 -> Partial n $ f s1
388+ Done n b -> Done n b
389+ Continue n s1 -> Continue n $ f s1
390+ Error err -> Error err
391+
370392-- | Map a monadic function over the result @b@ in @Step s b@.
371393--
372394-- /Internal/