086bbe6 · rowtype-yoga/purescript-native

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

Merge pull request #2488 from michaelficarra/string-newtypes

Represent PureScript strings internally as sequence of Word16 instead of Text

commit086bbe68ebd75ccb1acab71c88096eebd31de538 authorHarry Garrood <harry@garrood.me> dateWed 4 Jan 2017, 01:28 (10 years ago) parent068a019 0539687

38 files changed+537−189

compare with golang

unifiedsplit

examples/passing/StringEdgeCases.pursnew file+9

@@ -0,0 +1,9 @@

1+module Main where

3+import Prelude

4+import Records as Records

5+import Symbols as Symbols

7+main = do

8+ Records.main

9+ Symbols.main

examples/passing/StringEdgeCases/Records.pursnew file+66

@@ -0,0 +1,66 @@

1+module Records where

3+import Prelude

4+import Data.Generic (class Generic, toSpine, GenericSpine(..))

5+import Control.Monad.Eff.Console (log)

6+import Test.Assert (assert')

8+newtype AstralKeys = AstralKeys { "💡" :: Int, "💢" :: Int }

9+newtype LoneSurrogateKeys = LoneSurrogateKeys { "\xdf06" :: Int, "\xd834" :: Int }

10+

11+derive instance genericAstralKeys :: Generic AstralKeys

12+derive instance genericLoneSurrogateKeys :: Generic LoneSurrogateKeys

13+

14+spineOf :: forall a. Generic a => a -> Unit -> GenericSpine

15+spineOf x _ = toSpine x

16+

17+testLoneSurrogateKeys =

18+ let

19+ expected = 5

20+ actual = (_."\xd801" <<< helper) { "\xd800": 5 }

21+ in

22+ assert' ("lone surrogate keys: " <> show actual) (expected == actual)

23+

24+ where

25+ helper :: { "\xd800" :: Int } -> { "\xd801" :: Int }

26+ helper o =

27+ case o."\xd800" of

28+ x -> { "\xd801": x }

29+

30+testAstralKeys =

31+ let

32+ expected = 5

33+ actual = (_."💢" <<< helper) { "💡": 5 }

34+ in

35+ assert' ("astral keys: " <> show actual) (expected == actual)

36+

37+ where

38+ helper :: { "💡" :: Int } -> { "💢" :: Int }

39+ helper o =

40+ case o."💡" of

41+ x -> { "💢": x }

42+

43+testGenericLoneSurrogateKeys = do

44+ let expected = SProd "Records.LoneSurrogateKeys"

45+ [ \_ -> SRecord [ {recLabel: "\xd834", recValue: spineOf 1}

46+ , {recLabel: "\xdf06", recValue: spineOf 0}

47+ ]

48+ ]

49+ actual = toSpine (LoneSurrogateKeys { "\xdf06": 0, "\xd834": 1 })

50+ assert' ("generic lone surrogate keys: " <> show actual) (expected == actual)

51+

52+testGenericAstralKeys = do

53+ let expected = SProd "Records.AstralKeys"

54+ [ \_ -> SRecord [ {recLabel: "💡", recValue: spineOf 0}

55+ , {recLabel: "💢", recValue: spineOf 1}

56+ ]

57+ ]

58+ actual = toSpine (AstralKeys { "💡": 0, "💢": 1 })

59+ assert' ("generic astral keys: " <> show actual) (expected == actual)

60+

61+main = do

62+ testLoneSurrogateKeys

63+ testAstralKeys

64+ testGenericLoneSurrogateKeys

65+ testGenericAstralKeys

66+ log "Done"

examples/passing/StringEdgeCases/Symbols.pursnew file+30

@@ -0,0 +1,30 @@

1+-- This is similar to StringEscapes except we are performing the same tests

2+-- with Symbols (at the type level).

4+module Symbols where

6+import Prelude

7+import Control.Monad.Eff.Console (log)

8+import Type.Data.Symbol (SProxy(..), class AppendSymbol, appendSymbol, reflectSymbol)

9+import Test.Assert (assert')

10+

11+highS :: SProxy "\xd834"

12+highS = SProxy

13+

14+lowS :: SProxy "\xdf06"

15+lowS = SProxy

16+

17+loneSurrogates :: Boolean

18+loneSurrogates = reflectSymbol (appendSymbol highS lowS) == "\x1d306"

19+

20+outOfOrderSurrogates :: Boolean

21+outOfOrderSurrogates = reflectSymbol (appendSymbol lowS highS) == "\xdf06\xd834"

22+

23+notReplacing :: Boolean

24+notReplacing = reflectSymbol lowS /= "\xfffd"

25+

26+main = do

27+ assert' "lone surrogates may be combined into a surrogate pair" loneSurrogates

28+ assert' "lone surrogates may be combined out of order to remain lone surrogates" outOfOrderSurrogates

29+ assert' "lone surrogates are not replaced with the Unicode replacement character U+FFFD" notReplacing

30+ log "Done"

examples/passing/StringEscapes.purs+1−1

@@ -22,5 +22,5 @@ main = do

2222 assert' "astral code points are represented as a UTF-16 surrogate pair" surrogatePair

2323 assert' "lone surrogates may be combined into a surrogate pair" loneSurrogates

2424 assert' "lone surrogates may be combined out of order to remain lone surrogates" outOfOrderSurrogates

25− -- assert' "lone surrogates are not replaced with the Unicode replacement character U+FFFD" notReplacing

25+ assert' "lone surrogates are not replaced with the Unicode replacement character U+FFFD" notReplacing

2626 log "Done"

purescript.cabal+4

@@ -54,6 +54,7 @@ extra-source-files: examples/passing/*.purs

5454 , examples/passing/ResolvableScopeConflict3/*.purs

5555 , examples/passing/ShadowedModuleName/*.purs

5656 , examples/passing/SolvingIsSymbol/*.purs

57+ , examples/passing/StringEdgeCases/*.purs

5758 , examples/passing/TransitiveImport/*.purs

5859 , examples/passing/TypeOperators/*.purs

5960 , examples/passing/TypeWithoutParens/*.purs

@@ -146,6 +147,7 @@ library

146147 protolude >= 0.1.6,

147148 regex-tdfa -any,

148149 safe >= 0.3.9 && < 0.4,

150+ scientific >= 0.3.4.9 && < 0.4,

149151 semigroups >= 0.16.2 && < 0.19,

150152 sourcemap >= 0.1.6,

151153 spdx == 0.2.*,

@@ -199,6 +201,7 @@ library

199201 Language.PureScript.Errors

200202 Language.PureScript.Errors.JSON

201203 Language.PureScript.Kinds

204+ Language.PureScript.Label

202205 Language.PureScript.Linter

203206 Language.PureScript.Linter.Exhaustive

204207 Language.PureScript.Linter.Imports

@@ -219,6 +222,7 @@ library

219222 Language.PureScript.Pretty.Kinds

220223 Language.PureScript.Pretty.Types

221224 Language.PureScript.Pretty.Values

225+ Language.PureScript.PSString

222226 Language.PureScript.Renamer

223227 Language.PureScript.Sugar

224228 Language.PureScript.Sugar.BindingGroups

src/Language/PureScript/AST/Declarations.hs+8−6

@@ -18,6 +18,8 @@ import Language.PureScript.AST.Literals

1818import Language.PureScript.AST.Operators

1919import Language.PureScript.AST.SourcePos

2020import Language.PureScript.Types

21+import Language.PureScript.PSString (PSString)

22+import Language.PureScript.Label (Label)

2123import Language.PureScript.Names

2224import Language.PureScript.Kinds

2325import Language.PureScript.TypeClassDictionaries

@@ -90,7 +92,7 @@ data SimpleErrorMessage

9092 | CannotDerive (Qualified (ProperName 'ClassName)) [Type]

9193 | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [Type]

9294 | CannotFindDerivingType (ProperName 'TypeName)

93− | DuplicateLabel Text (Maybe Expr)

95+ | DuplicateLabel Label (Maybe Expr)

9496 | DuplicateValueDeclaration Ident

9597 | ArgListLengthsDiffer Ident

9698 | OverlappingArgNames (Maybe Ident)

@@ -99,8 +101,8 @@ data SimpleErrorMessage

99101 | ExpectedType Type Kind

100102 | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))

101103 | ExprDoesNotHaveType Expr Type

102− | PropertyIsMissing Text

103− | AdditionalProperty Text

104+ | PropertyIsMissing Label

105+ | AdditionalProperty Label

104106 | TypeSynonymInstance

105107 | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]

106108 | InvalidNewtype (ProperName 'TypeName)

@@ -145,7 +147,7 @@ data ErrorMessageHint

145147 | ErrorInModule ModuleName

146148 | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]

147149 | ErrorInSubsumption Type Type

148− | ErrorCheckingAccessor Expr Text

150+ | ErrorCheckingAccessor Expr PSString

149151 | ErrorCheckingType Expr Type

150152 | ErrorCheckingKind Type

151153 | ErrorCheckingGuard

@@ -573,11 +575,11 @@ data Expr

573575 -- Anonymous arguments will be removed during desugaring and expanded

574576 -- into a lambda that reads a property from a record.

575577 --

576− | Accessor Text Expr

578+ | Accessor PSString Expr

577579 -- |

578580 -- Partial record update

579581 --

580− | ObjectUpdate Expr [(Text, Expr)]

582+ | ObjectUpdate Expr [(PSString, Expr)]

581583 -- |

582584 -- Function introduction

583585 --

src/Language/PureScript/AST/Literals.hs+3−3

@@ -4,7 +4,7 @@

44module Language.PureScript.AST.Literals where

66import Prelude.Compat

7−import Data.Text (Text)

7+import Language.PureScript.PSString (PSString)

99-- |

1010-- Data type for literal values. Parameterised so it can be used for Exprs and

@@ -18,7 +18,7 @@ data Literal a

1818 -- |

1919 -- A string literal

2020 --

21− | StringLiteral Text

21+ | StringLiteral PSString

2222 -- |

2323 -- A character literal

2424 --

@@ -34,5 +34,5 @@ data Literal a

3434 -- |

3535 -- An object literal

3636 --

37− | ObjectLiteral [(Text, a)]

37+ | ObjectLiteral [(PSString, a)]

3838 deriving (Eq, Ord, Show, Functor)

src/Language/PureScript/CodeGen/JS.hs+20−14

@@ -20,6 +20,7 @@ import qualified Data.Foldable as F

2020import qualified Data.Map as M

2121import Data.Maybe (fromMaybe, isNothing)

2222import Data.Monoid ((<>))

23+import Data.String (fromString)

2324import Data.Text (Text)

2425import qualified Data.Text as T

2526

@@ -34,6 +35,7 @@ import Language.PureScript.Errors (ErrorMessageHint(..), SimpleErrorMessage(..),

3435 errorMessage, rethrowWithPosition, addHint)

3536import Language.PureScript.Names

3637import Language.PureScript.Options

38+import Language.PureScript.PSString (PSString, mkString, decodeString)

3739import Language.PureScript.Traversals (sndM)

3840import qualified Language.PureScript.Constants as C

3941

@@ -65,8 +67,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

6567 let moduleBody = header : foreign' ++ jsImports ++ concat optimized

6668 let foreignExps = exps `intersect` (fst `map` foreigns)

6769 let standardExps = exps \\ foreignExps

68− let exps' = JSObjectLiteral Nothing $ map (runIdent &&& JSVar Nothing . identToJs) standardExps

69− ++ map (runIdent &&& foreignIdent) foreignExps

70+ let exps' = JSObjectLiteral Nothing $ map (mkString . runIdent &&& JSVar Nothing . identToJs) standardExps

71+ ++ map (mkString . runIdent &&& foreignIdent) foreignExps

7072 return $ moduleBody ++ [JSAssignment Nothing (JSAccessor Nothing "exports" (JSVar Nothing "module")) exps']

7173

7274 where

@@ -108,7 +110,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

108110 importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m JS

109111 importToJs mnLookup mn' = do

110112 let ((ss, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup

111− let moduleBody = JSApp Nothing (JSVar Nothing "require") [JSStringLiteral Nothing (T.pack (".." </> T.unpack (runModuleName mn')))]

113+ let moduleBody = JSApp Nothing (JSVar Nothing "require") [JSStringLiteral Nothing (fromString (".." </> T.unpack (runModuleName mn')))]

112114 withPos ss $ JSVariableIntroduction Nothing (moduleNameToJs mnSafe) (Just moduleBody)

113115

114116 -- |

@@ -176,12 +178,16 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

176178 -- indexer is returned.

177179 --

178180 accessor :: Ident -> JS -> JS

179− accessor (Ident prop) = accessorString prop

181+ accessor (Ident prop) = accessorString $ mkString prop

180182 accessor (GenIdent _ _) = internalError "GenIdent in accessor"

181183

182− accessorString :: Text -> JS -> JS

183− accessorString prop | identNeedsEscaping prop = JSIndexer Nothing (JSStringLiteral Nothing prop)

184− | otherwise = JSAccessor Nothing prop

184+ accessorString :: PSString -> JS -> JS

185+ accessorString prop =

186+ case decodeString prop of

187+ Just s | not (identNeedsEscaping s) ->

188+ JSAccessor Nothing s

189+ _ ->

190+ JSIndexer Nothing (JSStringLiteral Nothing prop)

185191

186192 -- |

187193 -- Generate code in the simplified Javascript intermediate representation for a value or expression.

@@ -212,7 +218,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

212218 unAbs (Abs _ arg val) = arg : unAbs val

213219 unAbs _ = []

214220 assign :: Ident -> JS

215− assign name = JSAssignment Nothing (accessorString (runIdent name) (JSVar Nothing "this"))

221+ assign name = JSAssignment Nothing (accessorString (mkString $ runIdent name) (JSVar Nothing "this"))

216222 (var name)

217223 valueToJs' (Abs _ arg val) = do

218224 ret <- valueToJs val

@@ -272,7 +278,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

272278 literalToValueJS (NumericLiteral (Left i)) = return $ JSNumericLiteral Nothing (Left i)

273279 literalToValueJS (NumericLiteral (Right n)) = return $ JSNumericLiteral Nothing (Right n)

274280 literalToValueJS (StringLiteral s) = return $ JSStringLiteral Nothing s

275− literalToValueJS (CharLiteral c) = return $ JSStringLiteral Nothing (T.singleton c)

281+ literalToValueJS (CharLiteral c) = return $ JSStringLiteral Nothing (fromString [c])

276282 literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral Nothing b

277283 literalToValueJS (ArrayLiteral xs) = JSArrayLiteral Nothing <$> mapM valueToJs xs

278284 literalToValueJS (ObjectLiteral ps) = JSObjectLiteral Nothing <$> mapM (sndM valueToJs) ps

@@ -280,7 +286,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

280286 -- |

281287 -- Shallow copy an object.

282288 --

283− extendObj :: JS -> [(Text, JS)] -> m JS

289+ extendObj :: JS -> [(PSString, JS)] -> m JS

284290 extendObj obj sts = do

285291 newObj <- freshName

286292 key <- freshName

@@ -317,7 +323,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

317323 qualifiedToJS f (Qualified _ a) = JSVar Nothing $ identToJs (f a)

318324

319325 foreignIdent :: Ident -> JS

320− foreignIdent ident = accessorString (runIdent ident) (JSVar Nothing "$foreign")

326+ foreignIdent ident = accessorString (mkString $ runIdent ident) (JSVar Nothing "$foreign")

321327

322328 -- |

323329 -- Generate code in the simplified Javascript intermediate representation for pattern match binders

@@ -341,7 +347,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

341347 go _ _ _ = internalError "Invalid arguments to bindersToJs"

342348

343349 failedPatternError :: [Text] -> JS

344− failedPatternError names = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing "Error") [JSBinary Nothing Add (JSStringLiteral Nothing failedPatternMessage) (JSArrayLiteral Nothing $ zipWith valueError names vals)]

350+ failedPatternError names = JSUnary Nothing JSNew $ JSApp Nothing (JSVar Nothing "Error") [JSBinary Nothing Add (JSStringLiteral Nothing $ mkString failedPatternMessage) (JSArrayLiteral Nothing $ zipWith valueError names vals)]

345351

346352 failedPatternMessage :: Text

347353 failedPatternMessage = "Failed pattern match" <> maybe "" (((" at " <> runModuleName mn <> " ") <>) . displayStartEndPos) maybeSpan <> ": "

@@ -402,7 +408,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

402408 literalToBinderJS varName done (NumericLiteral num) =

403409 return [JSIfElse Nothing (JSBinary Nothing EqualTo (JSVar Nothing varName) (JSNumericLiteral Nothing num)) (JSBlock Nothing done) Nothing]

404410 literalToBinderJS varName done (CharLiteral c) =

405− return [JSIfElse Nothing (JSBinary Nothing EqualTo (JSVar Nothing varName) (JSStringLiteral Nothing (T.singleton c))) (JSBlock Nothing done) Nothing]

411+ return [JSIfElse Nothing (JSBinary Nothing EqualTo (JSVar Nothing varName) (JSStringLiteral Nothing (fromString [c]))) (JSBlock Nothing done) Nothing]

406412 literalToBinderJS varName done (StringLiteral str) =

407413 return [JSIfElse Nothing (JSBinary Nothing EqualTo (JSVar Nothing varName) (JSStringLiteral Nothing str)) (JSBlock Nothing done) Nothing]

408414 literalToBinderJS varName done (BooleanLiteral True) =

@@ -411,7 +417,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

411417 return [JSIfElse Nothing (JSUnary Nothing Not (JSVar Nothing varName)) (JSBlock Nothing done) Nothing]

412418 literalToBinderJS varName done (ObjectLiteral bs) = go done bs

413419 where

414− go :: [JS] -> [(Text, Binder Ann)] -> m [JS]

420+ go :: [JS] -> [(PSString, Binder Ann)] -> m [JS]

415421 go done' [] = return done'

416422 go done' ((prop, binder):bs') = do

417423 propVar <- freshName

src/Language/PureScript/CodeGen/JS/AST.hs+5−3

@@ -11,6 +11,7 @@ import Data.Text (Text)

1111

1212import Language.PureScript.AST (SourceSpan(..))

1313import Language.PureScript.Comments

14+import Language.PureScript.PSString (PSString)

1415import Language.PureScript.Traversals

1516

1617-- |

@@ -132,7 +133,7 @@ data JS

132133 -- |

133134 -- A string literal

134135 --

135− | JSStringLiteral (Maybe SourceSpan) Text

136+ | JSStringLiteral (Maybe SourceSpan) PSString

136137 -- |

137138 -- A boolean literal

138139 --

@@ -156,7 +157,7 @@ data JS

156157 -- |

157158 -- An object literal

158159 --

159− | JSObjectLiteral (Maybe SourceSpan) [(Text, JS)]

160+ | JSObjectLiteral (Maybe SourceSpan) [(PSString, JS)]

160161 -- |

161162 -- An object property accessor expression

162163 --

@@ -240,7 +241,8 @@ data JS

240241 -- |

241242 -- Commented Javascript

242243 --

243− | JSComment (Maybe SourceSpan) [Comment] JS deriving (Show, Eq)

244+ | JSComment (Maybe SourceSpan) [Comment] JS

245+ deriving (Show, Eq)

244246

245247withSourceSpan :: SourceSpan -> JS -> JS

246248withSourceSpan withSpan = go

src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs+2−1

@@ -11,6 +11,7 @@ import Data.Maybe (fromMaybe)

1111

1212import Language.PureScript.Crash

1313import Language.PureScript.CodeGen.JS.AST

14+import Language.PureScript.PSString (mkString)

1415

1516applyAll :: [a -> a] -> a -> a

1617applyAll = foldl' (.) id

@@ -73,7 +74,7 @@ isFn :: (Text, Text) -> JS -> Bool

7374isFn (moduleName, fnName) (JSAccessor _ x (JSVar _ y)) =

7475 x == fnName && y == moduleName

7576isFn (moduleName, fnName) (JSIndexer _ (JSStringLiteral _ x) (JSVar _ y)) =

76− x == fnName && y == moduleName

77+ x == mkString fnName && y == moduleName

7778isFn _ _ = False

7879

7980isDict :: (Text, Text) -> JS -> Bool

src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+1−1

@@ -239,7 +239,7 @@ inlineCommonOperators = applyAll $

239239 isModFn _ _ = False

240240

241241 isModFnWithDict :: (Text, Text) -> JS -> Bool

242− isModFnWithDict (m, op) (JSApp _ (JSAccessor _ op' (JSVar _ m')) [(JSVar _ _)]) = m == m' && op == op'

242+ isModFnWithDict (m, op) (JSApp _ (JSAccessor _ op' (JSVar _ m')) [JSVar _ _]) = m == m' && op == op'

243243 isModFnWithDict _ _ = False

244244

245245-- (f <<< g $ x) = f (g x)

src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs+2−1

@@ -12,6 +12,7 @@ import Data.Maybe (fromJust, isJust)

1212import Language.PureScript.CodeGen.JS.AST

1313import Language.PureScript.CodeGen.JS.Optimizer.Common

1414import Language.PureScript.Options

15+import Language.PureScript.PSString (mkString)

1516import qualified Language.PureScript.Constants as C

1617

1718magicDo :: Options -> JS -> JS

@@ -104,7 +105,7 @@ inlineST = everywhereOnJS convertBlock

104105 -- or in a more aggressive way, turning wrappers into local variables depending on the

105106 -- agg(ressive) parameter.

106107 convert agg (JSApp s1 f [arg]) | isSTFunc C.newSTRef f =

107− JSFunction s1 Nothing [] (JSBlock s1 [JSReturn s1 $ if agg then arg else JSObjectLiteral s1 [(C.stRefValue, arg)]])

108+ JSFunction s1 Nothing [] (JSBlock s1 [JSReturn s1 $ if agg then arg else JSObjectLiteral s1 [(mkString C.stRefValue, arg)]])

108109 convert agg (JSApp _ (JSApp s1 f [ref]) []) | isSTFunc C.readSTRef f =

109110 if agg then ref else JSAccessor s1 C.stRefValue ref

110111 convert agg (JSApp _ (JSApp _ (JSApp s1 f [ref]) [arg]) []) | isSTFunc C.writeSTRef f =

src/Language/PureScript/CoreFn/Desugar.hs+3−2

@@ -24,6 +24,7 @@ import Language.PureScript.Environment

2424import Language.PureScript.Names

2525import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)

2626import Language.PureScript.Types

27+import Language.PureScript.PSString (mkString)

2728import qualified Language.PureScript.AST as A

2829

2930-- |

@@ -119,7 +120,7 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =

119120 in foldl (App (ss, com, Nothing, Nothing)) ctor args

120121 exprToCoreFn ss com ty (A.TypeClassDictionaryAccessor _ ident) =

121122 Abs (ss, com, ty, Nothing) (Ident "dict")

122− (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))

123+ (Accessor nullAnn (mkString $ runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))

123124 exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =

124125 exprToCoreFn (Just ss) (com ++ com1) ty v

125126 exprToCoreFn _ _ _ e =

@@ -265,7 +266,7 @@ mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.De

265266mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])

266267mkTypeClassConstructor ss com supers members =

267268 let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers

268− props = [ (arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]

269+ props = [ (mkString arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]

269270 dict = Literal nullAnn (ObjectLiteral props)

270271 in Abs (ss, com, Nothing, Just IsTypeClassConstructor)

271272 (Ident a)

src/Language/PureScript/CoreFn/Expr.hs+3−3

@@ -6,11 +6,11 @@ module Language.PureScript.CoreFn.Expr where

66import Prelude.Compat

88import Control.Arrow ((***))

9−import Data.Text (Text)

109

1110import Language.PureScript.AST.Literals

1211import Language.PureScript.CoreFn.Binders

1312import Language.PureScript.Names

13+import Language.PureScript.PSString (PSString)

1414

1515-- |

1616-- Data type for expressions and terms

@@ -27,11 +27,11 @@ data Expr a

2727 -- |

2828 -- A record property accessor

2929 --

30− | Accessor a Text (Expr a)

30+ | Accessor a PSString (Expr a)

3131 -- |

3232 -- Partial record update

3333 --

34− | ObjectUpdate a (Expr a) [(Text, Expr a)]

34+ | ObjectUpdate a (Expr a) [(PSString, Expr a)]

3535 -- |

3636 -- Function introduction

3737 --

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

@@ -17,6 +17,7 @@ import qualified Data.Text as T

1717import Language.PureScript.AST.Literals

1818import Language.PureScript.CoreFn

1919import Language.PureScript.Names

20+import Language.PureScript.PSString (PSString)

2021

2122literalToJSON :: (a -> Value) -> Literal a -> Value

2223literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)

@@ -51,8 +52,8 @@ bindToJSON :: Bind a -> Value

5152bindToJSON (NonRec _ n e) = object [ runIdent n .= exprToJSON e ]

5253bindToJSON (Rec bs) = object $ map (\((_, n), e) -> runIdent n .= exprToJSON e) bs

5354

54−recordToJSON :: (a -> Value) -> [(Text, a)] -> Value

55−recordToJSON f = object . map (\(label, a) -> label .= f a)

55+recordToJSON :: (a -> Value) -> [(PSString, a)] -> Value

56+recordToJSON f = toJSON . map (\(key, a) -> (toJSON key, f a))

5657

5758exprToJSON :: Expr a -> Value

5859exprToJSON (Var _ i) = toJSON ( "Var"

src/Language/PureScript/Docs/RenderedCode/Render.hs+7−5

@@ -26,7 +26,9 @@ import Language.PureScript.Environment

2626import Language.PureScript.Kinds

2727import Language.PureScript.Names

2828import Language.PureScript.Pretty.Kinds

29+import Language.PureScript.Pretty.Types

2930import Language.PureScript.Types

31+import Language.PureScript.Label (Label)

3032

3133typeLiterals :: Pattern () Type RenderedCode

3234typeLiterals = mkPattern match

@@ -79,13 +81,13 @@ renderRow = uncurry renderRow' . rowToList

7981 where

8082 renderRow' h t = renderHead h <> renderTail t

8183

82−renderHead :: [(Text, Type)] -> RenderedCode

84+renderHead :: [(Label, Type)] -> RenderedCode

8385renderHead = mintersperse (syntax "," <> sp) . map renderLabel

8486

85−renderLabel :: (Text, Type) -> RenderedCode

87+renderLabel :: (Label, Type) -> RenderedCode

8688renderLabel (label, ty) =

8789 mintersperse sp

88− [ ident label

90+ [ syntax $ prettyPrintLabel label

8991 , syntax "::"

9092 , renderType ty

9193 ]

@@ -125,9 +127,9 @@ explicitParens = mkPattern match

125127 match _ = Nothing

126128

127129matchTypeAtom :: Pattern () Type RenderedCode

128−matchTypeAtom = typeLiterals <+> fmap parens matchType

130+matchTypeAtom = typeLiterals <+> fmap parens_ matchType

129131 where

130− parens x = syntax "(" <> x <> syntax ")"

132+ parens_ x = syntax "(" <> x <> syntax ")"

131133

132134matchType :: Pattern () Type RenderedCode

133135matchType = buildPrettyPrinter operators matchTypeAtom

src/Language/PureScript/Errors.hs+10−10

@@ -32,10 +32,10 @@ import Language.PureScript.Names

3232import Language.PureScript.Pretty

3333import Language.PureScript.Traversals

3434import Language.PureScript.Types

35−import Language.PureScript.Pretty.Common (endWith)

35+import Language.PureScript.Label (Label(..))

36+import Language.PureScript.Pretty.Common (before, endWith)

3637import qualified Language.PureScript.Bundle as Bundle

3738import qualified Language.PureScript.Constants as C

38−import Language.PureScript.Pretty.Common (before)

3939

4040import qualified System.Console.ANSI as ANSI

4141

@@ -264,7 +264,7 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

264264 gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t

265265 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t

266266 gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con

267− gSimple (AmbiguousTypeVariables t con) = AmbiguousTypeVariables <$> (f t) <*> pure con

267+ gSimple (AmbiguousTypeVariables t con) = AmbiguousTypeVariables <$> f t <*> pure con

268268 gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts

269269 gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts

270270 gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts

@@ -565,12 +565,12 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS

565565 sortRows t1 t2 = (t1, t2)

566566

567567 -- Put the common labels last

568− sortRows' :: ([(Text, Type)], Type) -> ([(Text, Type)], Type) -> (Type, Type)

568+ sortRows' :: ([(Label, Type)], Type) -> ([(Label, Type)], Type) -> (Type, Type)

569569 sortRows' (s1, r1) (s2, r2) =

570− let common :: [(Text, (Type, Type))]

570+ let common :: [(Label, (Type, Type))]

571571 common = sortBy (comparing fst) [ (name, (t1, t2)) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

572572

573− sd1, sd2 :: [(Text, Type)]

573+ sd1, sd2 :: [(Label, Type)]

574574 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

575575 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

576576 in ( rowFromList (sortBy (comparing fst) sd1 ++ map (fst &&& fst . snd) common, r1)

@@ -673,7 +673,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS

673673 renderSimpleErrorMessage (CannotFindDerivingType nm) =

674674 line $ "Cannot derive a type class instance, because the type declaration for " <> markCode (runProperName nm) <> " could not be found."

675675 renderSimpleErrorMessage (DuplicateLabel l expr) =

676− paras $ [ line $ "Label " <> markCode l <> " appears more than once in a row type." ]

676+ paras $ [ line $ "Label " <> markCode (prettyPrintLabel l) <> " appears more than once in a row type." ]

677677 <> foldMap (\expr' -> [ line "Relevant expression: "

678678 , markCodeBox $ indent $ prettyPrintValue valueDepth expr'

679679 ]) expr

@@ -706,9 +706,9 @@ prettyPrintSingleError (PPEOptions codeColor full level showDocs) e = flip evalS

706706 , markCodeBox $ indent $ typeAsBox ty

707707 ]

708708 renderSimpleErrorMessage (PropertyIsMissing prop) =

709− line $ "Type of expression lacks required label " <> markCode prop <> "."

709+ line $ "Type of expression lacks required label " <> markCode (prettyPrintLabel prop) <> "."

710710 renderSimpleErrorMessage (AdditionalProperty prop) =

711− line $ "Type of expression contains additional label " <> markCode prop <> "."

711+ line $ "Type of expression contains additional label " <> markCode (prettyPrintLabel prop) <> "."

712712 renderSimpleErrorMessage TypeSynonymInstance =

713713 line "Type class instances for type synonyms are disallowed."

714714 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =

@@ -1265,7 +1265,7 @@ renderBox = unlines

12651265 whiteSpace = all isSpace

12661266

12671267toTypelevelString :: Type -> Maybe Box.Box

1268−toTypelevelString (TypeLevelString s) = Just $ Box.text (T.unpack s)

1268+toTypelevelString (TypeLevelString s) = Just $ Box.text $ T.unpack $ prettyPrintString s

12691269toTypelevelString (TypeApp (TypeConstructor f) x)

12701270 | f == primName "TypeString" = Just $ typeAsBox x

12711271toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)

src/Language/PureScript/Label.hsnew file+16

@@ -0,0 +1,16 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+module Language.PureScript.Label (Label(..)) where

4+import Prelude.Compat hiding (lex)

5+import Data.Monoid ()

6+import Data.String (IsString(..))

7+import qualified Data.Aeson as A

9+import Language.PureScript.PSString (PSString)

10+

11+-- |

12+-- Labels are used as record keys and row entry names. Labels newtype PSString

13+-- because records are indexable by PureScript strings at runtime.

14+--

15+newtype Label = Label { runLabel :: PSString }

16+ deriving (Show, Eq, Ord, IsString, Monoid, A.ToJSON, A.FromJSON)

src/Language/PureScript/PSString.hsnew file+173

@@ -0,0 +1,173 @@

1+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+module Language.PureScript.PSString

4+ ( PSString

5+ , toUTF16CodeUnits

6+ , decodeString

7+ , decodeStringEither

8+ , prettyPrintString

9+ , prettyPrintStringJS

10+ , mkString

11+ ) where

12+

13+import Prelude.Compat

14+import Control.Exception (try, evaluate)

15+import Data.Char (chr)

16+import Data.Bits (shiftR)

17+import Data.List (unfoldr)

18+import Data.Monoid ((<>))

19+import Data.Scientific (toBoundedInteger)

20+import Data.String (IsString(..))

21+import Data.ByteString (ByteString)

22+import qualified Data.ByteString as BS

23+import Data.Text (Text)

24+import qualified Data.Text as T

25+import Data.Text.Encoding (decodeUtf16BE)

26+import Data.Text.Encoding.Error (UnicodeException)

27+import qualified Data.Vector as V

28+import Data.Word (Word16, Word8)

29+import Numeric (showHex)

30+import System.IO.Unsafe (unsafePerformIO)

31+import qualified Data.Aeson as A

32+import qualified Data.Aeson.Types as A

33+

34+-- |

35+-- Strings in PureScript are sequences of UTF-16 code units, which do not

36+-- necessarily represent UTF-16 encoded text. For example, it is permissible

37+-- for a string to contain *lone surrogates,* i.e. characters in the range

38+-- U+D800 to U+DFFF which do not appear as a part of a surrogate pair.

39+--

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

43+newtype PSString = PSString { toUTF16CodeUnits :: [Word16] }

44+ deriving (Eq, Ord, Monoid)

45+

46+instance Show PSString where

47+ show = show . codePoints

48+

49+-- Decode a PSString to a String, representing any lone surrogates as the

50+-- reserved code point with that index. Warning: if there are any lone

51+-- surrogates, converting the result to Text via Data.Text.pack will result in

52+-- loss of information as those lone surrogates will be replaced with U+FFFD

53+-- REPLACEMENT CHARACTER. Because this function requires care to use correctly,

54+-- we do not export it.

55+codePoints :: PSString -> String

56+codePoints = map (either (chr . fromIntegral) id) . decodeStringEither

57+

58+-- |

59+-- Decode a PSString as UTF-16. Lone surrogates in the input are represented in

60+-- the output with the Left constructor; characters which were successfully

61+-- decoded are represented with the Right constructor.

62+--

63+decodeStringEither :: PSString -> [Either Word16 Char]

64+decodeStringEither = unfoldr decode . toUTF16CodeUnits

65+ where

66+ decode :: [Word16] -> Maybe (Either Word16 Char, [Word16])

67+ decode (h:l:rest) | isLead h && isTrail l = Just (Right (unsurrogate h l), rest)

68+ decode (c:rest) | isSurrogate c = Just (Left c, rest)

69+ decode (c:rest) = Just (Right (toChar c), rest)

70+ decode [] = Nothing

71+

72+ unsurrogate :: Word16 -> Word16 -> Char

73+ unsurrogate h l = toEnum ((toInt h - 0xD800) * 0x400 + (toInt l - 0xDC00) + 0x10000)

74+

75+-- |

76+-- Pretty print a PSString, using Haskell/PureScript escape sequences.

77+-- This is identical to the Show instance except that we get a Text out instead

78+-- of a String.

79+--

80+prettyPrintString :: PSString -> Text

81+prettyPrintString = T.pack . show

82+

83+-- |

84+-- Attempt to decode a PSString as UTF-16 text. This will fail (returning

85+-- Nothing) if the argument contains lone surrogates.

86+--

87+decodeString :: PSString -> Maybe Text

88+decodeString = hush . decodeEither . BS.pack . concatMap unpair . toUTF16CodeUnits

89+ where

90+ unpair w = [highByte w, lowByte w]

91+

92+ lowByte :: Word16 -> Word8

93+ lowByte = fromIntegral

94+

95+ highByte :: Word16 -> Word8

96+ highByte = fromIntegral . (`shiftR` 8)

97+

98+ -- Based on a similar function from Data.Text.Encoding for utf8. This is a

99+ -- safe usage of unsafePerformIO because there are no side effects after

100+ -- handling any thrown UnicodeExceptions.

101+ decodeEither :: ByteString -> Either UnicodeException Text

102+ decodeEither = unsafePerformIO . try . evaluate . decodeUtf16BE

103+

104+ hush = either (const Nothing) Just

105+

106+instance IsString PSString where

107+ fromString a = PSString $ concatMap encodeUTF16 a

108+ where

109+ surrogates :: Char -> (Word16, Word16)

110+ surrogates c = (toWord (h + 0xD800), toWord (l + 0xDC00))

111+ where (h, l) = divMod (fromEnum c - 0x10000) 0x400

112+

113+ encodeUTF16 :: Char -> [Word16]

114+ encodeUTF16 c | fromEnum c > 0xFFFF = [high, low]

115+ where (high, low) = surrogates c

116+ encodeUTF16 c = [toWord $ fromEnum c]

117+

118+instance A.ToJSON PSString where

119+ toJSON = A.toJSON . toUTF16CodeUnits

120+

121+instance A.FromJSON PSString where

122+ parseJSON a = PSString <$> parseArrayOfCodeUnits a

123+ where

124+ parseArrayOfCodeUnits :: A.Value -> A.Parser [Word16]

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

126+ parseCodeUnit :: A.Value -> A.Parser Word16

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

128+

129+-- |

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

131+-- use in compiled JS output.

132+--

133+prettyPrintStringJS :: PSString -> Text

134+prettyPrintStringJS s = "\"" <> foldMap encodeChar (toUTF16CodeUnits s) <> "\""

135+ where

136+ encodeChar :: Word16 -> Text

137+ encodeChar c | c > 0xFF = "\\u" <> hex 4 c

138+ encodeChar c | c > 0x7E || c < 0x20 = "\\x" <> hex 2 c

139+ encodeChar c | toChar c == '\b' = "\\b"

140+ encodeChar c | toChar c == '\t' = "\\t"

141+ encodeChar c | toChar c == '\n' = "\\n"

142+ encodeChar c | toChar c == '\v' = "\\v"

143+ encodeChar c | toChar c == '\f' = "\\f"

144+ encodeChar c | toChar c == '\r' = "\\r"

145+ encodeChar c | toChar c == '"' = "\\\""

146+ encodeChar c | toChar c == '\\' = "\\\\"

147+ encodeChar c = T.singleton $ toChar c

148+

149+ hex :: (Enum a) => Int -> a -> Text

150+ hex width c =

151+ let hs = showHex (fromEnum c) "" in

152+ T.pack (replicate (width - length hs) '0' <> hs)

153+

154+isLead :: Word16 -> Bool

155+isLead h = h >= 0xD800 && h <= 0xDBFF

156+

157+isTrail :: Word16 -> Bool

158+isTrail l = l >= 0xDC00 && l <= 0xDFFF

159+

160+isSurrogate :: Word16 -> Bool

161+isSurrogate c = isLead c || isTrail c

162+

163+toChar :: Word16 -> Char

164+toChar = toEnum . fromIntegral

165+

166+toWord :: Int -> Word16

167+toWord = fromIntegral

168+

169+toInt :: Word16 -> Int

170+toInt = fromIntegral

171+

172+mkString :: Text -> PSString

173+mkString = fromString . T.unpack

src/Language/PureScript/Parser/Common.hs+7

@@ -16,6 +16,7 @@ import Language.PureScript.Comments

1616import Language.PureScript.Names

1717import Language.PureScript.Parser.Lexer

1818import Language.PureScript.Parser.State

19+import Language.PureScript.PSString (PSString, mkString)

1920

2021import qualified Text.Parsec as P

2122

@@ -72,6 +73,12 @@ parseQualified parser = part []

7273parseIdent :: TokenParser Ident

7374parseIdent = Ident <$> identifier

7475

76+-- |

77+-- Parse a label, which may look like an identifier or a string

78+--

79+parseLabel :: TokenParser PSString

80+parseLabel = (mkString <$> lname) <|> stringLiteral

81+

7582-- |

7683-- Parse an operator.

7784--

src/Language/PureScript/Parser/Declarations.hs+9−8

@@ -33,6 +33,7 @@ import Language.PureScript.Errors

3333import Language.PureScript.Kinds

3434import Language.PureScript.Names

3535import Language.PureScript.Types

36+import Language.PureScript.PSString (PSString, mkString)

3637import Language.PureScript.Parser.Common

3738import Language.PureScript.Parser.Kinds

3839import Language.PureScript.Parser.Lexer

@@ -338,15 +339,15 @@ parseBooleanLiteral = BooleanLiteral <$> booleanLiteral

338339parseArrayLiteral :: TokenParser a -> TokenParser (Literal a)

339340parseArrayLiteral p = ArrayLiteral <$> squares (commaSep p)

340341

341−parseObjectLiteral :: TokenParser (Text, a) -> TokenParser (Literal a)

342+parseObjectLiteral :: TokenParser (PSString, a) -> TokenParser (Literal a)

342343parseObjectLiteral p = ObjectLiteral <$> braces (commaSep p)

343344

344−parseIdentifierAndValue :: TokenParser (Text, Expr)

345+parseIdentifierAndValue :: TokenParser (PSString, Expr)

345346parseIdentifierAndValue =

346347 do

347348 name <- C.indented *> lname

348349 b <- P.option (Var $ Qualified Nothing (Ident name)) rest

349− return (name, b)

350+ return (mkString name, b)

350351 <|> (,) <$> (C.indented *> stringLiteral) <*> rest

351352 where

352353 rest = C.indented *> colon *> C.indented *> parseValue

@@ -428,16 +429,16 @@ parseInfixExpr

428429parseHole :: TokenParser Expr

429430parseHole = Hole <$> holeLit

430431

431−parsePropertyUpdate :: TokenParser (Text, Expr)

432+parsePropertyUpdate :: TokenParser (PSString, Expr)

432433parsePropertyUpdate = do

433− name <- lname <|> stringLiteral

434+ name <- parseLabel

434435 _ <- C.indented *> equals

435436 value <- C.indented *> parseValue

436437 return (name, value)

437438

438439parseAccessor :: Expr -> TokenParser Expr

439440parseAccessor (Constructor _) = P.unexpected "constructor"

440−parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> (lname <|> stringLiteral)) <*> pure obj

441+parseAccessor obj = P.try $ Accessor <$> (C.indented *> dot *> C.indented *> parseLabel) <*> pure obj

441442

442443parseDo :: TokenParser Expr

443444parseDo = do

@@ -520,11 +521,11 @@ parseVarOrNamedBinder = do

520521parseNullBinder :: TokenParser Binder

521522parseNullBinder = underscore *> return NullBinder

522523

523−parseIdentifierAndBinder :: TokenParser (Text, Binder)

524+parseIdentifierAndBinder :: TokenParser (PSString, Binder)

524525parseIdentifierAndBinder =

525526 do name <- lname

526527 b <- P.option (VarBinder (Ident name)) rest

527− return (name, b)

528+ return (mkString name, b)

528529 <|> (,) <$> stringLiteral <*> rest

529530 where

530531 rest = C.indented *> colon *> C.indented *> parseBinder

src/Language/PureScript/Parser/Lexer.hs+7−17

@@ -70,11 +70,13 @@ import Control.Monad (void, guard)

7070import Control.Monad.Identity (Identity)

7171import Data.Char (isSpace, isAscii, isSymbol, isAlphaNum)

7272import Data.Monoid ((<>))

73+import Data.String (fromString)

7374import Data.Text (Text)

7475import qualified Data.Text as T

7576

7677import Language.PureScript.Comments

7778import Language.PureScript.Parser.State

79+import Language.PureScript.PSString (PSString)

7880

7981import qualified Text.Parsec as P

8082import qualified Text.Parsec.Token as PT

@@ -106,7 +108,7 @@ data Token

106108 | Qualifier Text

107109 | Symbol Text

108110 | CharLiteral Char

109− | StringLiteral Text

111+ | StringLiteral PSString

110112 | Number (Either Integer Double)

111113 | HoleLit Text

112114 deriving (Show, Eq, Ord)

@@ -249,18 +251,6 @@ parseToken = P.choice

249251 symbolChar :: Lexer u Char

250252 symbolChar = P.satisfy isSymbolChar

251253

252− surrogates :: Char -> (Char, Char)

253− surrogates c = (high, low)

254− where

255− (h, l) = divMod (fromEnum c - 0x10000) 0x400

256− high = toEnum (h + 0xD800)

257− low = toEnum (l + 0xDC00)

258−

259− expandAstralCodePointToUTF16Surrogates :: Char -> [Char]

260− expandAstralCodePointToUTF16Surrogates c | fromEnum c > 0xFFFF = [high, low]

261− where (high, low) = surrogates c

262− expandAstralCodePointToUTF16Surrogates c = [c]

263−

264254 parseCharLiteral :: Lexer u Char

265255 parseCharLiteral = P.try $ do {

266256 c <- PT.charLiteral tokenParser;

@@ -269,11 +259,11 @@ parseToken = P.choice

269259 else return c

270260 }

271261

272− parseStringLiteral :: Lexer u Text

273− parseStringLiteral = blockString <|> T.pack <$> concatMap expandAstralCodePointToUTF16Surrogates <$> PT.stringLiteral tokenParser

262+ parseStringLiteral :: Lexer u PSString

263+ parseStringLiteral = fromString <$> (blockString <|> PT.stringLiteral tokenParser)

274264 where

275265 delimiter = P.try (P.string "\"\"\"")

276− blockString = delimiter *> (T.pack <$> P.manyTill P.anyChar delimiter)

266+ blockString = delimiter *> P.manyTill P.anyChar delimiter

277267

278268 parseNumber :: Lexer u (Either Integer Double)

279269 parseNumber = (consumeLeadingZero *> P.parserZero) <|>

@@ -516,7 +506,7 @@ charLiteral = token go P.<?> "char literal"

516506 go (CharLiteral c) = Just c

517507 go _ = Nothing

518508

519−stringLiteral :: TokenParser Text

509+stringLiteral :: TokenParser PSString

520510stringLiteral = token go P.<?> "string literal"

521511 where

522512 go (StringLiteral s) = Just s

src/Language/PureScript/Parser/Types.hs+3−3

@@ -9,7 +9,6 @@ import Prelude.Compat

1010import Control.Monad (when, unless)

1111import Control.Applicative ((<|>))

12−import Data.Text (Text)

1312import qualified Data.Text as T

1413

1514import Language.PureScript.AST.SourcePos

@@ -18,6 +17,7 @@ import Language.PureScript.Parser.Common

1817import Language.PureScript.Parser.Kinds

1918import Language.PureScript.Parser.Lexer

2019import Language.PureScript.Types

20+import Language.PureScript.Label (Label(..))

2121

2222import qualified Text.Parsec as P

2323import qualified Text.Parsec.Expr as P

@@ -118,8 +118,8 @@ noWildcards p = do

118118 when (containsWildcards ty) $ P.unexpected "type wildcard"

119119 return ty

120120

121−parseNameAndType :: TokenParser t -> TokenParser (Text, t)

122−parseNameAndType p = (,) <$> (indented *> (lname <|> stringLiteral) <* indented <* doubleColon) <*> p

121+parseNameAndType :: TokenParser t -> TokenParser (Label, t)

122+parseNameAndType p = (,) <$> (indented *> (Label <$> parseLabel) <* indented <* doubleColon) <*> p

123123

124124parseRowEnding :: TokenParser Type

125125parseRowEnding = P.option REmpty $ indented *> pipe *> indented *> parseType

src/Language/PureScript/Pretty.hs+1

@@ -15,3 +15,4 @@ import Language.PureScript.Pretty.JS as P

1515import Language.PureScript.Pretty.Kinds as P

1616import Language.PureScript.Pretty.Types as P

1717import Language.PureScript.Pretty.Values as P

18+import Language.PureScript.PSString as P (prettyPrintString)

src/Language/PureScript/Pretty/Common.hs+4−8

@@ -15,7 +15,7 @@ import Data.Text (Text)

1515import qualified Data.Text as T

1616

1717import Language.PureScript.AST (SourcePos(..), SourceSpan(..))

18−import Language.PureScript.Parser.Lexer (reservedPsNames, isUnquotedKey)

18+import Language.PureScript.Parser.Lexer (isUnquotedKey, reservedPsNames)

1919

2020import Text.PrettyPrint.Boxes hiding ((<>))

2121import qualified Text.PrettyPrint.Boxes as Box

@@ -146,13 +146,9 @@ prettyPrintMany f xs = do

146146 indentString <- currentIndent

147147 return $ intercalate (emit "\n") $ map (mappend indentString) ss

148148

149−-- |

150−-- Prints an object key, escaping reserved names.

151−--

152−prettyPrintObjectKey :: Text -> Text

153−prettyPrintObjectKey s | s `elem` reservedPsNames = T.pack (show s)

154− | isUnquotedKey s = s

155− | otherwise = T.pack (show s)

149+objectKeyRequiresQuoting :: Text -> Bool

150+objectKeyRequiresQuoting s =

151+ s `elem` reservedPsNames || isUnquotedKey s

156152

157153-- | Place a box before another, vertically when the first box takes up multiple lines.

158154before :: Box -> Box -> Box

src/Language/PureScript/Pretty/JS.hs+10−30

@@ -25,8 +25,7 @@ import Language.PureScript.CodeGen.JS.Common

2525import Language.PureScript.Comments

2626import Language.PureScript.Crash

2727import Language.PureScript.Pretty.Common

28−

29−import Numeric

28+import Language.PureScript.PSString (PSString, decodeString, prettyPrintStringJS)

3029

3130-- TODO (Christoph): Get rid of T.unpack / pack

3231

@@ -38,7 +37,7 @@ literals = mkPattern' match'

3837

3938 match :: (Emit gen) => JS -> StateT PrinterState Maybe gen

4039 match (JSNumericLiteral _ n) = return $ emit $ T.pack $ either show show n

41− match (JSStringLiteral _ s) = return $ string s

40+ match (JSStringLiteral _ s) = return $ emit $ prettyPrintStringJS s

4241 match (JSBooleanLiteral _ True) = return $ emit "true"

4342 match (JSBooleanLiteral _ False) = return $ emit "false"

4443 match (JSArrayLiteral _ xs) = mconcat <$> sequence

@@ -58,9 +57,13 @@ literals = mkPattern' match'

5857 , return $ emit "}"

5958 ]

6059 where

61− objectPropertyToString :: (Emit gen) => Text -> gen

62− objectPropertyToString s | identNeedsEscaping s = string s

63− | otherwise = emit s

60+ objectPropertyToString :: (Emit gen) => PSString -> gen

61+ objectPropertyToString s =

62+ emit $ case decodeString s of

63+ Just s' | not (identNeedsEscaping s') ->

64+ s'

65+ _ ->

66+ prettyPrintStringJS s

6467 match (JSBlock _ sts) = mconcat <$> sequence

6568 [ return $ emit "{\n"

6669 , withIndent $ prettyStatements sts

@@ -150,29 +153,6 @@ literals = mkPattern' match'

150153 match (JSRaw _ js) = return $ emit js

151154 match _ = mzero

152155

153−string :: (Emit gen) => Text -> gen

154−string s = emit $ "\"" <> T.concatMap encodeChar s <> "\""

155− where

156− encodeChar :: Char -> Text

157− encodeChar '\b' = "\\b"

158− encodeChar '\t' = "\\t"

159− encodeChar '\n' = "\\n"

160− encodeChar '\v' = "\\v"

161− encodeChar '\f' = "\\f"

162− encodeChar '\r' = "\\r"

163− encodeChar '"' = "\\\""

164− encodeChar '\\' = "\\\\"

165− -- PureScript strings are sequences of UTF-16 code units, so this case should never be hit.

166− -- If it is somehow hit, though, output the designated Unicode replacement character U+FFFD.

167− encodeChar c | fromEnum c > 0xFFFF = "\\uFFFD"

168− encodeChar c | fromEnum c > 0xFFF = "\\u" <> showHex' (fromEnum c) ""

169− encodeChar c | fromEnum c > 0xFF = "\\u0" <> showHex' (fromEnum c) ""

170− encodeChar c | fromEnum c < 0x10 = "\\x0" <> showHex' (fromEnum c) ""

171− encodeChar c | fromEnum c > 0x7E || fromEnum c < 0x20 = "\\x" <> showHex' (fromEnum c) ""

172− encodeChar c = T.singleton c

173−

174− showHex' a b = T.pack (showHex a b)

175−

176156conditional :: Pattern PrinterState JS ((Maybe SourceSpan, JS, JS), JS)

177157conditional = mkPattern match

178158 where

@@ -182,6 +162,7 @@ conditional = mkPattern match

182162accessor :: (Emit gen) => Pattern PrinterState JS (gen, JS)

183163accessor = mkPattern match

184164 where

165+ -- WARN: if `prop` does not match the `IdentifierName` grammar, this will generate invalid code; see #2513

185166 match (JSAccessor _ prop val) = Just (emit prop, val)

186167 match _ = Nothing

187168

@@ -189,7 +170,6 @@ indexer :: (Emit gen) => Pattern PrinterState JS (gen, JS)

189170indexer = mkPattern' match

190171 where

191172 match (JSIndexer _ index val) = (,) <$> prettyPrintJS' index <*> pure val

192−

193173 match _ = mzero

194174

195175lam :: Pattern PrinterState JS ((Maybe Text, [Text], Maybe SourceSpan), JS)

src/Language/PureScript/Pretty/Types.hs+22−6

@@ -10,6 +10,8 @@ module Language.PureScript.Pretty.Types

1010 , prettyPrintTypeAtom

1111 , prettyPrintRowWith

1212 , prettyPrintRow

13+ , prettyPrintLabel

14+ , prettyPrintObjectKey

1315 ) where

1416

1517import Prelude.Compat

@@ -18,6 +20,7 @@ import Control.Arrow ((<+>))

1820import Control.PatternArrows as PA

1921

2022import Data.Maybe (fromMaybe)

23+import Data.Text (Text)

2124import qualified Data.Text as T

2225

2326import Language.PureScript.Crash

@@ -27,6 +30,8 @@ import Language.PureScript.Names

2730import Language.PureScript.Pretty.Common

2831import Language.PureScript.Pretty.Kinds

2932import Language.PureScript.Types

33+import Language.PureScript.PSString (PSString, prettyPrintString, decodeString)

34+import Language.PureScript.Label (Label(..))

3035

3136import Text.PrettyPrint.Boxes hiding ((<+>))

3237

@@ -45,22 +50,22 @@ constraintAsBox (Constraint pn tys _) = typeAsBox (foldl TypeApp (TypeConstructo

4550prettyPrintRowWith :: Char -> Char -> Type -> Box

4651prettyPrintRowWith open close = uncurry listToBox . toList []

4752 where

48− nameAndTypeToPs :: Char -> String -> Type -> Box

49− nameAndTypeToPs start name ty = text (start : ' ' : T.unpack (prettyPrintObjectKey (T.pack name)) ++ " :: ") <> typeAsBox ty

53+ nameAndTypeToPs :: Char -> Label -> Type -> Box

54+ nameAndTypeToPs start name ty = text (start : ' ' : T.unpack (prettyPrintLabel name) ++ " :: ") <> typeAsBox ty

5055

5156 tailToPs :: Type -> Box

5257 tailToPs REmpty = nullBox

5358 tailToPs other = text "| " <> typeAsBox other

5459

55− listToBox :: [(String, Type)] -> Type -> Box

60+ listToBox :: [(Label, Type)] -> Type -> Box

5661 listToBox [] REmpty = text [open, close]

5762 listToBox [] rest = text [ open, ' ' ] <> tailToPs rest <> text [ ' ', close ]

5863 listToBox ts rest = vcat left $

5964 zipWith (\(nm, ty) i -> nameAndTypeToPs (if i == 0 then open else ',') nm ty) ts [0 :: Int ..] ++

6065 [ tailToPs rest, text [close] ]

6166

62− toList :: [(String, Type)] -> Type -> ([(String, Type)], Type)

63− toList tys (RCons name ty row) = toList ((T.unpack name, ty):tys) row

67+ toList :: [(Label, Type)] -> Type -> ([(Label, Type)], Type)

68+ toList tys (RCons name ty row) = toList ((name, ty):tys) row

6469 toList tys r = (reverse tys, r)

6570

6671prettyPrintRow :: Type -> String

@@ -116,7 +121,7 @@ matchTypeAtom suggesting =

116121 typeLiterals = mkPattern match where

117122 match TypeWildcard{} = Just $ text "_"

118123 match (TypeVar var) = Just $ text $ T.unpack var

119− match (TypeLevelString s) = Just . text $ show s

124+ match (TypeLevelString s) = Just $ text $ T.unpack $ prettyPrintString s

120125 match (PrettyPrintObject row) = Just $ prettyPrintRowWith '{' '}' row

121126 match (TypeConstructor ctor) = Just $ text $ T.unpack $ runProperName $ disqualify ctor

122127 match (TUnknown u)

@@ -186,3 +191,14 @@ prettyPrintType = render . typeAsBoxImpl False

186191-- | Generate a pretty-printed string representing a suggested 'Type'

187192prettyPrintSuggestedType :: Type -> String

188193prettyPrintSuggestedType = render . typeAsBoxImpl True

194+

195+prettyPrintLabel :: Label -> Text

196+prettyPrintLabel (Label s) =

197+ case decodeString s of

198+ Just s' | not (objectKeyRequiresQuoting s') ->

199+ s'

200+ _ ->

201+ prettyPrintString s

202+

203+prettyPrintObjectKey :: PSString -> Text

204+prettyPrintObjectKey = prettyPrintLabel . Label

src/Language/PureScript/Pretty/Values.hs+8−7

@@ -20,8 +20,9 @@ import Language.PureScript.AST

2020import Language.PureScript.Crash

2121import Language.PureScript.Names

2222import Language.PureScript.Pretty.Common

23−import Language.PureScript.Pretty.Types (typeAsBox, typeAtomAsBox)

23+import Language.PureScript.Pretty.Types (typeAsBox, typeAtomAsBox, prettyPrintObjectKey)

2424import Language.PureScript.Types (Constraint(..))

25+import Language.PureScript.PSString (PSString, prettyPrintString)

2526

2627import Text.PrettyPrint.Boxes

2728

@@ -40,10 +41,10 @@ list open close f xs = vcat left (zipWith toLine [0 :: Int ..] xs ++ [ text [ cl

4041ellipsis :: Box

4142ellipsis = text "..."

4243

43−prettyPrintObject :: Int -> [(Text, Maybe Expr)] -> Box

44+prettyPrintObject :: Int -> [(PSString, Maybe Expr)] -> Box

4445prettyPrintObject d = list '{' '}' prettyPrintObjectProperty

4546 where

46− prettyPrintObjectProperty :: (Text, Maybe Expr) -> Box

47+ prettyPrintObjectProperty :: (PSString, Maybe Expr) -> Box

4748 prettyPrintObjectProperty (key, value) = textT (prettyPrintObjectKey key Monoid.<> ": ") <> maybe (text "_") (prettyPrintValue (d - 1)) value

4849

4950-- | Pretty-print an expression

@@ -55,7 +56,7 @@ prettyPrintValue d (IfThenElse cond th el) =

5556 , text "else " <> prettyPrintValueAtom (d - 1) el

5657 ])

5758prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val `before` textT ("." Monoid.<> prettyPrintObjectKey prop)

58−prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o `beforeWithSpace` list '{' '}' (\(key, val) -> textT (key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps

59+prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o `beforeWithSpace` list '{' '}' (\(key, val) -> textT (prettyPrintObjectKey key Monoid.<> " = ") <> prettyPrintValue (d - 1) val) ps

5960prettyPrintValue d (App val arg) = prettyPrintValueAtom (d - 1) val `beforeWithSpace` prettyPrintValueAtom (d - 1) arg

6061prettyPrintValue d (Abs (Left arg) val) = text ('\\' : T.unpack (showIdent arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)

6162prettyPrintValue d (Abs (Right arg) val) = text ('\\' : T.unpack (prettyPrintBinder arg) ++ " -> ") // moveRight 2 (prettyPrintValue (d - 1) val)

@@ -105,7 +106,7 @@ prettyPrintValueAtom d expr = (text "(" <> prettyPrintValue d expr) `before` tex

105106

106107prettyPrintLiteralValue :: Int -> Literal Expr -> Box

107108prettyPrintLiteralValue _ (NumericLiteral n) = text $ either show show n

108−prettyPrintLiteralValue _ (StringLiteral s) = text $ show s

109+prettyPrintLiteralValue _ (StringLiteral s) = text $ T.unpack $ prettyPrintString s

109110prettyPrintLiteralValue _ (CharLiteral c) = text $ show c

110111prettyPrintLiteralValue _ (BooleanLiteral True) = text "true"

111112prettyPrintLiteralValue _ (BooleanLiteral False) = text "false"

@@ -169,7 +170,7 @@ prettyPrintBinderAtom (BinaryNoParensBinder op b1 b2) =

169170prettyPrintBinderAtom (ParensInBinder b) = parensT (prettyPrintBinder b)

170171

171172prettyPrintLiteralBinder :: Literal Binder -> Text

172−prettyPrintLiteralBinder (StringLiteral str) = T.pack (show str)

173+prettyPrintLiteralBinder (StringLiteral str) = prettyPrintString str

173174prettyPrintLiteralBinder (CharLiteral c) = T.pack (show c)

174175prettyPrintLiteralBinder (NumericLiteral num) = either (T.pack . show) (T.pack . show) num

175176prettyPrintLiteralBinder (BooleanLiteral True) = "true"

@@ -179,7 +180,7 @@ prettyPrintLiteralBinder (ObjectLiteral bs) =

179180 Monoid.<> T.intercalate ", " (map prettyPrintObjectPropertyBinder bs)

180181 Monoid.<> " }"

181182 where

182− prettyPrintObjectPropertyBinder :: (Text, Binder) -> Text

183+ prettyPrintObjectPropertyBinder :: (PSString, Binder) -> Text

183184 prettyPrintObjectPropertyBinder (key, binder) = prettyPrintObjectKey key Monoid.<> ": " Monoid.<> prettyPrintBinder binder

184185prettyPrintLiteralBinder (ArrayLiteral bs) =

185186 "[ "

src/Language/PureScript/Sugar/ObjectWildcards.hs+4−4

@@ -11,11 +11,11 @@ import Control.Monad.Supply.Class

1111

1212import Data.List (partition)

1313import Data.Maybe (catMaybes)

14−import Data.Text (Text)

1514

1615import Language.PureScript.AST

1716import Language.PureScript.Errors

1817import Language.PureScript.Names

18+import Language.PureScript.PSString (PSString)

1919

2020desugarObjectConstructors

2121 :: forall m

@@ -62,7 +62,7 @@ desugarDecl other = fn other

6262 return $ foldr (Abs . Left) if_ (catMaybes [u', t', f'])

6363 desugarExpr e = return e

6464

65− wrapLambda :: ([(Text, Expr)] -> Expr) -> [(Text, Expr)] -> m Expr

65+ wrapLambda :: ([(PSString, Expr)] -> Expr) -> [(PSString, Expr)] -> m Expr

6666 wrapLambda mkVal ps =

6767 let (args, props) = partition (isAnonymousArgument . snd) ps

6868 in if null args

@@ -75,7 +75,7 @@ desugarDecl other = fn other

7575 stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e

7676 stripPositionInfo e = e

7777

78− peelAnonAccessorChain :: Expr -> Maybe [Text]

78+ peelAnonAccessorChain :: Expr -> Maybe [PSString]

7979 peelAnonAccessorChain (Accessor p e) = (p :) <$> peelAnonAccessorChain e

8080 peelAnonAccessorChain (PositionedValue _ _ e) = peelAnonAccessorChain e

8181 peelAnonAccessorChain AnonymousArgument = Just []

@@ -86,7 +86,7 @@ desugarDecl other = fn other

8686 isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e

8787 isAnonymousArgument _ = False

8888

89− mkProp :: (Text, Expr) -> m (Maybe Ident, (Text, Expr))

89+ mkProp :: (PSString, Expr) -> m (Maybe Ident, (PSString, Expr))

9090 mkProp (name, e) = do

9191 arg <- freshIfAnon e

9292 return (arg, (name, maybe e argToExpr arg))

src/Language/PureScript/Sugar/TypeClasses.hs+4−2

@@ -19,6 +19,8 @@ import Language.PureScript.Externs

1919import Language.PureScript.Sugar.CaseDeclarations

2020import Control.Monad.Supply.Class

2121import Language.PureScript.Types

22+import Language.PureScript.Label (Label(..))

23+import Language.PureScript.PSString (mkString)

2224

2325import qualified Language.PureScript.Constants as C

2426

@@ -240,7 +242,7 @@ typeClassDictionaryDeclaration name args implies members =

240242 ]

241243 members' = map (first runIdent . memberToNameAndType) members

242244 mtys = members' ++ superclassTypes

243− in TypeSynonymDeclaration (coerceProperName name) args (TypeApp tyRecord $ rowFromList (mtys, REmpty))

245+ in TypeSynonymDeclaration (coerceProperName name) args (TypeApp tyRecord $ rowFromList (map (first (Label . mkString)) mtys, REmpty))

244246

245247typeClassMemberToDictionaryAccessor

246248 :: ModuleName

@@ -297,7 +299,7 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

297299 , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs

298300 ]

299301

300− let props = Literal $ ObjectLiteral (members ++ superclasses)

302+ let props = Literal $ ObjectLiteral $ map (first mkString) (members ++ superclasses)

301303 dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys

302304 constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)

303305 dict = TypeClassDictionaryConstructorApp className props

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+39−24

@@ -11,9 +11,11 @@ import Control.Monad.Error.Class (MonadError(..))

1111import Control.Monad.Supply.Class (MonadSupply)

1212import Data.List (foldl', find, sortBy, unzip5)

1313import qualified Data.Map as M

14+import Data.Monoid ((<>))

1415import Data.Maybe (fromMaybe, mapMaybe)

1516import Data.Ord (comparing)

1617import Data.Text (Text)

18+import qualified Data.Text as T

1719import Language.PureScript.AST

1820import qualified Language.PureScript.Constants as C

1921import Language.PureScript.Crash

@@ -22,6 +24,8 @@ import Language.PureScript.Errors

2224import Language.PureScript.Externs

2325import Language.PureScript.Kinds

2426import Language.PureScript.Names

27+import Language.PureScript.Label (Label(..))

28+import Language.PureScript.PSString (mkString, decodeStringEither)

2529import Language.PureScript.Types

2630import Language.PureScript.TypeChecker (checkNewtype)

2731import Language.PureScript.TypeChecker.Synonyms (SynonymMap, replaceAllTypeSynonymsM)

@@ -207,7 +211,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

207211 idents <- replicateM (length tys) freshIdent'

208212 tys' <- mapM (replaceAllTypeSynonymsM syns) tys

209213 let caseResult =

210− App (prodConstructor (Literal . StringLiteral . showQualified runProperName $ Qualified (Just mn) ctorName))

214+ App (prodConstructor (Literal . StringLiteral . mkString . showQualified runProperName $ Qualified (Just mn) ctorName))

211215 . Literal . ArrayLiteral

212216 $ zipWith toSpineFun (map (Var . Qualified Nothing) idents) tys'

213217 return $ CaseAlternative [ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)] (Right caseResult)

@@ -216,7 +220,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

216220 toSpineFun i r | Just rec <- objectType r =

217221 lamNull . recordConstructor . Literal . ArrayLiteral

218222 . map

219− (\(str,typ) ->

223+ (\((Label str),typ) ->

220224 Literal $ ObjectLiteral

221225 [ ("recLabel", Literal (StringLiteral str))

222226 , ("recValue", toSpineFun (Accessor str i) typ)

@@ -235,7 +239,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

235239 App

236240 (App

237241 (Constructor (Qualified (Just dataGeneric) (ProperName "SigProd")))

238− (Literal (StringLiteral (showQualified runProperName (Qualified (Just mn) name))))

242+ (Literal (StringLiteral $ mkString (showQualified runProperName (Qualified (Just mn) name))))

239243 )

240244 . Literal

241245 . ArrayLiteral

@@ -249,7 +253,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

249253 mkProdClause :: (ProperName 'ConstructorName, [Type]) -> Expr

250254 mkProdClause (ctorName, tys) =

251255 Literal $ ObjectLiteral

252− [ ("sigConstructor", Literal (StringLiteral (showQualified runProperName (Qualified (Just mn) ctorName))))

256+ [ ("sigConstructor", Literal (StringLiteral $ mkString (showQualified runProperName (Qualified (Just mn) ctorName))))

253257 , ("sigValues", Literal . ArrayLiteral . map (mkProductSignature . instantiate) $ tys)

254258 ]

255259

@@ -260,7 +264,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

260264 [ ("recLabel", Literal (StringLiteral str))

261265 , ("recValue", mkProductSignature typ)

262266 ]

263− | (str, typ) <- decomposeRec rec

267+ | ((Label str), typ) <- decomposeRec rec

264268 ]

265269 mkProductSignature typ = lamNull $ App (mkGenVar (Ident C.toSignature))

266270 (TypedValue False (mkGenVar (Ident "anyProxy")) (proxy typ))

@@ -291,7 +295,7 @@ deriveGeneric mn syns ds tyConNm dargs = do

291295 return $

292296 CaseAlternative

293297 [ prodBinder

294− [ LiteralBinder (StringLiteral (showQualified runProperName (Qualified (Just mn) ctorName)))

298+ [ LiteralBinder (StringLiteral $ mkString (showQualified runProperName (Qualified (Just mn) ctorName)))

295299 , LiteralBinder (ArrayLiteral (map VarBinder idents))

296300 ]

297301 ]

@@ -314,16 +318,16 @@ deriveGeneric mn syns ds tyConNm dargs = do

314318 (App e unitVal)

315319 fromSpineFun e _ = App (mkGenVar (Ident C.fromSpine)) (App e unitVal)

316320

317− mkRecCase :: [(Text, Type)] -> CaseAlternative

321+ mkRecCase :: [(Label, Type)] -> CaseAlternative

318322 mkRecCase rs =

319323 CaseAlternative

320− [ recordBinder [ LiteralBinder (ArrayLiteral (map (VarBinder . Ident . fst) rs)) ] ]

324+ [ recordBinder [ LiteralBinder (ArrayLiteral (map (VarBinder . labelToIdent . fst) rs)) ] ]

321325 . Right

322− $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar (Ident x))) y) rs)

326+ $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar $ labelToIdent x)) y) rs)

323327

324− mkRecFun :: [(Text, Type)] -> Expr

325− mkRecFun xs = mkJust $ foldr (lam . Ident . fst) recLiteral xs

326− where recLiteral = Literal . ObjectLiteral $ map (\(s,_) -> (s, mkVar (Ident s))) xs

328+ mkRecFun :: [(Label, Type)] -> Expr

329+ mkRecFun xs = mkJust $ foldr (lam . labelToIdent . fst) recLiteral xs

330+ where recLiteral = Literal . ObjectLiteral $ map (\(l@(Label s), _) -> (s, mkVar $ labelToIdent l)) xs

327331 mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d

328332 mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"

329333

@@ -405,7 +409,7 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do

405409 args' <- mapM (replaceAllTypeSynonymsM syns) args

406410 (ctorTy, matchProduct, ctorArgs, matchCtor, mkProduct) <- makeProduct args'

407411 return ( TypeApp (TypeApp (TypeConstructor constructor)

408− (TypeLevelString (runProperName ctorName)))

412+ (TypeLevelString $ mkString (runProperName ctorName)))

409413 ctorTy

410414 , CaseAlternative [ ConstructorBinder constructor [matchProduct] ]

411415 (Right (foldl App (Constructor (Qualified (Just mn) ctorName)) ctorArgs))

@@ -430,19 +434,19 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do

430434 makeArg :: Type -> m (Type, Binder, Expr, Binder, Expr)

431435 makeArg arg | Just rec <- objectType arg = do

432436 let fields = decomposeRec rec

433− fieldNames <- traverse freshIdent (map fst fields)

437+ fieldNames <- traverse freshIdent (map (runIdent . labelToIdent . fst) fields)

434438 pure ( TypeApp (TypeConstructor record)

435439 (foldr1 (\f -> TypeApp (TypeApp (TypeConstructor productName) f))

436− (map (\(name, ty) ->

440+ (map (\((Label name), ty) ->

437441 TypeApp (TypeApp (TypeConstructor field) (TypeLevelString name)) ty) fields))

438442 , ConstructorBinder record

439443 [ foldr1 (\b1 b2 -> ConstructorBinder productName [b1, b2])

440444 (map (\ident -> ConstructorBinder field [VarBinder ident]) fieldNames)

441445 ]

442446 , Literal . ObjectLiteral $

443− zipWith (\(name, _) ident -> (name, Var (Qualified Nothing ident))) fields fieldNames

447+ zipWith (\((Label name), _) ident -> (name, Var (Qualified Nothing ident))) fields fieldNames

444448 , LiteralBinder . ObjectLiteral $

445− zipWith (\(name, _) ident -> (name, VarBinder ident)) fields fieldNames

449+ zipWith (\((Label name), _) ident -> (name, VarBinder ident)) fields fieldNames

446450 , record' $

447451 foldr1 (\e1 -> App (App (Constructor productName) e1))

448452 (map (field' . Var . Qualified Nothing) fieldNames)

@@ -574,7 +578,7 @@ deriveEq mn syns ds tyConNm = do

574578 toEqTest :: Expr -> Expr -> Type -> Expr

575579 toEqTest l r ty | Just rec <- objectType ty =

576580 conjAll

577− . map (\(str, typ) -> toEqTest (Accessor str l) (Accessor str r) typ)

581+ . map (\((Label str), typ) -> toEqTest (Accessor str l) (Accessor str r) typ)

578582 $ decomposeRec rec

579583 toEqTest l r _ = preludeEq l r

580584

@@ -661,7 +665,7 @@ deriveOrd mn syns ds tyConNm = do

661665 toOrdering :: Expr -> Expr -> Type -> Expr

662666 toOrdering l r ty | Just rec <- objectType ty =

663667 appendAll

664− . map (\(str, typ) -> toOrdering (Accessor str l) (Accessor str r) typ)

668+ . map (\((Label str), typ) -> toOrdering (Accessor str l) (Accessor str r) typ)

665669 $ decomposeRec rec

666670 toOrdering l r _ = ordCompare l r

667671

@@ -733,11 +737,22 @@ mkVarMn mn = Var . Qualified mn

733737mkVar :: Ident -> Expr

734738mkVar = mkVarMn Nothing

735739

740+-- This function may seem a little obtuse, but it's only this way to ensure

741+-- that it is injective. Injectivity is important here; without it, we can end

742+-- up with accidental variable shadowing in the generated code.

743+labelToIdent :: Label -> Ident

744+labelToIdent =

745+ Ident . foldMap (either loneSurrogate char) . decodeStringEither . runLabel

746+ where

747+ char '_' = "__"

748+ char c = T.singleton c

749+ loneSurrogate x = "_" <> T.pack (show x) <> "_"

750+

736751objectType :: Type -> Maybe Type

737752objectType (TypeApp (TypeConstructor (Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Record"))) rec) = Just rec

738753objectType _ = Nothing

739754

740−decomposeRec :: Type -> [(Text, Type)]

755+decomposeRec :: Type -> [(Label, Type)]

741756decomposeRec = sortBy (comparing fst) . go

742757 where go (RCons str typ typs) = (str, typ) : decomposeRec typs

743758 go _ = []

@@ -790,17 +805,17 @@ deriveFunctor mn syns ds tyConNm = do

790805 goType recTy | Just row <- objectType recTy =

791806 traverse buildUpdate (decomposeRec row) >>= (traverse buildRecord . justUpdates)

792807 where

793− justUpdates :: [Maybe (Text, Expr)] -> Maybe [(Text, Expr)]

808+ justUpdates :: [Maybe (Label, Expr)] -> Maybe [(Label, Expr)]

794809 justUpdates = foldMap (fmap return)

795810

796− buildUpdate :: (Text, Type) -> m (Maybe (Text, Expr))

811+ buildUpdate :: (Label, Type) -> m (Maybe (Label, Expr))

797812 buildUpdate (lbl, ty) = do upd <- goType ty

798813 return ((lbl,) <$> upd)

799814

800− buildRecord :: [(Text, Expr)] -> m Expr

815+ buildRecord :: [(Label, Expr)] -> m Expr

801816 buildRecord updates = do arg <- freshIdent "o"

802817 let argVar = mkVar arg

803− mkAssignment (l, x) = (l, App x (Accessor l argVar))

818+ mkAssignment ((Label l), x) = (l, App x (Accessor l argVar))

804819 return (lam arg (ObjectUpdate argVar (mkAssignment <$> updates)))

805820

806821 -- under a `* -> *`, just assume functor for now

src/Language/PureScript/TypeChecker/Entailment.hs+6−4

@@ -37,13 +37,15 @@ import Language.PureScript.TypeChecker.Monad

3737import Language.PureScript.TypeChecker.Unify

3838import Language.PureScript.TypeClassDictionaries

3939import Language.PureScript.Types

40+import Language.PureScript.Label (Label(..))

41+import Language.PureScript.PSString (PSString, mkString)

4042import qualified Language.PureScript.Constants as C

4143

4244-- | Describes what sort of dictionary to generate for type class instances

4345data Evidence

4446 = NamedInstance (Qualified Ident)

4547 -- ^ An existing named instance

46− | IsSymbolInstance Text

48+ | IsSymbolInstance PSString

4749 -- ^ Computed instance of the IsSymbol type class for a given Symbol literal

4850 | CompareSymbolInstance

4951 -- ^ Computed instance of CompareSymbol

@@ -319,7 +321,7 @@ entails SolverOptions{..} constraint context hints =

319321 -- Turn a DictionaryValue into a Expr

320322 subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr

321323 subclassDictionaryValue dict superclassName index =

322− App (Accessor (C.__superclass_ <> showQualified runProperName superclassName <> "_" <> T.pack (show index))

324+ App (Accessor (mkString (C.__superclass_ <> showQualified runProperName superclassName <> "_" <> T.pack (show index)))

323325 dict)

324326 valUndefined

325327

@@ -387,7 +389,7 @@ matches deps TypeClassDictionaryInScope{..} tys = do

387389 sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

388390 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

389391

390− go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> (Bool, Matching [Type])

392+ go :: [(Label, Type)] -> Type -> [(Label, Type)] -> Type -> (Bool, Matching [Type])

391393 go l (KindedType t1 _) r t2 = go l t1 r t2

392394 go l t1 r (KindedType t2 _) = go l t1 r t2

393395 go [] REmpty [] REmpty = (True, M.empty)

@@ -429,7 +431,7 @@ matches deps TypeClassDictionaryInScope{..} tys = do

429431 sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

430432 in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'

431433 where

432− go :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> Bool

434+ go :: [(Label, Type)] -> Type -> [(Label, Type)] -> Type -> Bool

433435 go l (KindedType t1 _) r t2 = go l t1 r t2

434436 go l t1 r (KindedType t2 _) = go l t1 r t2

435437 go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = True

src/Language/PureScript/TypeChecker/Types.hs+18−17

@@ -41,7 +41,6 @@ import Data.Maybe (fromMaybe)

4141import Data.Monoid ((<>))

4242import qualified Data.Map as M

4343import qualified Data.Set as S

44−import Data.Text (Text)

4544

4645import Language.PureScript.AST

4746import Language.PureScript.Crash

@@ -60,6 +59,8 @@ import Language.PureScript.TypeChecker.Synonyms

6059import Language.PureScript.TypeChecker.TypeSearch

6160import Language.PureScript.TypeChecker.Unify

6261import Language.PureScript.Types

62+import Language.PureScript.Label (Label(..))

63+import Language.PureScript.PSString (PSString)

6364

6465

6566data BindingGroupType

@@ -289,22 +290,22 @@ infer' (Literal (ArrayLiteral vals)) = do

289290infer' (Literal (ObjectLiteral ps)) = do

290291 ensureNoDuplicateProperties ps

291292 ts <- traverse (infer . snd) ps

292− let fields = zipWith (\name (TypedValue _ _ t) -> (name, t)) (map fst ps) ts

293+ let fields = zipWith (\name (TypedValue _ _ t) -> (Label name, t)) (map fst ps) ts

293294 ty = TypeApp tyRecord $ rowFromList (fields, REmpty)

294295 return $ TypedValue True (Literal (ObjectLiteral (zip (map fst ps) ts))) ty

295296infer' (ObjectUpdate o ps) = do

296297 ensureNoDuplicateProperties ps

297298 row <- freshType

298299 newVals <- zipWith (\(name, _) t -> (name, t)) ps <$> traverse (infer . snd) ps

299− let newTys = map (\(name, TypedValue _ _ ty) -> (name, ty)) newVals

300− oldTys <- zip (map fst ps) <$> replicateM (length ps) freshType

300+ let newTys = map (\(name, TypedValue _ _ ty) -> (Label name, ty)) newVals

301+ oldTys <- zip (map (Label . fst) ps) <$> replicateM (length ps) freshType

301302 let oldTy = TypeApp tyRecord $ rowFromList (oldTys, row)

302303 o' <- TypedValue True <$> check o oldTy <*> pure oldTy

303304 return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyRecord $ rowFromList (newTys, row)

304305infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do

305306 field <- freshType

306307 rest <- freshType

307− typed <- check val (TypeApp tyRecord (RCons prop field rest))

308+ typed <- check val (TypeApp tyRecord (RCons (Label prop) field rest))

308309 return $ TypedValue True (Accessor prop typed) field

309310infer' (Abs (Left arg) ret) = do

310311 ty <- freshType

@@ -442,12 +443,12 @@ inferBinder val (LiteralBinder (ObjectLiteral props)) = do

442443 unifyTypes val (TypeApp tyRecord row)

443444 return m1

444445 where

445− inferRowProperties :: Type -> Type -> [(Text, Binder)] -> m (M.Map Ident Type)

446+ inferRowProperties :: Type -> Type -> [(PSString, Binder)] -> m (M.Map Ident Type)

446447 inferRowProperties nrow row [] = unifyTypes nrow row >> return M.empty

447448 inferRowProperties nrow row ((name, binder):binders) = do

448449 propTy <- freshType

449450 m1 <- inferBinder propTy binder

450− m2 <- inferRowProperties nrow (RCons name propTy row) binders

451+ m2 <- inferRowProperties nrow (RCons (Label name) propTy row) binders

451452 return $ m1 `M.union` m2

452453inferBinder val (LiteralBinder (ArrayLiteral binders)) = do

453454 el <- freshType

@@ -641,14 +642,14 @@ check' e@(ObjectUpdate obj ps) t@(TypeApp o row) | o == tyRecord = do

641642 -- We need to be careful to avoid duplicate labels here.

642643 -- We check _obj_ against the type _t_ with the types in _ps_ replaced with unknowns.

643644 let (propsToCheck, rest) = rowToList row

644− (removedProps, remainingProps) = partition (\(p, _) -> p `elem` map fst ps) propsToCheck

645+ (removedProps, remainingProps) = partition (\(p, _) -> p `elem` map (Label . fst) ps) propsToCheck

645646 us <- zip (map fst removedProps) <$> replicateM (length ps) freshType

646647 obj' <- check obj (TypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))

647648 ps' <- checkProperties e ps row True

648649 return $ TypedValue True (ObjectUpdate obj' ps') t

649650check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do

650651 rest <- freshType

651− val' <- check val (TypeApp tyRecord (RCons prop ty rest))

652+ val' <- check val (TypeApp tyRecord (RCons (Label prop) ty rest))

652653 return $ TypedValue True (Accessor prop val') ty

653654check' v@(Constructor c) ty = do

654655 env <- getEnv

@@ -681,10 +682,10 @@ check' val ty = do

681682checkProperties ::

682683 (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

683684 Expr ->

684− [(Text, Expr)] ->

685+ [(PSString, Expr)] ->

685686 Type ->

686687 Bool ->

687− m [(Text, Expr)]

688+ m [(PSString, Expr)]

688689checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' where

689690 go [] [] REmpty = return []

690691 go [] [] u@(TUnknown _)

@@ -694,18 +695,18 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh

694695 go [] [] Skolem{} | lax = return []

695696 go [] ((p, _): _) _ | lax = return []

696697 | otherwise = throwError . errorMessage $ PropertyIsMissing p

697− go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p

698+ go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty $ Label p

698699 go ((p,v):ps') ts r =

699− case lookup p ts of

700+ case lookup (Label p) ts of

700701 Nothing -> do

701702 v'@(TypedValue _ _ ty) <- infer v

702703 rest <- freshType

703− unifyTypes r (RCons p ty rest)

704+ unifyTypes r (RCons (Label p) ty rest)

704705 ps'' <- go ps' ts rest

705706 return $ (p, v') : ps''

706707 Just ty -> do

707708 v' <- check v ty

708− ps'' <- go ps' (delete (p, ty) ts) r

709+ ps'' <- go ps' (delete (Label p, ty) ts) r

709710 return $ (p, v') : ps''

710711 go _ _ _ = throwError . errorMessage $ ExprDoesNotHaveType expr (TypeApp tyRecord row)

711712

@@ -771,9 +772,9 @@ checkFunctionApplication' fn u arg = do

771772-- |

772773-- Ensure a set of property names and value does not contain duplicate labels

773774--

774−ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(Text, Expr)] -> m ()

775+ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(PSString, Expr)] -> m ()

775776ensureNoDuplicateProperties ps =

776777 let ls = map fst ps in

777778 case ls \\ nub ls of

778− l : _ -> throwError . errorMessage $ DuplicateLabel l Nothing

779+ l : _ -> throwError . errorMessage $ DuplicateLabel (Label l) Nothing

779780 _ -> return ()

src/Language/PureScript/TypeChecker/Unify.hs+2−1

@@ -31,6 +31,7 @@ import Language.PureScript.Crash

3131import Language.PureScript.Errors

3232import Language.PureScript.TypeChecker.Monad

3333import Language.PureScript.TypeChecker.Skolems

34+import Language.PureScript.Label (Label(..))

3435import Language.PureScript.Types

3536

3637-- | Generate a fresh type variable

@@ -139,7 +140,7 @@ unifyRows r1 r2 =

139140 forM_ int (uncurry unifyTypes)

140141 unifyRows' sd1 r1' sd2 r2'

141142 where

142− unifyRows' :: [(Text, Type)] -> Type -> [(Text, Type)] -> Type -> m ()

143+ unifyRows' :: [(Label, Type)] -> Type -> [(Label, Type)] -> Type -> m ()

143144 unifyRows' [] (TUnknown u) sd r = solveType u (rowFromList (sd, r))

144145 unifyRows' sd r [] (TUnknown u) = solveType u (rowFromList (sd, r))

145146 unifyRows' sd1 (TUnknown u1) sd2 (TUnknown u2) = do

src/Language/PureScript/Types.hs+6−4

@@ -20,6 +20,8 @@ import qualified Data.Text as T

2020import Language.PureScript.AST.SourcePos

2121import Language.PureScript.Kinds

2222import Language.PureScript.Names

23+import Language.PureScript.Label (Label)

24+import Language.PureScript.PSString (PSString)

2325

2426-- |

2527-- An identifier for the scope of a skolem variable

@@ -36,7 +38,7 @@ data Type

3638 -- | A named type variable

3739 | TypeVar Text

3840 -- | A type-level string

39− | TypeLevelString Text

41+ | TypeLevelString PSString

4042 -- | A type wildcard, as would appear in a partial type synonym

4143 | TypeWildcard SourceSpan

4244 -- | A type constructor

@@ -55,7 +57,7 @@ data Type

5557 -- | An empty row

5658 | REmpty

5759 -- | A non-empty row

58− | RCons Text Type Type

60+ | RCons Label Type Type

5961 -- | A type with a kind annotation

6062 | KindedType Type Kind

6163 -- | A placeholder used in pretty printing

@@ -108,7 +110,7 @@ $(A.deriveJSON A.defaultOptions ''ConstraintData)

108110-- |

109111-- Convert a row to a list of pairs of labels and types

110112--

111−rowToList :: Type -> ([(Text, Type)], Type)

113+rowToList :: Type -> ([(Label, Type)], Type)

112114rowToList (RCons name ty row) = let (tys, rest) = rowToList row

113115 in ((name, ty):tys, rest)

114116rowToList r = ([], r)

@@ -116,7 +118,7 @@ rowToList r = ([], r)

116118-- |

117119-- Convert a list of labels and types to a row

118120--

119−rowFromList :: ([(Text, Type)], Type) -> Type

121+rowFromList :: ([(Label, Type)], Type) -> Type

120122rowFromList ([], r) = r

121123rowFromList ((name, t):ts, r) = RCons name t (rowFromList (ts, r))

122124

tests/TestPsci.hs+1−1

@@ -120,7 +120,7 @@ getPSCiState :: IO PSCiState

120120getPSCiState = do

121121 cwd <- getCurrentDirectory

122122 let supportDir = cwd </> "tests" </> "support" </> "bower_components"

123− let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/**/*." ++ ext)) supportDir

123+ let supportFiles ext = Glob.globDir1 (Glob.compile ("purescript-*/src/**/*." ++ ext)) supportDir

124124 pursFiles <- supportFiles "purs"

125125

126126 modulesOrFirstError <- loadAllModules pursFiles

tests/TestUtils.hs+19−1

@@ -69,11 +69,15 @@ supportModules =

6969 , "Control.Monad.Eff.Class"

7070 , "Control.Monad.Eff.Console"

7171 , "Control.Monad.Eff.Unsafe"

72+ , "Control.Monad.Rec.Class"

7273 , "Control.Monad.ST"

7374 , "Control.MonadPlus"

7475 , "Control.MonadZero"

7576 , "Control.Plus"

7677 , "Control.Semigroupoid"

78+ , "Data.Array"

79+ , "Data.Array.Partial"

80+ , "Data.Array.ST"

7781 , "Data.Bifoldable"

7882 , "Data.Bifunctor"

7983 , "Data.Bifunctor.Clown"

@@ -86,7 +90,10 @@ supportModules =

8690 , "Data.Boolean"

8791 , "Data.BooleanAlgebra"

8892 , "Data.Bounded"

93+ , "Data.Char"

8994 , "Data.CommutativeRing"

95+ , "Data.Either"

96+ , "Data.Either.Nested"

9097 , "Data.Eq"

9198 , "Data.EuclideanRing"

9299 , "Data.Field"

@@ -95,6 +102,7 @@ supportModules =

95102 , "Data.Function.Uncurried"

96103 , "Data.Functor"

97104 , "Data.Functor.Invariant"

105+ , "Data.Generic"

98106 , "Data.Generic.Rep"

99107 , "Data.Generic.Rep.Eq"

100108 , "Data.Generic.Rep.Monoid"

@@ -102,6 +110,7 @@ supportModules =

102110 , "Data.Generic.Rep.Semigroup"

103111 , "Data.Generic.Rep.Show"

104112 , "Data.HeytingAlgebra"

113+ , "Data.Identity"

105114 , "Data.Maybe"

106115 , "Data.Maybe.First"

107116 , "Data.Maybe.Last"

@@ -115,6 +124,7 @@ supportModules =

115124 , "Data.Monoid.Multiplicative"

116125 , "Data.NaturalTransformation"

117126 , "Data.Newtype"

127+ , "Data.NonEmpty"

118128 , "Data.Ord"

119129 , "Data.Ord.Unsafe"

120130 , "Data.Ordering"

@@ -122,15 +132,23 @@ supportModules =

122132 , "Data.Semigroup"

123133 , "Data.Semiring"

124134 , "Data.Show"

135+ , "Data.String"

136+ , "Data.String.CaseInsensitive"

137+ , "Data.String.Regex"

138+ , "Data.String.Regex.Flags"

139+ , "Data.String.Regex.Unsafe"

140+ , "Data.String.Unsafe"

125141 , "Data.Symbol"

126142 , "Data.Traversable"

143+ , "Data.Tuple"

144+ , "Data.Tuple.Nested"

145+ , "Data.Unfoldable"

127146 , "Data.Unit"

128147 , "Data.Void"

129148 , "Partial"

130149 , "Partial.Unsafe"

131150 , "Prelude"

132151 , "Test.Assert"

133− , "Test.Main"

134152 , "Type.Data.Ordering"

135153 , "Type.Data.Symbol"

136154 , "Type.Equality"

tests/support/bower.json+1

@@ -9,6 +9,7 @@

99 "purescript-st": "2.0.0",

1010 "purescript-partial": "1.1.2",

1111 "purescript-newtype": "1.1.0",

12+ "purescript-generics": "3.3.0",

1213 "purescript-generics-rep": "4.0.0",

1314 "purescript-symbols": "^2.0.0",

1415 "purescript-typelevel-prelude": "https://github.com/purescript/purescript-typelevel-prelude.git#29a7123a0c29c85d4b923fcf4a7df8e45ebf9bac",