6fd4899 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #1861 from purescript/1846

6fd4899Phil Freeman11 years ago

examples/failing/AnonArgument1.pursnew file+5

compare with golang

unifiedsplit

@@ -0,0 +1,5 @@

1+-- @shouldFailWith IncorrectAnonymousArgument

2+module Main where

4+test :: Int -> Int

5+test = _

examples/failing/AnonArgument2.pursnew file+7

@@ -0,0 +1,7 @@

1+-- @shouldFailWith IncorrectAnonymousArgument

2+module Main where

4+import Prelude

6+test :: Int -> Int

7+test = 1 + 2 * _

examples/failing/AnonArgument3.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldFailWith IncorrectAnonymousArgument

2+module Main where

4+test :: Int -> Int

5+test = 1 + _

examples/passing/ExplicitOperatorSections.pursnew file+14

@@ -0,0 +1,14 @@

1+module Main where

3+import Prelude

5+subtractOne :: Int -> Int

6+subtractOne = (_ - 1)

8+addOne :: Int -> Int

9+addOne = (1 + _)

10+

11+named :: Int -> Int

12+named = (_ `sub` 1)

13+

14+main = Control.Monad.Eff.Console.log "Done"

src/Language/PureScript/AST/Declarations.hs+7−10

@@ -337,6 +337,9 @@ data Expr

337 -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor

338 -- will be removed.

339 --

340+ -- Note: although it seems this constructor is not used, it _is_ useful, since it prevents

341+ -- certain traversals from matching.

342+ --

340 | Parens Expr

343 | Parens Expr

341 -- |

344 -- |

342 -- Operator section. This will be removed during desugaring and replaced with a partially applied

345 -- Operator section. This will be removed during desugaring and replaced with a partially applied

@@ -352,11 +355,6 @@ data Expr

352 --

355 --

353 | ObjectLiteral [(String, Expr)]

356 | ObjectLiteral [(String, Expr)]

354 -- |

357 -- |

355− -- An object constructor (object literal with underscores). This will be removed during

356− -- desugaring and expanded into a lambda that returns an object literal.

357− --

358− | ObjectConstructor [(String, Maybe Expr)]

359− -- |

360 -- An object property getter (e.g. `_.x`). This will be removed during

358 -- An object property getter (e.g. `_.x`). This will be removed during

361 -- desugaring and expanded into a lambda that reads a property from an object.

359 -- desugaring and expanded into a lambda that reads a property from an object.

362 --

360 --

@@ -370,11 +368,6 @@ data Expr

370 --

368 --

371 | ObjectUpdate Expr [(String, Expr)]

369 | ObjectUpdate Expr [(String, Expr)]

372 -- |

370 -- |

373− -- Partial record updater. This will be removed during desugaring and

374− -- expanded into a lambda that returns an object update.

375− --

376− | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]

377− -- |

378 -- Function introduction

371 -- Function introduction

379 --

372 --

380 | Abs (Either Ident Binder) Expr

373 | Abs (Either Ident Binder) Expr

@@ -433,6 +426,10 @@ data Expr

433 --

426 --

434 | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]

427 | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]

435 -- |

428 -- |

429+ -- A placeholder for an anonymous function argument

430+ --

431+ | AnonymousArgument

432+ -- |

436 -- A value with source position information

433 -- A value with source position information

437 --

434 --

438 | PositionedValue SourceSpan [Comment] Expr

435 | PositionedValue SourceSpan [Comment] Expr

src/Language/PureScript/AST/Traversals.hs+1−15

@@ -23,7 +23,7 @@ import Data.Foldable (fold)

23import qualified Data.Set as S

25import Control.Monad

26−import Control.Arrow ((***), (+++), second)

26+import Control.Arrow ((***), (+++))

28import Language.PureScript.AST.Binders

29import Language.PureScript.AST.Declarations

@@ -54,11 +54,9 @@ everywhereOnValues f g h = (f', g', h')

54 g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))

55 g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))

56 g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))

57− g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))

58 g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))

57 g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))

59 g' (Accessor prop v) = g (Accessor prop (g' v))

58 g' (Accessor prop v) = g (Accessor prop (g' v))

60 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

59 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

61− g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))

62 g' (Abs name v) = g (Abs name (g' v))

