3d63f82 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Get parse error messages looking good

3d63f82Evan Czaplicki11 years ago

src/Parse/Declaration.hs+6−2

compare with master

unifiedsplit

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

20definition :: IParser D.SourceDecl'

21definition =

22+ D.Definition

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

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

24+ <?> "a value definition"

25-- TYPE ALIAS and UNION TYPES

27-- TYPE ALIAS and UNION TYPES

27typeDecl :: IParser D.SourceDecl'

29typeDecl :: IParser D.SourceDecl'

28typeDecl =

30typeDecl =

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

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

30 forcedWS

32 forcedWS

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

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

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

49infixDecl :: IParser D.SourceDecl'

51infixDecl :: IParser D.SourceDecl'

50infixDecl =

52infixDecl =

53+ expecting "an infix declaration" $

51 do assoc <-

54 do assoc <-

52 choice

55 choice

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

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

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

65port :: IParser D.SourceDecl'

68port :: IParser D.SourceDecl'

66port =

69port =

70+ expecting "a port declaration" $

67 do try (reserved "port")

71 do try (reserved "port")

68 whitespace

72 whitespace

69 name <- lowVar

73 name <- lowVar

src/Parse/Expression.hs+20−13

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

25varTerm :: IParser Source.Expr'

26varTerm =

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

27+ toVar <$> var

30toVar :: String -> Source.Expr'

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

56negative :: IParser Source.Expr'

57negative =

58 do (start, nTerm, end) <-

59+ located $ try $

60+ do char '-'

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

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

62+ term

61 let ann e =

64 let ann e =

62 A.at start end e

65 A.at start end e

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

179 [ do equals

182 [ do equals

180 whitespace

183 whitespace

181 E.Insert record field <$> expr

184 E.Insert record field <$> expr

182− , do string "<-"

185+ , do leftArrow

183 whitespace

186 whitespace

184 value <- expr

187 value <- expr

185 updates <- spaceyPrefixBy comma update

188 updates <- spaceyPrefixBy comma update

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

188

191

189 update =

192 update =

190 do lbl <- rLabel

193 do lbl <- rLabel

191− padded (string "<-")

194+ padded leftArrow

192 (,) lbl <$> expr

195 (,) lbl <$> expr

193

196

194

197

195−

196term :: IParser Source.Expr

198term :: IParser Source.Expr

197term =

199term =

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

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

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

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

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

202+ <?> "an expression"

201

203

202

204

203-------- Applications --------

205-------- Applications --------

204

206

205appExpr :: IParser Source.Expr

207appExpr :: IParser Source.Expr

206appExpr =

208appExpr =

209+ expecting "an expression" $

207 do t <- term

210 do t <- term

208 ts <- constrainedSpacePrefix term $ \str ->

211 ts <- constrainedSpacePrefix term $ \str ->

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

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

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

227binaryExpr =

230binaryExpr =

228 Binop.binops appExpr lastExpr anyOp

231 Binop.binops appExpr lastExpr anyOp

229 where

232 where

233+ lastExpr =

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

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

231− <|> lambdaExpr

235+ <|> lambdaExpr

236+ <?> "an expression"

232

237

233

238

234ifExpr :: IParser Source.Expr'

239ifExpr :: IParser Source.Expr'

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

254 E.MultiIf <$> spaceSep1 iff

259 E.MultiIf <$> spaceSep1 iff

255 where

260 where

256 iff =

261 iff =

262+ do string "|"

257− do string "|" ; whitespace

263+ whitespace

258− b <- expr ; padded arrow

264+ b <- expr

265+ padded rightArrow

259 (,) b <$> expr

266 (,) b <$> expr

260

267

261

268

262lambdaExpr :: IParser Source.Expr

269lambdaExpr :: IParser Source.Expr

263lambdaExpr =

270lambdaExpr =

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

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

265 whitespace

272 whitespace

266 args <- spaceSep1 Pattern.term

273 args <- spaceSep1 Pattern.term

267− padded arrow

274+ padded rightArrow

268 body <- expr

275 body <- expr

269 return (makeFunction args body)

276 return (makeFunction args body)

270

277

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

279 where

286 where

280 case_ =

287 case_ =

281 do p <- Pattern.expr

288 do p <- Pattern.expr

282− padded arrow

289+ padded rightArrow

283 (,) p <$> expr

290 (,) p <$> expr

284

291

285 with =

292 with =

src/Parse/Helpers.hs+52−35

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

20import qualified AST.Variable as Variable

21import Elm.Utils ((|>))

22import qualified Reporting.Annotation as A

23+import qualified Reporting.Error.Syntax as Syntax

23import qualified Reporting.Region as R

24import qualified Reporting.Region as R

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

37 ]

38 ]

41+-- ERROR HELP

42+

40expecting = flip (<?>)

43expecting = flip (<?>)

46+-- SETUP

47+

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

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

44type SourceM = State SourcePos

49type SourceM = State SourcePos

45type IParser a = ParsecT String OpTable SourceM a

