7dd0bbd · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add locations to context stack, allowing nicer error messages

7dd0bbdEvan Czaplicki10 years ago

src/Docs/Check.hs+2−3

compare with master

unifiedsplit

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

12import qualified Reporting.Annotation as A

13import qualified Reporting.Error as Error

14import qualified Reporting.Error.Docs as E

15−import qualified Reporting.Error.Syntax as SE

16import qualified Reporting.Helpers as Help (nearbyNames)

15import qualified Reporting.Helpers as Help (nearbyNames)

17import qualified Reporting.Region as R

16import qualified Reporting.Region as R

18import qualified Reporting.Result as R

17import qualified Reporting.Result as R

19import Parse.Helpers

18import Parse.Helpers

20− ( Parser, addLocation, getPosition, inContext

19+ ( Parser, addLocation, getPosition

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

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

22 , capVar, lowVar, leftParen, rightParen, infixOp, runAt

21 , capVar, lowVar, leftParen, rightParen, infixOp, runAt

23 , chompUntilDocs, comma, oneOf

22 , chompUntilDocs, comma, oneOf

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

162

161

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

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

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

163parseNames (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

166 Left (A.A region parseError) ->

165 Left (A.A region parseError) ->

167 R.throw region (Error.Syntax parseError)

166 R.throw region (Error.Syntax parseError)

168

167

src/Parse/Declaration.hs+7−6

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

21declaration :: SParser Decl.Source

22declaration =

23+ hint E.Decl $

23 do start <- getPosition

24 do start <- getPosition

24 oneOf

25 oneOf

25 [ docDecl start

26 [ docDecl start

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

62 spaces

63 spaces

63 oneOf

64 oneOf

64 [ do keyword "alias"

65 [ do keyword "alias"

65− inContext E.TypeAlias $

66+ inContext start E.TypeAlias $

66 do spaces

67 do spaces

67 (name, args) <- nameArgsEquals

68 (name, args) <- nameArgsEquals

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

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

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

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

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

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

71− , inContext E.TypeUnion $

72+ , inContext start E.TypeUnion $

72 do (name, args) <- nameArgsEquals

73 do (name, args) <- nameArgsEquals

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

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

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

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

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

116infixDecl start =

117infixDecl start =

117 oneOf

118 oneOf

118 [ do keyword "infixl"

119 [ do keyword "infixl"

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

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

120 , do keyword "infixr"

121 , do keyword "infixr"

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

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

122 , do keyword "infix"

123 , do keyword "infix"

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

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

124 ]

125 ]

125

126

127

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

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

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

144portDecl start =

145portDecl start =

145 do keyword "port"

146 do keyword "port"

146− inContext E.Port $

147+ inContext start E.Port $

147 do spaces

148 do spaces

148 name <- lowVar

149 name <- lowVar

149 spaces

150 spaces

src/Parse/Expression.hs+13−13

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

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

82list start =

83 do leftSquare

84− inContext E.ExprList $

84+ inContext start E.ExprList $

85 do spaces

86 oneOf

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

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

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

115tuple start =

116 do leftParen

117− inContext E.ExprTuple $ oneOf $

117+ inContext start E.ExprTuple $ oneOf $

118 [ do op <- infixOp

119 rightParen

120 end <- getPosition

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

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

183record start =

184 do leftCurly

185− inContext E.ExprRecord $

185+ inContext start E.ExprRecord $

186 do spaces

187 oneOf

188 [ do rightCurly

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

354if_ :: R.Position -> ExprParser

355if_ start =

356 do keyword "if"

357− inContext E.ExprIf $ ifHelp start []

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

358

359

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

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

385function :: R.Position -> ExprParser

386function start =

387 do lambda

388− inContext E.ExprFunc $

388+ inContext start E.ExprFunc $

389 do spaces

390 arg <- Pattern.term

391 spaces

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

414case_ :: R.Position -> ExprParser

415case_ start =

416 do keyword "case"

417− spaces

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

419− checkSpace switcherPos

420− keyword "of"

421− inContext E.ExprCase $

417+ inContext start E.ExprCase $

422 do spaces

418 do spaces

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

420+ checkSpace switcherPos

421+ keyword "of"

422+ spaces

423 oldIndent <- getIndent

424 newIndent <- getCol

425 setIndent newIndent

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

462 do oldIndent <- getIndent

463 letIndent <- getCol

464 keyword "let"

465− pushContext E.ExprLet

465+ pushContext start E.ExprLet

466 setIndent letIndent

467 spaces

468 defIndent <- getCol

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

502 P.Var name ->

503 oneOf

504 [ do hasType

505− inContext (E.Annotation name) $

505+ inContext start (E.Annotation name) $

506 do spaces

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

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

509− , inContext (E.Definition name) $

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

510 definitionHelp start root []

511 ]

512

src/Parse/Helpers.hs+3−3

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

185 return (A.at start end value)

186

187

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

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

189−inContext ctx parser =

189+inContext pos ctx parser =

190− do P.pushContext ctx

190+ do P.pushContext pos ctx

191 a <- parser

192 P.popContext a

193

src/Parse/Module.hs+22−18

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

22 freshLine E.ModuleDecl

23 end <- getPosition

24 oneOf

25− [ fullHeader

25+ [ fullHeader end

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

27 ]

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

31-- FULL HEADER

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

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

35−fullHeader =

35+fullHeader start =

36− do pushContext E.Module

36+ do pushContext start E.Module

37 tag <- sourceTag

38 spaces

39 name <- qualifiedCapVar

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

43 spaces

44 exports <- listing (addLocation listingValue)

45 popContext ()

46− start <- getPosition

47− freshLine E.DocCommentDecl

48− end <- getPosition

49− docs <- maybeDocComment start end

46+ docs <- maybeDocComment

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

47+ imports <- chompImports []

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

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

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

126-- DOC COMMENTS

123-- DOC COMMENTS

127

124

128

125

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

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

130−maybeDocComment start end =

127+maybeDocComment =

131− inContext E.DocComment $

128+ do oldEnd <- getPosition

129+ freshLine E.DocCommentDecl

130+ newStart <- getPosition

132− oneOf

131+ oneOf

133− [ do doc <- addLocation docComment

132+ [ do doc <- docComment

133+ end <- getPosition

134− freshLine E.ImportDecl

134+ freshLine E.ImportDecl

135− return (A.map Just doc)

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

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

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

137− ]

137+ ]

138

139

140

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

146 oneOf

147 [ do start <- getPosition

148 keyword "import"

149+ pushContext start E.Import

149 spaces

150 spaces

150 name <- qualifiedCapVar

151 name <- qualifiedCapVar

151 end <- getPosition

152 end <- getPosition

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

153 oneOf

154 oneOf

154 [ do checkFreshLine E.ImportDecl pos

155 [ do checkFreshLine E.ImportDecl pos

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

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

157+ popContext ()

156 chompImports (userImport:imports)

158 chompImports (userImport:imports)

157 , do checkSpace pos

159 , do checkSpace pos

158 oneOf

160 oneOf

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

174 oneOf

176 oneOf

175 [ do checkFreshLine E.ImportDecl pos

177 [ do checkFreshLine E.ImportDecl pos

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

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

179+ popContext ()

177 chompImports (userImport:imports)

180 chompImports (userImport:imports)

178 , do checkSpace pos

181 , do checkSpace pos

179 chompExposing start name (Just alias) imports

182 chompExposing start name (Just alias) imports

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

188 end <- getPosition

191 end <- getPosition

189 freshLine E.ImportDecl

192 freshLine E.ImportDecl

190 let userImport = method start end name maybeAlias exposed

193 let userImport = method start end name maybeAlias exposed

194+ popContext ()

191 chompImports (userImport:imports)

195 chompImports (userImport:imports)

192

196

193

197

src/Parse/Pattern.hs+54−46

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

21term :: Parser P.Raw

22term =

23 hint E.Pattern $

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

24+ do start <- getPosition

25−

25+ oneOf

26−

26+ [ record start

27+ , tuple start

28+ , list start

29+ , termHelp start

30+ ]

31+

32+

27−termHelp :: Parser P.Raw

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

28−termHelp =

34+termHelp start =

29− addLocation $

35+ do pattern <-

30− oneOf

36+ oneOf

31− [ do underscore

32− return P.Anything

37+ [ underscore >> return P.Anything

33− , P.Var <$> lowVar

38+ , P.Var <$> lowVar

34− , mkCtor <$> qualifiedCapVar

39+ , mkCtor <$> qualifiedCapVar

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

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

36− ]

41+ ]

42+ end <- getPosition

43+ return (A.at start end pattern)

39mkCtor :: Text -> P.Raw'

46mkCtor :: Text -> P.Raw'

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

53-- RECORDS

60-- RECORDS

56−record :: Parser P.Raw

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

57−record =

64+record start =

58− addLocation $

59− do leftCurly

65+ do leftCurly

60− inContext E.ExprRecord $

66+ inContext start E.ExprRecord $

61− do spaces

67+ do spaces

62− oneOf

68+ oneOf

63− [ do var <- lowVar

69+ [ do var <- lowVar

64− spaces

70+ spaces

65− recordHelp [var]

71+ recordHelp start [var]

66− , do rightCurly

72+ , do rightCurly

73+ end <- getPosition

67− return (P.Record [])

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

68− ]

75+ ]

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

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

72−recordHelp vars =

79+recordHelp start vars =

73 oneOf

80 oneOf

74 [ do comma

81 [ do comma

75 spaces

82 spaces

76 var <- lowVar

83 var <- lowVar

77 spaces

84 spaces

78− recordHelp (var:vars)

85+ recordHelp start (var:vars)

79 , do rightCurly

86 , do rightCurly

87+ end <- getPosition

80− return (P.Record vars)

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

81 ]

89 ]

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

85-- TUPLES

93-- TUPLES

88−tuple :: Parser P.Raw

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

89−tuple =

97+tuple start =

90− do start <- getPosition

91− leftParen

98+ do leftParen

92− inContext E.ExprTuple $

99+ inContext start E.ExprTuple $

93 do spaces

100 do spaces

94 oneOf

101 oneOf

95 [ do (pattern, sPos) <- expression

102 [ do (pattern, sPos) <- expression

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

124-- LIST

131-- LIST

125

132

126

133

127−list :: Parser P.Raw

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

128−list =

135+list start =

129 do leftSquare

136 do leftSquare

137+ inContext start E.PatternList $

130− spaces

138+ do spaces

131− oneOf

139+ oneOf

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

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

133− checkSpace sPos

141+ checkSpace sPos

134− listHelp [pattern]

142+ listHelp [pattern]

135− , do rightSquare

143+ , do rightSquare

136− end <- getPosition

144+ end <- getPosition

137− return (P.list end [])

145+ return (P.list end [])

138− ]

146+ ]

139

147

140

148

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

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

src/Parse/Primitives.hs+25−16

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

39import qualified AST.Literal as L

40import qualified Reporting.Annotation as A

41import qualified Reporting.Error.Syntax as E

42−import qualified Reporting.Region as Region

42+import qualified Reporting.Region as R

43import Reporting.Error.Syntax

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

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

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

46 )

45 )

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

71 , _indent :: !Int

70 , _indent :: !Int

72 , _row :: !Int

71 , _row :: !Int

73 , _col :: !Int

72 , _col :: !Int

74− , _context :: [Context]

73+ , _context :: E.ContextStack

75 }

74 }

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

84{-# INLINE expect #-}

83{-# INLINE expect #-}

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

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

86expect row col ctx theory =

85expect row col ctx theory =

87 ParseError row col (Theories ctx [theory])

86 ParseError row col (Theories ctx [theory])

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

104

103

105 Err (ParseError row col problem) ->

104 Err (ParseError row col problem) ->

106 let

105 let

106+ pos = R.Position row col

107− region =

107+ region = R.Region pos pos

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

108+ mkError overallRegion subRegion =

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

109 in

110 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

111

120

112

121

113data Result a

122data Result a

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

499-- STATE

508-- STATE

500

509

501

510

502−getPosition :: Parser Region.Position

511+getPosition :: Parser R.Position

503getPosition =

512getPosition =

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

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

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

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

506

515

507

516

508getIndent :: Parser Int

517getIndent :: Parser Int

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

517 eok col state noError

526 eok col state noError

518

527

519

528

520−getContext :: Parser [E.Context]

529+getContext :: Parser E.ContextStack

521getContext =

530getContext =

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

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

523 eok ctx state noError

532 eok ctx state noError

524

533

525

534

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

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

527−pushContext ctx =

536+pushContext pos ctx =

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

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

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

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

530

539

531

540

532popContext :: a -> Parser a

541popContext :: a -> Parser a

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

546

555

547

556

548newtype SPos =

557newtype SPos =

549− SPos Region.Position

558+ SPos R.Position

550

559

551

560

552whitespace :: Parser SPos

561whitespace :: Parser SPos

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

558

567

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

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

560 cok

569 cok

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

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

562 (State array newOffset newLength indent newRow newCol ctx)

571 (State array newOffset newLength indent newRow newCol ctx)

563 noError

572 noError

564

573

src/Parse/Type.hs+25−22

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

19term :: Parser Type.Raw

20term =

21 hint E.Type $

22+ do start <- getPosition

22− oneOf

23+ oneOf

23− [ constructor

24+ [ constructor

24− , variable

25+ , variable start

25− , tuple

26+ , tuple start

26− , record

27+ , record start

27− ]

28+ ]

31-- TYPE VARIABLES

32-- TYPE VARIABLES

34−variable :: Parser Type.Raw

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

35−variable =

36+variable start =

36− addLocation $

37− Type.RVar <$> lowVar

37+ do var <- lowVar

38+ end <- getPosition

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

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

114-- TUPLES

116-- TUPLES

115

117

116

118

117−tuple :: Parser Type.Raw

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

118−tuple =

120+tuple start =

119− do start <- getPosition

120− leftParen

121+ do leftParen

121− inContext E.TypeTuple $

122+ inContext start E.TypeTuple $

122 oneOf

123 oneOf

123 [ do rightParen

124 [ do rightParen

124 end <- getPosition

125 end <- getPosition

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

153-- RECORD

154-- RECORD

154

155

156

156−record :: Parser Type.Raw

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

157−record =

158+record start =

158− addLocation $

159 do leftCurly

160− inContext E.TypeRecord $

160+ inContext start E.TypeRecord $

161 do spaces

162 oneOf

163 [ do rightCurly

164+ end <- getPosition

164− return (Type.RRecord [] Nothing)

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

165 , do var <- addLocation lowVar

166 , do var <- addLocation lowVar

166 spaces

167 spaces

167 oneOf

168 oneOf

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

169 spaces

170 spaces

170 firstField <- field

171 firstField <- field

171 fields <- chompFields [firstField]

172 fields <- chompFields [firstField]

173+ end <- getPosition

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

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

173 , do hasType

175 , do hasType

174 spaces

176 spaces

175 (tipe, _, nextPos) <- expression

177 (tipe, _, nextPos) <- expression

176 checkSpace nextPos

178 checkSpace nextPos

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

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

180+ end <- getPosition

178− return (Type.RRecord fields Nothing)

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

179 ]

182 ]

180 ]

183 ]

181

184

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

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

3module Reporting.Error.Syntax

4 ( Error(..)

5 , ParseError(..)

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

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

7+ , ContextStack, Context(..)

7 , BadOp(..), Next(..), NextDecl(..)

8 , BadOp(..), Next(..), NextDecl(..)

8 , toReport

9 , toReport

9 )

10 )

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

14import Data.Text (Text)

15import Data.Text (Text)

16import qualified Reporting.Render.Type as RenderType

17import qualified Reporting.Render.Type as RenderType

17−import qualified Reporting.Region as Region

18+import qualified Reporting.Region as R

18import qualified Reporting.Report as Report

19import qualified Reporting.Report as Report

19import qualified Reporting.Helpers as Help

20import qualified Reporting.Helpers as Help

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

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

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

27data Error

28data Error

28− = Parse Problem

29+ = Parse (Maybe R.Region) Problem

29 | BadFunctionName Int

30 | BadFunctionName Int

30 | BadPattern Text

31 | BadPattern Text

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

42 | TypeWithoutDefinition Text

43 | TypeWithoutDefinition Text

44 | DuplicateArgument Text Text

45 | DuplicateArgument Text Text

45− | DuplicateFieldName Region.Region Text

46+ | DuplicateFieldName R.Region Text

46 | DuplicateValueDeclaration Text

47 | DuplicateValueDeclaration Text

47 | DuplicateTypeDeclaration Text

48 | DuplicateTypeDeclaration Text

48 | DuplicateDefinition Text

49 | DuplicateDefinition Text

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

74 | BadNumberHex

75 | BadNumberHex

75 | BadNumberZero

76 | BadNumberZero

76 | BadShader Text

77 | BadShader Text

77− | BadOp BadOp [Context]

78+ | BadOp BadOp ContextStack

78− | Theories [Context] [Theory]

79+ | Theories ContextStack [Theory]

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

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

84data Theory

85data Theory

85− = Expecting Next

86− | Keyword Text

86+ = Keyword Text

87 | Symbol Text

88+ | Expecting Next

88 | LowVar

89 | LowVar

89 | CapVar

90 | CapVar

90 | InfixOp

91 | InfixOp

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

98data Next

99data Next

100+ = Decl

99− = Expr

101+ | Expr

100 | AfterOpExpr Text

102 | AfterOpExpr Text

101 | ElseBranch

103 | ElseBranch

102 | Arg

104 | Arg

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

111 deriving (Eq, Ord)

113 deriving (Eq, Ord)

112

114

113

115

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

117+

118+

114data Context

119data Context

115 = ExprIf

120 = ExprIf

116 | ExprLet

121 | ExprLet

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

132 ----------------

137 ----------------

133 | Module

138 | Module

134 | Import

139 | Import

135− | DocComment

136 | TypeUnion

140 | TypeUnion

137 | TypeAlias

141 | TypeAlias

138 | Infix

142 | Infix

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

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

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

148toReport _localizer err =

152toReport _localizer err =

149 case err of

153 case err of

150− Parse problem ->

154+ Parse subRegion problem ->

151− problemToReport problem

155+ problemToReport subRegion problem

152

156

153 BadFunctionName arity ->

157 BadFunctionName arity ->

154 Report.report

158 Report.report

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

398-- PARSE ERROR TO REPORT

402-- PARSE ERROR TO REPORT

399

403

400

404

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

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

402−parseReport pre post =

406+makeParseReport subRegion pre post =

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

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

404

408

405

409

406−problemToReport :: Problem -> Report.Report

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

407−problemToReport problem =

411+problemToReport subRegion problem =

412+ let parseReport = makeParseReport subRegion in

408 case problem of

413 case problem of

409 Tab ->

414 Tab ->

410 parseReport

415 parseReport

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

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

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

530 (reflowParagraph msg)

535 (reflowParagraph msg)

531

536

532− BadOp op context ->

537+ BadOp op stack ->

533 case op of

538 case op of

534 HasType ->

539 HasType ->

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

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

536 "type annotations and record types"

541 "type annotations and record types"

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

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

538

543

539 Equals ->

544 Equals ->

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

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

541 "definitions"

546 "definitions"

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

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

543

548

544 Arrow ->

549 Arrow ->

545− if isCaseRelated context then

550+ if isCaseRelated stack then

546 parseReport

551 parseReport

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

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

548 ( reflowParagraph $

553 ( reflowParagraph $

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

552 )

557 )

553

558

554 else

559 else

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

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

556 "cases expressions and anonymous functions"

561 "cases expressions and anonymous functions"

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

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

558

563

559 Pipe ->

564 Pipe ->

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

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

561 "type declarations"

566 "type declarations"

562 "Maybe you want || instead?"

567 "Maybe you want || instead?"

563

568

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

570 \ there is some extra whitespace?"

575 \ there is some extra whitespace?"

571 )

576 )

572

577

573− Theories context allTheories ->

578+ Theories stack allTheories ->

574 let

579 let

575 starter =

580 starter =

576− "I got confused while trying to parse "

581+ "Something went wrong while parsing "

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

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

578 <> "."

583 <> "."

579 in

584 in

580 parseReport starter $

585 parseReport starter $

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

592 [theory] ->

597 [theory] ->

593 reflowParagraph $

598 reflowParagraph $

594 "I was expecting to see "

599 "I was expecting to see "

595− <> addPeriod (theoryToText context theory)

600+ <> addPeriod (theoryToText stack theory)

596

601

597 theories ->

602 theories ->

598 Help.vcat $

603 Help.vcat $

599 [ text "I was expecting:"

604 [ text "I was expecting:"

600 , text ""

605 , text ""

601 ]

606 ]

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

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

603

608

604

609

605bullet :: Text -> Help.Doc

610bullet :: Text -> Help.Doc

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

615 msg <> "."

620 msg <> "."

616

621

617

622

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

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

619−badOp context opName op setting hint =

624+badOp subRegion stack opName op setting hint =

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

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

621 Help.stack

626 Help.stack

622 [ reflowParagraph $

627 [ reflowParagraph $

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

628 "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 <> "."

625 , reflowParagraph hint

630 , reflowParagraph hint

626 ]

631 ]

627

632

628

633

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

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

630−contextToText defaultText prefixText contextStack =

635+contextToText defaultText prefixText stack =

631− case contextStack of

636+ case stack of

632 [] ->

637 [] ->

633 defaultText

638 defaultText

634

639

635− context : rest ->

640+ (context, _) : rest ->

636 let anchor = getAnchor rest in

641 let anchor = getAnchor rest in

637 prefixText <>

642 prefixText <>

638 case context of

643 case context of

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

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

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

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

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

643 ExprList -> "a list" <> anchor

648 ExprList -> "a list" <> anchor

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

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

645 ExprRecord -> "a record" <> anchor

650 ExprRecord -> "a record" <> anchor

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

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

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

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

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

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

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

653 Module -> "a module declaration"

658 Module -> "a module declaration"

654 Import -> "an import"

659 Import -> "an import"

655− DocComment -> "a documentation comment"

656 TypeUnion -> "a union type"

660 TypeUnion -> "a union type"

657 TypeAlias -> "a type alias"

661 TypeAlias -> "a type alias"

658 Infix -> "an infix declaration"

662 Infix -> "an infix declaration"

659 Port -> "a port declaration"

663 Port -> "a port declaration"

660

664

661

665

662−getAnchor :: [Context] -> Text

666+getAnchor :: ContextStack -> Text

663−getAnchor context =

667+getAnchor stack =

664− case context of

668+ case stack of

665− [] -> ""

669+ [] ->

670+ ""

671+

672+ (context, _) : rest ->

673+ case context of

674+ Definition name ->

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

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

676+

677+ Annotation name ->

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

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

679+

680+ _ ->

668− _ : rest -> getAnchor rest

681+ getAnchor rest

682+

669

683

684+isCaseRelated :: ContextStack -> Bool

685+isCaseRelated stack =

686+ case stack of

687+ [] ->

688+ False

670

689

671−isCaseRelated :: [Context] -> Bool

690+ (context, _) : rest ->

672−isCaseRelated context =

673− case context of

674− [] -> False

675− ExprCase : _ -> True

676− _ : rest -> isCaseRelated rest

691+ context == ExprCase || isCaseRelated rest

677

692

678

693

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

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

680theoryToText context theory =

695theoryToText context theory =

681 case theory of

696 case theory of

682 Keyword keyword ->

697 Keyword keyword ->

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

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

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

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

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

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

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

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

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

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

703

719

704 LowVar ->

720 LowVar ->

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

722 FreshLine nextDecl ->

738 FreshLine nextDecl ->

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

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

724 case nextDecl of

740 case nextDecl of

725− ModuleDecl -> "an `import`"

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

726− DocCommentDecl -> "an `import`"

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

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

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

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

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

729

745

730 Expecting next ->

746 Expecting next ->

731 case next of

747 case next of

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

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

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

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

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

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

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

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

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

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

740

757

741

758

742−equalsTheory :: [Context] -> Text

759+equalsTheory :: ContextStack -> Text

743−equalsTheory context =

760+equalsTheory stack =

744− case context of

761+ case stack of

745 [] ->

762 [] ->

746 "an equals sign (=)"

763 "an equals sign (=)"

747

764

748− first : rest ->

765+ (context, _) : rest ->

749− case first of

766+ case context of

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

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

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

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

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

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

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

754 _ -> equalsTheory rest

771 _ -> equalsTheory rest

755

772

756

773

757−barTheory :: [Context] -> Text

774+barTheory :: ContextStack -> Text

758−barTheory context =

775+barTheory stack =

759− case context of

776+ case stack of

760 [] ->

777 [] ->

761 "a vertical bar (|)"

778 "a vertical bar (|)"

762

779

763− first : rest ->

780+ (context, _) : rest ->

764− case first of

781+ case context of

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

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

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

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

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

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

768 _ -> barTheory rest

785 _ -> barTheory rest

769

786

770

787

771−badSpace :: [Context] -> Text

788+badSpace :: ContextStack -> Text

772−badSpace context =

789+badSpace stack =

773− case context of

790+ case stack of

774 [] ->

791 [] ->

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

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

776

793

777− first : rest ->

794+ (context, _) : rest ->

778− case first of

795+ case context of

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

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

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

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

781 ExprFunc -> badSpace rest

798 ExprFunc -> badSpace rest

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

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

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

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

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

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

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

795− DocComment -> badSpace rest

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

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

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

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

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

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