60 g' (Abs name v) = g (Abs name (g' v))

63 g' (App v1 v2) = g (App (g' v1) (g' v2))

61 g' (App v1 v2) = g (App (g' v1) (g' v2))

64 g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))

62 g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))

@@ -112,11 +110,9 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

112 g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))

110 g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))

113 g' (ArrayLiteral vs) = ArrayLiteral <$> traverse (g' <=< g) vs

111 g' (ArrayLiteral vs) = ArrayLiteral <$> traverse (g' <=< g) vs

114 g' (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g' <=< g)) vs

112 g' (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g' <=< g)) vs

115− g' (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g' <=< g)) vs

116 g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')

113 g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')

117 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

114 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

118 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs

115 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs

119− g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> traverse (sndM $ maybeM (g' <=< g)) vs

120 g' (Abs name v) = Abs name <$> (g v >>= g')

116 g' (Abs name v) = Abs name <$> (g v >>= g')

121 g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')

117 g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')

122 g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')

118 g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')

@@ -165,11 +161,9 @@ everywhereOnValuesM f g h = (f', g', h')

165 g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g

161 g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g

166 g' (ArrayLiteral vs) = (ArrayLiteral <$> traverse g' vs) >>= g

162 g' (ArrayLiteral vs) = (ArrayLiteral <$> traverse g' vs) >>= g

167 g' (ObjectLiteral vs) = (ObjectLiteral <$> traverse (sndM g') vs) >>= g

163 g' (ObjectLiteral vs) = (ObjectLiteral <$> traverse (sndM g') vs) >>= g

168− g' (ObjectConstructor vs) = (ObjectConstructor <$> traverse (sndM $ maybeM g') vs) >>= g

169 g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g

164 g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g

170 g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g

165 g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g

171 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g

166 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g

172− g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> traverse (sndM $ maybeM g') vs) >>= g

173 g' (Abs name v) = (Abs name <$> g' v) >>= g

167 g' (Abs name v) = (Abs name <$> g' v) >>= g

174 g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g

168 g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g

175 g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g

169 g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g

@@ -221,11 +215,9 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

221 g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1

215 g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1

222 g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)

216 g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)

223 g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)

217 g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)

224− g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))

225 g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1

218 g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1

226 g' v@(Accessor _ v1) = g v <> g' v1

219 g' v@(Accessor _ v1) = g v <> g' v1

227 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

220 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

228− g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))

229 g' v@(Abs _ v1) = g v <> g' v1

221 g' v@(Abs _ v1) = g v <> g' v1

230 g' v@(App v1 v2) = g v <> g' v1 <> g' v2

222 g' v@(App v1 v2) = g v <> g' v1 <> g' v2

231 g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3

223 g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3

@@ -288,11 +280,9 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

288 g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

280 g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

289 g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)

281 g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)

290 g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)

282 g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)

291− g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))

292 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

283 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

293 g' s (Accessor _ v1) = g'' s v1

284 g' s (Accessor _ v1) = g'' s v1

294 g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)

285 g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)

295− g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))

296 g' s (Abs _ v1) = g'' s v1

286 g' s (Abs _ v1) = g'' s v1

297 g' s (App v1 v2) = g'' s v1 <> g'' s v2

287 g' s (App v1 v2) = g'' s v1 <> g'' s v2

298 g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3

288 g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3

@@ -358,11 +348,9 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

358 g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)

348 g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)

359 g' s (ArrayLiteral vs) = ArrayLiteral <$> traverse (g'' s) vs

349 g' s (ArrayLiteral vs) = ArrayLiteral <$> traverse (g'' s) vs

360 g' s (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g'' s)) vs

350 g' s (ObjectLiteral vs) = ObjectLiteral <$> traverse (sndM (g'' s)) vs

361− g' s (ObjectConstructor vs) = ObjectConstructor <$> traverse (sndM $ maybeM (g'' s)) vs

362 g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v

351 g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v

363 g' s (Accessor prop v) = Accessor prop <$> g'' s v

352 g' s (Accessor prop v) = Accessor prop <$> g'' s v

364 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs

353 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs

365− g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> traverse (sndM $ maybeM (g'' s)) vs

366 g' s (Abs name v) = Abs name <$> g'' s v

354 g' s (Abs name v) = Abs name <$> g'' s v

367 g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2

