Fix property test prop_aeson_canonical

Canonical JSON is not a proper subset of RFC 7159.

So for the property 'prop_aeson_canonical', where we check that
everything produced as canoncal JSON can be parsed by Aeson (which we
assume correctly implements RFC 7159), we have to tweak things to keep
us within the common subset of canoncal JSON and RFC 7159.
Specifically, canoncal JSON only escapes \ and ", and does not escape
any other non-printable characters.

So the tweak is to just omit non-printable characters from all strings
in this test. Thus we test only within the common subset.

tests/TestSuite.hs

@@ -67,7 +67,9 @@ prop_canonical_pretty jsval =
     fmap canonicalise (parseCanonicalJSON (BS.pack (prettyCanonicalJSON jsval)))
 
 prop_aeson_canonical jsval =
-    Aeson.eitherDecode (renderCanonicalJSON jsval) == Right (toAeson jsval)
+    Aeson.eitherDecode (renderCanonicalJSON jsval') == Right (toAeson jsval')
+  where
+    jsval' = omitNonPrintableChars jsval
 
 prop_toJSON_fromJSON :: (Monad m, ToJSON m a, FromJSON m a, Eq a) => a -> m Bool
 prop_toJSON_fromJSON x =
@@ -127,6 +129,37 @@ toAeson (JSObject xs) = Aeson.Object $ KeyMap.fromList [ (toAesonStr k, toAeson
 toAesonStr :: IsString s => JSString -> s
 toAesonStr = fromString . fromJSString
 
+-- | As discussed in the haddock docs for 'renderCanonicalJSON', Canonical
+-- JSON is /not/ a proper subset of RFC 7159.
+--
+-- So for the property 'prop_aeson_canonical', where we check that everything
+-- produced as canoncal JSON can be parsed by Aeson (which we assume correctly
+-- implements RFC 7159), we have to tweak things to keep us within the common
+-- subset of canoncal JSON and RFC 7159. Specifically, canoncal JSON only
+-- escapes \ and ", and does not escape any other non-printable characters.
+--
+-- So the tweak is to just omit non-printable characters from all strings.
+--
+omitNonPrintableChars :: JSValue -> JSValue
+omitNonPrintableChars = omitJSValue
+  where
+    omitJSValue v@JSNull        = v
+    omitJSValue v@(JSBool    _) = v
+    omitJSValue v@(JSNum     _) = v
+    omitJSValue   (JSString  s) = JSString (omitJSString s)
+    omitJSValue   (JSArray  vs) = JSArray  [ omitJSValue v | v <- vs]
+    omitJSValue   (JSObject vs) = JSObject $ omitDupKeys
+                                           [ (omitJSString k, omitJSValue v)
+                                           | (k,v) <- vs ]
+
+    omitDupKeys :: [(JSString, JSValue)] -> [(JSString, JSValue)]
+    omitDupKeys = nubBy (\a b -> fst a == fst b)
+
+    omitJSString :: JSString -> JSString
+    omitJSString = toJSString
+                 . filter (\c -> c >= ' ')
+                 . fromJSString
+
 instance Arbitrary JSValue where
   arbitrary =
     sized $ \sz ->
@@ -165,5 +198,6 @@ instance Arbitrary Int54 where
 
 instance Arbitrary JSString where
   arbitrary = toJSString . getASCIIString <$> arbitrary
-  shrink  s = [ toJSString s' | s' <- shrink (fromJSString s) ]
+  shrink  s = [ toJSString s' | s' <- shrink (fromJSString s)
+                              , all (\c -> c >= ' ') s' ]