on master help sign in
Merge pull request #353 from phadej/issue-311

Resolve #311

commit28f5f5c267a3862cb45a73051209d52e5ed02f1d authorAdam Bergmark <adam@bergmark.nl> dateThu 4 Feb 2016, 15:10 (11 years ago) parentcfe2e24a147757
2 files changed+32−2
Data/Aeson/Types/Internal.hs+21−2 tests/UnitTests.hs+11
Data/Aeson/Types/Internal.hs+21−2
@@ -67,7 +67,7 @@ import Control.DeepSeq (NFData(..))
6767import Control.Monad (MonadPlus(..), ap)
6868import qualified Control.Monad.Fail as Fail
6969import Data.ByteString.Builder (Builder, char7, toLazyByteString)
70−import Data.Char (isLower, isUpper, toLower)
70+import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
7171import Data.Data (Data)
7272import Data.HashMap.Strict (HashMap)
7373import Data.Hashable (Hashable(..))
@@ -459,9 +459,28 @@ parseEither m v = runParser (m v) [] onError Right
459459formatError :: JSONPath -> String -> String
460460formatError path msg = "Error in " ++ (format "$" path) ++ ": " ++ msg
461461 where
462+ format :: String -> JSONPath -> String
462463 format pfx [] = pfx
463464 format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts
464− format pfx (Key key:parts) = format (pfx ++ "." ++ unpack key) parts
465+ format pfx (Key key:parts) = format (pfx ++ formatKey key) parts
466+
467+ formatKey :: Text -> String
468+ formatKey key
469+ | isIdentifierKey strKey = "." ++ strKey
470+ | otherwise = "['" ++ escapeKey strKey ++ "']"
471+ where strKey = unpack key
472+
473+ isIdentifierKey :: String -> Bool
474+ isIdentifierKey [] = False
475+ isIdentifierKey (x:xs) = isAlpha x && all isAlphaNum xs
476+
477+ escapeKey :: String -> String
478+ escapeKey = concatMap escapeChar
479+
480+ escapeChar :: Char -> String
481+ escapeChar '\'' = "\\'"
482+ escapeChar '\\' = "\\\\"
483+ escapeChar c = [c]
465484
466485-- | A key\/value pair for an 'Object'.
467486type Pair = (Text, Value)
tests/UnitTests.hs+11
@@ -7,6 +7,7 @@ module UnitTests (ioTests, tests) where
77import Control.Monad (forM)
88import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, FromJSON(..), withObject, (.:), (.:?), (.:!))
99import Data.Aeson.Encode (encodeToTextBuilder)
10+import Data.Aeson.Internal (JSONPathElement(..), formatError)
1011import Data.Aeson.TH (deriveJSON)
1112import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
1213import Data.Char (toUpper)
@@ -49,6 +50,9 @@ tests = testGroup "unit" [
4950 testCase "good" $ utcTimeGood
5051 , testCase "bad" $ utcTimeBad
5152 ]
53+ , testGroup "formatError" [
54+ testCase "example 1" $ formatErrorExample
55+ ]
5256 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
5357 , testGroup "To JSON representation" $ fmap (testCase "-") jsonEncoding
5458 , testGroup "From JSON representation" $ fmap (testCase "-") jsonDecoding
@@ -167,6 +171,13 @@ utcTimeBad = do
167171 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in
168172 assertEqual "verify failure" Nothing dec
169173
174+-- Non identifier keys should be escaped & enclosed in brackets
175+formatErrorExample :: Assertion
176+formatErrorExample =
177+ let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
178+ lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
179+ in assertEqual "formatError example" lhs rhs
180+
170181------------------------------------------------------------------------------
171182-- Comparison (.:?) and (.:!)
172183------------------------------------------------------------------------------