Commits

Mario Blažević committed 6f31255

Added peekChar.

Comments (0)

Files changed (3)

Data/Picoparsec/Monoid.hs

     -- ** Parsing individual characters
     , I.anyChar
     , I.char
+    , I.peekChar
     , I.satisfyChar
 
     -- * Efficient string handling

Data/Picoparsec/Monoid/Internal.hs

     , anyChar
     , char
     , satisfyChar
+    , peekChar
 
     -- * Efficient string handling
     , skipWhile
 char c = satisfyChar (== c) <?> show c
 {-# INLINE char #-}
 
+-- | Match any input character. Does not consume any input.
+peekChar :: TextualMonoid t => Parser t Char
+peekChar = do
+  s <- ensureOne
+  case Textual.characterPrefix s 
+     of Just c -> return c
+        _ -> fail "peekChar"
+{-# INLINE peekChar #-}
+
 -- | Match either a single newline character @\'\\n\'@, or a carriage
 -- return followed by a newline character @\"\\r\\n\"@.
 endOfLine :: (Eq t, TextualMonoid t) => Parser t ()

benchmarks/PicoAeson.hs

     else ary
 {-# INLINE json_ #-}
 
-object_ :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+object_ :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 object_ = {-# SCC "object_" #-} Object <$> objectValues jstring value
 {-# INLINEABLE object_ #-}
 
-object_' :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+object_' :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 object_' = {-# SCC "object_'" #-} do
   !vals <- objectValues jstring' value'
   return (Object vals)
     return s
 {-# INLINEABLE object_' #-}
 
-objectValues :: (Hashable t, Ord t, TextualMonoid t)
+objectValues :: (Eq t, Hashable t, TextualMonoid t)
                 => Parser t t -> Parser t (Value t) -> Parser t (H.HashMap t (Value t))
 objectValues str val = do
   skipSpace
   H.fromList <$> commaSeparated pair '}'
 {-# INLINE objectValues #-}
 
-array_ :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+array_ :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 array_ = {-# SCC "array_" #-} Array <$> arrayValues value
 {-# INLINEABLE array_ #-}
 
-array_' :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+array_' :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 array_' = {-# SCC "array_'" #-} do
   !vals <- arrayValues value'
   return (Array vals)
 
 commaSeparated :: (Eq t, TextualMonoid t) => Parser t a -> Char -> Parser t [a]
 commaSeparated item end = do
-  c <- P.peekToken
-  if c == singleton end
+  c <- P.peekChar
+  if c == end
     then P.anyToken >> return []
     else loop
   where
 -- unless the encoded data represents an object or an array.  JSON
 -- implementations in other languages conform to that same restriction
 -- to preserve interoperability and security.
-value :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+value :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 value = do
-  c <- P.peekToken
+  c <- P.peekChar
   case c of
-    "\""  -> P.anyToken *> (String <$> jstring_)
-    "{"   -> P.anyToken *> object_
-    "["   -> P.anyToken *> array_
-    "f"   -> string "false" *> pure (Bool False)
-    "t"   -> string "true" *> pure (Bool True)
-    "n"   -> string "null" *> pure Null
-    _      | c >= "0" && c <= "9" || c == "."
+    '"'   -> P.anyToken *> (String <$> jstring_)
+    '{'   -> P.anyToken *> object_
+    '['   -> P.anyToken *> array_
+    'f'   -> string "false" *> pure (Bool False)
+    't'   -> string "true" *> pure (Bool True)
+    'n'   -> string "null" *> pure Null
+    _      | c >= '0' && c <= '9' || c == '.'
           -> Number <$> scientific
            | otherwise -> fail "not a valid json value"
 {-# INLINEABLE value #-}
 
 -- | Strict version of 'value'. See also 'json''.
-value' :: (Hashable t, Ord t, TextualMonoid t) => Parser t (Value t)
+value' :: (Eq t, Hashable t, TextualMonoid t) => Parser t (Value t)
 value' = do
-  c <- P.peekToken
+  c <- P.peekChar
   case c of
-    "\""  -> P.anyToken *> (String <$> jstring_)
-    "{"   -> P.anyToken *> object_'
-    "["   -> P.anyToken *> array_'
-    "f"   -> string "false" *> pure (Bool False)
-    "t"   -> string "true" *> pure (Bool True)
-    "n"   -> string "null" *> pure Null
-    _      | c >= "0" && c <= "9" || c == "."
+    '"'   -> P.anyToken *> (String <$> jstring_)
+    '{'   -> P.anyToken *> object_'
+    '['   -> P.anyToken *> array_'
+    'f'   -> string "false" *> pure (Bool False)
+    't'   -> string "true" *> pure (Bool True)
+    'n'   -> string "null" *> pure Null
+    _      | c >= '0' && c <= '9' || c == '.'
           -> do
              !n <- scientific
              return (Number n)