355 g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2

368 g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3

356 g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3

@@ -440,11 +428,9 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)

440 g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

428 g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v

441 g' s (ArrayLiteral vs) = foldMap (g'' s) vs

429 g' s (ArrayLiteral vs) = foldMap (g'' s) vs

442 g' s (ObjectLiteral vs) = foldMap (g'' s . snd) vs

430 g' s (ObjectLiteral vs) = foldMap (g'' s . snd) vs

443− g' s (ObjectConstructor vs) = foldMap (g'' s) (mapMaybe snd vs)

444 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

431 g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1

445 g' s (Accessor _ v1) = g'' s v1

432 g' s (Accessor _ v1) = g'' s v1

446 g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs

433 g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs

447− g' s (ObjectUpdater obj vs) = foldMap (g'' s) obj <> foldMap (g'' s) (mapMaybe snd vs)

448 g' s (Abs (Left name) v1) =

434 g' s (Abs (Left name) v1) =

449 let s' = S.insert name s

435 let s' = S.insert name s

450 in g'' s' v1

436 in g'' s' v1

src/Language/PureScript/Errors.hs+53−20

@@ -24,6 +24,7 @@ import Control.Arrow ((&&&))

24import Language.PureScript.Crash

25import Language.PureScript.AST

26import Language.PureScript.Pretty

27+import Language.PureScript.Pretty.Common (before)

27import Language.PureScript.Types

28import Language.PureScript.Types

28import Language.PureScript.Names

29import Language.PureScript.Names

29import Language.PureScript.Kinds

30import Language.PureScript.Kinds

@@ -128,6 +129,7 @@ data SimpleErrorMessage

