mirror of
https://github.com/composewell/streamly.git
synced 2024-08-16 23:10:36 +03:00
Implement ParserK to Parser conversion function
This commit is contained in:
parent
37a6fc1e6b
commit
c4084db5c5
@ -30,7 +30,7 @@ module Streamly.Internal.Data.ParserK.Type
|
||||
, adaptC
|
||||
, adapt
|
||||
, adaptCG
|
||||
-- , toParser
|
||||
, toParser -- XXX unParserK, unK, unPK
|
||||
, fromPure
|
||||
, fromEffect
|
||||
, die
|
||||
@ -705,7 +705,6 @@ adaptCG ::
|
||||
adaptCG (ParserD.Parser step initial extract) =
|
||||
MkParser $ adaptCGWith step initial extract
|
||||
|
||||
{-
|
||||
-------------------------------------------------------------------------------
|
||||
-- Convert CPS style 'Parser' to direct style 'D.Parser'
|
||||
-------------------------------------------------------------------------------
|
||||
@ -713,9 +712,13 @@ adaptCG (ParserD.Parser step initial extract) =
|
||||
-- | A continuation to extract the result when a CPS parser is done.
|
||||
{-# INLINE parserDone #-}
|
||||
parserDone :: Monad m => ParseResult b -> Int -> Input a -> m (Step a m b)
|
||||
parserDone (Success n b) _ None = return $ Done n b
|
||||
parserDone (Failure n e) _ None = return $ Error n e
|
||||
parserDone _ _ _ = error "Bug: toParser: called with input"
|
||||
parserDone (Success n b) _ None = return $ Done (negate n) b
|
||||
parserDone (Success n b) _ (Chunk _) = return $ Done (1 - n) b
|
||||
parserDone (Failure n e) _ None = return $ Error (negate n) e
|
||||
parserDone (Failure n e) _ (Chunk _) = return $ Error (1 - n) e
|
||||
|
||||
-- XXX Note that this works only for single element parsers and not for Array
|
||||
-- input parsers. The asserts will fail for array parsers.
|
||||
|
||||
-- | Convert a CPS style 'ParserK' to a direct style 'ParserD.Parser'.
|
||||
--
|
||||
@ -727,26 +730,28 @@ toParser parser = ParserD.Parser step initial extract
|
||||
|
||||
where
|
||||
|
||||
initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))
|
||||
initial = pure (ParserD.IPartial (runParser parser parserDone 0 0))
|
||||
|
||||
step cont a = do
|
||||
r <- cont (Single a)
|
||||
r <- cont (Chunk a)
|
||||
return $ case r of
|
||||
Done n b -> ParserD.Done n b
|
||||
Done n b -> assert (n <= 1) (ParserD.Done (1 - n) b)
|
||||
Error _ e -> ParserD.Error e
|
||||
Partial n cont1 -> ParserD.Partial n cont1
|
||||
Continue n cont1 -> ParserD.Continue n cont1
|
||||
Partial n cont1 -> assert (n <= 1) (ParserD.Partial (1 - n) cont1)
|
||||
Continue n cont1 -> assert (n <= 1) (ParserD.Continue (1 - n) cont1)
|
||||
|
||||
extract cont = do
|
||||
r <- cont None
|
||||
case r of
|
||||
Done n b -> return $ ParserD.Done n b
|
||||
-- This is extract so no input has been given, therefore, the
|
||||
-- translation here is (0 - n) rather than (1 - n).
|
||||
Done n b -> assert (n <= 0) (return $ ParserD.Done (negate n) b)
|
||||
Error _ e -> return $ ParserD.Error e
|
||||
Partial _ cont1 -> extract cont1
|
||||
Continue n cont1 -> return $ ParserD.Continue n cont1
|
||||
Continue n cont1 ->
|
||||
assert (n <= 0) (return $ ParserD.Continue (negate n) cont1)
|
||||
|
||||
{-# RULES "fromParser/toParser fusion" [2]
|
||||
forall s. toParser (fromParser s) = s #-}
|
||||
forall s. toParser (adapt s) = s #-}
|
||||
{-# RULES "toParser/fromParser fusion" [2]
|
||||
forall s. fromParser (toParser s) = s #-}
|
||||
-}
|
||||
forall s. adapt (toParser s) = s #-}
|
||||
|
@ -7,9 +7,10 @@ module Main (main) where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Exception (SomeException(..), try)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Word (Word8, Word32, Word64)
|
||||
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
|
||||
import Test.Hspec (Spec, hspec, describe)
|
||||
import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe)
|
||||
import Test.Hspec.QuickCheck
|
||||
import Test.QuickCheck
|
||||
(arbitrary, forAll, elements, Property,
|
||||
@ -22,8 +23,12 @@ import qualified Streamly.Data.Stream as S
|
||||
import qualified Streamly.Internal.Data.Array as A
|
||||
import qualified Streamly.Internal.Data.Fold as FL
|
||||
import qualified Streamly.Internal.Data.Parser as P
|
||||
import qualified Streamly.Internal.Data.Parser as Parser
|
||||
import qualified Streamly.Internal.Data.ParserK as ParserK
|
||||
import qualified Streamly.Internal.Data.Producer as Producer
|
||||
import qualified Streamly.Internal.Data.Stream as S
|
||||
import qualified Streamly.Internal.Data.Stream as Stream
|
||||
import qualified Streamly.Internal.Data.StreamK as StreamK
|
||||
import qualified Streamly.Internal.Data.Stream as D
|
||||
import qualified Streamly.Internal.Data.Unfold as Unfold
|
||||
import qualified Test.Hspec as H
|
||||
@ -756,6 +761,40 @@ parseMany2Events =
|
||||
}
|
||||
in listEquals (==) xs (replicate 2 ev)
|
||||
|
||||
toParser :: Spec
|
||||
toParser = do
|
||||
let p = ParserK.toParser (ParserK.adapt Parser.one)
|
||||
runP xs = Stream.parse p (Stream.fromList xs)
|
||||
describe "toParser . adapt" $ do
|
||||
it "empty stream" $ do
|
||||
r1 <- runP ([] :: [Int])
|
||||
case r1 of
|
||||
Left e -> print e
|
||||
Right x ->
|
||||
expectationFailure $ "Expecting failure, got: " ++ show x
|
||||
it "exact stream" $ do
|
||||
r2 <- runP [0::Int]
|
||||
fromRight undefined r2 `shouldBe` 0
|
||||
it "longer stream" $ do
|
||||
r3 <- runP [0,1::Int]
|
||||
fromRight undefined r3 `shouldBe` 0
|
||||
|
||||
let p1 = ParserK.adapt $ ParserK.toParser (ParserK.adapt Parser.one)
|
||||
runP1 xs = StreamK.parse p1 (StreamK.fromStream $ Stream.fromList xs)
|
||||
describe "adapt . toParser . adapt" $ do
|
||||
it "empty stream" $ do
|
||||
r1 <- runP1 ([] :: [Int])
|
||||
case r1 of
|
||||
Left e -> print e
|
||||
Right x ->
|
||||
expectationFailure $ "Expecting failure, got: " ++ show x
|
||||
it "exact stream" $ do
|
||||
r2 <- runP1 [0::Int]
|
||||
fromRight undefined r2 `shouldBe` 0
|
||||
it "longer stream" $ do
|
||||
r3 <- runP1 [0,1::Int]
|
||||
fromRight undefined r3 `shouldBe` 0
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Main
|
||||
-------------------------------------------------------------------------------
|
||||
@ -839,3 +878,4 @@ main =
|
||||
prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some
|
||||
prop "fail due to parser being die" someFail
|
||||
takeProperties
|
||||
toParser
|
||||
|
Loading…
Reference in New Issue
Block a user