7dd0bbd · elk · git.iko.soy

git.iko.soy/elk

Add locations to context stack, allowing nicer error messages

The context stack now says where each bit of context starts. That means we can show all the relevant code when there is a parse error, not just the line where things went wrong.

commit7dd0bbd7e5a3f5a4434b5f589043c2e3d1c5db1d authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 15 Dec 2016, 18:32 (10 years ago) parent3f6ffc3

9 files changed+238−198

compare with master

unifiedsplit

src/Docs/Check.hs+2−3 src/Parse/Declaration.hs+7−6 src/Parse/Expression.hs+13−13 src/Parse/Helpers.hs+3−3 src/Parse/Module.hs+22−18 src/Parse/Pattern.hs+54−46 src/Parse/Primitives.hs+25−16 src/Parse/Type.hs+25−22 src/Reporting/Error/Syntax.hs+87−71

src/Docs/Check.hs+2−3

@@ -12,12 +12,11 @@ import Elm.Utils ((|>))

1212import qualified Reporting.Annotation as A

1313import qualified Reporting.Error as Error

1414import qualified Reporting.Error.Docs as E

15−import qualified Reporting.Error.Syntax as SE

1615import qualified Reporting.Helpers as Help (nearbyNames)

1716import qualified Reporting.Region as R

1817import qualified Reporting.Result as R

1918import Parse.Helpers