128 | UnusedDctorImport (ProperName 'TypeName)

129 | UnusedDctorImport (ProperName 'TypeName)

129 | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

130 | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

130 | DeprecatedOperatorDecl String

131 | DeprecatedOperatorDecl String

132+ | DeprecatedOperatorSection Expr (Either Expr Expr)

131 | DeprecatedQualifiedSyntax ModuleName ModuleName

133 | DeprecatedQualifiedSyntax ModuleName ModuleName

132 | DeprecatedClassImport ModuleName (ProperName 'ClassName)

134 | DeprecatedClassImport ModuleName (ProperName 'ClassName)

133 | DeprecatedClassExport (ProperName 'ClassName)

135 | DeprecatedClassExport (ProperName 'ClassName)

@@ -142,6 +144,7 @@ data SimpleErrorMessage

142 | ImplicitImport ModuleName [DeclarationRef]

144 | ImplicitImport ModuleName [DeclarationRef]

143 | HidingImport ModuleName [DeclarationRef]

145 | HidingImport ModuleName [DeclarationRef]

144 | CaseBinderLengthDiffers Int [Binder]

146 | CaseBinderLengthDiffers Int [Binder]

147+ | IncorrectAnonymousArgument

145 deriving (Show)

148 deriving (Show)

146

149

147-- | Error message hints, providing more detailed information about failure.

150-- | Error message hints, providing more detailed information about failure.

@@ -303,6 +306,7 @@ errorCode em = case unwrapErrorMessage em of

303 UnusedDctorImport{} -> "UnusedDctorImport"

306 UnusedDctorImport{} -> "UnusedDctorImport"

304 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

307 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"

305 DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"

308 DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"

309+ DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"

306 DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"

310 DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"

307 DeprecatedClassImport{} -> "DeprecatedClassImport"

311 DeprecatedClassImport{} -> "DeprecatedClassImport"

308 DeprecatedClassExport{} -> "DeprecatedClassExport"

312 DeprecatedClassExport{} -> "DeprecatedClassExport"

@@ -317,6 +321,7 @@ errorCode em = case unwrapErrorMessage em of

317 ImplicitImport{} -> "ImplicitImport"

321 ImplicitImport{} -> "ImplicitImport"

318 HidingImport{} -> "HidingImport"

322 HidingImport{} -> "HidingImport"

319 CaseBinderLengthDiffers{} -> "CaseBinderLengthDiffers"

323 CaseBinderLengthDiffers{} -> "CaseBinderLengthDiffers"

324+ IncorrectAnonymousArgument -> "IncorrectAnonymousArgument"

320

325

321-- |

326-- |

322-- A stack trace for an error

327-- A stack trace for an error

@@ -424,7 +429,7 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error

424-- TODO Other possible suggestions:

429-- TODO Other possible suggestions:

425-- WildcardInferredType - source span not small enough

430-- WildcardInferredType - source span not small enough

426-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert

431-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert

427−-- DeprecatedClassExport, DeprecatedClassImport, would want to replace smaller span?

432+-- DeprecatedClassExport, DeprecatedClassImport, DeprecatedOperatorSection, would want to replace smaller span?

428errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

433errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion

429errorSuggestion err = case err of

434errorSuggestion err = case err of

430 UnusedImport{} -> emptySuggestion

435 UnusedImport{} -> emptySuggestion

@@ -798,7 +803,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

798 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =

803 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =

799 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."

804 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."

800 renderSimpleErrorMessage (ImportHidingModule name) =

805 renderSimpleErrorMessage (ImportHidingModule name) =

801− paras [ line $ "'hiding' imports cannot be used to hide modules."

806+ paras [ line "'hiding' imports cannot be used to hide modules."

802 , line $ "An attempt was made to hide the import of " ++ runModuleName name

807 , line $ "An attempt was made to hide the import of " ++ runModuleName name

803 ]

808 ]

804 renderSimpleErrorMessage (WildcardInferredType ty) =

809 renderSimpleErrorMessage (WildcardInferredType ty) =

@@ -812,14 +817,14 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

812 , indent $ typeAsBox ty

817 , indent $ typeAsBox ty

813 ]

818 ]

814 renderSimpleErrorMessage (NotExhaustivePattern bs b) =

819 renderSimpleErrorMessage (NotExhaustivePattern bs b) =

815− paras $ [ line "A case expression could not be determined to cover all inputs."

820+ paras [ line "A case expression could not be determined to cover all inputs."

816− , line "The following additional cases are required to cover all inputs:\n"

821+ , line "The following additional cases are required to cover all inputs:\n"

817− , indent $ paras $

822+ , indent $ paras $

818− [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]

823+ [ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs)) ]

819− ++ [ line "..." | not b ]

824+ ++ [ line "..." | not b ]

820− , line "Or alternatively, add a Partial constraint to the type of the enclosing value."

825+ , line "Or alternatively, add a Partial constraint to the type of the enclosing value."

821− , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."

826+ , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."

822− ]

827+ ]

823 renderSimpleErrorMessage (OverlappingPattern bs b) =

828 renderSimpleErrorMessage (OverlappingPattern bs b) =

824 paras $ [ line "A case expression contains unreachable cases:\n"

829 paras $ [ line "A case expression contains unreachable cases:\n"

825 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

830 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

@@ -835,7 +840,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

835 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =

840 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =

836 paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"

841 paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"

837 , indent $ paras $ map line names

842 , indent $ paras $ map line names

838− , line $ "It could be replaced with:"

843+ , line "It could be replaced with:"

839 , indent $ line $ showSuggestion msg ]

844 , indent $ line $ showSuggestion msg ]

840

845

841 renderSimpleErrorMessage (UnusedDctorImport name) =

846 renderSimpleErrorMessage (UnusedDctorImport name) =

@@ -849,15 +854,39 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

849 paras [ line $ "The operator (" ++ name ++ ") was declared as a value rather than an alias for a named function."

854 paras [ line $ "The operator (" ++ name ++ ") was declared as a value rather than an alias for a named function."

850 , line "Operator aliases are declared by using a fixity declaration, for example:"

855 , line "Operator aliases are declared by using a fixity declaration, for example:"

851 , indent $ line $ "infixl 9 someFunction as " ++ name

856 , indent $ line $ "infixl 9 someFunction as " ++ name

852− , line $ "Support for value-declared operators will be removed in PureScript 0.9."

857+ , line "Support for value-declared operators will be removed in PureScript 0.9."

853 ]

858 ]

854

859

860+ renderSimpleErrorMessage (DeprecatedOperatorSection op val) =

861+ paras [ line "An operator section uses legacy syntax. Operator sections are now written using anonymous function syntax:"

862+ , indent $ foldr1 before $

863+ case val of

864+ Left l ->

865+ [ line "("

866+ , prettyPrintValue valueDepth l

867+ , line " "

868+ , renderOperator op

869+ , line " _)"

870+ ]

871+ Right r ->

872+ [ line "(_ "

873+ , renderOperator op

874+ , line " "

875+ , prettyPrintValue valueDepth r

876+ , line ")"

877+ ]

878+ , line "Support for legacy operator sections will be removed in PureScript 0.9."

879+ ]

880+ where

881+ renderOperator (PositionedValue _ _ ex) = renderOperator ex

882+ renderOperator (Var (Qualified _ (Op ident))) = line ident

883+ renderOperator other = Box.hcat Box.top [ line "`", prettyPrintValue valueDepth other, line "`" ]

855 renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =

884 renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =

856− paras [ line $ "Import uses the deprecated 'qualified' syntax:"

885+ paras [ line "Import uses the deprecated 'qualified' syntax:"

857 , indent $ line $ "import qualified " ++ runModuleName name ++ " as " ++ runModuleName qualName

886 , indent $ line $ "import qualified " ++ runModuleName name ++ " as " ++ runModuleName qualName

858 , line "Should instead use the form:"

887 , line "Should instead use the form:"

859 , indent $ line $ "import " ++ runModuleName name ++ " as " ++ runModuleName qualName

888 , indent $ line $ "import " ++ runModuleName name ++ " as " ++ runModuleName qualName

860− , line $ "The deprecated syntax will be removed in PureScript 0.9."

889+ , line "The deprecated syntax will be removed in PureScript 0.9."

861 ]

890 ]

862

891

863 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

892 renderSimpleErrorMessage (DeprecatedClassImport mn name) =

@@ -865,15 +894,15 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

865 , indent $ line $ runProperName name

894 , indent $ line $ runProperName name

866 , line "Should instead use the form:"

895 , line "Should instead use the form:"

867 , indent $ line $ "class " ++ runProperName name

896 , indent $ line $ "class " ++ runProperName name

868− , line $ "The deprecated syntax will be removed in PureScript 0.9."

897+ , line "The deprecated syntax will be removed in PureScript 0.9."

869 ]

898 ]

