git.iko.soy/typeable/attoparsec
on master help sign in
Merge pull request #69 from nilcons-contrib/lookahead

Added back the lookAhead combinator

commit1aa3e4494f2b4fc1a60998f17f910e1e590421d4 authorBryan O'Sullivan <bos@serpentine.com> dateTue 17 Feb 2015, 22:51 (12 years ago) parent64c9707df136e5
2 files changed+20−1
compare with master
unifiedsplit
Data/Attoparsec/Combinator.hs+8 tests/QC/Combinator.hs+12−1
Data/Attoparsec/Combinator.hs+8
@@ -36,6 +36,7 @@ module Data.Attoparsec.Combinator
3636 , satisfyElem
3737 , endOfInput
3838 , atEnd
39+ , lookAhead
3940 ) where
4041
4142#if !MIN_VERSION_base(4,8,0)
@@ -246,3 +247,10 @@ feed f@(Fail _ _ _) _ = f
246247feed (Partial k) d = k d
247248feed (Done t r) d = Done (mappend t d) r
248249{-# INLINE feed #-}
250+
251+-- | Apply a parser without consuming any input.
252+lookAhead :: Parser i a -> Parser i a
253+lookAhead p = Parser $ \t pos more lose succ ->
254+ let succ' t' _pos' more' = succ t' pos more'
255+ in runParser p t pos more lose succ'
256+{-# INLINE lookAhead #-}
tests/QC/Combinator.hs+12−1
@@ -1,8 +1,11 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
13module QC.Combinator where
24
35import Control.Applicative
6+import Data.Maybe (fromJust, isJust)
47import Data.Word (Word8)
5−import QC.Common (Repack, parseBS, repackBS)
8+import QC.Common (Repack, parseBS, repackBS, toLazyBS)
69import Test.Framework (Test)
710import Test.Framework.Providers.QuickCheck2 (testProperty)
811import Test.QuickCheck
@@ -22,6 +25,13 @@ count (Positive (Small n)) rs s =
2225 (length <$> parseBS (C.count n (P.string s)) input) == Just n
2326 where input = repackBS rs (B.concat (replicate (n+1) s))
2427
28+lookAhead :: NonEmptyList Word8 -> Bool
29+lookAhead (NonEmpty xs) =
30+ let ys = B.pack xs
31+ withLookAheadThenConsume = (\x y -> (x, y)) <$> C.lookAhead (P.string ys) <*> P.string ys
32+ mr = parseBS withLookAheadThenConsume $ toLazyBS ys
33+ in isJust mr && fst (fromJust mr) == snd (fromJust mr)
34+
2535match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool
2636match n (NonNegative x) (NonNegative y) rs =
2737 parseBS (P.match parser) (repackBS rs input) == Just (input, n)
@@ -35,5 +45,6 @@ tests :: [Test]
3545tests = [
3646 testProperty "choice" choice
3747 , testProperty "count" count
48+ , testProperty "lookAhead" lookAhead
3849 , testProperty "match" match
3950 ]