git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2536 from purescript/psstring-json-backwards-compat

Restore JSON backwards compatibility for PSStrings

commit9d5d71f38ab3c361e6ea64a91bcf3f7104615b69 authorHarry Garrood <harry@garrood.me> dateThu 5 Jan 2017, 01:19 (10 years ago) parent086bbe6f478e2f
2 files changed+28−4
compare with golang
unifiedsplit
src/Language/PureScript/CoreFn/ToJSON.hs+12−2 src/Language/PureScript/PSString.hs+16−2
src/Language/PureScript/CoreFn/ToJSON.hs+12−2
@@ -9,6 +9,7 @@ module Language.PureScript.CoreFn.ToJSON
99
1010import Prelude.Compat
1111
12+import Data.Maybe (fromMaybe)
1213import Data.Aeson
1314import Data.Version (Version, showVersion)
1415import Data.Text (Text)
@@ -17,7 +18,7 @@ import qualified Data.Text as T
1718import Language.PureScript.AST.Literals
1819import Language.PureScript.CoreFn
1920import Language.PureScript.Names
20−import Language.PureScript.PSString (PSString)
21+import Language.PureScript.PSString (PSString, decodeString)
2122
2223literalToJSON :: (a -> Value) -> Literal a -> Value
2324literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)
@@ -52,8 +53,17 @@ bindToJSON :: Bind a -> Value
5253bindToJSON (NonRec _ n e) = object [ runIdent n .= exprToJSON e ]
5354bindToJSON (Rec bs) = object $ map (\((_, n), e) -> runIdent n .= exprToJSON e) bs
5455
56+-- If all of the labels in the record can safely be converted to JSON strings,
57+-- we generate a JSON object. Otherwise the labels must be represented as
58+-- arrays of integers in the JSON, and in this case we generate the record as
59+-- an array of pairs.
5560recordToJSON :: (a -> Value) -> [(PSString, a)] -> Value
56−recordToJSON f = toJSON . map (\(key, a) -> (toJSON key, f a))
61+recordToJSON f rec = fromMaybe (asArrayOfPairs rec) (asObject rec)
62+ where
63+ asObject = fmap object . traverse (uncurry maybePair)
64+ maybePair label a = fmap (\l -> l .= f a) (decodeString label)
65+
66+ asArrayOfPairs = toJSON . map (\(label, a) -> (toJSON label, f a))
5767
5868exprToJSON :: Expr a -> Value
5969exprToJSON (Var _ i) = toJSON ( "Var"
src/Language/PureScript/PSString.hs+16−2
@@ -12,6 +12,7 @@ module Language.PureScript.PSString
1212
1313import Prelude.Compat
1414import Control.Exception (try, evaluate)
15+import Control.Applicative ((<|>))
1516import Data.Char (chr)
1617import Data.Bits (shiftR)
1718import Data.List (unfoldr)
@@ -40,6 +41,11 @@ import qualified Data.Aeson.Types as A
4041-- The Show instance for PSString produces a string literal which would
4142-- represent the same data were it inserted into a PureScript source file.
4243--
44+-- Because JSON parsers vary wildly in terms of how they deal with lone
45+-- surrogates in JSON strings, the ToJSON instance for PSString produces JSON
46+-- strings where that would be safe (i.e. when there are no lone surrogates),
47+-- and arrays of UTF-16 code units (integers) otherwise.
48+--
4349newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
4450 deriving (Eq, Ord, Monoid)
4551
@@ -116,13 +122,21 @@ instance IsString PSString where
116122 encodeUTF16 c = [toWord $ fromEnum c]
117123
118124instance A.ToJSON PSString where
119− toJSON = A.toJSON . toUTF16CodeUnits
125+ toJSON str =
126+ case decodeString str of
127+ Just t -> A.toJSON t
128+ Nothing -> A.toJSON (toUTF16CodeUnits str)
120129
121130instance A.FromJSON PSString where
122− parseJSON a = PSString <$> parseArrayOfCodeUnits a
131+ parseJSON a = jsonString <|> arrayOfCodeUnits
123132 where
133+ jsonString = fromString <$> A.parseJSON a
134+
135+ arrayOfCodeUnits = PSString <$> parseArrayOfCodeUnits a
136+
124137 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]
125138 parseArrayOfCodeUnits = A.withArray "array of UTF-16 code units" (traverse parseCodeUnit . V.toList)
139+
126140 parseCodeUnit :: A.Value -> A.Parser Word16
127141 parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b
128142