870

899

871 renderSimpleErrorMessage (DeprecatedClassExport name) =

900 renderSimpleErrorMessage (DeprecatedClassExport name) =

872− paras [ line $ "Class export uses deprecated syntax that omits the 'class' keyword:"

901+ paras [ line "Class export uses deprecated syntax that omits the 'class' keyword:"

873 , indent $ line $ runProperName name

902 , indent $ line $ runProperName name

874 , line "Should instead use the form:"

903 , line "Should instead use the form:"

875 , indent $ line $ "class " ++ runProperName name

904 , indent $ line $ "class " ++ runProperName name

876− , line $ "The deprecated syntax will be removed in PureScript 0.9."

905+ , line "The deprecated syntax will be removed in PureScript 0.9."

877 ]

906 ]

878

907

879 renderSimpleErrorMessage (RedundantUnqualifiedImport name imp) =

908 renderSimpleErrorMessage (RedundantUnqualifiedImport name imp) =

@@ -915,9 +944,13 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap

915 ]

944 ]

916

945

917 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =

946 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =

918− paras $ [ line $ "Binder list length differs in case alternative:"

947+ paras [ line "Binder list length differs in case alternative:"

919− , indent $ line $ intercalate ", " $ fmap prettyPrintBinderAtom bs

948+ , indent $ line $ intercalate ", " $ fmap prettyPrintBinderAtom bs

920− , line $ "Expecting " ++ show l ++ " binder" ++ (if l == 1 then "" else "s") ++ "." ]

949+ , line $ "Expecting " ++ show l ++ " binder" ++ (if l == 1 then "" else "s") ++ "."

950+ ]

951+

952+ renderSimpleErrorMessage IncorrectAnonymousArgument =

953+ line "An anonymous function argument appears in an invalid context."

921

954

922 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

955 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

923 renderHint (ErrorUnifyingTypes t1 t2) detail =

956 renderHint (ErrorUnifyingTypes t1 t2) detail =

src/Language/PureScript/Linter.hs+1

@@ -71,6 +71,7 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl

71 go d | Just i <- getDeclIdent d

72 , i `S.member` s = errorMessage (ShadowedName i)

73 | otherwise = mempty

