3d63f82 · elk · git.iko.soy

git.iko.soy/elk

Get parse error messages looking good

commit3d63f8270d4db2f7528844ac2468a9fe6f87e8ff authorEvan Czaplicki <info@elm-lang.org> dateSat 9 May 2015, 16:29 (11 years ago) parent4a5d921

10 files changed+183−86

compare with master

unifiedsplit

src/Parse/Declaration.hs+6−2 src/Parse/Expression.hs+20−13 src/Parse/Helpers.hs+52−35 src/Parse/Literal.hs+4−4 src/Parse/Module.hs+11−8 src/Parse/Parse.hs+3−3 src/Parse/Pattern.hs+2−2 src/Parse/Type.hs+3−3 src/Reporting/Error/Syntax.hs+81−15 src/Reporting/Report.hs+1−1

src/Parse/Declaration.hs+6−2

@@ -19,14 +19,16 @@ declaration =

1919

2020definition :: IParser D.SourceDecl'

2121definition =

22− D.Definition <$> (Expr.typeAnnotation <|> Expr.definition)

22+ D.Definition

23+ <$> (Expr.typeAnnotation <|> Expr.definition)

24+ <?> "a value definition"

2325

2426

2527-- TYPE ALIAS and UNION TYPES

2628

2729typeDecl :: IParser D.SourceDecl'

2830typeDecl =

29− do try (reserved "type") <?> "type declaration"

31+ do try (reserved "type") <?> "a type declaration"

3032 forcedWS

3133 isAlias <- optionMaybe (string "alias" >> forcedWS)

3234

@@ -48,6 +50,7 @@ typeDecl =

4850

4951infixDecl :: IParser D.SourceDecl'

5052infixDecl =

53+ expecting "an infix declaration" $

5154 do assoc <-

5255 choice

5356 [ try (reserved "infixl") >> return D.L

@@ -64,6 +67,7 @@ infixDecl =

6467

6568port :: IParser D.SourceDecl'

6669port =

70+ expecting "a port declaration" $

6771 do try (reserved "port")

6872 whitespace

6973 name <- lowVar

src/Parse/Expression.hs+20−13

@@ -24,7 +24,7 @@ import qualified Reporting.Annotation as A

2424

2525varTerm :: IParser Source.Expr'

2626varTerm =

27− toVar <$> var <?> "variable"

27+ toVar <$> var

2828

2929

3030toVar :: String -> Source.Expr'

@@ -56,7 +56,10 @@ accessor =

5656negative :: IParser Source.Expr'

5757negative =

5858 do (start, nTerm, end) <-

59− located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)

59+ located $ try $

60+ do char '-'

61+ notFollowedBy (char '.' <|> char '-')

62+ term

6063

6164 let ann e =

6265 A.at start end e

@@ -179,7 +182,7 @@ recordTerm =

179182 [ do equals

180183 whitespace

181184 E.Insert record field <$> expr

182− , do string "<-"

185+ , do leftArrow

183186 whitespace

184187 value <- expr

185188 updates <- spaceyPrefixBy comma update

@@ -188,22 +191,22 @@ recordTerm =

188191

189192 update =

190193 do lbl <- rLabel

191− padded (string "<-")

194+ padded leftArrow

192195 (,) lbl <$> expr

193196

194197

195−

196198term :: IParser Source.Expr

197199term =

198200 addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])

199201 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

200− <?> "basic term (4, x, 'c', etc.)"

202+ <?> "an expression"

201203

202204

203205-------- Applications --------

204206

205207appExpr :: IParser Source.Expr

206208appExpr =

209+ expecting "an expression" $

207210 do t <- term

208211 ts <- constrainedSpacePrefix term $ \str ->

209212 if null str then notFollowedBy (char '-') else return ()

@@ -227,8 +230,10 @@ binaryExpr :: IParser Source.Expr

227230binaryExpr =

228231 Binop.binops appExpr lastExpr anyOp

229232 where

230− lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

231− <|> lambdaExpr

233+ lastExpr =

