diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,6 @@ +Version 0.9 + * Merge-in contributions from Neil Mitchell to accomodate working with HEAD. + Version 0.8 * Add `Applicative` instance for `GetJSON` diff --git a/Text/JSON/Parsec.hs b/Text/JSON/Parsec.hs --- a/Text/JSON/Parsec.hs +++ b/Text/JSON/Parsec.hs @@ -30,18 +30,18 @@ import Numeric p_value :: CharParser () JSValue -p_value = spaces *> p_jvalue +p_value = spaces **> p_jvalue tok :: CharParser () a -> CharParser () a -tok p = p <* spaces +tok p = p <** spaces p_jvalue :: CharParser () JSValue -p_jvalue = (JSNull <$ p_null) - <|> (JSBool <$> p_boolean) - <|> (JSArray <$> p_array) - <|> (JSString <$> p_js_string) - <|> (JSObject <$> p_js_object) - <|> (JSRational False <$> p_number) +p_jvalue = (JSNull <$$ p_null) + <|> (JSBool <$$> p_boolean) + <|> (JSArray <$$> p_array) + <|> (JSString <$$> p_js_string) + <|> (JSObject <$$> p_js_object) + <|> (JSRational False <$$> p_number) "JSON value" p_null :: CharParser () () @@ -49,8 +49,8 @@ p_boolean :: CharParser () Bool p_boolean = tok - ( (True <$ string "true") - <|> (False <$ string "false") + ( (True <$$ string "true") + <|> (False <$$ string "false") ) p_array :: CharParser () [JSValue] @@ -62,62 +62,56 @@ where p_char = (char '\\' >> p_esc) <|> (satisfy (\x -> x /= '"' && x /= '\\')) - p_esc = ('"' <$ char '"') - <|> ('\\' <$ char '\\') - <|> ('/' <$ char '/') - <|> ('\b' <$ char 'b') - <|> ('\f' <$ char 'f') - <|> ('\n' <$ char 'n') - <|> ('\r' <$ char 'r') - <|> ('\t' <$ char 't') - <|> (char 'u' *> p_uni) + p_esc = ('"' <$$ char '"') + <|> ('\\' <$$ char '\\') + <|> ('/' <$$ char '/') + <|> ('\b' <$$ char 'b') + <|> ('\f' <$$ char 'f') + <|> ('\n' <$$ char 'n') + <|> ('\r' <$$ char 'r') + <|> ('\t' <$$ char 't') + <|> (char 'u' **> p_uni) "escape character" p_uni = check =<< count 4 (satisfy isHexDigit) - where check x | code <= max_char = pure (toEnum code) - | otherwise = empty + where check x | code <= max_char = return (toEnum code) + | otherwise = mzero where code = fst $ head $ readHex x max_char = fromEnum (maxBound :: Char) p_object :: CharParser () [(String,JSValue)] p_object = between (tok (char '{')) (tok (char '}')) $ p_field `sepBy` tok (char ',') - where p_field = (,) <$> (p_string <* tok (char ':')) <*> p_jvalue + where p_field = (,) <$$> (p_string <** tok (char ':')) <**> p_jvalue p_number :: CharParser () Rational p_number = tok $ do s <- getInput case readSigned readFloat s of - [(n,s1)] -> n <$ setInput s1 - _ -> empty + [(n,s1)] -> n <$$ setInput s1 + _ -> mzero p_js_string :: CharParser () JSString -p_js_string = toJSString <$> p_string +p_js_string = toJSString <$$> p_string p_js_object :: CharParser () (JSObject JSValue) -p_js_object = toJSObject <$> p_object +p_js_object = toJSObject <$$> p_object -------------------------------------------------------------------------------- -- XXX: Because Parsec is not Applicative yet... -pure :: a -> CharParser () a -pure = return - -(<*>) :: CharParser () (a -> b) -> CharParser () a -> CharParser () b -(<*>) = ap - -(*>) :: CharParser () a -> CharParser () b -> CharParser () b -(*>) = (>>) +(<**>) :: CharParser () (a -> b) -> CharParser () a -> CharParser () b +(<**>) = ap -(<*) :: CharParser () a -> CharParser () b -> CharParser () a -m <* n = do x <- m; _ <- n; return x +(**>) :: CharParser () a -> CharParser () b -> CharParser () b +(**>) = (>>) -empty :: CharParser () a -empty = mzero +(<**) :: CharParser () a -> CharParser () b -> CharParser () a +m <** n = do x <- m; _ <- n; return x -(<$>) :: (a -> b) -> CharParser () a -> CharParser () b -(<$>) = fmap +(<$$>) :: (a -> b) -> CharParser () a -> CharParser () b +(<$$>) = fmap -(<$) :: a -> CharParser () b -> CharParser () a -x <$ m = m >> return x +(<$$) :: a -> CharParser () b -> CharParser () a +x <$$ m = m >> return x diff --git a/Text/JSON/ReadP.hs b/Text/JSON/ReadP.hs --- a/Text/JSON/ReadP.hs +++ b/Text/JSON/ReadP.hs @@ -30,23 +30,23 @@ import Numeric token :: ReadP a -> ReadP a -token p = skipSpaces *> p +token p = skipSpaces **> p p_value :: ReadP JSValue -p_value = (JSNull <$ p_null) - <|> (JSBool <$> p_boolean) - <|> (JSArray <$> p_array) - <|> (JSString <$> p_js_string) - <|> (JSObject <$> p_js_object) - <|> (JSRational False <$> p_number) +p_value = (JSNull <$$ p_null) + <||> (JSBool <$$> p_boolean) + <||> (JSArray <$$> p_array) + <||> (JSString <$$> p_js_string) + <||> (JSObject <$$> p_js_object) + <||> (JSRational False <$$> p_number) p_null :: ReadP () p_null = token (string "null") >> return () p_boolean :: ReadP Bool p_boolean = token - ( (True <$ string "true") - <|> (False <$ string "false") + ( (True <$$ string "true") + <||> (False <$$ string "false") ) p_array :: ReadP [JSValue] @@ -56,62 +56,56 @@ p_string :: ReadP String p_string = between (token (char '"')) (char '"') (many p_char) where p_char = (char '\\' >> p_esc) - <|> (satisfy (\x -> x /= '"' && x /= '\\')) + <||> (satisfy (\x -> x /= '"' && x /= '\\')) - p_esc = ('"' <$ char '"') - <|> ('\\' <$ char '\\') - <|> ('/' <$ char '/') - <|> ('\b' <$ char 'b') - <|> ('\f' <$ char 'f') - <|> ('\n' <$ char 'n') - <|> ('\r' <$ char 'r') - <|> ('\t' <$ char 't') - <|> (char 'u' *> p_uni) + p_esc = ('"' <$$ char '"') + <||> ('\\' <$$ char '\\') + <||> ('/' <$$ char '/') + <||> ('\b' <$$ char 'b') + <||> ('\f' <$$ char 'f') + <||> ('\n' <$$ char 'n') + <||> ('\r' <$$ char 'r') + <||> ('\t' <$$ char 't') + <||> (char 'u' **> p_uni) p_uni = check =<< count 4 (satisfy isHexDigit) - where check x | code <= max_char = pure (toEnum code) - | otherwise = empty + where check x | code <= max_char = return (toEnum code) + | otherwise = pfail where code = fst $ head $ readHex x max_char = fromEnum (maxBound :: Char) p_object :: ReadP [(String,JSValue)] p_object = between (token (char '{')) (token (char '}')) $ p_field `sepBy` token (char ',') - where p_field = (,) <$> (p_string <* token (char ':')) <*> p_value + where p_field = (,) <$$> (p_string <** token (char ':')) <**> p_value p_number :: ReadP Rational p_number = readS_to_P (readSigned readFloat) p_js_string :: ReadP JSString -p_js_string = toJSString <$> p_string +p_js_string = toJSString <$$> p_string p_js_object :: ReadP (JSObject JSValue) -p_js_object = toJSObject <$> p_object +p_js_object = toJSObject <$$> p_object -------------------------------------------------------------------------------- -- XXX: Because ReadP is not Applicative yet... -pure :: a -> ReadP a -pure = return - -(<*>) :: ReadP (a -> b) -> ReadP a -> ReadP b -(<*>) = ap - -(*>) :: ReadP a -> ReadP b -> ReadP b -(*>) = (>>) +(<**>) :: ReadP (a -> b) -> ReadP a -> ReadP b +(<**>) = ap -(<*) :: ReadP a -> ReadP b -> ReadP a -m <* n = do x <- m; _ <- n; return x +(**>) :: ReadP a -> ReadP b -> ReadP b +(**>) = (>>) -empty :: ReadP a -empty = pfail +(<**) :: ReadP a -> ReadP b -> ReadP a +m <** n = do x <- m; _ <- n; return x -(<|>) :: ReadP a -> ReadP a -> ReadP a -(<|>) = (+++) +(<||>) :: ReadP a -> ReadP a -> ReadP a +(<||>) = (+++) -(<$>) :: (a -> b) -> ReadP a -> ReadP b -(<$>) = fmap +(<$$>) :: (a -> b) -> ReadP a -> ReadP b +(<$$>) = fmap -(<$) :: a -> ReadP b -> ReadP a -x <$ m = m >> return x +(<$$) :: a -> ReadP b -> ReadP a +x <$$ m = m >> return x diff --git a/json.cabal b/json.cabal --- a/json.cabal +++ b/json.cabal @@ -1,5 +1,5 @@ name: json -version: 0.8 +version: 0.9 synopsis: Support for serialising Haskell to and from JSON description: JSON (JavaScript Object Notation) is a lightweight data-interchange @@ -16,7 +16,7 @@ author: Galois Inc. maintainer: Iavor S. Diatchki (iavor.diatchki@gmail.com) Copyright: (c) 2007-2009 Galois Inc. -cabal-version: >= 1.2.0 +cabal-version: >= 1.6 build-type: Simple extra-source-files: CHANGES @@ -63,6 +63,10 @@ tests/unit/pass1.json tests/unit/pass2.json tests/unit/pass3.json + +source-repository head + type: git + location: https://github.com/GaloisInc/json.git flag split-base default: True