74+ stepE _ (OperatorSection op val) = errorMessage $ DeprecatedOperatorSection op val

74 stepE _ _ = mempty

75 stepE _ _ = mempty

76 stepB :: S.Set Ident -> Binder -> MultipleErrors

77 stepB :: S.Set Ident -> Binder -> MultipleErrors

src/Language/PureScript/Parser/Declarations.hs+13−19

@@ -312,18 +312,17 @@ parseArrayLiteral :: TokenParser Expr

312parseArrayLiteral = ArrayLiteral <$> squares (commaSep parseValue)

313

314parseObjectLiteral :: TokenParser Expr

315−parseObjectLiteral = ObjectConstructor <$> braces (commaSep parseIdentifierAndValue)

315+parseObjectLiteral = ObjectLiteral <$> braces (commaSep parseIdentifierAndValue)

316

317−parseIdentifierAndValue :: TokenParser (String, Maybe Expr)

317+parseIdentifierAndValue :: TokenParser (String, Expr)

318parseIdentifierAndValue =

319 do

320 name <- C.indented *> lname

321− b <- P.option (Just $ Var $ Qualified Nothing (Ident name)) rest

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

322 return (name, b)

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

324 where

325− rest = C.indented *> colon *> C.indented *> val

325+ rest = C.indented *> colon *> C.indented *> parseValue

326− val = P.try (Just <$> parseValue) <|> (underscore *> pure Nothing)

327

326

328parseAbs :: TokenParser Expr

327parseAbs :: TokenParser Expr

329parseAbs = do

328parseAbs = do

@@ -373,13 +372,13 @@ parseLet = do

373

372

374parseValueAtom :: TokenParser Expr

373parseValueAtom :: TokenParser Expr

375parseValueAtom = P.choice

374parseValueAtom = P.choice

375+ [ parseAnonymousArgument

376− [ parseNumericLiteral

376+ , parseNumericLiteral

377 , parseCharLiteral

378 , parseStringLiteral

379 , parseBooleanLiteral

380 , parseArrayLiteral

381 , P.try parseObjectLiteral

382− , P.try parseObjectGetter

383 , parseAbs

382 , parseAbs

384 , P.try parseConstructor

383 , P.try parseConstructor

385 , P.try parseVar

384 , P.try parseVar

@@ -389,8 +388,6 @@ parseValueAtom = P.choice

389 , parseLet

388 , parseLet

390 , P.try $ Parens <$> parens parseValue

389 , P.try $ Parens <$> parens parseValue

391 , parseOperatorSection

390 , parseOperatorSection

392− -- TODO: combine this with parseObjectGetter

393− , parseObjectUpdaterWildcard

394 ]

391 ]

395

392

396-- |

393-- |

@@ -406,11 +403,11 @@ parseOperatorSection = parens $ left <|> right

406 right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> indexersAndAccessors)

403 right = OperatorSection <$> parseInfixExpr <* indented <*> (Right <$> indexersAndAccessors)

407 left = flip OperatorSection <$> (Left <$> indexersAndAccessors) <* indented <*> parseInfixExpr

404 left = flip OperatorSection <$> (Left <$> indexersAndAccessors) <* indented <*> parseInfixExpr

408

405

409−parsePropertyUpdate :: TokenParser (String, Maybe Expr)

406+parsePropertyUpdate :: TokenParser (String, Expr)

410parsePropertyUpdate = do

407parsePropertyUpdate = do

411 name <- lname <|> stringLiteral

408 name <- lname <|> stringLiteral

412 _ <- C.indented *> equals

409 _ <- C.indented *> equals

413− value <- C.indented *> (underscore *> pure Nothing) <|> (Just <$> parseValue)

410+ value <- C.indented *> parseValue

414 return (name, value)

411 return (name, value)

415

412

416parseAccessor :: Expr -> TokenParser Expr

413parseAccessor :: Expr -> TokenParser Expr

@@ -436,15 +433,12 @@ parseDoNotationElement = P.choice

436 , DoNotationValue <$> parseValue

433 , DoNotationValue <$> parseValue

437 ]

434 ]

438

435

439−parseObjectGetter :: TokenParser Expr

440−parseObjectGetter = ObjectGetter <$> (underscore *> C.indented *> dot *> C.indented *> (lname <|> stringLiteral))

441−