234+ addLocation (choice [ ifExpr, letExpr, caseExpr ])

235+ <|> lambdaExpr

236+ <?> "an expression"

232237

233238

234239ifExpr :: IParser Source.Expr'

@@ -254,17 +259,19 @@ ifExpr =

254259 E.MultiIf <$> spaceSep1 iff

255260 where

256261 iff =

257− do string "|" ; whitespace

258− b <- expr ; padded arrow

262+ do string "|"

263+ whitespace

264+ b <- expr

265+ padded rightArrow

259266 (,) b <$> expr

260267

261268

262269lambdaExpr :: IParser Source.Expr

263270lambdaExpr =

264− do char '\\' <|> char '\x03BB' <?> "anonymous function"

271+ do char '\\' <|> char '\x03BB' <?> "an anonymous function"

265272 whitespace

266273 args <- spaceSep1 Pattern.term

267− padded arrow

274+ padded rightArrow

268275 body <- expr

269276 return (makeFunction args body)

270277

@@ -279,7 +286,7 @@ caseExpr =

279286 where

280287 case_ =

281288 do p <- Pattern.expr

282− padded arrow

289+ padded rightArrow

283290 (,) p <$> expr

284291

285292 with =

src/Parse/Helpers.hs+52−35

@@ -20,6 +20,7 @@ import qualified AST.Literal as L

2020import qualified AST.Variable as Variable

2121import Elm.Utils ((|>))

2222import qualified Reporting.Annotation as A

23+import qualified Reporting.Error.Syntax as Syntax

2324import qualified Reporting.Region as R

2425

2526

@@ -37,9 +38,13 @@ reserveds =

3738 ]

3839

3940

41+-- ERROR HELP

42+

4043expecting = flip (<?>)

4144

4245

46+-- SETUP

47+

4348type OpTable = Map.Map String (Int, Decl.Assoc)

4449type SourceM = State SourcePos

4550type IParser a = ParsecT String OpTable SourceM a

@@ -59,17 +64,17 @@ iParseWithTable sourceName table aParser input =

5964

6065var :: IParser String

6166var =

62− makeVar (letter <|> char '_' <?> "variable")

67+ makeVar (letter <|> char '_') <?> "a variable"

6368

6469

6570lowVar :: IParser String

6671lowVar =

67− makeVar (lower <?> "lower case variable")

72+ makeVar lower <?> "a lower case variable"

6873

6974

7075capVar :: IParser String

7176capVar =

72− makeVar (upper <?> "upper case variable")

77+ makeVar upper <?> "an upper case variable"

7378

7479

7580qualifiedVar :: IParser String

@@ -84,15 +89,15 @@ rLabel = lowVar

8489

8590innerVarChar :: IParser Char

8691innerVarChar =

87− alphaNum <|> char '_' <|> char '\'' <?> ""

92+ alphaNum <|> char '_' <|> char '\'' <?> "more letters in this variable"

8893

8994

9095makeVar :: IParser Char -> IParser String

91−makeVar p =

92− do v <- (:) <$> p <*> many innerVarChar

93− if v `elem` reserveds

94− then fail $ "unexpected keyword '" ++ v ++ "', variables cannot be keywords"

95− else return v

96+makeVar firstChar =

97+ do variable <- (:) <$> firstChar <*> many innerVarChar

98+ if variable `elem` reserveds

99+ then fail (Syntax.keyword variable)

100+ else return variable

96101

97102

98103reserved :: String -> IParser String

@@ -109,7 +114,7 @@ anyOp :: IParser String

109114anyOp =

110115 betwixt '`' '`' qualifiedVar

111116 <|> symOp

112− <?> "infix operator"

117+ <?> "an infix operator like (+)"

113118

114119

115120symOp :: IParser String

@@ -124,13 +129,23 @@ symOp =

124129-- COMMON SYMBOLS

125130

126131equals :: IParser String

127−equals = string "="

132+equals =

133+ string "=" <?> "="

134+

135+

136+rightArrow :: IParser String

137+rightArrow =

138+ string "->" <|> string "\8594" <?> "->"

