c5da7c0 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Get parse error messages working again

c5da7c0Evan Czaplicki10 years ago

src/Docs/Check.hs+3−2

compare with master

unifiedsplit

@@ -12,11 +12,12 @@ 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

15import qualified Reporting.Helpers as Help (nearbyNames)

16import qualified Reporting.Helpers as Help (nearbyNames)

16import qualified Reporting.Region as R

17import qualified Reporting.Region as R

17import qualified Reporting.Result as R

18import qualified Reporting.Result as R

18import Parse.Helpers

19import Parse.Helpers

19− ( Parser, addLocation, getPosition

20+ ( Parser, addLocation, getPosition, inContext

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

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

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

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

22 , chompUntilDocs, comma, oneOf

23 , chompUntilDocs, comma, oneOf

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

161

162

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

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

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

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

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

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

165 Left (A.A region parseError) ->

166 Left (A.A region parseError) ->

166 R.throw region (Error.Syntax parseError)

167 R.throw region (Error.Syntax parseError)

167

168

src/Parse/Declaration.hs+25−21

@@ -10,6 +10,7 @@ import qualified Parse.Expression as Expr

10import Parse.Helpers as Help

11import qualified Parse.Type as Type

12import qualified Reporting.Annotation as A

13+import qualified Reporting.Error.Syntax as E

13import qualified Reporting.Region as R

14import qualified Reporting.Region as R

@@ -61,16 +62,18 @@ typeDecl start =

61 spaces

62 spaces

62 oneOf

63 oneOf

63 [ do keyword "alias"

64 [ do keyword "alias"

65+ inContext E.TypeAlias $

64− spaces

66+ do spaces

65− (name, args) <- nameArgsEquals

67+ (name, args) <- nameArgsEquals

66− (tipe, end, pos) <- Type.expression

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

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

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

68− return ( Decl.Whatever decl, end, pos )

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

71+ , inContext E.TypeUnion $

69− , do (name, args) <- nameArgsEquals

72+ do (name, args) <- nameArgsEquals

70− (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

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

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

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

72− let decl = A.at start end (Decl.Union (Decl.Type name args ctors))

75+ let decl = A.at start end (Decl.Union (Decl.Type name args ctors))

73− return ( Decl.Whatever decl, end, pos )

76+ return ( Decl.Whatever decl, end, pos )

74 ]

77 ]

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

113infixDecl start =

116infixDecl start =

114 oneOf

117 oneOf

115 [ do keyword "infixl"

118 [ do keyword "infixl"

116− infixDeclHelp start Decl.L

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

117 , do keyword "infixr"

120 , do keyword "infixr"

118− infixDeclHelp start Decl.R

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

119 , do keyword "infix"

122 , do keyword "infix"

120− infixDeclHelp start Decl.N

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

121 ]

124 ]

122

125

123

126

@@ -140,12 +143,13 @@ infixDeclHelp start assoc =

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

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

141portDecl start =

144portDecl start =

142 do keyword "port"

145 do keyword "port"

146+ inContext E.Port $

143− spaces

147+ do spaces

144− name <- lowVar

148+ name <- lowVar

145− spaces

149+ spaces

146− hasType

150+ hasType

147− spaces

151+ spaces

148− (tipe, end, pos) <- Type.expression

152+ (tipe, end, pos) <- Type.expression

149− let decl = A.at start end (Decl.Port name tipe)

153+ let decl = A.at start end (Decl.Port name tipe)

150− return ( Decl.Whatever decl, end, pos )

154+ return ( Decl.Whatever decl, end, pos )

151

155

src/Parse/Expression.hs+102−90

@@ -15,6 +15,7 @@ import qualified Parse.Type as Type

15import qualified AST.Expression.Source as Src

16import qualified AST.Pattern as P

17import qualified Reporting.Annotation as A

18+import qualified Reporting.Error.Syntax as E

18import qualified Reporting.Region as R

19import qualified Reporting.Region as R

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

25term :: Parser Src.RawExpr

26term :: Parser Src.RawExpr

26term =

27term =

28+ hint E.Expr $

27 do start <- getPosition

29 do start <- getPosition

28 oneOf

30 oneOf

29 [ variable start >>= accessible start

31 [ variable start >>= accessible start

@@ -79,15 +81,16 @@ accessible start expr =

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

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

80list start =

82list start =

81 do leftSquare

83 do leftSquare

84+ inContext E.ExprList $

82− spaces

85+ do spaces

83− oneOf

86+ oneOf

84− [ do (entry, _, pos) <- expression

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

85− checkSpace pos

88+ checkSpace pos

86− listHelp start [entry]

89+ listHelp start [entry]

87− , do rightSquare

90+ , do rightSquare

88− end <- getPosition

91+ end <- getPosition

89− return (A.at start end (Src.List []))

92+ return (A.at start end (Src.List []))

90− ]

93+ ]

93listHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

96listHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

@@ -111,33 +114,33 @@ listHelp start entries =

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

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

112tuple start =

115tuple start =

113 do leftParen

116 do leftParen

114− oneOf

117+ inContext E.ExprTuple $ oneOf $

115− [ do op <- infixOp

118+ [ do op <- infixOp

116− rightParen

119+ rightParen

117− end <- getPosition

120+ end <- getPosition

118− let x = A.at start end (Src.var "x")

121+ let x = A.at start end (Src.var "x")

119− let y = A.at start end (Src.var "y")

122+ let y = A.at start end (Src.var "y")

120− return $ mkLambda start end "x" $ mkLambda start end "y" $

123+ return $ mkLambda start end "x" $ mkLambda start end "y" $

121− A.at start end (Src.Binop [(x, A.at start end op)] y)

124+ A.at start end (Src.Binop [(x, A.at start end op)] y)

122−

125+

123− , do rightParen

126+ , do rightParen

124− end <- getPosition

127+ end <- getPosition

125− return (A.at start end (Src.tuple []))

128+ return (A.at start end (Src.tuple []))

126−

129+

127− , do comma

130+ , do comma

128− arity <- chompCommas 2

131+ arity <- chompCommas 2

129− rightParen

132+ rightParen

130− end <- getPosition

133+ end <- getPosition

131− let args = map (\n -> Text.pack ("v" ++ show n)) [ 1 .. arity ]

134+ let args = map (\n -> Text.pack ("v" ++ show n)) [ 1 .. arity ]

132− let ann x = A.at start end x

135+ let ann x = A.at start end x

133− let result = ann (Src.tuple (map (ann . Src.var) args))

136+ let result = ann (Src.tuple (map (ann . Src.var) args))

134− return (foldr (mkLambda start end) result args)

137+ return (foldr (mkLambda start end) result args)

135−

138+

136− , do spaces

139+ , do spaces

137− (entry, _, pos) <- expression

140+ (entry, _, pos) <- expression

138− checkSpace pos

141+ checkSpace pos

139− tupleHelp start [entry]

142+ tupleHelp start [entry]

140− ]

143+ ]

141

144

142

145

143mkLambda :: R.Position -> R.Position -> Text -> Src.RawExpr -> Src.RawExpr

146mkLambda :: R.Position -> R.Position -> Text -> Src.RawExpr -> Src.RawExpr

@@ -179,29 +182,30 @@ tupleHelp start entries =

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

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

180record start =

183record start =

181 do leftCurly

184 do leftCurly

185+ inContext E.ExprRecord $

182− spaces

186+ do spaces

183− oneOf

187+ oneOf

184− [ do rightCurly

188+ [ do rightCurly

185− end <- getPosition

189+ end <- getPosition

186− return (A.at start end (Src.Record []))

190+ return (A.at start end (Src.Record []))

187− , do starter <- addLocation lowVar

191+ , do starter <- addLocation lowVar

188− spaces

192+ spaces

189− oneOf

193+ oneOf

190− [ do pipe

194+ [ do pipe

191− spaces

195+ spaces

192− firstField <- chompField

196+ firstField <- chompField

193− fields <- chompFields [firstField]

197+ fields <- chompFields [firstField]

194− end <- getPosition

198+ end <- getPosition

195− return (A.at start end (Src.Update (A.map Src.var starter) fields))

199+ return (A.at start end (Src.Update (A.map Src.var starter) fields))

196− , do equals

200+ , do equals

197− spaces

201+ spaces

198− (value, _, nextPos) <- expression

202+ (value, _, nextPos) <- expression

199− checkSpace nextPos

203+ checkSpace nextPos

200− fields <- chompFields [(starter, value)]

204+ fields <- chompFields [(starter, value)]

201− end <- getPosition

205+ end <- getPosition

202− return (A.at start end (Src.Record fields))

206+ return (A.at start end (Src.Record fields))

203− ]

207+ ]

204− ]

208+ ]

205

209

206

210

207type Field = ( A.Located Text, Src.RawExpr )

211type Field = ( A.Located Text, Src.RawExpr )

@@ -240,6 +244,7 @@ type ExprParser =

240

244

241expression :: ExprParser

245expression :: ExprParser

242expression =

246expression =

247+ hint E.Expr $

243 do start <- getPosition

248 do start <- getPosition

244 oneOf

249 oneOf

245 [ let_ start

250 [ let_ start

@@ -346,24 +351,25 @@ possiblyNegativeTerm start =

346

351

347if_ :: R.Position -> ExprParser

352if_ :: R.Position -> ExprParser

348if_ start =

353if_ start =

354+ do keyword "if"

349− ifHelp start []

355+ inContext E.ExprIf $ ifHelp start []

350

356

351

357

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

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

353ifHelp start branches =

359ifHelp start branches =

354− do keyword "if"

355− spaces

360+ do spaces

356 (condition, _, condPos) <- expression

361 (condition, _, condPos) <- expression

357 checkSpace condPos

362 checkSpace condPos

358 keyword "then"

363 keyword "then"

359 spaces

364 spaces

360 (thenBranch, _, thenPos) <- expression

365 (thenBranch, _, thenPos) <- expression

361− checkSpace thenPos

366+ hint E.ElseBranch $ checkSpace thenPos

362− keyword "else"

367+ hint E.ElseBranch $ keyword "else"

363 spaces

368 spaces

364 let newBranches = (condition, thenBranch) : branches

369 let newBranches = (condition, thenBranch) : branches

365 oneOf

370 oneOf

371+ [ do keyword "if"

366− [ ifHelp start newBranches

372+ ifHelp start newBranches

367 , do (elseBranch, elseEnd, elseSpace) <- expression

373 , do (elseBranch, elseEnd, elseSpace) <- expression

368 let ifExpr = A.at start elseEnd (Src.If (reverse newBranches) elseBranch)

374 let ifExpr = A.at start elseEnd (Src.If (reverse newBranches) elseBranch)

369 return ( ifExpr, elseEnd, elseSpace )

375 return ( ifExpr, elseEnd, elseSpace )

@@ -377,14 +383,15 @@ ifHelp start branches =

377function :: R.Position -> ExprParser

383function :: R.Position -> ExprParser

378function start =

384function start =

379 do lambda

385 do lambda

386+ inContext E.ExprFunc $

380− spaces

387+ do spaces

381− arg <- Pattern.term

388+ arg <- Pattern.term

382− spaces

389+ spaces

383− revArgs <- gatherArgs [arg]

390+ revArgs <- gatherArgs [arg]

384− spaces

391+ spaces

385− (body, end, space) <- expression

392+ (body, end, space) <- expression

386− let func = List.foldl' (\e x -> A.at start end (Src.Lambda x e)) body revArgs

393+ let func = List.foldl' (\e x -> A.at start end (Src.Lambda x e)) body revArgs

387− return ( func, end, space )

394+ return ( func, end, space )

388

395

389

396

390gatherArgs :: [P.Raw] -> Parser [P.Raw]

397gatherArgs :: [P.Raw] -> Parser [P.Raw]

@@ -409,18 +416,19 @@ case_ start =

409 (switcher, _, switcherPos) <- expression

416 (switcher, _, switcherPos) <- expression

410 checkSpace switcherPos

417 checkSpace switcherPos

411 keyword "of"

418 keyword "of"

419+ inContext E.ExprCase $

412− spaces

420+ do spaces

413− oldIndent <- getIndent

421+ oldIndent <- getIndent

414− newIndent <- getCol

422+ newIndent <- getCol

415− setIndent newIndent

423+ setIndent newIndent

416− (firstBranch, firstEnd, firstPos) <- branchHelp

424+ (firstBranch, firstEnd, firstPos) <- branchHelp

417− (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos

425+ (branches, end, pos) <- caseHelp [firstBranch] firstEnd firstPos

418− setIndent oldIndent

426+ setIndent oldIndent

419− return

427+ return

420− ( A.at start end (Src.Case switcher branches)

428+ ( A.at start end (Src.Case switcher branches)

421− , end

429+ , end

422− , pos

430+ , pos

423− )

431+ )

424

432

425

433

426branchHelp :: SParser (P.Raw, Src.RawExpr)

434branchHelp :: SParser (P.Raw, Src.RawExpr)

@@ -452,6 +460,7 @@ let_ start =

452 do oldIndent <- getIndent

460 do oldIndent <- getIndent

453 letIndent <- getCol

461 letIndent <- getCol

454 keyword "let"

462 keyword "let"

463+ pushContext E.ExprLet

455 setIndent letIndent

464 setIndent letIndent

456 spaces

465 spaces

457 defIndent <- getCol

466 defIndent <- getCol

@@ -470,6 +479,7 @@ letHelp start oldIndent defs end pos =

470 , do setIndent oldIndent

479 , do setIndent oldIndent

471 checkSpace pos

480 checkSpace pos

472 keyword "in"

481 keyword "in"

482+ popContext ()

473 spaces

483 spaces

474 (body, newEnd, newPos) <- expression

484 (body, newEnd, newPos) <- expression

475 let letExpr = A.at start end (Src.Let defs body)

485 let letExpr = A.at start end (Src.Let defs body)

@@ -490,10 +500,12 @@ definition =

490 P.Var name ->

500 P.Var name ->

491 oneOf

501 oneOf

492 [ do hasType

502 [ do hasType

503+ inContext (E.Annotation name) $

493− spaces

504+ do spaces

494− (tipe, end, space) <- Type.expression

505+ (tipe, end, space) <- Type.expression

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

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

507+ , inContext (E.Definition name) $

496− , definitionHelp start root []

508+ definitionHelp start root []

497 ]

509 ]

498

510

499 _ ->

511 _ ->

@@ -514,7 +526,7 @@ rootPattern start =

514definitionHelp :: R.Position -> P.Raw -> [P.Raw] -> SParser Src.RawDef

526definitionHelp :: R.Position -> P.Raw -> [P.Raw] -> SParser Src.RawDef

515definitionHelp start root revArgs =

527definitionHelp start root revArgs =

516 oneOf

528 oneOf

517− [ do arg <- Pattern.term

529+ [ do arg <- hint E.Arg Pattern.term

518 spaces

530 spaces

519 definitionHelp start root (arg : revArgs)

531 definitionHelp start root (arg : revArgs)

520 , do equals

532 , do equals

src/Parse/Helpers.hs+30−18

@@ -6,8 +6,8 @@ module Parse.Helpers

6 , qualifiedVar, qualifiedCapVar

7 , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, underscore, lambda

8 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

9− , addLocation

9+ , addLocation, inContext

10− , spaces, checkSpace, checkAligned, checkFreshline

10+ , spaces, checkSpace, checkAligned, checkFreshLine

11 )

12 where

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

15import Data.Text (Text)

17import Parse.Primitives

18+import qualified Parse.Primitives as P

18import qualified Reporting.Annotation as A

19import qualified Reporting.Annotation as A

19import qualified Reporting.Error.Syntax as E

20import qualified Reporting.Error.Syntax as E

20import qualified Reporting.Region as R

21import qualified Reporting.Region as R

@@ -35,7 +36,13 @@ type SParser a =

35qualifiedCapVar :: Parser Text

36qualifiedCapVar :: Parser Text

36qualifiedCapVar =

37qualifiedCapVar =

37 do var <- capVar

38 do var <- capVar

38− qualifiedVarHelp True [var]

39+ qualifiedVarHelp qualifiedCapVarHelp [var]

40+

41+

42+qualifiedCapVarHelp :: Parser a

43+qualifiedCapVarHelp =

44+ do ctx <- getContext

45+ failure (E.Theories ctx [E.CapVar])

41qualifiedVar :: Parser Text

48qualifiedVar :: Parser Text

@@ -43,22 +50,19 @@ qualifiedVar =

43 oneOf

50 oneOf

44 [ lowVar

51 [ lowVar

45 , do var <- capVar

52 , do var <- capVar

46− qualifiedVarHelp False [var]

53+ qualifiedVarHelp lowVar [var]

47 ]

54 ]

50−qualifiedVarHelp :: Bool -> [Text] -> Parser Text

57+qualifiedVarHelp :: Parser Text -> [Text] -> Parser Text

51−qualifiedVarHelp allCaps vars =

58+qualifiedVarHelp altEnding vars =

52 oneOf

59 oneOf

53 [ do dot

60 [ do dot

54 oneOf

61 oneOf

55 [ do var <- capVar

62 [ do var <- capVar

56− qualifiedVarHelp allCaps (var:vars)

63+ qualifiedVarHelp altEnding (var:vars)

57− , if allCaps then

58− failure E.BadChunkInQualifiedCapVar

59− else

60− do var <- lowVar

64+ , do var <- altEnding

61− return (Text.intercalate "." (reverse (var:vars)))

65+ return (Text.intercalate "." (reverse (var:vars)))

62 ]

66 ]

63 , return (Text.intercalate "." (reverse vars))

67 , return (Text.intercalate "." (reverse vars))

64 ]

68 ]

@@ -182,6 +186,12 @@ addLocation parser =

182 return (A.at start end value)

186 return (A.at start end value)

183

187

184

188

189+inContext :: E.Context -> Parser a -> Parser a

190+inContext ctx parser =

191+ do P.pushContext ctx

192+ a <- parser

193+ P.popContext a

194+

185

195

186-- WHITESPACE VARIATIONS

196-- WHITESPACE VARIATIONS

187

197

@@ -192,7 +202,9 @@ spaces =

192 indent <- getIndent

202 indent <- getIndent

193 if col > indent && col > 1

203 if col > indent && col > 1

194 then return ()

204 then return ()

205+ else

206+ do ctx <- getContext

195− else failure (E.Theories [E.BadIndent])

207+ failure (E.Theories ctx [E.BadSpace])

196

208

197

209

198checkSpace :: SPos -> Parser ()

210checkSpace :: SPos -> Parser ()

@@ -200,7 +212,7 @@ checkSpace (SPos (R.Position _ col)) =

200 do indent <- getIndent

212 do indent <- getIndent

201 if col > indent && col > 1

213 if col > indent && col > 1

202 then return ()

214 then return ()

203− else deadend E.BadIndent

215+ else deadend [E.BadSpace]

204

216

205

217

206checkAligned :: SPos -> Parser ()

218checkAligned :: SPos -> Parser ()

@@ -208,11 +220,11 @@ checkAligned (SPos (R.Position _ col)) =

208 do indent <- getIndent

220 do indent <- getIndent

209 if col == indent

221 if col == indent

210 then return ()

222 then return ()

211− else deadend E.BadIndent

223+ else deadend [E.BadSpace]

212

224

213

225

214−checkFreshline :: SPos -> Parser ()

226+checkFreshLine :: E.NextDecl -> SPos -> Parser ()

215−checkFreshline (SPos (R.Position _ col)) =

227+checkFreshLine nextDecl (SPos (R.Position _ col)) =

216 if col == 1

228 if col == 1

217 then return ()

229 then return ()

218− else deadend E.FreshLine

230+ else deadend [E.FreshLine nextDecl]

src/Parse/Module.hs+13−14

@@ -8,6 +8,7 @@ import qualified AST.Module as Module

8import qualified AST.Variable as Var

9import Parse.Helpers

10import qualified Reporting.Annotation as A

11+import qualified Reporting.Error.Syntax as E

11import qualified Reporting.Region as R

12import qualified Reporting.Region as R

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

18header :: Parser (Module.Header [Module.UserImport])

19header :: Parser (Module.Header [Module.UserImport])

19header =

20header =

20 do start <- getPosition

21 do start <- getPosition

21− freshLine

22+ freshLine E.ModuleDecl

22 end <- getPosition

23 end <- getPosition

23 oneOf

24 oneOf

24 [ fullHeader

25 [ fullHeader

@@ -34,14 +35,14 @@ fullHeader :: Parser (Module.Header [Module.UserImport])

34fullHeader =

35fullHeader =

35 do tag <- sourceTag

36 do tag <- sourceTag

36 spaces

37 spaces

37− name <- qualifiedCapVar -- TODO <?> "the name of this module"

38+ name <- qualifiedCapVar

38 spaces

39 spaces

39 settings <- effectSettings

40 settings <- effectSettings

40− keyword "exposing" -- TODO <?> "something like `exposing (..)` which replaced `where` in 0.17"

41+ hint E.Exposing $ keyword "exposing"

41 spaces

42 spaces

42 exports <- listing (addLocation listingValue)

43 exports <- listing (addLocation listingValue)

43 start <- getPosition

44 start <- getPosition

44− freshLine

45+ freshLine E.DocCommentDecl

45 end <- getPosition

46 end <- getPosition

46 docs <- maybeDocComment start end

47 docs <- maybeDocComment start end

47 imports <- chompImports []

48 imports <- chompImports []

@@ -127,7 +128,7 @@ maybeDocComment :: R.Position -> R.Position -> Parser (A.Located (Maybe Text))

127maybeDocComment start end =

128maybeDocComment start end =

128 oneOf

129 oneOf

129 [ do doc <- addLocation docComment

130 [ do doc <- addLocation docComment

130− freshLine

131+ freshLine E.ImportDecl

131 return (A.map Just doc)

132 return (A.map Just doc)

132 , return (A.at start end Nothing)

133 , return (A.at start end Nothing)

133 ]

134 ]

@@ -147,7 +148,7 @@ chompImports imports =

147 end <- getPosition

148 end <- getPosition

148 pos <- whitespace

149 pos <- whitespace

149 oneOf

150 oneOf

150− [ do checkFreshline pos

151+ [ do checkFreshLine E.ImportDecl pos

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

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

152 chompImports (userImport:imports)

153 chompImports (userImport:imports)

153 , do checkSpace pos

154 , do checkSpace pos

@@ -168,7 +169,7 @@ chompAs start name imports =

168 end <- getPosition

169 end <- getPosition

169 pos <- whitespace

170 pos <- whitespace

170 oneOf

171 oneOf

171− [ do checkFreshline pos

172+ [ do checkFreshLine E.ImportDecl pos

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

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

173 chompImports (userImport:imports)

174 chompImports (userImport:imports)

174 , do checkSpace pos

175 , do checkSpace pos

@@ -182,7 +183,7 @@ chompExposing start name maybeAlias imports =

182 spaces

183 spaces

183 exposed <- listing listingValue

184 exposed <- listing listingValue

184 end <- getPosition

185 end <- getPosition

185− freshLine

186+ freshLine E.ImportDecl

186 let userImport = method start end name maybeAlias exposed

187 let userImport = method start end name maybeAlias exposed

187 chompImports (userImport:imports)

188 chompImports (userImport:imports)

188

189

@@ -198,7 +199,7 @@ method start end name maybeAlias exposed =

198

199

199listing :: Parser a -> Parser (Var.Listing a)

200listing :: Parser a -> Parser (Var.Listing a)

200listing parser =

201listing parser =

201− expecting "a listing of values and types to expose, like (..)" $

202+ hint E.Listing $

202 do leftParen

203 do leftParen

203 spaces

204 spaces

204 oneOf

205 oneOf

@@ -231,9 +232,7 @@ listingValue =

231 oneOf

232 oneOf

232 [ Var.Value <$> lowVar

233 [ Var.Value <$> lowVar

233 , do leftParen

234 , do leftParen

234− spaces

235 op <- infixOp

236− spaces

237 rightParen

236 rightParen

238 return (Var.Value op)

237 return (Var.Value op)

239 , do name <- capVar

238 , do name <- capVar

@@ -249,8 +248,8 @@ listingValue =

249-- FRESH LINES

248-- FRESH LINES

250

249

251

250

252−freshLine :: Parser ()

251+freshLine :: E.NextDecl -> Parser ()

253−freshLine =

252+freshLine nextDecl =

254 do pos <- whitespace

253 do pos <- whitespace

255− checkFreshline pos

254+ checkFreshLine nextDecl pos

256

255

src/Parse/Parse.hs+2−1

@@ -11,6 +11,7 @@ import Parse.Helpers

11import qualified Parse.Module as Parse (header)

12import qualified Parse.Declaration as Parse (declaration)

13import qualified Reporting.Annotation as A

14+import qualified Reporting.Error.Syntax as E

14import qualified Reporting.Result as Result

15import qualified Reporting.Result as Result

15import qualified Validate

16import qualified Validate

@@ -44,7 +45,7 @@ chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]

44chompDeclarations decls =

45chompDeclarations decls =

45 do (decl, _, pos) <- Parse.declaration

46 do (decl, _, pos) <- Parse.declaration

46 oneOf

47 oneOf

47− [ do checkFreshline pos

48+ [ do checkFreshLine E.OtherDecl pos

48 chompDeclarations (decl:decls)

49 chompDeclarations (decl:decls)

49 , return (reverse (decl:decls))

50 , return (reverse (decl:decls))

50 ]

51 ]

src/Parse/Pattern.hs+26−21

@@ -10,6 +10,7 @@ import qualified AST.Variable as Var

10import Parse.Helpers

11import qualified Parse.Literal as Literal

12import qualified Reporting.Annotation as A

13+import qualified Reporting.Error.Syntax as E

13import qualified Reporting.Region as R

14import qualified Reporting.Region as R

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

20term :: Parser P.Raw

21term :: Parser P.Raw

21term =

22term =

23+ hint E.Pattern $

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

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

25termHelp :: Parser P.Raw

27termHelp :: Parser P.Raw

@@ -55,14 +57,15 @@ record :: Parser P.Raw

55record =

57record =

56 addLocation $

58 addLocation $

57 do leftCurly

59 do leftCurly

60+ inContext E.ExprRecord $

58− spaces

61+ do spaces

59− oneOf

62+ oneOf

60− [ do var <- lowVar

63+ [ do var <- lowVar

61− spaces

64+ spaces

62− recordHelp [var]

65+ recordHelp [var]

63− , do rightCurly

66+ , do rightCurly

64− return (P.Record [])

67+ return (P.Record [])

65− ]

68+ ]

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

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

@@ -86,15 +89,16 @@ tuple :: Parser P.Raw

86tuple =

89tuple =

87 do start <- getPosition

90 do start <- getPosition

88 leftParen

91 leftParen

92+ inContext E.ExprTuple $

89− spaces

93+ do spaces

90− oneOf

94+ oneOf

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

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

92− checkSpace sPos

96+ checkSpace sPos

93− tupleHelp start [pattern]

97+ tupleHelp start [pattern]

94− , do rightParen

98+ , do rightParen

95− end <- getPosition

99+ end <- getPosition

96− return (A.at start end (P.tuple []))

100+ return (A.at start end (P.tuple []))

97− ]

101+ ]

102

103

100tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw

104tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw

@@ -154,9 +158,10 @@ listHelp patterns =

154

158

155expression :: Parser (P.Raw, SPos)

159expression :: Parser (P.Raw, SPos)

156expression =

160expression =

161+ hint E.Pattern $

157− do start <- getPosition

162+ do start <- getPosition

158− cTerm <- consTerm

163+ cTerm <- consTerm

159− exprHelp start [] cTerm

164+ exprHelp start [] cTerm

160

165

161

166

162consTerm :: SParser P.Raw

167consTerm :: SParser P.Raw

src/Parse/Primitives.hs+176−114

@@ -3,11 +3,12 @@

3module Parse.Primitives

4 ( Parser

5 , run, runAt

6− , try, failure, deadend, expecting, endOfFile

6+ , try, failure, deadend, hint, endOfFile

7 , oneOf

8 , symbol, keyword, keywords

9 , lowVar, capVar, infixOp

10 , getPosition, getCol

11+ , getContext, pushContext, popContext

11 , getIndent, setIndent

12 , getIndent, setIndent

12 , SPos(..), whitespace

13 , SPos(..), whitespace

13 , docComment, chompUntilDocs

14 , docComment, chompUntilDocs

@@ -38,8 +39,11 @@ import qualified AST.Helpers as Help (isSymbol)

38import qualified AST.Literal as L

39import qualified AST.Literal as L

39import qualified Reporting.Annotation as A

40import qualified Reporting.Annotation as A

40import qualified Reporting.Error.Syntax as E

41import qualified Reporting.Error.Syntax as E

41−import Reporting.Error.Syntax ( ParseError(..), Problem(..), Theory(..) )

42import qualified Reporting.Region as Region

43+import Reporting.Error.Syntax

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

45+ , Context(..), BadOp(..)

46+ )

@@ -51,10 +55,10 @@ newtype Parser a =

51 { _run

55 { _run

52 :: forall b.

56 :: forall b.

53 State

57 State

54− -> (a -> State -> b) -- consumed ok

58+ -> (a -> State -> ParseError -> b) -- consumed ok

55− -> (ParseError -> b) -- consumed err

59+ -> ( ParseError -> b) -- consumed err

56− -> (a -> State -> b) -- empty ok

60+ -> (a -> State -> ParseError -> b) -- empty ok

57− -> (ParseError -> b) -- empty err

61+ -> ( ParseError -> b) -- empty err

58 -> b

62 -> b

59 }

63 }

@@ -67,24 +71,20 @@ data State =

67 , _indent :: !Int

71 , _indent :: !Int

68 , _row :: !Int

72 , _row :: !Int

69 , _col :: !Int

73 , _col :: !Int

74+ , _context :: [Context]

70 }

75 }

73−data Result a

78+{-# NOINLINE noError #-}

74− = Ok a State

79+noError :: ParseError

75− | Err ParseError

80+noError =

76−

81+ ParseError 0 0 (Theories [] [])

78−{-# INLINE noTheory #-}

79−noTheory :: Int -> Int -> ParseError

80−noTheory row col =

81− ParseError row col (Theories [])

83−

84−{-# INLINE loneTheory #-}

84+{-# INLINE expect #-}

85−loneTheory :: Int -> Int -> Theory -> ParseError

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

86−loneTheory row col theory =

86+expect row col ctx theory =

87− ParseError row col (Theories [theory])

87+ ParseError row col (Theories ctx [theory])

@@ -98,8 +98,8 @@ run parser text =

99runAt :: Int -> Int -> Parser a -> Text -> Either (A.Located E.Error) a

100runAt sRow sCol parser (Text.Text array offset length) =

101− case _run parser (State array offset length 0 sRow sCol) Ok Err Ok Err of

101+ case _run parser (State array offset length 0 sRow sCol []) Ok Err Ok Err of

102− Ok value _ ->

102+ Ok value _ _ ->

103 Right value

104

105 Err (ParseError row col problem) ->

@@ -110,6 +110,11 @@ runAt sRow sCol parser (Text.Text array offset length) =

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

111

112

113+data Result a

114+ = Ok a State ParseError

115+ | Err ParseError

116+

117+

113

118

114-- COMBINATORS

119-- COMBINATORS

115

120

@@ -122,7 +127,7 @@ try parser =

122

127

123failure :: Problem -> Parser a

128failure :: Problem -> Parser a

124failure problem =

129failure problem =

125− Parser $ \(State _ _ _ _ row col) _ cerr _ _ ->

130+ Parser $ \(State _ _ _ _ row col _) _ cerr _ _ ->

126 cerr (ParseError row col problem)

131 cerr (ParseError row col problem)

127

132

128

133

@@ -132,33 +137,33 @@ shaderFailure row col msg =

132 cerr (ParseError row col (BadShader msg))

137 cerr (ParseError row col (BadShader msg))

133

138

134

139

135−deadend :: Theory -> Parser a

140+deadend :: [Theory] -> Parser a

136−deadend theory =

141+deadend thrys =

137− Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

142+ Parser $ \(State _ _ _ _ row col ctx) _ _ _ eerr ->

138− eerr (loneTheory row col theory)

143+ eerr (ParseError row col (Theories ctx thrys))

139

144

140

145

141−expecting :: Text -> Parser a -> Parser a

146+hint :: E.Next -> Parser a -> Parser a

142−expecting description parser =

147+hint next parser =

143− Parser $ \state@(State _ _ _ _ row col) cok cerr eok eerr ->

148+ Parser $ \state@(State _ _ _ _ row col ctx) cok cerr eok eerr ->

144 let

149 let

145− eok' x s =

150+ eok' x s _ =

146− eok x s

151+ eok x s (expect row col ctx (Expecting next))

147

152

148 eerr' _ =

153 eerr' _ =

149− eerr (loneTheory row col (Expecting description))

154+ eerr (expect row col ctx (Expecting next))

150 in

155 in

151 _run parser state cok cerr eok' eerr'

156 _run parser state cok cerr eok' eerr'

152

157

153

158

154endOfFile :: Parser ()

159endOfFile :: Parser ()

155endOfFile =

160endOfFile =

156− Parser $ \state@(State _ _ length _ row col) _ _ eok eerr ->

161+ Parser $ \state@(State _ _ length _ row col ctx) _ _ eok eerr ->

157 if length == 0 then

162 if length == 0 then

158− eok () state

163+ eok () state (expect row col ctx EndOfFile)

159

164

160 else

165 else

161− eerr (noTheory row col)

166+ eerr (expect row col ctx EndOfFile)

162

167

163

168

164

169

@@ -169,8 +174,8 @@ instance Functor Parser where

169 fmap f parser =

174 fmap f parser =

170 Parser $ \state cok cerr eok eerr ->

175 Parser $ \state cok cerr eok eerr ->

171 let

176 let

172− cok' x s = cok (f x) s

177+ cok' x s e = cok (f x) s e

173− eok' x s = eok (f x) s

178+ eok' x s e = eok (f x) s e

174 in

179 in

175 _run parser state cok' cerr eok' eerr

180 _run parser state cok' cerr eok' eerr

176

181

@@ -196,18 +201,18 @@ oneOf parsers =

196

201

197allTheOptionsFailed :: Parser a

202allTheOptionsFailed :: Parser a

198allTheOptionsFailed =

203allTheOptionsFailed =

199− Parser $ \(State _ _ _ _ row col) _ _ _ eerr ->

204+ Parser $ \_ _ _ _ eerr ->

200− eerr (noTheory row col)

205+ eerr noError

201

206

202

207

203oneOfHelp :: Parser a -> Parser a -> Parser a

208oneOfHelp :: Parser a -> Parser a -> Parser a

204oneOfHelp parser1 parser2 =

209oneOfHelp parser1 parser2 =

205 Parser $ \state cok cerr eok eerr ->

210 Parser $ \state cok cerr eok eerr ->

206 let

211 let

207− eerr1 err1 =

212+ eerr1 e1 =

208 let

213 let

209− eok2 y state' = eok y state'

214+ eok2 y s e2 = eok y s (mergeErrors e1 e2)

210− eerr2 err2 = eerr (mergeErrors err1 err2)

215+ eerr2 e2 = eerr (mergeErrors e1 e2)

211 in

216 in

212 _run parser2 state cok cerr eok2 eerr2

217 _run parser2 state cok cerr eok2 eerr2

213 in

218 in

@@ -215,16 +220,30 @@ oneOfHelp parser1 parser2 =

215

220

216

221

217mergeErrors :: ParseError -> ParseError -> ParseError

222mergeErrors :: ParseError -> ParseError -> ParseError

218−mergeErrors error1@(ParseError row col problem1) error2@(ParseError _ _ problem2) =

223+mergeErrors e1@(ParseError r1 c1 p1) e2@(ParseError r2 c2 p2) =

219− case (problem1, problem2) of

224+ case compare r1 r2 of

220− (Theories theories1, Theories theories2) ->

225+ LT -> e2

221− ParseError row col (Theories (theories1 ++ theories2))

226+ GT -> e1

227+ EQ ->

228+ case compare c1 c2 of

229+ LT -> e2

230+ GT -> e1

231+ EQ ->

232+ case (p1, p2) of

233+ (Theories _ [], Theories _ _) ->

234+ e2

235+

236+ (Theories _ _, Theories _ []) ->

237+ e1

222

238

223− (Theories _, _) ->

239+ (Theories ctx ts1, Theories _ ts2) ->

224− error2

240+ ParseError r1 c1 (Theories ctx (ts1 ++ ts2))

225

241

242+ (Theories _ _, _) ->

243+ e2

244+

226− (_, _) ->

245+ (_, _) ->

227− error1

246+ e1

228

247

229

248

230

249

@@ -234,18 +253,26 @@ mergeErrors error1@(ParseError row col problem1) error2@(ParseError _ _ problem2

234instance Monad Parser where

253instance Monad Parser where

235 return value =

254 return value =

236 Parser $ \state _ _ eok _ ->

255 Parser $ \state _ _ eok _ ->

237− eok value state

256+ eok value state noError

238

257

239 parser >>= callback =

258 parser >>= callback =

240 Parser $ \state cok cerr eok eerr ->

259 Parser $ \state cok cerr eok eerr ->

241 let

260 let

242− cok' value newState =

261+ cok1 x s1 e1 =

262+ let

263+ eok2 y s2 e2 = cok y s2 (mergeErrors e1 e2)

264+ eerr2 e2 = cerr (mergeErrors e1 e2)

265+ in

243− _run (callback value) newState cok cerr cok cerr

266+ _run (callback x) s1 cok cerr eok2 eerr2

244

267

245− eok' value newState =

268+ eok1 x s1 e1 =

269+ let

270+ eok2 y s2 e2 = eok y s2 (mergeErrors e1 e2)

271+ eerr2 e2 = eerr (mergeErrors e1 e2)

272+ in

246− _run (callback value) newState cok cerr eok eerr

273+ _run (callback x) s1 cok cerr eok2 eerr2

247 in

274 in

248− _run parser state cok' cerr eok' eerr

275+ _run parser state cok1 cerr eok1 eerr

249

276

250

277

251

278

@@ -254,16 +281,19 @@ instance Monad Parser where

254

281

255symbol :: Text -> Parser ()

282symbol :: Text -> Parser ()

256symbol sym@(Text.Text tArray tOffset tLen) =

283symbol sym@(Text.Text tArray tOffset tLen) =

257− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

284+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

258 if tLen <= length && Text.equal tArray tOffset array offset tLen then

285 if tLen <= length && Text.equal tArray tOffset array offset tLen then

259 let

286 let

260 (# newRow, newCol #) =

287 (# newRow, newCol #) =

261 moveCursor tArray tOffset tLen row col

288 moveCursor tArray tOffset tLen row col

289+

290+ !newState =

291+ State array (offset + tLen) (length - tLen) indent newRow newCol ctx

262 in

292 in

263− cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

293+ cok () newState noError

264

294

265 else

295 else

266− eerr (loneTheory row col (Symbol sym))

296+ eerr (expect row col ctx (Symbol sym))

267

297

268

298

269moveCursor :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int #)

299moveCursor :: Text.Array -> Int -> Int -> Int -> Int -> (# Int, Int #)

@@ -291,21 +321,24 @@ moveCursor array offset length row col =

291

321

292keyword :: Text -> Parser ()

322keyword :: Text -> Parser ()

293keyword kwd@(Text.Text tArray tOffset tLen) =

323keyword kwd@(Text.Text tArray tOffset tLen) =

294− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

324+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

295 if tLen <= length && Text.equal tArray tOffset array offset tLen then

325 if tLen <= length && Text.equal tArray tOffset array offset tLen then

296

326

297 if isInnerVarChar (peekChar array (offset + tLen)) then

327 if isInnerVarChar (peekChar array (offset + tLen)) then

298− eerr (loneTheory row col (Keyword kwd))

328+ eerr (expect row col ctx (Keyword kwd))

299

329

300 else

330 else

301 let

331 let

302 (# newRow, newCol #) =

332 (# newRow, newCol #) =

303 moveCursor tArray tOffset tLen row col

333 moveCursor tArray tOffset tLen row col

334+

335+ !newState =

336+ State array (offset + tLen) (length - tLen) indent newRow newCol ctx

304 in

337 in

305− cok () (State array (offset + tLen) (length - tLen) indent newRow newCol)

338+ cok () newState noError

306

339

307 else

340 else

308− eerr (loneTheory row col (Keyword kwd))

341+ eerr (expect row col ctx (Keyword kwd))

309

342

310

343

311keywords :: Set.Set Text

344keywords :: Set.Set Text

@@ -328,20 +361,20 @@ keywords =

328

361

329lowVar :: Parser Text.Text

362lowVar :: Parser Text.Text

330lowVar =

363lowVar =

331− varPrim Char.isLower

364+ varPrim LowVar Char.isLower

332

365

333

366

334capVar :: Parser Text.Text

367capVar :: Parser Text.Text

335capVar =

368capVar =

336− varPrim Char.isUpper

369+ varPrim CapVar Char.isUpper

337

370

338

371

339{-# INLINE varPrim #-}

372{-# INLINE varPrim #-}

340−varPrim :: (Char -> Bool) -> Parser Text.Text

373+varPrim :: Theory -> (Char -> Bool) -> Parser Text.Text

341−varPrim isGoodFirstChar =

374+varPrim theory isGoodFirstChar =

342− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

375+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

343 if length == 0 then

376 if length == 0 then

344− eerr (loneTheory row col Variable)

377+ eerr (expect row col ctx theory)

345

378

346 else

379 else

347 let

380 let

@@ -356,12 +389,12 @@ varPrim isGoodFirstChar =

356 copyText array offset (newOffset - offset)

389 copyText array offset (newOffset - offset)

357 in

390 in

358 if Set.member copiedText keywords then

391 if Set.member copiedText keywords then

359− eerr (loneTheory row newCol Variable)

392+ eerr (expect row newCol ctx theory)

360 else

393 else

361− cok copiedText (State array newOffset newLength indent row newCol)

394+ cok copiedText (State array newOffset newLength indent row newCol ctx) noError

362

395

363 else

396 else

364− eerr (loneTheory row col Variable)

397+ eerr (expect row col ctx theory)

365

398

366

399

367{-# INLINE copyText #-}

400{-# INLINE copyText #-}

@@ -428,16 +461,16 @@ isInnerVarChar char =

428

461

429infixOp :: Parser Text

462infixOp :: Parser Text

430infixOp =

463infixOp =

431− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

464+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

432 if length == 0 then

465 if length == 0 then

433− eerr (loneTheory row col InfixOp)

466+ eerr (expect row col ctx InfixOp)

434

467

435 else

468 else

436 let

469 let

437 (Text.Iter char size) = peek array offset

470 (Text.Iter char size) = peek array offset

438 in

471 in

439 if not (Help.isSymbol char) then

472 if not (Help.isSymbol char) then

440− eerr (loneTheory row col InfixOp)

473+ eerr (expect row col ctx InfixOp)

441 else

474 else

442 case infixOpHelp array (offset + size) (length - size) row (col + 1) of

475 case infixOpHelp array (offset + size) (length - size) row (col + 1) of

443 Left err ->

476 Left err ->

@@ -445,12 +478,12 @@ infixOp =

445

478

446 Right ( newOffset, newLength, newCol ) ->

479 Right ( newOffset, newLength, newCol ) ->

447 case copyText array offset (newOffset - offset) of

480 case copyText array offset (newOffset - offset) of

448− "=" -> cerr (ParseError row col Dot)

481+ "." -> cerr (ParseError row col (BadOp Dot ctx))

449− "|" -> cerr (ParseError row col Pipe)

482+ "|" -> cerr (ParseError row col (BadOp Pipe ctx))

450− ":" -> cerr (ParseError row col Arrow)

483+ "->" -> cerr (ParseError row col (BadOp Arrow ctx))

451− "." -> cerr (ParseError row col Equals)

484+ "=" -> cerr (ParseError row col (BadOp Equals ctx))

452− "->" -> cerr (ParseError row col HasType)

485+ ":" -> cerr (ParseError row col (BadOp HasType ctx))

453− op -> cok op (State array newOffset newLength indent row newCol)

486+ op -> cok op (State array newOffset newLength indent row newCol ctx) noError

454

487

455

488

456infixOpHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError (Int, Int, Int)

489infixOpHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError (Int, Int, Int)

@@ -474,26 +507,44 @@ infixOpHelp array offset length row col =

474

507

475getPosition :: Parser Region.Position

508getPosition :: Parser Region.Position

476getPosition =

509getPosition =

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

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

478− eok (Region.Position row col) state

511+ eok (Region.Position row col) state noError

479

512

480

513

481getIndent :: Parser Int

514getIndent :: Parser Int

482getIndent =

515getIndent =

483− Parser $ \state@(State _ _ _ indent _ _) _ _ eok _ ->

516+ Parser $ \state@(State _ _ _ indent _ _ _) _ _ eok _ ->

484− eok indent state

517+ eok indent state noError

485

518

486

519

487getCol :: Parser Int

520getCol :: Parser Int

488getCol =

521getCol =

489− Parser $ \state@(State _ _ _ _ _ col) _ _ eok _ ->

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

490− eok col state

523+ eok col state noError

524+

525+

526+getContext :: Parser [E.Context]

527+getContext =

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

529+ eok ctx state noError

530+

531+

532+pushContext :: E.Context -> Parser ()

533+pushContext ctx =

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

535+ eok () (state { _context = ctx : context }) noError

536+

537+

538+popContext :: a -> Parser a

539+popContext value =

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

541+ eok value (state { _context = tail context }) noError

491

542

492

543

493setIndent :: Int -> Parser ()

544setIndent :: Int -> Parser ()

494setIndent indent =

545setIndent indent =

495 Parser $ \state _ _ eok _ ->

546 Parser $ \state _ _ eok _ ->

496− eok () (state { _indent = indent })

547+ eok () (state { _indent = indent }) noError

497

548

498

549

499

550

@@ -506,7 +557,7 @@ newtype SPos =

506

557

507whitespace :: Parser SPos

558whitespace :: Parser SPos

508whitespace =

559whitespace =

509− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

560+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

510 case eatSpaces array offset length row col of

561 case eatSpaces array offset length row col of

511 Left err ->

562 Left err ->

512 cerr err

563 cerr err

@@ -514,7 +565,8 @@ whitespace =

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

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

515 cok

566 cok

516 (SPos (Region.Position newRow newCol))

567 (SPos (Region.Position newRow newCol))

517− (State array newOffset newLength indent newRow newCol)

568+ (State array newOffset newLength indent newRow newCol ctx)

569+ noError

518

570

519

571

520eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

572eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

@@ -646,7 +698,7 @@ eatMultiCommentHelp array offset length row col openComments =

646docComment :: Parser Text

698docComment :: Parser Text

647docComment =

699docComment =

648 do symbol "{-|"

700 do symbol "{-|"

649− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

701+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

650 case eatMultiCommentHelp array offset length row col 1 of

702 case eatMultiCommentHelp array offset length row col 1 of

651 Left err ->

703 Left err ->

652 cerr err

704 cerr err

@@ -654,17 +706,21 @@ docComment =

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

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

655 cok

707 cok

656 (copyText array offset (newOffset - offset))

708 (copyText array offset (newOffset - offset))

657− (State array newOffset newLength indent newRow newCol)

709+ (State array newOffset newLength indent newRow newCol ctx)

710+ noError

658

711

659

712

660chompUntilDocs :: Parser Bool

713chompUntilDocs :: Parser Bool

661chompUntilDocs =

714chompUntilDocs =

662− Parser $ \(State array offset length indent row col) cok _ _ _ ->

715+ Parser $ \(State array offset length indent row col ctx) cok _ _ _ ->

663 let

716 let

664 (# isStart, newOffset, newLength, newRow, newCol #) =

717 (# isStart, newOffset, newLength, newRow, newCol #) =

665 eatDocs array offset length row col

718 eatDocs array offset length row col

719+

720+ !newState =

721+ State array newOffset newLength indent newRow newCol ctx

666 in

722 in

667− cok isStart (State array newOffset newLength indent newRow newCol)

723+ cok isStart newState noError

668

724

669

725

670eatDocs :: Text.Array -> Int -> Int -> Int -> Int -> (# Bool, Int, Int, Int, Int #)

726eatDocs :: Text.Array -> Int -> Int -> Int -> Int -> (# Bool, Int, Int, Int, Int #)

@@ -705,16 +761,16 @@ isDocsStart array offset length =

705

761

706string :: Parser Text.Text

762string :: Parser Text.Text

707string =

763string =

708− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

764+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

709 if length == 0 then

765 if length == 0 then

710− eerr (noTheory row col)

766+ eerr noError

711

767

712 else

768 else

713 let

769 let

714 !word = Text.unsafeIndex array offset

770 !word = Text.unsafeIndex array offset

715 in

771 in

716 if word /= 0x0022 {- " -} then

772 if word /= 0x0022 {- " -} then

717− eerr (noTheory row col)

773+ eerr noError

718

774

719 else

775 else

720 let

776 let

@@ -731,7 +787,8 @@ string =

731 Right ( newOffset, newLength, newCol, builder ) ->

787 Right ( newOffset, newLength, newCol, builder ) ->

732 cok

788 cok

733 (LT.toStrict (LB.toLazyText builder))

789 (LT.toStrict (LB.toLazyText builder))

734− (State array newOffset newLength indent row newCol)

790+ (State array newOffset newLength indent row newCol ctx)

791+ noError

735

792

736

793

737{-# INLINE isQuote #-}

794{-# INLINE isQuote #-}

@@ -880,13 +937,13 @@ multiString array offset length row col initialOffset builder =

880

937

881character :: Parser Text

938character :: Parser Text

882character =

939character =

883− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

940+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

884 if length == 0 then

941 if length == 0 then

885− eerr (noTheory row col)

942+ eerr noError

886

943

887 else

944 else

888 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

945 if Text.unsafeIndex array offset /= 0x0027 {- ' -} then

889− eerr (noTheory row col)

946+ eerr noError

890

947

891 else if length < 3 then

948 else if length < 3 then

892 cerr (ParseError row col BadChar)

949 cerr (ParseError row col BadChar)

@@ -907,7 +964,8 @@ character =

907 else

964 else

908 cok

965 cok

909 (copyText array (offset + 1) size)

966 (copyText array (offset + 1) size)

910− (State array (newOffset + 1) (newLength - 1) indent row endCol)

967+ (State array (newOffset + 1) (newLength - 1) indent row endCol ctx)

968+ noError

911

969

912

970

913characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int )

971characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int )

@@ -938,9 +996,9 @@ characterHelp array offset length row col =

938

996

939digit :: Parser Int

997digit :: Parser Int

940digit =

998digit =

941− Parser $ \(State array offset length indent row col) cok _ _ eerr ->

999+ Parser $ \(State array offset length indent row col ctx) cok _ _ eerr ->

942 if length == 0 then

1000 if length == 0 then

943− eerr (loneTheory row col Digit)

1001+ eerr (expect row col ctx Digit)

944

1002

945 else

1003 else

946 let

1004 let

@@ -949,9 +1007,10 @@ digit =

949 if isDigit word then

1007 if isDigit word then

950 cok

1008 cok

951 (fromIntegral (word - 0x0030))

1009 (fromIntegral (word - 0x0030))

952− (State array (offset + 1) (length - 1) indent row (col + 1))

1010+ (State array (offset + 1) (length - 1) indent row (col + 1) ctx)

1011+ noError

953 else

1012 else

954− eerr (loneTheory row col Digit)

1013+ eerr (expect row col ctx Digit)

955

1014

956

1015

957

1016

@@ -960,16 +1019,16 @@ digit =

960

1019

961number :: Parser L.Literal

1020number :: Parser L.Literal

962number =

1021number =

963− Parser $ \(State array offset length indent row col) cok cerr _ eerr ->

1022+ Parser $ \(State array offset length indent row col ctx) cok cerr _ eerr ->

964 if length == 0 then

1023 if length == 0 then

965− eerr (noTheory row col)

1024+ eerr noError

966

1025

967 else

1026 else

968 let

1027 let

969 !word = Text.unsafeIndex array offset

1028 !word = Text.unsafeIndex array offset

970 in

1029 in

971 if not (isDigit word) then

1030 if not (isDigit word) then

972− eerr (noTheory row col)

1031+ eerr noError

973

1032

974 else

1033 else

975 let

1034 let

@@ -988,7 +1047,10 @@ number =

988 cerr (ParseError row (col + (newOffset - offset)) BadNumberEnd)

1047 cerr (ParseError row (col + (newOffset - offset)) BadNumberEnd)

989

1048

990 else

1049 else

1050+ cok

1051+ literal

991− cok literal (State array newOffset newLength indent row (col + (newOffset - offset)))

1052+ (State array newOffset newLength indent row (col + (newOffset - offset)) ctx)

1053+ noError

992

1054

993

1055

994isDirtyEnd :: Text.Array -> Int -> Int -> Bool

1056isDirtyEnd :: Text.Array -> Int -> Int -> Bool

@@ -1182,7 +1244,7 @@ readFloat array startOffset endOffset =

1182shaderSource :: Parser Text

1244shaderSource :: Parser Text

1183shaderSource =

1245shaderSource =

1184 do symbol "[glsl|"

1246 do symbol "[glsl|"

1185− Parser $ \(State array offset length indent row col) cok cerr _ _ ->

1247+ Parser $ \(State array offset length indent row col ctx) cok cerr _ _ ->

1186 case eatShader array offset length row col of

1248 case eatShader array offset length row col of

1187 Nothing ->

1249 Nothing ->

1188 cerr (ParseError row col EndOfFile_Shader)

1250 cerr (ParseError row col EndOfFile_Shader)

@@ -1190,10 +1252,10 @@ shaderSource =

1190 Just ( shaderEndOffset, newRow, newCol ) ->

1252 Just ( shaderEndOffset, newRow, newCol ) ->

1191 let

1253 let

1192 !size = shaderEndOffset - offset

1254 !size = shaderEndOffset - offset

1255+ !newState =

1256+ State array (shaderEndOffset + 2) (length - size - 2) indent newRow newCol ctx

1193 in

1257 in

1194− cok

1195− (copyText array offset size)

1258+ cok (copyText array offset size) newState noError

1196− (State array (shaderEndOffset + 2) (length - size - 2) indent newRow newCol)

1197

1259

1198

1260

1199eatShader :: Text.Array -> Int -> Int -> Int -> Int -> Maybe (Int, Int, Int)

1261eatShader :: Text.Array -> Int -> Int -> Int -> Int -> Maybe (Int, Int, Int)

src/Parse/Type.hs+42−37

@@ -8,6 +8,7 @@ import qualified AST.Type as Type

8import qualified AST.Variable as Var

9import Parse.Helpers

10import qualified Reporting.Annotation as A

11+import qualified Reporting.Error.Syntax as E

11import qualified Reporting.Region as R

12import qualified Reporting.Region as R

@@ -17,12 +18,13 @@ import qualified Reporting.Region as R

18term :: Parser Type.Raw

19term :: Parser Type.Raw

19term =

20term =

21+ hint E.Type $

20− oneOf

22+ oneOf

21− [ constructor

23+ [ constructor

22− , variable

24+ , variable

23− , tuple

25+ , tuple

24− , record

26+ , record

25− ]

27+ ]

@@ -31,7 +33,7 @@ term =

32variable :: Parser Type.Raw

34variable :: Parser Type.Raw

33variable =

35variable =

34− expecting "a type variable" $ addLocation $

36+ addLocation $

35 Type.RVar <$> lowVar

37 Type.RVar <$> lowVar

@@ -41,6 +43,7 @@ variable =

42expression :: SParser Type.Raw

44expression :: SParser Type.Raw

43expression =

45expression =

46+ hint E.Type $

44 do start <- getPosition

47 do start <- getPosition

45 (tipe1, end1, pos1) <-

48 (tipe1, end1, pos1) <-

46 oneOf

49 oneOf

@@ -64,7 +67,7 @@ expression =

65constructor :: Parser Type.Raw

68constructor :: Parser Type.Raw

66constructor =

69constructor =

67− expecting "a type constructor, like Maybe or List" $ addLocation $

70+ addLocation $

68 fmap (Type.RType . Var.Raw) qualifiedCapVar

71 fmap (Type.RType . Var.Raw) qualifiedCapVar

@@ -115,15 +118,16 @@ tuple :: Parser Type.Raw

115tuple =

118tuple =

116 do start <- getPosition

119 do start <- getPosition

117 leftParen

120 leftParen

121+ inContext E.TypeTuple $

118− oneOf

122+ oneOf

119− [ do rightParen

123+ [ do rightParen

120− end <- getPosition

124+ end <- getPosition

121− return (Type.tuple (R.Region start end) [])

125+ return (Type.tuple (R.Region start end) [])

122− , do spaces

126+ , do spaces

123− (tipe, _, pos) <- expression

127+ (tipe, _, pos) <- expression

124− checkSpace pos

128+ checkSpace pos

125− tupleEnding start [tipe]

129+ tupleEnding start [tipe]

126− ]

130+ ]

127

131

128

132

129tupleEnding :: R.Position -> [Type.Raw] -> Parser Type.Raw

133tupleEnding :: R.Position -> [Type.Raw] -> Parser Type.Raw

@@ -153,26 +157,27 @@ record :: Parser Type.Raw

153record =

157record =

154 addLocation $

158 addLocation $

155 do leftCurly

159 do leftCurly

160+ inContext E.TypeRecord $

156− spaces

161+ do spaces

157− oneOf

162+ oneOf

158− [ do rightCurly

163+ [ do rightCurly

159− return (Type.RRecord [] Nothing)

164+ return (Type.RRecord [] Nothing)

160− , do var <- addLocation lowVar

165+ , do var <- addLocation lowVar

161− spaces

166+ spaces

162− oneOf

167+ oneOf

163− [ do pipe

168+ [ do pipe

164− spaces

169+ spaces

165− firstField <- field

170+ firstField <- field

166− fields <- chompFields [firstField]

171+ fields <- chompFields [firstField]

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

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

168− , do hasType

173+ , do hasType

169− spaces

174+ spaces

170− (tipe, _, nextPos) <- expression

175+ (tipe, _, nextPos) <- expression

171− checkSpace nextPos

176+ checkSpace nextPos

172− fields <- chompFields [(var, tipe)]

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

173− return (Type.RRecord fields Nothing)

178+ return (Type.RRecord fields Nothing)

174− ]

179+ ]

175− ]

180+ ]

176

181

177

182

178type Field = ( A.Located Text, Type.Raw )

183type Field = ( A.Located Text, Type.Raw )

src/Reporting/Error/Syntax.hs+230−80

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

3module Reporting.Error.Syntax

4 ( Error(..)

5 , ParseError(..)

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

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

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

7 , toReport

8 , toReport

8 )

9 )

9 where

10 where

@@ -54,8 +55,7 @@ data Error

54-- PARSE ERRORS

55-- PARSE ERRORS

57−data ParseError

58− = ParseError !Int !Int !Problem

58+data ParseError = ParseError !Int !Int !Problem

61data Problem

@@ -73,25 +73,62 @@ data Problem

73 | BadNumberHex

74 | BadNumberZero

75 | BadShader Text

76− | BadChunkInQualifiedCapVar

76+ | BadOp BadOp [Context]

77− | HasType

77+ | Theories [Context] [Theory]

78− | Equals

78+

79− | Arrow

79+

80− | Pipe

80+data BadOp = HasType | Equals | Arrow | Pipe | Dot

81− | Dot

82− | Theories [Theory]

85data Theory

83data Theory

84+ = Expecting Next

86− = Keyword Text

85+ | Keyword Text

87 | Symbol Text

86 | Symbol Text

88− | Variable

87+ | LowVar

88+ | CapVar

89 | InfixOp

90 | Digit

91− | BadIndent

91+ | EndOfFile

92− | FreshLine

92+ | FreshLine NextDecl

93− | Expecting Text

93+ | BadSpace

94+ deriving (Eq, Ord, Show)

95+

96+

98+ deriving (Eq, Ord, Show)

99+

100+

101+data NextDecl = ModuleDecl | DocCommentDecl | ImportDecl | OtherDecl

102+ deriving (Eq, Ord, Show)

103+

104+

105+data Context

106+ = ExprIf

107+ | ExprLet

108+ | ExprFunc

109+ | ExprCase

110+ | ExprList

111+ | ExprTuple

112+ | ExprRecord

113+ ----------------

114+ | Definition Text

115+ | Annotation Text

116+ ----------------

117+ | TypeTuple

118+ | TypeRecord

119+ ----------------

120+ | PatternList

121+ | PatternTuple

122+ | PatternRecord

123+ ----------------

124+ | Module

125+ | Import

126+ | DocComment

127+ | TypeUnion

128+ | TypeAlias

129+ | Infix

130+ | Port

94− deriving (Eq, Ord)

131+ deriving (Eq, Ord, Show)

132

133

134

@@ -149,8 +186,8 @@ toReport _localizer err =

149 "A normal module can expose values, but not settings like this."

186 "A normal module can expose values, but not settings like this."

150 ( reflowParagraph $

187 ( reflowParagraph $

151 "If you want a normal module, just remove this stuff. If you want to create\

188 "If you want a normal module, just remove this stuff. If you want to create\

152− \ an `effect module` you just forgot to use the `effect` keyword. In that\

189+ \ an `effect module` you forgot to use the `effect` keyword. In that\

153− \ case, just change `module` to `effect module` and you should be headed in\

190+ \ case, change `module` to `effect module` and you should be headed in\

154 \ the right direction!"

191 \ the right direction!"

155 )

192 )

156

193

@@ -161,7 +198,7 @@ toReport _localizer err =

161 "A port module can expose values, but not have settings like this."

198 "A port module can expose values, but not have settings like this."

162 ( reflowParagraph $

199 ( reflowParagraph $

163 "If you want a port module, just remove this stuff. If you want to create\

200 "If you want a port module, just remove this stuff. If you want to create\

164− \ a custom effect module instead (which is rare) just change `port module`\

201+ \ a custom effect module instead (which is rare) change `port module`\

165 \ to `effect module` and you should be headed in the right direction!"

202 \ to `effect module` and you should be headed in the right direction!"

166 )

203 )

167

204

@@ -214,7 +251,7 @@ toReport _localizer err =

214 Nothing

251 Nothing

215 ("You are declaring port " <> Help.functionName name <> " in a normal module.")

252 ("You are declaring port " <> Help.functionName name <> " in a normal module.")

216 ( reflowParagraph $

253 ( reflowParagraph $

217− "All ports must be defined in a `port module`. You should probably have just\

254+ "All ports must be defined in a `port module`. You should probably have only\

218 \ one of these for your project. This way all of your foreign interactions\

255 \ one of these for your project. This way all of your foreign interactions\

219 \ stay relatively organized."

256 \ stay relatively organized."

220 )

257 )

@@ -429,7 +466,7 @@ problemToReport problem =

429 "Ran into a bad use of single quotes."

466 "Ran into a bad use of single quotes."

430 ( Help.stack

467 ( Help.stack

431 [ reflowParagraph $

468 [ reflowParagraph $

432− "If you want to create a string, just switch to double quotes:"

469+ "If you want to create a string, switch to double quotes:"

433 , Help.indent 4 $

470 , Help.indent 4 $

434 dullyellow (text "'this'")

471 dullyellow (text "'this'")

435 <> text " => "

472 <> text " => "

@@ -483,48 +520,47 @@ problemToReport problem =

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

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

484 (reflowParagraph msg)

521 (reflowParagraph msg)

485

522

486− BadChunkInQualifiedCapVar ->

523+ BadOp op context ->

487− error "TODO"

524+ case op of

488−

489− HasType ->

525+ HasType ->

490− parseReport

526+ badOp context "the \"has type\" operator (:)"

491− "Single colons should only show up in types."

527+ "type annotations and record types"

492− ( reflowParagraph $

493− "Maybe you want :: instead? Or maybe you are defining\

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

494− \ a type annotation but there are extra spaces before it?"

529+

495− )

496−

497− Equals ->

530+ Equals ->

498− parseReport

531+ badOp context "an equals sign (=)"

499− "The = operator is reserved for defining variables."

532+ "definitions"

500− ( reflowParagraph $

501− "Maybe you want == instead? Or maybe you are defining a\

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

502− \ variable but there are extra spaces before it?"

534+

503− )

504−

505− Arrow ->

535+ Arrow ->

536+ if isCaseRelated context then

506− parseReport

537+ parseReport

538+ "I am parsing a case expression, but this arrow (->) is out of place."

539+ ( reflowParagraph $

540+ "Each branch in a case expression needs to start on the same\

541+ \ column, so maybe this branch is indented too much?"

542+ )

543+

544+ else

545+ badOp context "an arrow (->)"

507− "Arrows are reserved for cases and anonymous functions."

546+ "cases expressions and anonymous functions"

508− ( reflowParagraph $

509− "Maybe you want > or >= instead?"

547+ "Maybe you want > or >= instead?"

510− )

548+

511−

512− Pipe ->

549+ Pipe ->

513− parseReport

550+ badOp context "a vertical bar (|)"

514− "Vertical bars are reserved for use in type declarations."

551+ "type declarations"

515− ( reflowParagraph $

516 "Maybe you want || instead?"

552 "Maybe you want || instead?"

517− )

518

553

519− Dot ->

554+ Dot ->

520− parseReport

555+ parseReport

556+ "I was not expecting a dot (.) here."

557+ ( reflowParagraph $

521− "Dots are for record access and decimal points."

558+ "Dots are for record access and decimal points, so\

522− ( reflowParagraph $

523− "They cannot float around on their own though, so\

559+ \ they cannot float around on their own. Maybe\

524− \ maybe there is some extra whitespace?"

560+ \ there is some extra whitespace?"

525− )

561+ )

526

562

527− Theories allTheories ->

563+ Theories context allTheories ->

528 case Set.toList (Set.fromList allTheories) of

564 case Set.toList (Set.fromList allTheories) of

529 [] ->

565 [] ->

530 parseReport

566 parseReport

@@ -536,33 +572,147 @@ problemToReport problem =

536 \ That way we can figure out how to give better advice!"

572 \ That way we can figure out how to give better advice!"

537 )

573 )

538

574

575+ [theory] ->

576+ parseReport

577+ "I got confused while trying to parse your code."

578+ ( reflowParagraph $

579+ contextToText context

580+ <> " right now, so I was expecting "

581+ <> theoryToText theory

582+ )

583+

539 theories ->

584 theories ->

585+ parseReport

586+ "I got confused while trying to parse your code."

587+ ( Help.vcat $

588+ [ reflowParagraph $

589+ contextToText context <> ", so I was expecting:"

590+ , text ""

591+ ]

540− error "TODO" (map theoryToText theories)

592+ ++ map (bullet . theoryToText) theories

593+ )

594+

595+

596+bullet :: Text -> Help.Doc

597+bullet point =

598+ Help.indent 2 (reflowParagraph point)

599+

600+

601+badOp :: [Context] -> Text -> Text -> Text -> Report.Report

602+badOp context opName setting hint =

603+ parseReport ("I was not expecting " <> opName <> " here.") $

604+ reflowParagraph $

605+ "It should only appear in " <> setting <> ", but "

606+ <> contextToText context <> ". " <> hint

607+

608+

609+contextToText :: [Context] -> Text

610+contextToText contextStack =

611+ case contextStack of

612+ [] ->

613+ "I am in between top-level declarations right now."

614+

615+ context : rest ->

616+ let anchor = getAnchor rest in

617+ "I think I am parsing " <>

618+ case context of

619+ ExprIf -> "an `if`" <> anchor

620+ ExprLet -> "a `let`" <> anchor

621+ ExprFunc -> "an anonymous function" <> anchor

622+ ExprCase -> "a `case`" <> anchor

623+ ExprList -> "a list" <> anchor

624+ ExprTuple -> "a tuple" <> anchor

625+ ExprRecord -> "a record" <> anchor

626+ Definition name -> "the definition of `" <> name <> "`"

627+ Annotation name -> "the type annotation for `" <> name <> "`"

628+ TypeTuple -> "a tuple type" <> anchor

629+ TypeRecord -> "a record type" <> anchor

630+ PatternList -> "a pattern" <> anchor

631+ PatternTuple -> "a pattern" <> anchor

632+ PatternRecord -> "a pattern" <> anchor

633+ Module -> "a module declaration"

634+ Import -> "an import"

635+ DocComment -> "a documentation comment"

636+ TypeUnion -> "a union type"

637+ TypeAlias -> "a type alias"

638+ Infix -> "an infix declaration"

639+ Port -> "a port declaration"

640+

641+

642+getAnchor :: [Context] -> Text

643+getAnchor context =

644+ case context of

645+ [] -> ""

646+ Definition name : _ -> " in the definition of `" <> name <> "`"

647+ Annotation name : _ -> " in the type annotation for `" <> name <> "`"

648+ _ : rest -> getAnchor rest

649+

650+

651+isCaseRelated :: [Context] -> Bool

652+isCaseRelated context =

653+ case context of

654+ [] -> False

655+ ExprCase : _ -> True

656+ _ : rest -> isCaseRelated rest

541

657

542

658

543theoryToText :: Theory -> Text

659theoryToText :: Theory -> Text

544theoryToText theory =

660theoryToText theory =

545 case theory of

661 case theory of

546− Keyword _ ->

662+ Keyword keyword ->

547− ""

663+ "the `" <> keyword <> "` keyword"

548−

664+

549− Symbol _ ->

665+ Symbol symbol ->

550− ""

666+ case symbol of

551−

667+ "=" -> "an equals sign (=)"

552− Variable ->

668+ "->" -> "an arrow (->) followed by an expression"

553− ""

669+ ":" -> "the \"has type\" symbol (:) followed by a type"

670+ "," -> "a comma"

671+ "|" -> "a vertical bar (|)"

672+ "::" -> "the cons operator (::)"

673+ "." -> "a dot (.)"

674+ "-" -> "a minus sign (-)"

675+ "_" -> "an underscore"

676+ "(" -> "a left paren, for grouping or starting tuples"

677+ ")" -> "a closing paren"

678+ "[" -> "a left square bracket, for starting lists"

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

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

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

682+ _ -> "the (" <> symbol <> ") symbol"

683+

684+ LowVar ->

685+ "a lower-case variable, like `x` or `user`"

686+

687+ CapVar ->

688+ "an upper-case variable, like `Maybe` or `Just`"

554

689

555 InfixOp ->

690 InfixOp ->

556− ""

691+ "an infix operator, like + or =="

557

692

558 Digit ->

693 Digit ->

559− "a digit, like 0 or 6"

694+ "a digit from 0 to 9"

560−

695+

561− BadIndent ->

696+ EndOfFile ->

562− ""

697+ "the end of the file"

563−

698+

699+ BadSpace ->

700+ "more indentation"

701+

564− FreshLine ->

702+ FreshLine nextDecl ->

565− ""

703+ "a fresh line with no indentation for " <>

566−

704+ case nextDecl of

705+ ModuleDecl -> "an `import`"

706+ DocCommentDecl -> "an `import`"

707+ ImportDecl -> "an `import` or a declarations"

708+ OtherDecl -> "a top-level declaration"

709+

567− Expecting _ ->

710+ Expecting next ->

568− ""

711+ case next of

712+ Expr -> "an expression, like x or 42"

713+ ElseBranch -> "an `else` branch. An `if` must handle both possibilities!"

714+ Arg -> "an argument, like `name` or `total`"

715+ Pattern -> "a pattern, like `name` or (Just x)"

716+ Type -> "a type, like Int or (List String)"

717+ Listing -> "a list of exposed values and types, like (..) or (x,y,z)"

718+ Exposing -> "something like `exposing (..)`"