442-- | Expressions including indexers and record updates

436-- | Expressions including indexers and record updates

443indexersAndAccessors :: TokenParser Expr

437indexersAndAccessors :: TokenParser Expr

444indexersAndAccessors = C.buildPostfixParser postfixTable parseValueAtom

438indexersAndAccessors = C.buildPostfixParser postfixTable parseValueAtom

445 where

439 where

446 postfixTable = [ parseAccessor

440 postfixTable = [ parseAccessor

447− , P.try . parseUpdaterBody . Just

441+ , P.try . parseUpdaterBody

448 ]

442 ]

449

443

450-- |

444-- |

@@ -466,11 +460,11 @@ parseValue = withSourceSpan PositionedValue

466 ]

460 ]

467 ]

461 ]

468

462

469−parseUpdaterBody :: Maybe Expr -> TokenParser Expr

463+parseUpdaterBody :: Expr -> TokenParser Expr

470−parseUpdaterBody v = ObjectUpdater v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))

464+parseUpdaterBody v = ObjectUpdate v <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate)))

471

465

472−parseObjectUpdaterWildcard :: TokenParser Expr

466+parseAnonymousArgument :: TokenParser Expr

473−parseObjectUpdaterWildcard = underscore *> C.indented *> parseUpdaterBody Nothing

467+parseAnonymousArgument = underscore *> pure AnonymousArgument

474

468

475parseStringBinder :: TokenParser Binder

469parseStringBinder :: TokenParser Binder

476parseStringBinder = StringBinder <$> stringLiteral

470parseStringBinder = StringBinder <$> stringLiteral

src/Language/PureScript/Pretty/Values.hs+1−3

@@ -57,7 +57,6 @@ prettyPrintValue d (IfThenElse cond th el) =

57 ])

58prettyPrintValue d (Accessor prop val) = prettyPrintValueAtom (d - 1) val <> text ("." ++ show prop)

59prettyPrintValue d (ObjectUpdate o ps) = prettyPrintValueAtom (d - 1) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> prettyPrintValue (d - 1) val) ps

60−prettyPrintValue d (ObjectUpdater o ps) = maybe (text "_") (prettyPrintValueAtom (d - 1)) o <> text " " <> list '{' '}' (\(key, val) -> text (key ++ " = ") <> maybe (text "_") (prettyPrintValue (d - 1)) val) ps

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

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

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

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

63prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =

62prettyPrintValue d (TypeClassDictionaryConstructorApp className ps) =

@@ -86,8 +85,7 @@ prettyPrintValueAtom _ (BooleanLiteral True) = text "true"

86prettyPrintValueAtom _ (BooleanLiteral False) = text "false"

85prettyPrintValueAtom _ (BooleanLiteral False) = text "false"

87prettyPrintValueAtom d (ArrayLiteral xs) = list '[' ']' (prettyPrintValue (d - 1)) xs

86prettyPrintValueAtom d (ArrayLiteral xs) = list '[' ']' (prettyPrintValue (d - 1)) xs

88prettyPrintValueAtom d (ObjectLiteral ps) = prettyPrintObject (d - 1) $ second Just `map` ps

87prettyPrintValueAtom d (ObjectLiteral ps) = prettyPrintObject (d - 1) $ second Just `map` ps

89−prettyPrintValueAtom d (ObjectConstructor ps) = prettyPrintObject (d - 1) ps

88+prettyPrintValueAtom _ AnonymousArgument = text "_"

90−prettyPrintValueAtom _ (ObjectGetter prop) = text $ "_." ++ show prop

91prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify name)

89prettyPrintValueAtom _ (Constructor name) = text $ runProperName (disqualify name)

92prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)

90prettyPrintValueAtom _ (Var ident) = text $ showIdent (disqualify ident)

93prettyPrintValueAtom d (OperatorSection op (Right val)) = ((text "(" <> prettyPrintValue (d - 1) op) `beforeWithSpace` prettyPrintValue (d - 1) val) `before` text ")"

91prettyPrintValueAtom d (OperatorSection op (Right val)) = ((text "(" <> prettyPrintValue (d - 1) op) `beforeWithSpace` prettyPrintValue (d - 1) val) `before` text ")"

src/Language/PureScript/Sugar/ObjectWildcards.hs+36−15

