git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #2536 from purescript/psstring-json-backwards-compat
9d5d71fHarry Garrood
src/Language/PureScript/CoreFn/ToJSON.hs+12−2
compare with golang
unifiedsplit
@@ -9,6 +9,7 @@ module Language.PureScript.CoreFn.ToJSON
9
9
10import Prelude.Compat
10import Prelude.Compat
11
11
12+import Data.Maybe (fromMaybe)
12import Data.Aeson
13import Data.Aeson
13import Data.Version (Version, showVersion)
14import Data.Version (Version, showVersion)
14import Data.Text (Text)
15import Data.Text (Text)
@@ -17,7 +18,7 @@ import qualified Data.Text as T
17import Language.PureScript.AST.Literals
18import Language.PureScript.AST.Literals
18import Language.PureScript.CoreFn
19import Language.PureScript.CoreFn
19import Language.PureScript.Names
20import Language.PureScript.Names
20−import Language.PureScript.PSString (PSString)
21+import Language.PureScript.PSString (PSString, decodeString)
21
22
22literalToJSON :: (a -> Value) -> Literal a -> Value
23literalToJSON :: (a -> Value) -> Literal a -> Value
23literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)
24literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)
@@ -52,8 +53,17 @@ bindToJSON :: Bind a -> Value
52bindToJSON (NonRec _ n e) = object [ runIdent n .= exprToJSON e ]
53bindToJSON (NonRec _ n e) = object [ runIdent n .= exprToJSON e ]
53bindToJSON (Rec bs) = object $ map (\((_, n), e) -> runIdent n .= exprToJSON e) bs
54bindToJSON (Rec bs) = object $ map (\((_, n), e) -> runIdent n .= exprToJSON e) bs
54
55
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.
55recordToJSON :: (a -> Value) -> [(PSString, a)] -> Value
60recordToJSON :: (a -> Value) -> [(PSString, a)] -> Value
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+
56−recordToJSON f = toJSON . map (\(key, a) -> (toJSON key, f a))
66+ asArrayOfPairs = toJSON . map (\(label, a) -> (toJSON label, f a))
57
67
58exprToJSON :: Expr a -> Value
68exprToJSON :: Expr a -> Value
59exprToJSON (Var _ i) = toJSON ( "Var"
69exprToJSON (Var _ i) = toJSON ( "Var"
src/Language/PureScript/PSString.hs+16−2
@@ -12,6 +12,7 @@ module Language.PureScript.PSString
12
12
13import Prelude.Compat
13import Prelude.Compat
14import Control.Exception (try, evaluate)
14import Control.Exception (try, evaluate)
15+import Control.Applicative ((<|>))
15import Data.Char (chr)
16import Data.Char (chr)
16import Data.Bits (shiftR)
17import Data.Bits (shiftR)
17import Data.List (unfoldr)
18import Data.List (unfoldr)
@@ -40,6 +41,11 @@ import qualified Data.Aeson.Types as A
40-- The Show instance for PSString produces a string literal which would
41-- The Show instance for PSString produces a string literal which would
41-- represent the same data were it inserted into a PureScript source file.
42-- represent the same data were it inserted into a PureScript source file.
42--
43--
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+--
43newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
49newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
44 deriving (Eq, Ord, Monoid)
50 deriving (Eq, Ord, Monoid)
45
51
@@ -116,13 +122,21 @@ instance IsString PSString where
116 encodeUTF16 c = [toWord $ fromEnum c]
122 encodeUTF16 c = [toWord $ fromEnum c]
117
123
118instance A.ToJSON PSString where
124instance A.ToJSON PSString where
125+ toJSON str =
126+ case decodeString str of
127+ Just t -> A.toJSON t
119− toJSON = A.toJSON . toUTF16CodeUnits
128+ Nothing -> A.toJSON (toUTF16CodeUnits str)
120
129
121instance A.FromJSON PSString where
130instance A.FromJSON PSString where
122− parseJSON a = PSString <$> parseArrayOfCodeUnits a
131+ parseJSON a = jsonString <|> arrayOfCodeUnits
123 where
132 where
133+ jsonString = fromString <$> A.parseJSON a
134+
135+ arrayOfCodeUnits = PSString <$> parseArrayOfCodeUnits a
136+
124 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]
137 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]
125 parseArrayOfCodeUnits = A.withArray "array of UTF-16 code units" (traverse parseCodeUnit . V.toList)
138 parseArrayOfCodeUnits = A.withArray "array of UTF-16 code units" (traverse parseCodeUnit . V.toList)
139+
126 parseCodeUnit :: A.Value -> A.Parser Word16
140 parseCodeUnit :: A.Value -> A.Parser Word16
127 parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b
141 parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b
128
142