@@ -24,10 +24,10 @@ tests = testGroup "Test.Prop.IncrementalParsing" [
2424 testProperty " parser"
2525 ]
2626
27- test_parser :: Input -> [ChunkSize ] -> PhraseSize -> Property
28- test_parser input splits phraseSize =
27+ test_parser :: MarkLast -> Input -> [ChunkSize ] -> PhraseSize -> Property
28+ test_parser markLast input splits phraseSize =
2929 counterexample (" chunks: " ++ show chunks)
30- $ case processAll chunks processPhrase (parsePhrase phraseSize) of
30+ $ case processAll markLast chunks phraseSize of
3131 Left ->
3232 counterexample (" Unexpected failure " ++ show err) $ False
3333 Right ->
@@ -64,29 +64,33 @@ runPure chunks =
6464 . flip runStateT chunks
6565 . unwrapPure
6666
67- getChunk :: Pure Strict. ByteString
68- getChunk =
67+ getChunk :: MarkLast -> Pure ( Strict. ByteString, Bool )
68+ getChunk ( MarkLast markLast) =
6969 state $ \ case
70- [] -> (BS.Strict. empty, [] )
71- c: cs -> (c, cs)
70+ [] -> ((BS.Strict. empty, True [] )
71+ [c] -> ((c, markLast), [] )
72+ c: cs -> ((c, False
7273
7374processAll ::
74- [ Strict. ByteString ]
75- -> ( a -> Pure () )
76- -> Parser String a
75+ MarkLast
76+ -> [ Strict. ByteString ]
77+ -> PhraseSize
7778 -> Either String Lazy. ByteString
78- processAll chunks processOne p =
79+ processAll markLast chunks phraseSize =
7980 runPure chunks aux >>= verifyAllChunksConsumed
8081 where
82+ p :: Parser String Word8 ]
83+ p = parsePhrase phraseSize
84+
8185 -- 'processAll' does not assume that the monad @m@ in which it is executed
8286 -- has any way of reporting errors: if there is a parse failure during
8387 -- execution, this failure is returned as a value. For the specific case of
8488 -- 'Pure', however, we /can/ throw errors in @m@ (to allow 'processOne' to
8589 -- throw errors), so we can reuse that also for any parse failures.
8690 aux :: Pure Lazy. ByteString
8791 aux =
88- Parser. processAll getChunk processOne p
89- >>= either throwError return
92+ Parser. processAll ( getChunk markLast) processPhrase processPhrase p
93+ >>= throwParseErrors
9094
9195 -- 'processAll' should run until all chunks are used
9296 verifyAllChunksConsumed ::
@@ -99,6 +103,28 @@ processAll chunks processOne p =
99103 | otherwise
100104 = Left " not all chunks consumed"
101105
106+ throwParseErrors :: Parser. ProcessResultString () -> Pure Lazy. ByteString
107+ throwParseErrors (Parser. ProcessError=
108+ throwError err
109+ throwParseErrors (Parser. ProcessedWithFinal() bs) = do
110+ unless canMarkFinal $ throwError " Unexpected ProcessedWithFinal"
111+ return bs
112+ throwParseErrors (Parser. ProcessedWithoutFinal= do
113+ when canMarkFinal $ throwError " Unexpected ProcessedWithoutFinal"
114+ return bs
115+
116+ -- We can mark the final phrase as final if the final chunk is marked as
117+ -- final, and when we get that chunk, it contains at least one phrase.
118+ canMarkFinal :: Bool
119+ canMarkFinal = and [
120+ getMarkLast markLast
121+ , case reverse chunks of
122+ [] -> False
123+ c: cs -> let left = sum (map BS.Strict. length cs)
124+ `mod` getPhraseSize phraseSize
125+ in (left + BS.Strict. length c) >= getPhraseSize phraseSize
126+ ]
127+
102128{- ------------------------------------------------------------------------------
103129 Test input
104130
@@ -111,6 +137,8 @@ processAll chunks processOne p =
111137 ```
112138
113139 * We split this input into non-empty chunks of varying sizes @[ChunkSize]@.
140+ We sometimes mark the last chunk as being the last, and sometimes don't
141+ (see <https://github.com/well-typed/grapesy/issues/114>).
114142
115143 * We then choose a non-zero 'PhraseSize' @n@. The idea is that the parser
116144 splits the input into phrases of @n@ bytes
@@ -134,6 +162,7 @@ processAll chunks processOne p =
134162 (in 'processAll') that all input chunks are fed to the parser.
135163-------------------------------------------------------------------------------}
136164
165+ newtype MarkLast = MarkLast { getMarkLast :: Bool } deriving (Show )
137166newtype Input = Input { getInputBytes :: [Word8 ] } deriving (Show )
138167newtype ChunkSize = ChunkSize { getChunkSize :: Int } deriving (Show )
139168newtype PhraseSize = PhraseSize { getPhraseSize :: Int } deriving (Show )
@@ -179,6 +208,8 @@ processPhrase phrase =
179208 Arbitrary instances
180209-------------------------------------------------------------------------------}
181210
211+ deriving newtype instance Arbitrary MarkLast
212+
182213instance Arbitrary Input where
183214 arbitrary = sized $ \ n -> do
184215 len <- choose (0 , n * 100 )
@@ -187,3 +218,4 @@ instance Arbitrary Input where
187218
188219deriving via Positive Int instance Arbitrary ChunkSize
189220deriving via Positive Int instance Arbitrary PhraseSize
221+
0 commit comments