@@ -1,4 +1,5 @@

1{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE PatternGuards #-}

2{-# LANGUAGE ScopedTypeVariables #-}

3{-# LANGUAGE ScopedTypeVariables #-}

4module Language.PureScript.Sugar.ObjectWildcards (

5module Language.PureScript.Sugar.ObjectWildcards (

@@ -8,12 +9,11 @@ module Language.PureScript.Sugar.ObjectWildcards (

8import Prelude ()

9import Prelude ()

9import Prelude.Compat

10import Prelude.Compat

11−import Control.Arrow (second)

12import Control.Monad.Error.Class (MonadError(..))

13import Control.Monad.Supply.Class

15import Data.List (partition)

16−import Data.Maybe (isJust, fromJust, catMaybes)

16+import Data.Maybe (catMaybes)

18import Language.PureScript.AST

19import Language.PureScript.Errors

@@ -24,30 +24,51 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

24 where

26 desugarDecl :: Declaration -> m Declaration

27+ desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d

28+ desugarDecl other = f other

29+ where

27− (desugarDecl, _, _) = everywhereOnValuesM return desugarExpr return

30+ (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return

29 desugarExpr :: Expr -> m Expr

32 desugarExpr :: Expr -> m Expr

30− desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps

33+ desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument

31− desugarExpr (ObjectUpdater (Just obj) ps) = wrapLambda (ObjectUpdate obj) ps

34+ desugarExpr (Parens b)

32− desugarExpr (ObjectUpdater Nothing ps) = do

35+ | b' <- stripPositionInfo b

36+ , BinaryNoParens op val u <- b'

37+ , isAnonymousArgument u = return $ OperatorSection op (Left val)

38+ | b' <- stripPositionInfo b

39+ , BinaryNoParens op u val <- b'

40+ , isAnonymousArgument u = return $ OperatorSection op (Right val)

41+ desugarExpr (ObjectLiteral ps) = wrapLambda ObjectLiteral ps

42+ desugarExpr (ObjectUpdate u ps) | isAnonymousArgument u = do

33 obj <- freshIdent'

43 obj <- freshIdent'

34 Abs (Left obj) <$> wrapLambda (ObjectUpdate (Var (Qualified Nothing obj))) ps

44 Abs (Left obj) <$> wrapLambda (ObjectUpdate (Var (Qualified Nothing obj))) ps

35− desugarExpr (ObjectGetter prop) = do

45+ desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps

46+ desugarExpr (Accessor prop u) | isAnonymousArgument u = do

36 arg <- freshIdent'

47 arg <- freshIdent'

37 return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))

48 return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))

38 desugarExpr e = return e

49 desugarExpr e = return e

40− wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Maybe Expr)] -> m Expr

51+ wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Expr)] -> m Expr

41 wrapLambda mkVal ps =

52 wrapLambda mkVal ps =

42− let (props, args) = partition (isJust . snd) ps

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

43 in if null args

54 in if null args

44− then return . mkVal $ second fromJust `map` props

55+ then return $ mkVal props

45 else do

56 else do

46 (args', ps') <- unzip <$> mapM mkProp ps

57 (args', ps') <- unzip <$> mapM mkProp ps

47 return $ foldr (Abs . Left) (mkVal ps') (catMaybes args')

58 return $ foldr (Abs . Left) (mkVal ps') (catMaybes args')

60+ stripPositionInfo :: Expr -> Expr

61+ stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e

62+ stripPositionInfo e = e

63+

64+ isAnonymousArgument :: Expr -> Bool

65+ isAnonymousArgument AnonymousArgument = True

66+ isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e

67+ isAnonymousArgument _ = False

68+

49− mkProp :: (String, Maybe Expr) -> m (Maybe Ident, (String, Expr))

69+ mkProp :: (String, Expr) -> m (Maybe Ident, (String, Expr))

50− mkProp (name, Just e) = return (Nothing, (name, e))

70+ mkProp (name, e)

51− mkProp (name, Nothing) = do

71+ | isAnonymousArgument e = do

52− arg <- freshIdent'

72+ arg <- freshIdent'

53− return (Just arg, (name, Var (Qualified Nothing arg)))

73+ return (Just arg, (name, Var (Qualified Nothing arg)))

74+ | otherwise = return (Nothing, (name, e))