@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns #-}
1+{-# LANGUAGE CPP, BangPatterns #-}
22-- |
33-- Module : Data.Attoparsec.Internal
44-- Copyright : Bryan O'Sullivan 2007-2014
@@ -12,10 +12,15 @@
1212-- library.
1313
1414module Data.Attoparsec.Internal
15− (
16− compareResults
15+ ( compareResults
16+ , prompt
17+ , demandInput
1718 ) where
1819
20+#if __GLASGOW_HASKELL__ >= 700
21+import Data.ByteString (ByteString)
22+import Data.Text (Text)
23+#endif
1924import Data.Attoparsec.Internal.Types
2025import Prelude hiding (succ)
2126
@@ -31,3 +36,41 @@ compareResults (Done t0 r0) (Done t1 r1) =
3136 Just (t0 == t1 && r0 == r1)
3237compareResults (Partial _) (Partial _) = Nothing
3338compareResults _ _ = Just False
39+
40+-- | Ask for input. If we receive any, pass it to a success
41+-- continuation, otherwise to a failure continuation.
42+prompt :: Chunk t
43+ => State t -> Pos -> More
44+ -> (State t -> Pos -> More -> IResult t r)
45+ -> (State t -> Pos -> More -> IResult t r)
46+ -> IResult t r
47+prompt t pos _more lose succ = Partial $ \s ->
48+ if nullChunk s
49+ then lose t pos Complete
50+ else succ (pappendChunk t s) pos Incomplete
51+#if __GLASGOW_HASKELL__ >= 700
52+{-# SPECIALIZE prompt :: State ByteString -> Pos -> More
53+ -> (State ByteString -> Pos -> More
54+ -> IResult ByteString r)
55+ -> (State ByteString -> Pos -> More
56+ -> IResult ByteString r)
57+ -> IResult ByteString r #-}
58+{-# SPECIALIZE prompt :: State Text -> Pos -> More
59+ -> (State Text -> Pos -> More -> IResult Text r)
60+ -> (State Text -> Pos -> More -> IResult Text r)
61+ -> IResult Text r #-}
62+#endif
63+
64+-- | Immediately demand more input via a 'Partial' continuation
65+-- result.
66+demandInput :: Chunk t => Parser t ()
67+demandInput = Parser $ \t pos more lose succ ->
68+ case more of
69+ Complete -> lose t pos more [] "not enough input"
70+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
71+ succ' t' pos' more' = succ t' pos' more' ()
72+ in prompt t pos more lose' succ'
73+#if __GLASGOW_HASKELL__ >= 700
74+{-# SPECIALIZE demandInput :: Parser ByteString () #-}
75+{-# SPECIALIZE demandInput :: Parser Text () #-}
76+#endif