139+

140+

141+leftArrow :: IParser String

142+leftArrow =

143+ string "<-" <?> "<- for a record update"

128144

129−arrow :: IParser String

130−arrow = string "->" <|> string "\8594" <?> "arrow (->)"

131145

132146hasType :: IParser String

133−hasType = string ":" <?> "':' (a type annotation)'"

147+hasType =

148+ string ":" <?> "the \"has type\" symbol ':'"

134149

135150

136151commitIf check p =

@@ -155,7 +170,7 @@ spaceyPrefixBy sep parser =

155170

156171comma :: IParser Char

157172comma =

158− char ',' <?> "comma ','"

173+ char ',' <?> "a comma ','"

159174

160175

161176commaSep1 :: IParser a -> IParser [a]

@@ -170,17 +185,17 @@ commaSep =

170185

171186semiSep1 :: IParser a -> IParser [a]

172187semiSep1 =

173− spaceySepBy1 (char ';' <?> "semicolon ';'")

188+ spaceySepBy1 (char ';' <?> "a semicolon ';'")

174189

175190

176191pipeSep1 :: IParser a -> IParser [a]

177192pipeSep1 =

178− spaceySepBy1 (char '|' <?> "type divider '|'")

193+ spaceySepBy1 (char '|' <?> "a vertical bar '|'")

179194

180195

181196consSep1 :: IParser a -> IParser [a]

182197consSep1 =

183− spaceySepBy1 (string "::" <?> "cons operator '::'")

198+ spaceySepBy1 (string "::" <?> "a cons operator '::'")

184199

185200

186201dotSep1 :: IParser a -> IParser [a]

@@ -197,15 +212,15 @@ spacePrefix p =

197212 constrainedSpacePrefix p (\_ -> return ())

198213

199214

200−constrainedSpacePrefix p constraint =

215+constrainedSpacePrefix parser constraint =

201216 many $ choice