50type IParser a = ParsecT String OpTable SourceM a

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

60var :: IParser String

65var :: IParser String

61var =

66var =

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

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

65lowVar :: IParser String

70lowVar :: IParser String

66lowVar =

71lowVar =

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

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

70capVar :: IParser String

75capVar :: IParser String

71capVar =

76capVar =

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

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

75qualifiedVar :: IParser String

80qualifiedVar :: IParser String

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

85innerVarChar :: IParser Char

90innerVarChar :: IParser Char

86innerVarChar =

91innerVarChar =

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

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

90makeVar :: IParser Char -> IParser String

95makeVar :: IParser Char -> IParser String

91−makeVar p =

96+makeVar firstChar =

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

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

93− if v `elem` reserveds

98+ if variable `elem` reserveds

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

99+ then fail (Syntax.keyword variable)

95− else return v

100+ else return variable

101

102

98reserved :: String -> IParser String

103reserved :: String -> IParser String

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

109anyOp =

114anyOp =

110 betwixt '`' '`' qualifiedVar

115 betwixt '`' '`' qualifiedVar

111 <|> symOp

116 <|> symOp

112− <?> "infix operator"

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

113

118

114

119

115symOp :: IParser String

120symOp :: IParser String

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

124-- COMMON SYMBOLS

129-- COMMON SYMBOLS

125

130

126equals :: IParser String

131equals :: 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"

128

144

129−arrow :: IParser String

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

131

145

132hasType :: IParser String

146hasType :: IParser String

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

147+hasType =

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

134

149

135

150

136commitIf check p =

151commitIf check p =

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

155

170

156comma :: IParser Char

171comma :: IParser Char

157comma =

172comma =

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

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

159

174

160

175

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

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

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

170

185

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

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

172semiSep1 =

187semiSep1 =

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

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

174

189

175

190

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

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

177pipeSep1 =

192pipeSep1 =

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

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

179

194

180

195

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

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

182consSep1 =

197consSep1 =

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

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

184

199

185

200

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

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

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

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

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

198

213

199

214

200−constrainedSpacePrefix p constraint =

215+constrainedSpacePrefix parser constraint =

201 many $ choice

216 many $ choice

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

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

203− , try (spacing >> p)

218+ , try (spacing >> parser)

204 ]

219 ]

205 where

220 where

206 spacing = do

221 spacing = do

207 n <- whitespace

222 n <- whitespace

208− constraint n

223+ constraint n <?> Syntax.whitespace

209 indented

224 indented

210

225

211

226

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

220betwixt a b c =

235betwixt a b c =

221 do char a

236 do char a

222 out <- c

237 out <- c

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

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

224 return out

239 return out

225

240

226

241

227surround a z name p = do

242surround a z name p = do

228 char a

243 char a

229 v <- padded p

244 v <- padded p

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

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

231 return v

246 return v

232

247

233

248

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

273

288

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

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

275

290

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

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

277

292

278 case access of

293 case access of

279 Nothing ->

294 Nothing ->

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

281

296

282 Just _ ->

297 Just _ ->

283 accessible $

298 accessible $

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

299+ do v <- var

285 end <- getMyPosition

300 end <- getMyPosition

286 return . A.at start end $

301 return . A.at start end $

287 case rootExpr of

302 case rootExpr of

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

294

309

295dot :: IParser ()

310dot :: IParser ()

296dot =

311dot =

312+ do char '.'

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

313+ notFollowedBy (char '.')

298

314

299

315

300-- WHITESPACE

316-- WHITESPACE

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

309

325

310spaces :: IParser String

326spaces :: IParser String

311spaces =

327spaces =

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

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

313 in

329 in

314 concat <$> many1 space

330 concat <$> many1 space

315

331

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

338

354

339freshLine :: IParser [[String]]

355freshLine :: IParser [[String]]

340freshLine =

356freshLine =

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

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

342 where

358 where

343 space_nl = try $ spaces >> many1 newline

359 space_nl = try $ spaces >> many1 newline

344

360

345

361

346newline :: IParser String

362newline :: IParser String

347newline =

363newline =

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

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

349

365

350

366

351simpleNewline :: IParser String

367simpleNewline :: IParser String

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

369closeComment =

385closeComment =

370 anyUntil $

386 anyUntil $

371 choice $

387 choice $

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

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

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

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

374 ]

390 ]

375

391

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

518

534

519

535

520str :: IParser String

536str :: IParser String

537+str =

521−str = expecting "String" $ do

538+ expecting "a string" $

522− s <- choice [ multiStr, singleStr ]

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

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

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

524 where

541 where

525 rawString quote insides =

542 rawString quote insides =

526 quote >> manyTill insides quote

543 quote >> manyTill insides quote

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

560

577

561chr :: IParser Char

578chr :: IParser Char

562chr =

579chr =

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

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

564 where

581 where

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

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

566

583

src/Parse/Literal.hs+4−4

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

10literal :: IParser L.Literal

11literal =

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

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

15num :: IParser L.Literal

16num =

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

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

