Merge pull request #353 from phadej/issue-311

Resolve #311

Data/Aeson/Types/Internal.hs

@@ -67,7 +67,7 @@ import Control.DeepSeq (NFData(..))
 import Control.Monad (MonadPlus(..), ap)
 import qualified Control.Monad.Fail as Fail
 import Data.ByteString.Builder (Builder, char7, toLazyByteString)
-import Data.Char (isLower, isUpper, toLower)
+import Data.Char (isLower, isUpper, toLower, isAlpha, isAlphaNum)
 import Data.Data (Data)
 import Data.HashMap.Strict (HashMap)
 import Data.Hashable (Hashable(..))
@@ -459,9 +459,28 @@ parseEither m v = runParser (m v) [] onError Right
 formatError :: JSONPath -> String -> String
 formatError path msg = "Error in " ++ (format "$" path) ++ ": " ++ msg
   where
+    format :: String -> JSONPath -> String
     format pfx []                = pfx
     format pfx (Index idx:parts) = format (pfx ++ "[" ++ show idx ++ "]") parts
-    format pfx (Key key:parts)   = format (pfx ++ "." ++ unpack key) parts
+    format pfx (Key key:parts)   = format (pfx ++ formatKey key) parts
+
+    formatKey :: Text -> String
+    formatKey key
+       | isIdentifierKey strKey = "." ++ strKey
+       | otherwise              = "['" ++ escapeKey strKey ++ "']"
+      where strKey = unpack key
+
+    isIdentifierKey :: String -> Bool
+    isIdentifierKey []     = False
+    isIdentifierKey (x:xs) = isAlpha x && all isAlphaNum xs
+
+    escapeKey :: String -> String
+    escapeKey = concatMap escapeChar
+
+    escapeChar :: Char -> String
+    escapeChar '\'' = "\\'"
+    escapeChar '\\' = "\\\\"
+    escapeChar c    = [c]
 
 -- | A key\/value pair for an 'Object'.
 type Pair = (Text, Value)

tests/UnitTests.hs

@@ -7,6 +7,7 @@ module UnitTests (ioTests, tests) where
 import Control.Monad (forM)
 import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, FromJSON(..), withObject, (.:), (.:?), (.:!))
 import Data.Aeson.Encode (encodeToTextBuilder)
+import Data.Aeson.Internal (JSONPathElement(..), formatError)
 import Data.Aeson.TH (deriveJSON)
 import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
 import Data.Char (toUpper)
@@ -49,6 +50,9 @@ tests = testGroup "unit" [
       testCase "good" $ utcTimeGood
     , testCase "bad"  $ utcTimeBad
     ]
+  , testGroup "formatError" [
+      testCase "example 1" $ formatErrorExample
+    ]
   , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
   , testGroup "To JSON representation" $ fmap (testCase "-") jsonEncoding
   , testGroup "From JSON representation" $ fmap (testCase "-") jsonDecoding
@@ -167,6 +171,13 @@ utcTimeBad = do
       let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in
       assertEqual "verify failure" Nothing dec
 
+-- Non identifier keys should be escaped & enclosed in brackets
+formatErrorExample :: Assertion
+formatErrorExample =
+  let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
+      lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
+  in assertEqual "formatError example" lhs rhs
+
 ------------------------------------------------------------------------------
 -- Comparison (.:?) and (.:!)
 ------------------------------------------------------------------------------