202− [ try (spacing >> lookAhead (oneOf "[({")) >> p

203− , try (spacing >> p)

217+ [ try (spacing >> lookAhead (oneOf "[({")) >> parser

218+ , try (spacing >> parser)

204219 ]

205220 where

206221 spacing = do

207222 n <- whitespace

208− constraint n

223+ constraint n <?> Syntax.whitespace

209224 indented

210225

211226

@@ -220,14 +235,14 @@ followedBy a b =

220235betwixt a b c =

221236 do char a

222237 out <- c

223− char b <?> "closing '" ++ [b] ++ "'"

238+ char b <?> "a closing '" ++ [b] ++ "'"

224239 return out

225240

226241

227242surround a z name p = do

228243 char a

229244 v <- padded p

230− char z <?> unwords ["closing", name, show z]

245+ char z <?> unwords ["a closing", name, show z]

231246 return v

232247

233248

@@ -273,7 +288,7 @@ accessible exprParser =

273288

274289 annotatedRootExpr@(A.A _ rootExpr) <- exprParser

275290

276− access <- optionMaybe (try dot <?> "field access (e.g. List.map)")

291+ access <- optionMaybe (try dot <?> "a field access like .name")

277292

278293 case access of

279294 Nothing ->

@@ -281,7 +296,7 @@ accessible exprParser =

281296

282297 Just _ ->

283298 accessible $

284− do v <- var <?> "field access (e.g. List.map)"

299+ do v <- var

285300 end <- getMyPosition

286301 return . A.at start end $

287302 case rootExpr of

@@ -294,7 +309,8 @@ accessible exprParser =

294309

295310dot :: IParser ()

296311dot =

297− char '.' >> notFollowedBy (char '.')

312+ do char '.'

313+ notFollowedBy (char '.')

298314

299315

300316-- WHITESPACE

@@ -309,7 +325,7 @@ padded p =

309325

310326spaces :: IParser String

311327spaces =

312− let space = string " " <|> multiComment <?> "whitespace"

328+ let space = string " " <|> multiComment <?> Syntax.whitespace

313329 in

314330 concat <$> many1 space

315331

@@ -338,14 +354,14 @@ whitespace =

338354

339355freshLine :: IParser [[String]]

340356freshLine =

341− try (many1 newline >> many space_nl) <|> try (many1 space_nl) <?> ""

357+ try (many1 newline >> many space_nl) <|> try (many1 space_nl) <?> Syntax.freshLine

342358 where

343359 space_nl = try $ spaces >> many1 newline

344360

345361

346362newline :: IParser String

347363newline =

348− simpleNewline <|> lineComment <?> "a newline"

364+ simpleNewline <|> lineComment <?> Syntax.newline

349365

350366

351367simpleNewline :: IParser String

@@ -369,7 +385,7 @@ closeComment :: IParser String

369385closeComment =

370386 anyUntil $

371387 choice $

372− [ try (string "-}") <?> "close comment"

388+ [ try (string "-}") <?> "the end of a comment -}"

373389 , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]

374390 ]

375391

@@ -518,9 +534,10 @@ glSource src =

518534

519535

520536str :: IParser String

521−str = expecting "String" $ do

522− s <- choice [ multiStr, singleStr ]

523− processAs T.stringLiteral . sandwich '\"' $ concat s

537+str =

538+ expecting "a string" $

539+ do s <- choice [ multiStr, singleStr ]

540+ processAs T.stringLiteral . sandwich '\"' $ concat s

524541 where

525542 rawString quote insides =

526543 quote >> manyTill insides quote

@@ -560,7 +577,7 @@ escaped delim =

560577

561578chr :: IParser Char

562579chr =

563− betwixt '\'' '\'' character <?> "character"

580+ betwixt '\'' '\'' character <?> "a character"

564581 where

565582 nonQuote = satisfy (/='\'')

566583

src/Parse/Literal.hs+4−4

@@ -9,19 +9,19 @@ import qualified AST.Literal as L

1010literal :: IParser L.Literal

1111literal =

12− num <|> (L.Str <$> str) <|> (L.Chr <$> chr) <?> "literal"

12+ num <|> (L.Str <$> str) <|> (L.Chr <$> chr)

1313

1414

1515num :: IParser L.Literal

1616num =

17− toLiteral <$> (rawNumber <?> "number")

17+ toLiteral <$> (rawNumber <?> "a number")

1818

1919

2020toLiteral :: String -> L.Literal

2121toLiteral n

22− | 'x' `elem` n = L.IntNum (read n)

22+ | 'x' `elem` n = L.IntNum (read n)

2323 | any (`elem` ".eE") n = L.FloatNum (read n)

24− | otherwise = L.IntNum (read n)

24+ | otherwise = L.IntNum (read n)

2525

2626

2727rawNumber :: IParser String

src/Parse/Module.hs+11−8

@@ -32,12 +32,13 @@ header =

3232

3333moduleDecl :: IParser ([String], Var.Listing (A.Located Var.Value))

3434moduleDecl =

35+ expecting "a module declaration" $

3536 do try (reserved "module")

3637 whitespace

37− names <- dotSep1 capVar <?> "name of module"

38+ names <- dotSep1 capVar <?> "the name of this module"

3839 whitespace

3940 exports <- option Var.openListing (listing (addLocation value))

40− whitespace <?> "reserved word 'where'"

41+ whitespace

4142 reserved "where"

4243 return (names, exports)

4344

@@ -49,6 +50,7 @@ imports =

4950

5051import' :: IParser Module.UserImport

5152import' =

53+ expecting "an import" $

5254 addLocation $

5355 do try (reserved "import")

5456 whitespace

@@ -58,14 +60,14 @@ import' =

5860 method :: String -> IParser Module.ImportMethod

5961 method defaultAlias =

6062 Module.ImportMethod

61− <$> option (Just defaultAlias) (Just <$> as')

63+ <$> option (Just defaultAlias) (Just <$> as' defaultAlias)

6264 <*> option Var.closedListing exposing

6365

64− as' :: IParser String

65− as' =

66+ as' :: String -> IParser String

67+ as' moduleName =

6668 do try (whitespace >> reserved "as")

6769 whitespace

68− capVar <?> "alias for module"

70+ capVar <?> ("an alias for module '" ++ moduleName ++ "'")

6971

7072 exposing :: IParser (Var.Listing Var.Value)

7173 exposing =

@@ -76,13 +78,14 @@ import' =

7678

7779listing :: IParser a -> IParser (Var.Listing a)

7880listing item =

81+ expecting "a listing of values to expose, like (..)" $

7982 do try (whitespace >> char '(')

8083 whitespace

8184 listing <-

8285 choice

8386 [ const Var.openListing <$> string ".."

8487 , Var.Listing <$> commaSep1 item <*> return False

85− ] <?> "listing of values (x,y,z)"

88+ ]

8689 whitespace

8790 char ')'

8891 return listing

@@ -90,7 +93,7 @@ listing item =

9093

9194value :: IParser Var.Value

9295value =

93− val <|> tipe

96+ val <|> tipe <?> "a value to expose"

9497 where

9598 val =

9699 Var.Value <$> (lowVar <|> parens symOp)

src/Parse/Parse.hs+3−3

@@ -4,7 +4,7 @@ module Parse.Parse (program) where

44import Control.Applicative ((<$>), (<*>))

55import qualified Data.Map as Map

66import qualified Data.Traversable as T

7−import Text.Parsec (char, eof, letter, many, optional, putState, (<|>), (<?>))

7+import Text.Parsec (char, eof, letter, many, optional, putState, (<|>))

88import qualified Text.Parsec.Error as Parsec

1010import qualified AST.Declaration as D

@@ -50,7 +50,7 @@ programParser =

5050

5151declarations :: IParser [D.SourceDecl]

5252declarations =

53− (:) <$> (Decl.declaration <?> "at least one datatype or variable definition")

53+ (:) <$> Decl.declaration

5454 <*> many freshDef

5555

5656

@@ -58,7 +58,7 @@ freshDef :: IParser D.SourceDecl

5858freshDef =

5959 commitIf (freshLine >> (letter <|> char '_')) $

6060 do _ <- freshLine

61− Decl.declaration <?> "another datatype or variable definition"

61+ Decl.declaration

6262

6363

6464-- RUN PARSERS

src/Parse/Pattern.hs+2−2

@@ -89,7 +89,7 @@ list =

8989term :: IParser P.RawPattern

9090term =

9191 choice [ record, tuple, list, basic ]

92− <?> "pattern"

92+ <?> "a pattern"

9393

9494

9595patternConstructor :: IParser P.RawPattern

@@ -104,7 +104,7 @@ patternConstructor =

104104

105105expr :: IParser P.RawPattern

106106expr =

107− asPattern subPattern <?> "pattern"

107+ asPattern subPattern <?> "a pattern"

108108 where

109109 subPattern =

110110 do patterns <- consSep1 (patternConstructor <|> term)

src/Parse/Type.hs+3−3

@@ -15,7 +15,7 @@ import qualified Reporting.Region as R

1515tvar :: IParser Type.Raw

1616tvar =

1717 addLocation

18− (Type.RVar <$> lowVar <?> "type variable")

18+ (Type.RVar <$> lowVar <?> "a type variable")

1919

2020

2121tuple :: IParser Type.Raw

@@ -71,7 +71,7 @@ term =

7171app :: IParser Type.Raw

7272app =

7373 do start <- getMyPosition

74− f <- constructor0 <|> try tupleCtor <?> "type constructor"

74+ f <- constructor0 <|> try tupleCtor <?> "a type constructor"

7575 args <- spacePrefix term

7676 end <- getMyPosition

7777 case args of

@@ -89,7 +89,7 @@ expr :: IParser Type.Raw

8989expr =

9090 do start <- getMyPosition

9191 t1 <- app <|> term

92− arr <- optionMaybe $ try (whitespace >> arrow)

92+ arr <- optionMaybe $ try (whitespace >> rightArrow)

9393 case arr of

9494 Nothing ->

9595 return t1

src/Reporting/Error/Syntax.hs+81−15

@@ -2,6 +2,7 @@

22module Reporting.Error.Syntax where

44import qualified Data.List as List

5+import qualified Data.Set as Set

56import qualified Text.Parsec.Error as Parsec

67import qualified Text.PrettyPrint as P

78import Text.PrettyPrint ((<+>))

@@ -31,10 +32,7 @@ toReport :: Error -> Report.Report

3132toReport err =

3233 case err of

3334 Parse messages ->

34− Report.simple

35− "SYNTAX PROBLEM"

36− "Problem when parsing your code!"

37− (unlines (map parseErrorHint messages))

35+ parseErrorReport messages

3836

3937 InfixDuplicate opName ->

4038 Report.simple

@@ -138,17 +136,85 @@ unboundTypeVars typeName tvar tvars revisedDeclaration =

138136 )

139137

140138

141−parseErrorHint :: Parsec.Message -> String

142−parseErrorHint message =

143− case message of

144− Parsec.SysUnExpect msg ->

145− "SysUnExpect: " ++ msg

139+-- TAGGING PARSE ERRORS

140+

141+newline :: String

142+newline = "NEWLINE"

143+

144+freshLine :: String

145+freshLine = "FRESH_LINE"

146+

147+whitespace :: String

148+whitespace = "WHITESPACE"

149+

150+keyword :: String -> String

151+keyword kwd =

152+ "KEYWORD=" ++ kwd

153+

154+unkeyword :: String -> Maybe String

155+unkeyword message =

156+ if List.isPrefixOf "KEYWORD=" message

157+ then Just (drop (length "KEYWORD=") message)

158+ else Nothing

159+

160+

161+-- REPORTING PARSE ERRORS

162+

163+parseErrorReport :: [Parsec.Message] -> Report.Report

164+parseErrorReport messages =

165+ let

166+ addMsg message hint =

167+ case message of

168+ Parsec.SysUnExpect _msg ->

169+ hint

170+

171+ Parsec.UnExpect _msg ->

172+ hint

173+

174+ Parsec.Expect msg ->

175+ let

176+ msg' =

177+ if msg `elem` [whitespace, newline, freshLine]

178+ then "whitespace"

179+ else msg

180+ in

181+ hint { _expected = Set.insert msg' (_expected hint) }

182+

183+ Parsec.Message msg ->

184+ hint { _messages = msg : _messages hint }

185+

186+ (ParseHint msgs expects) =

187+ foldr addMsg emptyHint messages

188+

189+ preHint =

190+ case msgs of

191+ [msg] ->

192+ case unkeyword msg of

193+ Just kwd ->

194+ "It looks like the keyword '" ++ kwd ++ "' is being used as a variable.\n"

195+ ++ "Try renaming it to something else."

196+ Nothing ->

197+ msg

198+

199+ _ -> "I ran into something unexpected when parsing your code!"

200+

201+ postHint =

202+ if Set.null expects

203+ then ""

204+ else

205+ "I am looking for one of the following things:\n"

206+ ++ concatMap ("\n "++) (Set.toList expects)

207+ in

208+ Report.simple "SYNTAX PROBLEM" preHint postHint

209+

146210

147− Parsec.UnExpect msg ->

148− "UnExpect: " ++ msg

211+data ParseHint = ParseHint

212+ { _messages :: [String]

213+ , _expected :: Set.Set String

214+ }

215+ deriving (Show)

149216

150− Parsec.Expect msg ->

151− "UnExpect: " ++ msg

152217

153− Parsec.Message msg ->

154− "UnExpect: " ++ msg

218+emptyHint :: ParseHint

219+emptyHint =

220+ ParseHint [] Set.empty

src/Reporting/Report.hs+1−1

@@ -57,7 +57,7 @@ grabRegion maybeSubRegion (R.Region start end) source =

5757 in

5858 case relevantLines of

5959 [] ->

60− error "something has gone badly wrong with reporting source locations"

60+ ""

6161

6262 [sourceLine] ->

6363 singleLineRegion startLine sourceLine $