git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Generate PSString values as JSON strings where possible
f478e2fHarry 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+13−7
@@ -41,6 +41,11 @@ import qualified Data.Aeson.Types as A
41-- The Show instance for PSString produces a string literal which would
41-- The Show instance for PSString produces a string literal which would
42-- 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.
43--
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+--
44newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
49newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }
45 deriving (Eq, Ord, Monoid)
50 deriving (Eq, Ord, Monoid)
46
51
@@ -117,12 +122,17 @@ instance IsString PSString where
117 encodeUTF16 c = [toWord $ fromEnum c]
122 encodeUTF16 c = [toWord $ fromEnum c]
118
123
119instance A.ToJSON PSString where
124instance A.ToJSON PSString where
125+ toJSON str =
126+ case decodeString str of
127+ Just t -> A.toJSON t
120− toJSON = A.toJSON . toUTF16CodeUnits
128+ Nothing -> A.toJSON (toUTF16CodeUnits str)
121
129
122instance A.FromJSON PSString where
130instance A.FromJSON PSString where
123− parseJSON a = currentParser <|> backwardsCompat
131+ parseJSON a = jsonString <|> arrayOfCodeUnits
124 where
132 where
133+ jsonString = fromString <$> A.parseJSON a
134+
125− currentParser = PSString <$> parseArrayOfCodeUnits a
135+ arrayOfCodeUnits = PSString <$> parseArrayOfCodeUnits a
126
136
127 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]
137 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]
128 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)
@@ -130,10 +140,6 @@ instance A.FromJSON PSString where
130 parseCodeUnit :: A.Value -> A.Parser Word16
140 parseCodeUnit :: A.Value -> A.Parser Word16
131 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
132
142
133− -- For backwards compatibility: this allows us to parse JSON produced by
134− -- 0.10.4 or earlier
135− backwardsCompat = fromString <$> A.parseJSON a
136−
137-- |
143-- |
138-- Pretty print a PSString, using JavaScript escape sequences. Intended for
144-- Pretty print a PSString, using JavaScript escape sequences. Intended for
139-- use in compiled JS output.
145-- use in compiled JS output.