@@ -32,6 +32,7 @@ module Streamly.Internal.Data.Array.Stream.Fold.Foreign
3232
3333 -- * Construction
3434 , fromFold
35+ , fromParser
3536 , fromArrayFold
3637
3738 -- * Mapping
@@ -127,6 +128,55 @@ fromFold (Fold.Fold fstep finitial fextract) =
127128 Fold.Partial fs1 ->
128129 goArray SPEC next fs1
129130
131+-- | Convert an element 'Parser' into an array stream fold. If the parser fails
132+-- the fold would throw an exception.
133+--
134+-- /Pre-release/
135+{-# INLINE fromParser #-}
136+fromParser :: forall m a b. (MonadIO m, Storable a) =>
137+ ParserD.Parser m a b -> Fold m a b
138+fromParser (ParserD.Parser step1 initial1 extract1) =
139+ Fold (ParserD.Parser step initial extract1)
140+
141+ where
142+
143+ initial = do
144+ res <- initial1
145+ return
146+ $ case res of
147+ IPartial s1 -> IPartial s1
148+ IDone b -> IDone b
149+ IError err -> IError err
150+
151+ step s (Array fp@(ForeignPtr start _) end) = do
152+ if Ptr start >= end
153+ then return $ Continue 0 s
154+ else goArray SPEC (Ptr start) s
155+
156+ where
157+
158+ goArray !_ !cur !fs = do
159+ x <- liftIO $ peek cur
160+ liftIO $ touchForeignPtr fp
161+ res <- step1 fs x
162+ let elemSize = sizeOf (undefined :: a)
163+ next = cur `plusPtr` elemSize
164+ arrRem = (end `minusPtr` next) `div` elemSize
165+ case res of
166+ ParserD.Done n b -> do
167+ return $ Done (arrRem + n) b
168+ ParserD.Partial n fs1 -> do
169+ let next1 = next `plusPtr` negate (n * elemSize)
170+ if next1 >= Ptr start && cur < end
171+ then goArray SPEC next1 fs1
172+ else return $ Partial (arrRem + n) fs1
173+ ParserD.Continue n fs1 -> do
174+ let next1 = next `plusPtr` negate (n * elemSize)
175+ if next1 >= Ptr start && cur < end
176+ then goArray SPEC next1 fs1
177+ else return $ Continue (arrRem + n) fs1
178+ Error err -> return $ Error err
179+
130180-- | Adapt an array stream fold.
131181--
132182-- /Pre-release/