f478e2f · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Generate PSString values as JSON strings where possible

Also generate records as JSON objects in the corefn JSON where possible. This means although the the JSON format change in the next release is strictly a breaking change, the majority of code can still be processed without changing corefn parsers.

commitf478e2f5ae5993f3cea42644a7e3ed252f662dd0 authorHarry Garrood <harry@garrood.me> dateThu 5 Jan 2017, 00:05 (10 years ago) parent16c6aae

2 files changed+25−9

compare with golang

unifiedsplit

src/Language/PureScript/CoreFn/ToJSON.hs+12−2 src/Language/PureScript/PSString.hs+13−7

src/Language/PureScript/CoreFn/ToJSON.hs+12−2

@@ -9,6 +9,7 @@ module Language.PureScript.CoreFn.ToJSON

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+13−7

@@ -41,6 +41,11 @@ import qualified Data.Aeson.Types as A

4141-- The Show instance for PSString produces a string literal which would

4242-- represent the same data were it inserted into a PureScript source file.

4343--

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+--

4449newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }

4550 deriving (Eq, Ord, Monoid)

4651

@@ -117,12 +122,17 @@ instance IsString PSString where

117122 encodeUTF16 c = [toWord $ fromEnum c]

118123

119124instance A.ToJSON PSString where

120− toJSON = A.toJSON . toUTF16CodeUnits

125+ toJSON str =

126+ case decodeString str of

127+ Just t -> A.toJSON t

128+ Nothing -> A.toJSON (toUTF16CodeUnits str)

121129

122130instance A.FromJSON PSString where

123− parseJSON a = currentParser <|> backwardsCompat

131+ parseJSON a = jsonString <|> arrayOfCodeUnits

124132 where

125− currentParser = PSString <$> parseArrayOfCodeUnits a

133+ jsonString = fromString <$> A.parseJSON a

134+

135+ arrayOfCodeUnits = PSString <$> parseArrayOfCodeUnits a

126136

127137 parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]

128138 parseArrayOfCodeUnits = A.withArray "array of UTF-16 code units" (traverse parseCodeUnit . V.toList)

@@ -130,10 +140,6 @@ instance A.FromJSON PSString where

130140 parseCodeUnit :: A.Value -> A.Parser Word16

131141 parseCodeUnit b = A.withScientific "two-byte non-negative integer" (maybe (A.typeMismatch "" b) return . toBoundedInteger) b

132142

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−

137143-- |

138144-- Pretty print a PSString, using JavaScript escape sequences. Intended for

139145-- use in compiled JS output.