20toLiteral :: String -> L.Literal

21toLiteral n

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

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

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

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

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

27rawNumber :: IParser String

src/Parse/Module.hs+11−8

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

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

34moduleDecl =

35+ expecting "a module declaration" $

35 do try (reserved "module")

36 do try (reserved "module")

36 whitespace

37 whitespace

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

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

38 whitespace

39 whitespace

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

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

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

41+ whitespace

41 reserved "where"

42 reserved "where"

42 return (names, exports)

43 return (names, exports)

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

50import' :: IParser Module.UserImport

51import' :: IParser Module.UserImport

51import' =

52import' =

53+ expecting "an import" $

52 addLocation $

54 addLocation $

53 do try (reserved "import")

55 do try (reserved "import")

54 whitespace

56 whitespace

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

58 method :: String -> IParser Module.ImportMethod

60 method :: String -> IParser Module.ImportMethod

59 method defaultAlias =

61 method defaultAlias =

60 Module.ImportMethod

62 Module.ImportMethod

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

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

62 <*> option Var.closedListing exposing

64 <*> option Var.closedListing exposing

64− as' :: IParser String

66+ as' :: String -> IParser String

65− as' =

67+ as' moduleName =

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

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

67 whitespace

69 whitespace

68− capVar <?> "alias for module"

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

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

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

71 exposing =

73 exposing =

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

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

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

78listing item =

80listing item =

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

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

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

80 whitespace

83 whitespace

81 listing <-

84 listing <-

82 choice

85 choice

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

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

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

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

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

88+ ]

86 whitespace

89 whitespace

87 char ')'

90 char ')'

88 return listing

91 return listing

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

91value :: IParser Var.Value

94value :: IParser Var.Value

92value =

95value =

93− val <|> tipe

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

94 where

97 where

95 val =

98 val =

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

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

src/Parse/Parse.hs+3−3

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

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

5import qualified Data.Map as Map

6import 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, (<|>))

8import qualified Text.Parsec.Error as Parsec

10import qualified AST.Declaration as D

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

51declarations :: IParser [D.SourceDecl]

52declarations =

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

53+ (:) <$> Decl.declaration

54 <*> many freshDef

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

58freshDef =

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

60 do _ <- freshLine

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

61+ Decl.declaration

64-- RUN PARSERS

src/Parse/Pattern.hs+2−2

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

89term :: IParser P.RawPattern

90term =

91 choice [ record, tuple, list, basic ]

92− <?> "pattern"

92+ <?> "a pattern"

95patternConstructor :: IParser P.RawPattern

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

104

105expr :: IParser P.RawPattern

106expr =

107− asPattern subPattern <?> "pattern"

107+ asPattern subPattern <?> "a pattern"

108 where

109 subPattern =

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

src/Parse/Type.hs+3−3

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

15tvar :: IParser Type.Raw

16tvar =

17 addLocation

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

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

21tuple :: IParser Type.Raw

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

71app :: IParser Type.Raw

72app =

73 do start <- getMyPosition

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

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

75 args <- spacePrefix term

76 end <- getMyPosition

77 case args of

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

89expr =

90 do start <- getMyPosition

91 t1 <- app <|> term

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

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

93 case arr of

94 Nothing ->

95 return t1

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

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

2module Reporting.Error.Syntax where

4import qualified Data.List as List

5+import qualified Data.Set as Set

5import qualified Text.Parsec.Error as Parsec

6import qualified Text.Parsec.Error as Parsec

6import qualified Text.PrettyPrint as P

7import qualified Text.PrettyPrint as P

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

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

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

31toReport err =

32toReport err =

32 case err of

33 case err of

33 Parse messages ->

34 Parse messages ->

34− Report.simple

35+ parseErrorReport messages

35− "SYNTAX PROBLEM"

36− "Problem when parsing your code!"

37− (unlines (map parseErrorHint messages))

39 InfixDuplicate opName ->

37 InfixDuplicate opName ->

40 Report.simple

38 Report.simple

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

138 )

136 )

139

137

140

138

141−parseErrorHint :: Parsec.Message -> String

139+-- TAGGING PARSE ERRORS

142−parseErrorHint message =

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 =

143− case message of

167+ case message of

144− Parsec.SysUnExpect msg ->

168+ Parsec.SysUnExpect _msg ->

145− "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+

146

210

147− Parsec.UnExpect msg ->

211+data ParseHint = ParseHint

148− "UnExpect: " ++ msg

212+ { _messages :: [String]

213+ , _expected :: Set.Set String

214+ }

215+ deriving (Show)

149

216

150− Parsec.Expect msg ->

151− "UnExpect: " ++ msg

152

217

153− Parsec.Message msg ->

218+emptyHint :: ParseHint

154− "UnExpect: " ++ msg

219+emptyHint =

220+ ParseHint [] Set.empty

src/Reporting/Report.hs+1−1

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

57 in

58 case relevantLines of

59 [] ->

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

60+ ""

62 [sourceLine] ->

63 singleLineRegion startLine sourceLine $