20− ( Parser, addLocation, getPosition, inContext

19+ ( Parser, addLocation, getPosition

2120 , spaces, checkSpace, whitespace, SPos(..)

2221 , capVar, lowVar, leftParen, rightParen, infixOp, runAt

2322 , chompUntilDocs, comma, oneOf

@@ -162,7 +161,7 @@ checkModuleComment docRegion exports locatedDocNames =

162161

163162parseNames :: R.Region -> Text -> R.Result () w Error.Error [A.Located Text]

164163parseNames (R.Region (R.Position row col) _) comment =

165− case runAt row (col + 3) (inContext SE.DocComment (namesParser [])) comment of

164+ case runAt row (col + 3) (namesParser []) comment of

166165 Left (A.A region parseError) ->

167166 R.throw region (Error.Syntax parseError)

168167

src/Parse/Declaration.hs+7−6

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

2020

2121declaration :: SParser Decl.Source

2222declaration =

23+ hint E.Decl $

2324 do start <- getPosition

2425 oneOf

2526 [ docDecl start

@@ -62,13 +63,13 @@ typeDecl start =

6263 spaces

6364 oneOf

6465 [ do keyword "alias"

65− inContext E.TypeAlias $

66+ inContext start E.TypeAlias $

6667 do spaces

6768 (name, args) <- nameArgsEquals

6869 (tipe, end, pos) <- Type.expression

6970 let decl = A.at start end (Decl.Alias (Decl.Type name args tipe))

7071 return ( Decl.Whatever decl, end, pos )

71− , inContext E.TypeUnion $

72+ , inContext start E.TypeUnion $

7273 do (name, args) <- nameArgsEquals

7374 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

7475 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace

@@ -116,11 +117,11 @@ infixDecl :: R.Position -> SParser Decl.Source

116117infixDecl start =

117118 oneOf

118119 [ do keyword "infixl"

119− inContext E.Infix $ infixDeclHelp start Decl.L

120+ inContext start E.Infix $ infixDeclHelp start Decl.L

120121 , do keyword "infixr"

121− inContext E.Infix $ infixDeclHelp start Decl.R

122+ inContext start E.Infix $ infixDeclHelp start Decl.R

122123 , do keyword "infix"

123− inContext E.Infix $ infixDeclHelp start Decl.N

124+ inContext start E.Infix $ infixDeclHelp start Decl.N

124125 ]

125126

126127

@@ -143,7 +144,7 @@ infixDeclHelp start assoc =

143144portDecl :: R.Position -> SParser Decl.Source

144145portDecl start =

145146 do keyword "port"

146− inContext E.Port $

147+ inContext start E.Port $

147148 do spaces

148149 name <- lowVar

149150 spaces

src/Parse/Expression.hs+13−13

@@ -81,7 +81,7 @@ accessible start expr =

8181list :: R.Position -> Parser Src.RawExpr

8282list start =

8383 do leftSquare

84− inContext E.ExprList $

84+ inContext start E.ExprList $

8585 do spaces

8686 oneOf

8787 [ do (entry, _, pos) <- expression

@@ -114,7 +114,7 @@ listHelp start entries =

114114tuple :: R.Position -> Parser Src.RawExpr

115115tuple start =

116116 do leftParen

117− inContext E.ExprTuple $ oneOf $

117+ inContext start E.ExprTuple $ oneOf $

118118 [ do op <- infixOp

119119 rightParen

120120 end <- getPosition

@@ -182,7 +182,7 @@ tupleHelp start entries =

182182record :: R.Position -> Parser Src.RawExpr

183183record start =

184184 do leftCurly

185− inContext E.ExprRecord $

185+ inContext start E.ExprRecord $

186186 do spaces

187187 oneOf

188188 [ do rightCurly

@@ -354,7 +354,7 @@ possiblyNegativeTerm start =

354354if_ :: R.Position -> ExprParser

355355if_ start =

356356 do keyword "if"

357− inContext E.ExprIf $ ifHelp start []

357+ inContext start E.ExprIf $ ifHelp start []

358358

359359

360360ifHelp :: R.Position -> [(Src.RawExpr, Src.RawExpr)] -> ExprParser

@@ -385,7 +385,7 @@ ifHelp start branches =

385385function :: R.Position -> ExprParser

386386function start =

387387 do lambda

388− inContext E.ExprFunc $

388+ inContext start E.ExprFunc $

389389 do spaces

390390 arg <- Pattern.term

391391 spaces

@@ -414,12 +414,12 @@ gatherArgs args =

414414case_ :: R.Position -> ExprParser

415415case_ start =

416416 do keyword "case"

417− spaces

418− (switcher, _, switcherPos) <- expression

419− checkSpace switcherPos

420− keyword "of"

421− inContext E.ExprCase $

417+ inContext start E.ExprCase $

422418 do spaces

419+ (switcher, _, switcherPos) <- expression

420+ checkSpace switcherPos

421+ keyword "of"

422+ spaces

423423 oldIndent <- getIndent

424424 newIndent <- getCol

425425 setIndent newIndent

@@ -462,7 +462,7 @@ let_ start =

462462 do oldIndent <- getIndent

463463 letIndent <- getCol

464464 keyword "let"

465− pushContext E.ExprLet

465+ pushContext start E.ExprLet

466466 setIndent letIndent

467467 spaces

468468 defIndent <- getCol

@@ -502,11 +502,11 @@ definition =

502502 P.Var name ->

503503 oneOf

504504 [ do hasType

505− inContext (E.Annotation name) $

505+ inContext start (E.Annotation name) $

506506 do spaces

507507 (tipe, end, space) <- Type.expression

508508 return ( A.at start end (Src.Annotation name tipe), end, space )

509− , inContext (E.Definition name) $

509+ , inContext start (E.Definition name) $

510510 definitionHelp start root []

511511 ]

512512

src/Parse/Helpers.hs+3−3

@@ -185,9 +185,9 @@ addLocation parser =

185185 return (A.at start end value)

186186

187187

188−inContext :: E.Context -> Parser a -> Parser a

189−inContext ctx parser =

190− do P.pushContext ctx

188+inContext :: R.Position -> E.Context -> Parser a -> Parser a

189+inContext pos ctx parser =

190+ do P.pushContext pos ctx

191191 a <- parser

192192 P.popContext a

193193

src/Parse/Module.hs+22−18

@@ -22,7 +22,7 @@ header =

2222 freshLine E.ModuleDecl

2323 end <- getPosition

2424 oneOf

25− [ fullHeader

25+ [ fullHeader end

2626 , Module.defaultHeader start end <$> chompImports []

2727 ]

2828

@@ -31,9 +31,9 @@ header =

3131-- FULL HEADER

3232

3333

34−fullHeader :: Parser (Module.Header [Module.UserImport])

35−fullHeader =

36− do pushContext E.Module

34+fullHeader :: R.Position -> Parser (Module.Header [Module.UserImport])

35+fullHeader start =

36+ do pushContext start E.Module

3737 tag <- sourceTag

3838 spaces

3939 name <- qualifiedCapVar

@@ -43,11 +43,8 @@ fullHeader =

4343 spaces

4444 exports <- listing (addLocation listingValue)

4545 popContext ()

46− start <- getPosition

47− freshLine E.DocCommentDecl

48− end <- getPosition

49− docs <- maybeDocComment start end

50− imports <- inContext E.Import (chompImports [])

46+ docs <- maybeDocComment

47+ imports <- chompImports []

5148 return (Module.Header tag name exports settings docs imports)

5249

5350

@@ -126,15 +123,18 @@ setting =

126123-- DOC COMMENTS

127124

128125

129−maybeDocComment :: R.Position -> R.Position -> Parser (A.Located (Maybe Text))

130−maybeDocComment start end =

131− inContext E.DocComment $

132− oneOf

133− [ do doc <- addLocation docComment

134− freshLine E.ImportDecl

135− return (A.map Just doc)

136− , return (A.at start end Nothing)

137− ]

126+maybeDocComment :: Parser (A.Located (Maybe Text))

127+maybeDocComment =

128+ do oldEnd <- getPosition

129+ freshLine E.DocCommentDecl

130+ newStart <- getPosition

131+ oneOf

132+ [ do doc <- docComment

133+ end <- getPosition

134+ freshLine E.ImportDecl

135+ return (A.at newStart end (Just doc))

136+ , return (A.at oldEnd newStart Nothing)

137+ ]

138138

139139

140140

@@ -146,6 +146,7 @@ chompImports imports =

146146 oneOf

147147 [ do start <- getPosition

148148 keyword "import"

149+ pushContext start E.Import

149150 spaces

150151 name <- qualifiedCapVar

151152 end <- getPosition

@@ -153,6 +154,7 @@ chompImports imports =

153154 oneOf

154155 [ do checkFreshLine E.ImportDecl pos

155156 let userImport = method start end name Nothing Var.closedListing

157+ popContext ()

156158 chompImports (userImport:imports)

157159 , do checkSpace pos

158160 oneOf

@@ -174,6 +176,7 @@ chompAs start name imports =

174176 oneOf

175177 [ do checkFreshLine E.ImportDecl pos

176178 let userImport = method start end name (Just alias) Var.closedListing

179+ popContext ()

177180 chompImports (userImport:imports)

178181 , do checkSpace pos

179182 chompExposing start name (Just alias) imports

@@ -188,6 +191,7 @@ chompExposing start name maybeAlias imports =

188191 end <- getPosition

189192 freshLine E.ImportDecl

190193 let userImport = method start end name maybeAlias exposed

194+ popContext ()

191195 chompImports (userImport:imports)

192196

193197

src/Parse/Pattern.hs+54−46

@@ -21,19 +21,26 @@ import qualified Reporting.Region as R

2121term :: Parser P.Raw

2222term =

2323 hint E.Pattern $

24− oneOf [ record, tuple, list, termHelp ]

25−

26−

27−termHelp :: Parser P.Raw

28−termHelp =

29− addLocation $

30− oneOf

31− [ do underscore

32− return P.Anything

33− , P.Var <$> lowVar

34− , mkCtor <$> qualifiedCapVar

35− , P.Literal <$> Literal.literal

36− ]

24+ do start <- getPosition

25+ oneOf

26+ [ record start

27+ , tuple start

28+ , list start

29+ , termHelp start

30+ ]

31+

32+

33+termHelp :: R.Position -> Parser P.Raw

34+termHelp start =

35+ do pattern <-

36+ oneOf

37+ [ underscore >> return P.Anything

38+ , P.Var <$> lowVar

39+ , mkCtor <$> qualifiedCapVar

40+ , P.Literal <$> Literal.literal

41+ ]

42+ end <- getPosition

43+ return (A.at start end pattern)

3744

3845

3946mkCtor :: Text -> P.Raw'

@@ -53,31 +60,32 @@ mkCtor ctor =

5360-- RECORDS

5461

5562

56−record :: Parser P.Raw

57−record =

58− addLocation $

59− do leftCurly

60− inContext E.ExprRecord $

61− do spaces

62− oneOf

63− [ do var <- lowVar

64− spaces

65− recordHelp [var]

66− , do rightCurly

67− return (P.Record [])

68− ]

63+record :: R.Position -> Parser P.Raw

64+record start =

65+ do leftCurly

66+ inContext start E.ExprRecord $

67+ do spaces

68+ oneOf

69+ [ do var <- lowVar

70+ spaces

71+ recordHelp start [var]

72+ , do rightCurly

73+ end <- getPosition

74+ return (A.at start end (P.Record []))

75+ ]

6976

7077

71−recordHelp :: [Text] -> Parser P.Raw'

72−recordHelp vars =

78+recordHelp :: R.Position -> [Text] -> Parser P.Raw

79+recordHelp start vars =

7380 oneOf

7481 [ do comma

7582 spaces

7683 var <- lowVar

7784 spaces

78− recordHelp (var:vars)

85+ recordHelp start (var:vars)

7986 , do rightCurly

80− return (P.Record vars)

87+ end <- getPosition

88+ return (A.at start end (P.Record vars))

8189 ]

8290

8391

@@ -85,11 +93,10 @@ recordHelp vars =

8593-- TUPLES

8694

8795

88−tuple :: Parser P.Raw

89−tuple =

90− do start <- getPosition

91− leftParen

92− inContext E.ExprTuple $

96+tuple :: R.Position -> Parser P.Raw

97+tuple start =

98+ do leftParen

99+ inContext start E.ExprTuple $

93100 do spaces

94101 oneOf

95102 [ do (pattern, sPos) <- expression

@@ -124,18 +131,19 @@ tupleHelp start patterns =

124131-- LIST

125132

126133

127−list :: Parser P.Raw

128−list =

134+list :: R.Position -> Parser P.Raw

135+list start =

129136 do leftSquare

130− spaces

131− oneOf

132− [ do (pattern, sPos) <- expression

133− checkSpace sPos

134− listHelp [pattern]

135− , do rightSquare

136− end <- getPosition

137− return (P.list end [])

138− ]

137+ inContext start E.PatternList $

138+ do spaces

139+ oneOf

140+ [ do (pattern, sPos) <- expression

141+ checkSpace sPos

142+ listHelp [pattern]

143+ , do rightSquare

144+ end <- getPosition

145+ return (P.list end [])

146+ ]

139147

140148

141149listHelp :: [P.Raw] -> Parser P.Raw

src/Parse/Primitives.hs+25−16

@@ -39,10 +39,9 @@ import qualified AST.Helpers as Help (isSymbol)

3939import qualified AST.Literal as L

4040import qualified Reporting.Annotation as A

4141import qualified Reporting.Error.Syntax as E

42−import qualified Reporting.Region as Region

42+import qualified Reporting.Region as R

4343import Reporting.Error.Syntax

44− ( ParseError(..), Problem(..), Theory(..)

45− , Context(..), BadOp(..)

44+ ( ParseError(..), Problem(..), Theory(..), BadOp(..)

4645 )

4746

4847

@@ -71,7 +70,7 @@ data State =

7170 , _indent :: !Int

7271 , _row :: !Int

7372 , _col :: !Int

74− , _context :: [Context]

73+ , _context :: E.ContextStack

7574 }

7675

7776

@@ -82,7 +81,7 @@ noError =

8281

8382

8483{-# INLINE expect #-}

85−expect :: Int -> Int -> [Context] -> Theory -> ParseError

84+expect :: Int -> Int -> E.ContextStack -> Theory -> ParseError

8685expect row col ctx theory =

8786 ParseError row col (Theories ctx [theory])

8887

@@ -104,10 +103,20 @@ runAt sRow sCol parser (Text.Text array offset length) =

104103

105104 Err (ParseError row col problem) ->

106105 let

107− region =

108− Region.Region (Region.Position row col) (Region.Position row (col + 1))

106+ pos = R.Position row col

107+ region = R.Region pos pos

108+ mkError overallRegion subRegion =

109+ Left (A.A overallRegion (E.Parse subRegion problem))

109110 in

110− Left (A.A region (E.Parse problem))

111+ case problem of

112+ BadOp _ ((_, start) : _) ->

113+ mkError (R.Region start pos) (Just region)

114+

115+ Theories ((_, start) : _) _ ->

116+ mkError (R.Region start pos) (Just region)

117+

118+ _ ->

119+ mkError region Nothing

111120

112121

113122data Result a

@@ -499,10 +508,10 @@ infixOpHelp array offset length row col =

499508-- STATE

500509

501510

502−getPosition :: Parser Region.Position

511+getPosition :: Parser R.Position

503512getPosition =

504513 Parser $ \state@(State _ _ _ _ row col _) _ _ eok _ ->

505− eok (Region.Position row col) state noError

514+ eok (R.Position row col) state noError

506515

507516

508517getIndent :: Parser Int

@@ -517,16 +526,16 @@ getCol =

517526 eok col state noError

518527

519528

520−getContext :: Parser [E.Context]

529+getContext :: Parser E.ContextStack

521530getContext =

522531 Parser $ \state@(State _ _ _ _ _ _ ctx) _ _ eok _ ->

523532 eok ctx state noError

524533

525534

526−pushContext :: E.Context -> Parser ()

527−pushContext ctx =

535+pushContext :: R.Position -> E.Context -> Parser ()

536+pushContext pos ctx =

528537 Parser $ \state@(State _ _ _ _ _ _ context) _ _ eok _ ->

529− eok () (state { _context = ctx : context }) noError

538+ eok () (state { _context = (ctx, pos) : context }) noError

530539

531540

532541popContext :: a -> Parser a

@@ -546,7 +555,7 @@ setIndent indent =

546555

547556

548557newtype SPos =

549− SPos Region.Position

558+ SPos R.Position

550559

551560

552561whitespace :: Parser SPos

@@ -558,7 +567,7 @@ whitespace =

558567

559568 Right (newOffset, newLength, newRow, newCol) ->

560569 cok

561− (SPos (Region.Position newRow newCol))

570+ (SPos (R.Position newRow newCol))

562571 (State array newOffset newLength indent newRow newCol ctx)

563572 noError

564573

src/Parse/Type.hs+25−22

@@ -19,22 +19,24 @@ import qualified Reporting.Region as R

1919term :: Parser Type.Raw

2020term =

2121 hint E.Type $

22− oneOf

23− [ constructor

24− , variable

25− , tuple

26− , record

27− ]

22+ do start <- getPosition

23+ oneOf

24+ [ constructor

25+ , variable start

26+ , tuple start

27+ , record start

28+ ]

2829

2930

3031

3132-- TYPE VARIABLES

3233

3334

34−variable :: Parser Type.Raw

35−variable =

36− addLocation $

37− Type.RVar <$> lowVar

35+variable :: R.Position -> Parser Type.Raw

36+variable start =

37+ do var <- lowVar

38+ end <- getPosition

39+ return (A.at start end (Type.RVar var))

3840

3941

4042

@@ -114,11 +116,10 @@ eatArgs args end pos =

114116-- TUPLES

115117

116118

117−tuple :: Parser Type.Raw

118−tuple =

119− do start <- getPosition

120− leftParen

121− inContext E.TypeTuple $

119+tuple :: R.Position -> Parser Type.Raw

120+tuple start =

121+ do leftParen

122+ inContext start E.TypeTuple $

122123 oneOf

123124 [ do rightParen

124125 end <- getPosition

@@ -153,15 +154,15 @@ tupleEnding start tipes =

153154-- RECORD

154155

155156

156−record :: Parser Type.Raw

157−record =

158− addLocation $

157+record :: R.Position -> Parser Type.Raw

158+record start =

159159 do leftCurly

160− inContext E.TypeRecord $

160+ inContext start E.TypeRecord $

161161 do spaces

162162 oneOf

163163 [ do rightCurly

164− return (Type.RRecord [] Nothing)

164+ end <- getPosition

165+ return (A.at start end (Type.RRecord [] Nothing))

165166 , do var <- addLocation lowVar

166167 spaces

167168 oneOf

@@ -169,13 +170,15 @@ record =

169170 spaces

170171 firstField <- field

171172 fields <- chompFields [firstField]

172− return (Type.RRecord fields (Just (A.map Type.RVar var)))

173+ end <- getPosition

174+ return (A.at start end (Type.RRecord fields (Just (A.map Type.RVar var))))

173175 , do hasType

174176 spaces

175177 (tipe, _, nextPos) <- expression

176178 checkSpace nextPos

177179 fields <- chompFields [(var, tipe)]

178− return (Type.RRecord fields Nothing)

180+ end <- getPosition

181+ return (A.at start end (Type.RRecord fields Nothing))

179182 ]

180183 ]

181184

src/Reporting/Error/Syntax.hs+87−71

@@ -3,7 +3,8 @@

33module Reporting.Error.Syntax

44 ( Error(..)

55 , ParseError(..)

6− , Problem(..), Theory(..), Context(..)

6+ , Problem(..), Theory(..)

7+ , ContextStack, Context(..)

78 , BadOp(..), Next(..), NextDecl(..)

89 , toReport

910 )

@@ -14,7 +15,7 @@ import qualified Data.Text as Text

1415import Data.Text (Text)

1516

1617import qualified Reporting.Render.Type as RenderType

17−import qualified Reporting.Region as Region

18+import qualified Reporting.Region as R

1819import qualified Reporting.Report as Report

1920import qualified Reporting.Helpers as Help

2021import Reporting.Helpers ((<>), dullyellow, hsep, i2t, reflowParagraph, text)

@@ -25,7 +26,7 @@ import Reporting.Helpers ((<>), dullyellow, hsep, i2t, reflowParagraph, text)

2526

2627

2728data Error

28− = Parse Problem

29+ = Parse (Maybe R.Region) Problem

2930 | BadFunctionName Int

3031 | BadPattern Text

3132

@@ -42,7 +43,7 @@ data Error

4243 | TypeWithoutDefinition Text

4344

4445 | DuplicateArgument Text Text

45− | DuplicateFieldName Region.Region Text

46+ | DuplicateFieldName R.Region Text

4647 | DuplicateValueDeclaration Text

4748 | DuplicateTypeDeclaration Text

4849 | DuplicateDefinition Text

@@ -74,17 +75,17 @@ data Problem

7475 | BadNumberHex

7576 | BadNumberZero

7677 | BadShader Text

77− | BadOp BadOp [Context]

78− | Theories [Context] [Theory]

78+ | BadOp BadOp ContextStack

79+ | Theories ContextStack [Theory]

7980

8081

8182data BadOp = HasType | Equals | Arrow | Pipe | Dot

8283

8384

8485data Theory

85− = Expecting Next

86− | Keyword Text

86+ = Keyword Text

8787 | Symbol Text

88+ | Expecting Next

8889 | LowVar

8990 | CapVar

9091 | InfixOp

@@ -96,7 +97,8 @@ data Theory

9697

9798

9899data Next

99− = Expr

100+ = Decl

101+ | Expr

100102 | AfterOpExpr Text

101103 | ElseBranch

102104 | Arg

@@ -111,6 +113,9 @@ data NextDecl = ModuleDecl | DocCommentDecl | ImportDecl | OtherDecl

111113 deriving (Eq, Ord)

112114

113115

116+type ContextStack = [(Context, R.Position)]

117+

118+

114119data Context

115120 = ExprIf

116121 | ExprLet

@@ -132,7 +137,6 @@ data Context

132137 ----------------

133138 | Module

134139 | Import

135− | DocComment

136140 | TypeUnion

137141 | TypeAlias

138142 | Infix

@@ -147,8 +151,8 @@ data Context

147151toReport :: RenderType.Localizer -> Error -> Report.Report

148152toReport _localizer err =

149153 case err of

150− Parse problem ->

151− problemToReport problem

154+ Parse subRegion problem ->

155+ problemToReport subRegion problem

152156

153157 BadFunctionName arity ->

154158 Report.report

@@ -398,13 +402,14 @@ unboundTypeVars declKind typeName givenVars unboundVars =

398402-- PARSE ERROR TO REPORT

399403

400404

401−parseReport :: Text -> Help.Doc -> Report.Report

402−parseReport pre post =

403− Report.report "PARSE ERROR" Nothing pre post

405+makeParseReport :: Maybe R.Region -> Text -> Help.Doc -> Report.Report

406+makeParseReport subRegion pre post =

407+ Report.report "PARSE ERROR" subRegion pre post

404408

405409

406−problemToReport :: Problem -> Report.Report

407−problemToReport problem =

410+problemToReport :: Maybe R.Region -> Problem -> Report.Report

411+problemToReport subRegion problem =

412+ let parseReport = makeParseReport subRegion in

408413 case problem of

409414 Tab ->

410415 parseReport

@@ -529,20 +534,20 @@ problemToReport problem =

529534 "I ran into a problem while parsing this GLSL block."

530535 (reflowParagraph msg)

531536

532− BadOp op context ->

537+ BadOp op stack ->

533538 case op of

534539 HasType ->

535− badOp context "the \"has type\" operator" "(:)"

540+ badOp subRegion stack "the \"has type\" operator" "(:)"

536541 "type annotations and record types"

537542 "Maybe you want :: instead? Or maybe your indentation is a bit off?"

538543

539544 Equals ->

540− badOp context "an equals sign" "(=)"

545+ badOp subRegion stack "an equals sign" "(=)"

541546 "definitions"

542547 "Maybe you want == instead? Or maybe your indentation is a bit off?"

543548

544549 Arrow ->

545− if isCaseRelated context then

550+ if isCaseRelated stack then

546551 parseReport

547552 "I ran into a stray arrow (->) while parsing this `case` expression."

548553 ( reflowParagraph $

@@ -552,12 +557,12 @@ problemToReport problem =

552557 )

553558

554559 else

555− badOp context "an arrow" "(->)"

560+ badOp subRegion stack "an arrow" "(->)"

556561 "cases expressions and anonymous functions"

557562 "Maybe you want > or >= instead?"

558563

559564 Pipe ->

560− badOp context "a vertical bar" "(|)"

565+ badOp subRegion stack "a vertical bar" "(|)"

561566 "type declarations"

562567 "Maybe you want || instead?"

563568

@@ -570,11 +575,11 @@ problemToReport problem =

570575 \ there is some extra whitespace?"

571576 )

572577

573− Theories context allTheories ->

578+ Theories stack allTheories ->

574579 let

575580 starter =

576− "I got confused while trying to parse "

577− <> contextToText "your code" "" context

581+ "Something went wrong while parsing "

582+ <> contextToText "your code" "" stack

578583 <> "."

579584 in

580585 parseReport starter $

@@ -592,14 +597,14 @@ problemToReport problem =

592597 [theory] ->

593598 reflowParagraph $

594599 "I was expecting to see "

595− <> addPeriod (theoryToText context theory)

600+ <> addPeriod (theoryToText stack theory)

596601

597602 theories ->

598603 Help.vcat $

599604 [ text "I was expecting:"

600605 , text ""

601606 ]

602− ++ map (bullet . theoryToText context) theories

607+ ++ map (bullet . theoryToText stack) theories

603608

604609

605610bullet :: Text -> Help.Doc

@@ -615,24 +620,24 @@ addPeriod msg =

615620 msg <> "."

616621

617622

618−badOp :: [Context] -> Text -> Text -> Text -> Text -> Report.Report

619−badOp context opName op setting hint =

620− parseReport ("I was not expecting " <> opName <> " here.") $

623+badOp :: Maybe R.Region -> ContextStack -> Text -> Text -> Text -> Text -> Report.Report

624+badOp subRegion stack opName op setting hint =

625+ makeParseReport subRegion ("I was not expecting " <> opName <> " here.") $

621626 Help.stack

622627 [ reflowParagraph $

623628 "A " <> op <> " should only appear in " <> setting

624− <> contextToText "" ", but I think I am parsing " context <> "."

629+ <> contextToText "" ", but I think I am parsing " stack <> "."

625630 , reflowParagraph hint

626631 ]

627632

628633

629−contextToText :: Text -> Text -> [Context] -> Text

630−contextToText defaultText prefixText contextStack =

631− case contextStack of

634+contextToText :: Text -> Text -> ContextStack -> Text

635+contextToText defaultText prefixText stack =

636+ case stack of

632637 [] ->

633638 defaultText

634639

635− context : rest ->

640+ (context, _) : rest ->

636641 let anchor = getAnchor rest in

637642 prefixText <>

638643 case context of

@@ -641,7 +646,7 @@ contextToText defaultText prefixText contextStack =

641646 ExprFunc -> "an anonymous function" <> anchor

642647 ExprCase -> "a `case`" <> anchor

643648 ExprList -> "a list" <> anchor

644− ExprTuple -> "a expression (in parentheses)" <> anchor

649+ ExprTuple -> "an expression (in parentheses)" <> anchor

645650 ExprRecord -> "a record" <> anchor

646651 Definition name -> name <> "'s definition"

647652 Annotation name -> name <> "'s type annotation"

@@ -652,31 +657,41 @@ contextToText defaultText prefixText contextStack =

652657 PatternRecord -> "a record pattern" <> anchor

653658 Module -> "a module declaration"

654659 Import -> "an import"

655− DocComment -> "a documentation comment"

656660 TypeUnion -> "a union type"

657661 TypeAlias -> "a type alias"

658662 Infix -> "an infix declaration"

659663 Port -> "a port declaration"

660664

661665

662−getAnchor :: [Context] -> Text

663−getAnchor context =

664− case context of

665− [] -> ""

666− Definition name : _ -> " in " <> name <> "'s definition"

667− Annotation name : _ -> " in " <> name <> "'s type annotation"

668− _ : rest -> getAnchor rest

666+getAnchor :: ContextStack -> Text

667+getAnchor stack =

668+ case stack of

669+ [] ->

670+ ""

671+

672+ (context, _) : rest ->

673+ case context of

674+ Definition name ->

675+ " in " <> name <> "'s definition"

676+

677+ Annotation name ->

678+ " in " <> name <> "'s type annotation"

679+

680+ _ ->

681+ getAnchor rest

682+

669683

684+isCaseRelated :: ContextStack -> Bool

685+isCaseRelated stack =

686+ case stack of

687+ [] ->

688+ False

670689

671−isCaseRelated :: [Context] -> Bool

672−isCaseRelated context =

673− case context of

674− [] -> False

675− ExprCase : _ -> True

676− _ : rest -> isCaseRelated rest

690+ (context, _) : rest ->

691+ context == ExprCase || isCaseRelated rest

677692

678693

679−theoryToText :: [Context] -> Theory -> Text

694+theoryToText :: ContextStack -> Theory -> Text

680695theoryToText context theory =

681696 case theory of

682697 Keyword keyword ->

@@ -699,6 +714,7 @@ theoryToText context theory =

699714 "]" -> "a right square bracket, to end a list"

700715 "{" -> "a left curly brace, for starting records"

701716 "}" -> "a right curly brace, to end a record"

717+ "{-|" -> "a doc comment, like {-| example -}"

702718 _ -> "the (" <> symbol <> ") symbol"

703719

704720 LowVar ->

@@ -722,13 +738,14 @@ theoryToText context theory =

722738 FreshLine nextDecl ->

723739 "a fresh line (without any leading spaces) for " <>

724740 case nextDecl of

725− ModuleDecl -> "an `import`"

726− DocCommentDecl -> "an `import`"

741+ ModuleDecl -> "something like `module Main exposing (..)`"

742+ DocCommentDecl -> "something like `import Html exposing (text)`"

727743 ImportDecl -> "an `import` or a declarations"

728− OtherDecl -> "a top-level declaration"

744+ OtherDecl -> "a top-level declaration, like `view model = div [] [...]`"

729745

730746 Expecting next ->

731747 case next of

748+ Decl -> "a declaration, like `x = 5` or `type alias Model = { ... }`"

732749 Expr -> "an expression, like x or 42"

733750 AfterOpExpr op -> "an expression after that (" <> op <> ") operator, like x or 42"

734751 ElseBranch -> "an `else` branch. An `if` must handle both possibilities."

@@ -739,14 +756,14 @@ theoryToText context theory =

739756 Exposing -> "something like `exposing (..)`"

740757

741758

742−equalsTheory :: [Context] -> Text

743−equalsTheory context =

744− case context of

759+equalsTheory :: ContextStack -> Text

760+equalsTheory stack =

761+ case stack of

745762 [] ->

746763 "an equals sign (=)"

747764

748− first : rest ->

749− case first of

765+ (context, _) : rest ->

766+ case context of

750767 ExprRecord -> "an equals sign (=) followed by an expression"

751768 Definition name -> "an equals sign (=) followed by " <> name <> "'s definition"

752769 TypeUnion -> "an equals sign (=) followed by the first union type constructor"

@@ -754,28 +771,28 @@ equalsTheory context =

754771 _ -> equalsTheory rest

755772

756773

757−barTheory :: [Context] -> Text

758−barTheory context =

759− case context of

774+barTheory :: ContextStack -> Text

775+barTheory stack =

776+ case stack of

760777 [] ->

761778 "a vertical bar (|)"

762779

763− first : rest ->

764− case first of

780+ (context, _) : rest ->

781+ case context of

765782 ExprRecord -> "a vertical bar (|) followed by the record fields you want to update"

766783 TypeRecord -> "a vertical bar (|) followed by some record field types"

767784 TypeUnion -> "a vertical bar (|) followed by more union type constructors"

768785 _ -> barTheory rest

769786

770787

771−badSpace :: [Context] -> Text

772−badSpace context =

773− case context of

788+badSpace :: ContextStack -> Text

789+badSpace stack =

790+ case stack of

774791 [] ->

775792 "more indentation? I was not done with that last thing yet."

776793

777− first : rest ->

778− case first of

794+ (context, _) : rest ->

795+ case context of

779796 ExprIf -> "the end of that `if`" <> badSpaceEnd

780797 ExprLet -> "the end of that `let`" <> badSpaceEnd

781798 ExprFunc -> badSpace rest

@@ -792,7 +809,6 @@ badSpace context =

792809 PatternRecord -> "the end of that record" <> badSpaceEnd

793810 Module -> "something like `module Main exposing (..)`"

794811 Import -> "something like `import Html exposing (..)`"

795− DocComment -> badSpace rest

796812 TypeUnion -> "more of that union type" <> badSpaceEnd

797813 TypeAlias -> "more of that type alias" <> badSpaceEnd

798814 Infix -> "more of that infix declaration" <> badSpaceEnd