1433e40 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add some structure to parse errors

1433e40Evan Czaplicki10 years ago

src/Parse/Expression.hs+1−4

compare with master

unifiedsplit

@@ -466,12 +466,9 @@ letHelp start oldIndent defs end pos =

466 (def, newEnd, newPos) <- definition

467 letHelp start oldIndent (def:defs) newEnd newPos

468

469− , do checkFreshline pos

470− failure (error "TODO missing `in`")

471−

472 , do setIndent oldIndent

469 , do setIndent oldIndent

473− keyword "in"

474 checkSpace pos

470 checkSpace pos

471+ keyword "in"

475 spaces

472 spaces

476 (body, newEnd, newPos) <- expression

473 (body, newEnd, newPos) <- expression

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

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

src/Parse/Helpers.hs+23−31

@@ -14,9 +14,9 @@ module Parse.Helpers

14import qualified Data.Text as Text

15import Data.Text (Text)

17−import Parse.Primitives hiding (text)

17+import Parse.Primitives

18−import qualified Parse.Primitives as Prim

19import qualified Reporting.Annotation as A

18import qualified Reporting.Annotation as A

19+import qualified Reporting.Error.Syntax as E

20import qualified Reporting.Region as R

@@ -55,7 +55,7 @@ qualifiedVarHelp allCaps vars =

55 [ do var <- capVar

56 qualifiedVarHelp allCaps (var:vars)

57 , if allCaps then

58− failure False -- TODO

58+ failure E.BadChunkInQualifiedCapVar

59 else

60 do var <- lowVar

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

@@ -71,69 +71,61 @@ qualifiedVarHelp allCaps vars =

71{-# INLINE equals #-}

72equals :: Parser ()

73equals =

74− expecting "an equals sign '='" $

74+ symbol "="

75− Prim.text "="

78{-# INLINE rightArrow #-}

77{-# INLINE rightArrow #-}

79rightArrow :: Parser ()

78rightArrow :: Parser ()

80rightArrow =

79rightArrow =

81− expecting "an arrow '->'" $

80+ symbol "->"

82− Prim.text "->"

85{-# INLINE hasType #-}

83{-# INLINE hasType #-}

86hasType :: Parser ()

84hasType :: Parser ()

87hasType =

85hasType =

88− expecting "the \"has type\" symbol ':'" $

86+ symbol ":"

89− Prim.text ":"

92{-# INLINE comma #-}

89{-# INLINE comma #-}

93comma :: Parser ()

90comma :: Parser ()

94comma =

91comma =

95− expecting "a comma ','" $

92+ symbol ","

96− Prim.text ","

99{-# INLINE pipe #-}

95{-# INLINE pipe #-}

100pipe :: Parser ()

96pipe :: Parser ()

101pipe =

97pipe =

102− expecting "a vertical bar '|'" $

98+ symbol "|"

103− Prim.text "|"

104

105

100

106{-# INLINE cons #-}

101{-# INLINE cons #-}

107cons :: Parser ()

102cons :: Parser ()

108cons =

103cons =

109− expecting "a cons operator '::'" $

104+ symbol "::"

110− Prim.text "::"

111

105

112

106

113{-# INLINE dot #-}

107{-# INLINE dot #-}

114dot :: Parser ()

108dot :: Parser ()

115dot =

109dot =

116− expecting "a dot '.'" $

110+ symbol "."

117− Prim.text "."

118

111

119

112

120{-# INLINE minus #-}

113{-# INLINE minus #-}

121minus :: Parser ()

114minus :: Parser ()

122minus =

115minus =

123− Prim.text "-"

116+ symbol "-"

124

117

125

118

126{-# INLINE underscore #-}

119{-# INLINE underscore #-}

127underscore :: Parser ()

120underscore :: Parser ()

128underscore =

121underscore =

129− expecting "a wildcard '_'" $

122+ symbol "_"

130− Prim.text "_"

131

123

132

124

133{-# INLINE lambda #-}

125{-# INLINE lambda #-}

134lambda :: Parser ()

126lambda :: Parser ()

135lambda =

127lambda =

136− oneOf [ Prim.text "\\", Prim.text "\x03BB" ]

128+ oneOf [ symbol "\\", symbol "\x03BB" ]

137

129

138

130

139

131

@@ -143,37 +135,37 @@ lambda =

143{-# INLINE leftParen #-}

135{-# INLINE leftParen #-}

144leftParen :: Parser ()

136leftParen :: Parser ()

145leftParen =

137leftParen =

146− Prim.text "("

138+ symbol "("

147

139

148

140

149{-# INLINE rightParen #-}

141{-# INLINE rightParen #-}

150rightParen :: Parser ()

142rightParen :: Parser ()

151rightParen =

143rightParen =

152− Prim.text ")"

144+ symbol ")"

153

145

154

146

155{-# INLINE leftSquare #-}

147{-# INLINE leftSquare #-}

156leftSquare :: Parser ()

148leftSquare :: Parser ()

157leftSquare =

149leftSquare =

158− Prim.text "["

150+ symbol "["

159

151

160

152

161{-# INLINE rightSquare #-}

153{-# INLINE rightSquare #-}

162rightSquare :: Parser ()

154rightSquare :: Parser ()

163rightSquare =

155rightSquare =

164− Prim.text "]"

156+ symbol "]"

165

157

166

158

167{-# INLINE leftCurly #-}

159{-# INLINE leftCurly #-}

168leftCurly :: Parser ()

160leftCurly :: Parser ()

169leftCurly =

161leftCurly =

170− Prim.text "{"

162+ symbol "{"

171

163

172

164

173{-# INLINE rightCurly #-}

165{-# INLINE rightCurly #-}

174rightCurly :: Parser ()

166rightCurly :: Parser ()

175rightCurly =

167rightCurly =

176− Prim.text "}"

168+ symbol "}"

177

169

178

170

179

171

@@ -200,7 +192,7 @@ spaces =

200 indent <- getIndent

192 indent <- getIndent

201 if col > indent && col > 1

193 if col > indent && col > 1

202 then return ()

194 then return ()

203− else failure False -- TODO

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

204

196

205

197

206checkSpace :: SPos -> Parser ()

198checkSpace :: SPos -> Parser ()

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

208 do indent <- getIndent

200 do indent <- getIndent

209 if col > indent && col > 1

201 if col > indent && col > 1

210 then return ()

202 then return ()

211− else deadend False -- TODO

203+ else deadend E.BadIndent

212

204

213

205

214checkAligned :: SPos -> Parser ()

206checkAligned :: SPos -> Parser ()

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

216 do indent <- getIndent

208 do indent <- getIndent

217 if col == indent

209 if col == indent

218 then return ()

210 then return ()

219− else deadend False -- TODO

211+ else deadend E.BadIndent

220

212

221

213

222checkFreshline :: SPos -> Parser ()

214checkFreshline :: SPos -> Parser ()

223checkFreshline (SPos (R.Position _ col)) =

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

224 if col == 1

216 if col == 1

225 then return ()

217 then return ()

226− else deadend False -- TODO

218+ else deadend E.FreshLine

src/Parse/Parse.hs+6−4

@@ -1,7 +1,6 @@

1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2module Parse.Parse (program) where

4−import qualified Data.Text as Text

5import Data.Text (Text)

4import Data.Text (Text)

7import qualified AST.Declaration as Decl

6import qualified AST.Declaration as Decl

@@ -11,6 +10,8 @@ import qualified Elm.Package as Package

11import Parse.Helpers

10import Parse.Helpers

12import qualified Parse.Module as Parse (header)

11import qualified Parse.Module as Parse (header)

13import qualified Parse.Declaration as Parse (declaration)

12import qualified Parse.Declaration as Parse (declaration)

13+import qualified Reporting.Annotation as A

14+import qualified Reporting.Result as Result

14import qualified Validate

15import qualified Validate

@@ -22,10 +23,11 @@ program :: Package.Name -> Text -> Validate.Result wrn Module.Valid

22program pkgName src =

23program pkgName src =

23 case run (chompProgram pkgName) src of

24 case run (chompProgram pkgName) src of

24 Right modul ->

25 Right modul ->

25− Validate.validate modul

26+ Validate.validate modul

27+

28+ Left (A.A region syntaxError) ->

29+ Result.throw region syntaxError

27− Left err ->

28− error ("TODO program parse error\n" ++ show err ++ "\n" ++ Text.unpack (Text.take 100 src))

31chompProgram :: Package.Name -> Parser Module.Source

33chompProgram :: Package.Name -> Parser Module.Source

src/Parse/Primitives.hs+143−120

@@ -5,7 +5,7 @@ module Parse.Primitives

5 , run

6 , try, failure, deadend, expecting, endOfFile

7 , oneOf

8− , text, keyword, keywords

8+ , symbol, keyword, keywords

9 , lowVar, capVar, infixOp

10 , getPosition, getCol

11 , getIndent, setIndent

@@ -34,6 +34,9 @@ import GHC.Word (Word16(..))

35import qualified AST.Helpers as Help (isSymbol)

36import qualified AST.Literal as L

37+import qualified Reporting.Annotation as A

38+import qualified Reporting.Error.Syntax as E

39+import Reporting.Error.Syntax ( ParseError(..), Problem(..), Theory(..) )

37import qualified Reporting.Region as Region

40import qualified Reporting.Region as Region

@@ -47,9 +50,9 @@ newtype Parser a =

47 :: forall b.

50 :: forall b.

48 State

51 State

49 -> (a -> State -> b) -- consumed ok

52 -> (a -> State -> b) -- consumed ok

50− -> (Error -> b) -- consumed err

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

51 -> (a -> State -> b) -- empty ok

54 -> (a -> State -> b) -- empty ok

52− -> (Error -> b) -- empty err

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

53 -> b

56 -> b

54 }

57 }

@@ -67,26 +70,37 @@ data State =

68data Result a

71data Result a

69 = Ok a State

72 = Ok a State

70− | Err Error

73+ | Err ParseError

73−data Error

76+{-# INLINE noTheory #-}

74− = Error !Int !Int

77+noTheory :: Int -> Int -> ParseError

75− deriving (Show)

78+noTheory row col =

79+ ParseError row col (Theories [])

80+

81+

82+{-# INLINE loneTheory #-}

83+loneTheory :: Int -> Int -> Theory -> ParseError

84+loneTheory row col theory =

85+ ParseError row col (Theories [theory])

79-- RUN PARSER

89-- RUN PARSER

82−run :: Parser a -> Text -> Either Error a

92+run :: Parser a -> Text -> Either (A.Located E.Error) a

83run parser (Text.Text array offset length) =

93run parser (Text.Text array offset length) =

84 case _run parser (State array offset length 0 1 1) Ok Err Ok Err of

94 case _run parser (State array offset length 0 1 1) Ok Err Ok Err of

85 Ok value _ ->

95 Ok value _ ->

86 Right value

96 Right value

88− Err err ->

98+ Err (ParseError row col problem) ->

89− Left err

99+ let

100+ region =

101+ Region.Region (Region.Position row col) (Region.Position row (col + 1))

102+ in

103+ Left (A.A region (E.Parse problem))

104

105

106

@@ -99,24 +113,27 @@ try parser =

99 _run parser state cok eerr eok eerr

113 _run parser state cok eerr eok eerr

100

114

101

115

102−failure :: error -> Parser a

116+failure :: Problem -> Parser a

103−failure _msg =

117+failure problem =

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

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

105− cerr (Error row col)

119+ cerr (ParseError row col problem)

106

120

107

121

108−deadend :: error -> Parser a

122+deadend :: Theory -> Parser a

109−deadend _msg =

123+deadend theory =

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

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

111− eerr (Error row col)

125+ eerr (loneTheory row col theory)

112

126

113

127

114−expecting :: String -> Parser a -> Parser a

128+expecting :: Text -> Parser a -> Parser a

115−expecting _msg parser =

129+expecting description parser =

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

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

117 let

131 let

118− eok' x s = eok x s

132+ eok' x s =

119− eerr' _err = eerr (Error row col)

133+ eok x s

134+

135+ eerr' _ =

136+ eerr (loneTheory row col (Expecting description))

120 in

137 in

121 _run parser state cok cerr eok' eerr'

138 _run parser state cok cerr eok' eerr'

122

139

@@ -128,7 +145,7 @@ endOfFile =

128 eok () state

145 eok () state

129

146

130 else

147 else

131− eerr (Error row col)

148+ eerr (noTheory row col)

132

149

133

150

134

151

@@ -151,7 +168,7 @@ instance Functor Parser where

151

168

152instance Applicative.Applicative Parser where

169instance Applicative.Applicative Parser where

153 pure = return

170 pure = return

154− (<*>) = ap -- TODO: Can this be optimized?

171+ (<*>) = ap

155

172

156

173

157instance Applicative.Alternative Parser where

174instance Applicative.Alternative Parser where

@@ -167,21 +184,34 @@ oneOf parsers =

167allTheOptionsFailed :: Parser a

184allTheOptionsFailed :: Parser a

168allTheOptionsFailed =

185allTheOptionsFailed =

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

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

170− eerr (Error row col)

187+ eerr (noTheory row col)

171

188

172

189

173oneOfHelp :: Parser a -> Parser a -> Parser a

190oneOfHelp :: Parser a -> Parser a -> Parser a

174oneOfHelp parser1 parser2 =

191oneOfHelp parser1 parser2 =

175 Parser $ \state cok cerr eok eerr ->

192 Parser $ \state cok cerr eok eerr ->

176 let

193 let

177− meerr err =

194+ eerr1 err1 =

178 let

195 let

179− neok y state' = eok y state'

196+ eok2 y state' = eok y state'

180− neerr _err' = eerr err -- TODO merge things properly

197+ eerr2 err2 = eerr (mergeErrors err1 err2)

181 in

198 in

182− _run parser2 state cok cerr neok neerr

199+ _run parser2 state cok cerr eok2 eerr2

183 in

200 in

184− _run parser1 state cok cerr eok meerr

201+ _run parser1 state cok cerr eok eerr1

202+

203+

204+mergeErrors :: ParseError -> ParseError -> ParseError

205+mergeErrors error1@(ParseError row col problem1) error2@(ParseError _ _ problem2) =

206+ case (problem1, problem2) of

207+ (Theories theories1, Theories theories2) ->

208+ ParseError row col (Theories (theories1 ++ theories2))

209+

210+ (Theories _, _) ->

211+ error2

212+

213+ (_, _) ->

214+ error1

185

215

186

216

187

217

@@ -189,36 +219,28 @@ oneOfHelp parser1 parser2 =

189

219

190

220

191instance Monad Parser where

221instance Monad Parser where

192− return x =

222+ return value =

193− Parser $ \state _ _ eok _ ->

223+ Parser $ \state _ _ eok _ ->

194− eok x state

224+ eok value state

195

225

196− parser >>= callback =

226+ parser >>= callback =

197− Parser $ \state cok cerr eok eerr ->

227+ Parser $ \state cok cerr eok eerr ->

198− let

228+ let

199− cok' x state1 =

229+ cok' value newState =

200− let

201− peok y state2 = cok y state2

202− peerr err = cerr err -- TODO is this correct?

203− in

204− _run (callback x) state1 cok cerr peok peerr

230+ _run (callback value) newState cok cerr cok cerr

205

231

206− eok' x state1 =

232+ eok' value newState =

207− let

208− peok y state2 = eok y state2

209− peerr err = eerr err -- TODO is this correct?

210− in

211− _run (callback x) state1 cok cerr peok peerr

233+ _run (callback value) newState cok cerr eok eerr

212− in

234+ in

213− _run parser state cok' cerr eok' eerr

235+ _run parser state cok' cerr eok' eerr

214

236

215

237

216

238

217-- TEXT

239-- TEXT

218

240

219

241

220−text :: Text -> Parser ()

242+symbol :: Text -> Parser ()

221−text (Text.Text tArray tOffset tLen) =

243+symbol sym@(Text.Text tArray tOffset tLen) =

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

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

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

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

224 let

246 let

@@ -228,7 +250,7 @@ text (Text.Text tArray tOffset tLen) =

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

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

229

251

230 else

252 else

231− eerr (Error row col)

253+ eerr (loneTheory row col (Symbol sym))

232

254

233

255

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

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

@@ -255,12 +277,13 @@ moveCursor array offset length row col =

255

277

256

278

257keyword :: Text -> Parser ()

279keyword :: Text -> Parser ()

258−keyword (Text.Text tArray tOffset tLen) =

280+keyword kwd@(Text.Text tArray tOffset tLen) =

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

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

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

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

261

283

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

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

263− eerr (error "TODO keyword 1")

285+ eerr (loneTheory row col (Keyword kwd))

286+

264 else

287 else

265 let

288 let

266 (# newRow, newCol #) =

289 (# newRow, newCol #) =

@@ -269,7 +292,7 @@ keyword (Text.Text tArray tOffset tLen) =

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

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

270

293

271 else

294 else

272− eerr (Error row col)

295+ eerr (loneTheory row col (Keyword kwd))

273

296

274

297

275keywords :: Set.Set Text

298keywords :: Set.Set Text

@@ -305,7 +328,7 @@ varPrim :: (Char -> Bool) -> Parser Text.Text

305varPrim isGoodFirstChar =

328varPrim isGoodFirstChar =

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

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

307 if length == 0 then

330 if length == 0 then

308− eerr (error "TODO varPrim")

331+ eerr (loneTheory row col Variable)

309

332

310 else

333 else

311 let

334 let

@@ -328,12 +351,12 @@ varPrim isGoodFirstChar =

328 Text.Text (Text.run makeArray) 0 newSize

351 Text.Text (Text.run makeArray) 0 newSize

329 in

352 in

330 if Set.member copiedText keywords then

353 if Set.member copiedText keywords then

331− eerr (Error row newCol)

354+ eerr (loneTheory row newCol Variable)

332 else

355 else

333 cok copiedText (State array newOffset newLength indent row newCol)

356 cok copiedText (State array newOffset newLength indent row newCol)

334

357

335 else

358 else

336− eerr (error "TODO varPrim 2")

359+ eerr (loneTheory row col Variable)

337

360

338

361

339{-# INLINE peek #-}

362{-# INLINE peek #-}

@@ -390,7 +413,7 @@ infixOp :: Parser Text

390infixOp =

413infixOp =

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

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

392 if length == 0 then

415 if length == 0 then

393− eerr (Error row col)

416+ eerr (loneTheory row col InfixOp)

394

417

395 else

418 else

396 case infixOpHelp array offset length row col of

419 case infixOpHelp array offset length row col of

@@ -408,22 +431,22 @@ infixOp =

408 return mutableArray

431 return mutableArray

409 in

432 in

410 if size == 0 then

433 if size == 0 then

411− eerr (Error row col)

434+ eerr (loneTheory row col InfixOp)

412

435

413 else

436 else

414 case Text.Text (Text.run makeArray) 0 size of

437 case Text.Text (Text.run makeArray) 0 size of

415− "=" -> cerr (Error row col) -- "The = operator is reserved for defining variables. Maybe you want == instead? Or maybe you are defining a variable, but there is whitespace before it?"

438+ "=" -> cerr (ParseError row col Dot)

416− "->" -> cerr (Error row col) -- "Arrows are reserved for cases and anonymous functions. Maybe you want > or >= instead?"

439+ "|" -> cerr (ParseError row col Pipe)

417− "|" -> cerr (Error row col) -- "Vertical bars are reserved for use in union type declarations. Maybe you want || instead?"

440+ ":" -> cerr (ParseError row col Arrow)

418− ":" -> cerr (Error row col) -- "A single colon is for type annotations. Maybe you want :: instead? Or maybe you are defining a type annotation, but there is whitespace before it?"

441+ "." -> cerr (ParseError row col Equals)

419− "." -> cerr (Error row col) -- "Dots are for record access. They cannot float around on their own!"

442+ "->" -> cerr (ParseError row col HasType)

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

443+ op -> cok op (State array newOffset newLength indent row newCol)

421

444

422

445

423−infixOpHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either Error (Int, Int, Int)

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

424infixOpHelp array offset length row col =

447infixOpHelp array offset length row col =

425 if length == 0 then

448 if length == 0 then

426− Left (Error row col)

449+ Left (ParseError row col (EndOfFile "infix operator"))

427

450

428 else

451 else

429 let

452 let

@@ -484,7 +507,7 @@ whitespace =

484 (State array newOffset newLength indent newRow newCol)

507 (State array newOffset newLength indent newRow newCol)

485

508

486

509

487−eatSpaces :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

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

488eatSpaces array offset length row col =

511eatSpaces array offset length row col =

489 if length == 0 then

512 if length == 0 then

490 Right ( offset, length, row, col )

513 Right ( offset, length, row, col )

@@ -507,7 +530,7 @@ eatSpaces array offset length row col =

507 eatSpaces array (offset + 1) (length - 1) row col

530 eatSpaces array (offset + 1) (length - 1) row col

508

531

509 0x0009 {- \t -} ->

532 0x0009 {- \t -} ->

510− Left (Error row col)

533+ Left (ParseError row col Tab)

511

534

512 _ ->

535 _ ->

513 Right ( offset, length, row, col )

536 Right ( offset, length, row, col )

@@ -517,7 +540,7 @@ eatSpaces array offset length row col =

517-- LINE COMMENTS

540-- LINE COMMENTS

518

541

519

542

520−eatLineComment :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

543+eatLineComment :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

521eatLineComment array offset length row col =

544eatLineComment array offset length row col =

522 if length == 1 then

545 if length == 1 then

523 Right ( offset, length, row, col )

546 Right ( offset, length, row, col )

@@ -531,7 +554,7 @@ eatLineComment array offset length row col =

531 Right ( offset, length, row, col )

554 Right ( offset, length, row, col )

532

555

533

556

534−eatLineCommentHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

557+eatLineCommentHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

535eatLineCommentHelp array offset length row col =

558eatLineCommentHelp array offset length row col =

536 if length == 0 then

559 if length == 0 then

537 Right ( offset, length, row, col )

560 Right ( offset, length, row, col )

@@ -554,7 +577,7 @@ eatLineCommentHelp array offset length row col =

554-- MULTI COMMENTS

577-- MULTI COMMENTS

555

578

556

579

557−eatMultiComment :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

580+eatMultiComment :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

558eatMultiComment array offset length row col =

581eatMultiComment array offset length row col =

559 if length <= 2 then

582 if length <= 2 then

560 Right ( offset, length, row, col )

583 Right ( offset, length, row, col )

@@ -573,10 +596,10 @@ eatMultiComment array offset length row col =

573 Right ( offset, length, row, col )

596 Right ( offset, length, row, col )

574

597

575

598

576−eatMultiCommentHelp :: Text.Array -> Int -> Int -> Int -> Int -> Int -> Either Error ( Int, Int, Int, Int )

599+eatMultiCommentHelp :: Text.Array -> Int -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Int, Int, Int )

577eatMultiCommentHelp array offset length row col openComments =

600eatMultiCommentHelp array offset length row col openComments =

578 if length == 0 then

601 if length == 0 then

579− Left (Error row col) -- never closed the comment!

602+ Left (ParseError row col (EndOfFile "multi-line comment"))

580

603

581 else

604 else

582 let

605 let

@@ -612,7 +635,7 @@ eatMultiCommentHelp array offset length row col openComments =

612

635

613docComment :: Parser Text

636docComment :: Parser Text

614docComment =

637docComment =

615− do text "{-|"

638+ do symbol "{-|"

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

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

617 case eatMultiCommentHelp array offset length row col 1 of

640 case eatMultiCommentHelp array offset length row col 1 of

618 Left err ->

641 Left err ->

@@ -642,14 +665,14 @@ string :: Parser Text.Text

642string =

665string =

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

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

644 if length == 0 then

667 if length == 0 then

645− eerr (Error row col)

668+ eerr (noTheory row col)

646

669

647 else

670 else

648 let

671 let

649 !word = Text.unsafeIndex array offset

672 !word = Text.unsafeIndex array offset

650 in

673 in

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

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

652− eerr (Error row col)

675+ eerr (noTheory row col)

653

676

654 else

677 else

655 let

678 let

@@ -660,8 +683,8 @@ string =

660 singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty

683 singleString array (offset + 1) (length - 1) row (col + 1) (offset + 1) mempty

661 in

684 in

662 case stringResult of

685 case stringResult of

663− Left msg ->

686+ Left err ->

664− cerr msg

687+ cerr err

665

688

666 Right ( newOffset, newLength, newCol, str ) ->

689 Right ( newOffset, newLength, newCol, str ) ->

667 cok str (State array newOffset newLength indent row newCol)

690 cok str (State array newOffset newLength indent row newCol)

@@ -677,10 +700,10 @@ isQuote array offset =

677-- SINGLE STRINGS

700-- SINGLE STRINGS

678

701

679

702

680−singleString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either Error ( Int, Int, Int, Text.Text )

703+singleString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either ParseError ( Int, Int, Int, Text.Text )

681singleString array offset length row col initialOffset builder =

704singleString array offset length row col initialOffset builder =

682 if length == 0 then

705 if length == 0 then

683− Left (Error row col)

706+ Left (ParseError row col (EndOfFile "string"))

684

707

685 else

708 else

686 let

709 let

@@ -698,7 +721,7 @@ singleString array offset length row col initialOffset builder =

698 Right ( offset + 1, length - 1, col + 1, str )

721 Right ( offset + 1, length - 1, col + 1, str )

699

722

700 else if word == 0x000A {- \n -} then

723 else if word == 0x000A {- \n -} then

701− Left (Error row col)

724+ Left (ParseError row col NewLineInString)

702

725

703 else if word == 0x005C {- \ -} then

726 else if word == 0x005C {- \ -} then

704 case eatEscape array (offset + 1) (length - 1) row (col + 1) of

727 case eatEscape array (offset + 1) (length - 1) row (col + 1) of

@@ -720,10 +743,10 @@ singleString array offset length row col initialOffset builder =

720 singleString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

743 singleString array (offset + 2) (length - 2) row (col + 1) initialOffset builder

721

744

722

745

723−eatEscape :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Char )

746+eatEscape :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Char )

724eatEscape array offset length row col =

747eatEscape array offset length row col =

725 if length == 0 then

748 if length == 0 then

726− Left (Error row col)

749+ Left (ParseError row col (EndOfFile "escape sequence"))

727

750

728 else

751 else

729 case Text.unsafeIndex array offset of

752 case Text.unsafeIndex array offset of

@@ -740,16 +763,16 @@ eatEscape array offset length row col =

740 0x0078 {- x -} ->

763 0x0078 {- x -} ->

741 case eatHex array (offset + 1) (length - 1) 0 of

764 case eatHex array (offset + 1) (length - 1) 0 of

742 Nothing ->

765 Nothing ->

743− Left (Error row col)

766+ Left (ParseError row col BadEscape)

744

767

745 Just (newOffset, code) ->

768 Just (newOffset, code) ->

746 if code <= 0x10FFFF then

769 if code <= 0x10FFFF then

747 Right ( 1 + (newOffset - offset), toEnum (fromInteger code) )

770 Right ( 1 + (newOffset - offset), toEnum (fromInteger code) )

748 else

771 else

749− Left (Error row col)

772+ Left (ParseError row col BadEscape)

750

773

751 _ ->

774 _ ->

752− Left (Error row col)

775+ Left (ParseError row col BadEscape)

753

776

754

777

755eatHex :: Text.Array -> Int -> Int -> Integer -> Maybe ( Int, Integer )

778eatHex :: Text.Array -> Int -> Int -> Integer -> Maybe ( Int, Integer )

@@ -778,10 +801,10 @@ eatHex array offset length n =

778-- MULTI STRINGS

801-- MULTI STRINGS

779

802

780

803

781−multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either Error ( Int, Int, Int, Text.Text )

804+multiString :: Text.Array -> Int -> Int -> Int -> Int -> Int -> LB.Builder -> Either ParseError ( Int, Int, Int, Text.Text )

782multiString array offset length row col initialOffset builder =

805multiString array offset length row col initialOffset builder =

783 if length == 0 then

806 if length == 0 then

784− Left (Error row col)

807+ Left (ParseError row col (EndOfFile "multi-line string"))

785

808

786 else

809 else

787 let

810 let

@@ -826,14 +849,14 @@ character :: Parser Char

826character =

849character =

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

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

828 if length == 0 then

851 if length == 0 then

829− eerr (Error row col)

852+ eerr (noTheory row col)

830

853

831 else

854 else

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

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

833− eerr (Error row col)

856+ eerr (noTheory row col)

834

857

835 else if length < 3 then

858 else if length < 3 then

836− cerr (Error row col)

859+ cerr (ParseError row col BadChar)

837

860

838 else

861 else

839 case characterHelp array (offset + 1) (length - 1) row (col + 1) of

862 case characterHelp array (offset + 1) (length - 1) row (col + 1) of

@@ -846,28 +869,28 @@ character =

846 !newLength = length - size - 1

869 !newLength = length - size - 1

847 in

870 in

848 if newLength == 0 then

871 if newLength == 0 then

849− cerr (Error row col)

872+ cerr (ParseError row col BadChar)

850

873

851 else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then

874 else if Text.unsafeIndex array newOffset == 0x0027 {- ' -} then

852 cok char (State array (newOffset + 1) (newLength - 1) indent row (col + size + 2))

875 cok char (State array (newOffset + 1) (newLength - 1) indent row (col + size + 2))

853

876

854 else

877 else

855− cerr (Error row col)

878+ cerr (ParseError row col BadChar)

856

879

857

880

858−characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either Error ( Int, Char )

881+characterHelp :: Text.Array -> Int -> Int -> Int -> Int -> Either ParseError ( Int, Char )

859characterHelp array offset length row col =

882characterHelp array offset length row col =

860 let

883 let

861 !word = Text.unsafeIndex array offset

884 !word = Text.unsafeIndex array offset

862 in

885 in

863 if word == 0x0027 {- ' -} then

886 if word == 0x0027 {- ' -} then

864− Left (Error row col)

887+ Left (ParseError row col BadChar)

865

888

866 else if word == 0x005C {- \ -} then

889 else if word == 0x005C {- \ -} then

867 eatEscape array (offset + 1) (length - 1) row (col + 1)

890 eatEscape array (offset + 1) (length - 1) row (col + 1)

868

891

869 else if word == 0x000A {- \n -} then

892 else if word == 0x000A {- \n -} then

870− Left (Error row col)

893+ Left (ParseError row col BadChar)

871

894

872 else if word < 0xD800 || word > 0xDBFF then

895 else if word < 0xD800 || word > 0xDBFF then

873 Right (1, unsafeChr word)

896 Right (1, unsafeChr word)

@@ -876,7 +899,7 @@ characterHelp array offset length row col =

876 Right (2, chr2 word (Text.unsafeIndex array offset))

899 Right (2, chr2 word (Text.unsafeIndex array offset))

877

900

878 else

901 else

879− Left (Error row col)

902+ Left (ParseError row col BadChar)

880

903

881

904

882

905

@@ -887,7 +910,7 @@ digit :: Parser Int

887digit =

910digit =

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

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

889 if length == 0 then

912 if length == 0 then

890− eerr (Error row col)

913+ eerr (loneTheory row col Digit)

891

914

892 else

915 else

893 let

916 let

@@ -898,7 +921,7 @@ digit =

898 (fromIntegral (word - 0x0030))

921 (fromIntegral (word - 0x0030))

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

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

900 else

923 else

901− eerr (Error row col)

924+ eerr (loneTheory row col Digit)

902

925

903

926

904

927

@@ -909,14 +932,14 @@ number :: Parser L.Literal

909number =

932number =

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

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

911 if length == 0 then

934 if length == 0 then

912− eerr (Error row col)

935+ eerr (noTheory row col)

913

936

914 else

937 else

915 let

938 let

916 !word = Text.unsafeIndex array offset

939 !word = Text.unsafeIndex array offset

917 in

940 in

918 if not (isDigit word) then

941 if not (isDigit word) then

919− eerr (Error row col)

942+ eerr (noTheory row col)

920

943

921 else

944 else

922 let

945 let

@@ -927,12 +950,12 @@ number =

927 chompInt array offset (offset + 1) (length - 1)

950 chompInt array offset (offset + 1) (length - 1)

928 in

951 in

929 case chompResults of

952 case chompResults of

930− Left err ->

953+ Left (newOffset, problem) ->

931− cerr err

954+ cerr (ParseError row (col + (newOffset - offset)) problem)

932

955

933 Right (newOffset, newLength, literal) ->

956 Right (newOffset, newLength, literal) ->

934 if isDirtyEnd array newOffset newLength then

957 if isDirtyEnd array newOffset newLength then

935− cerr (Error row col)

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

936

959

937 else

960 else

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

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

@@ -950,7 +973,7 @@ isDirtyEnd array offset length =

950 Char.isAlpha char || char == '_'

973 Char.isAlpha char || char == '_'

951

974

952

975

953−chompInt :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

976+chompInt :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

954chompInt array startOffset offset length =

977chompInt array startOffset offset length =

955 if length == 0 then

978 if length == 0 then

956

979

@@ -971,19 +994,19 @@ chompInt array startOffset offset length =

971 Right ( offset, length, readInt array startOffset offset )

994 Right ( offset, length, readInt array startOffset offset )

972

995

973

996

974−chompFraction :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

997+chompFraction :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

975chompFraction array startOffset offset length =

998chompFraction array startOffset offset length =

976 if length == 0 then

999 if length == 0 then

977− Left (error "TODO chompFraction")

1000+ Left (offset, BadNumberDot)

978

1001

979 else if isDigit (Text.unsafeIndex array offset) then

1002 else if isDigit (Text.unsafeIndex array offset) then

980 chompFractionHelp array startOffset (offset + 1) (length - 1)

1003 chompFractionHelp array startOffset (offset + 1) (length - 1)

981

1004

982 else

1005 else

983− Left (error "TODO must be a number after a decimal point")

1006+ Left (offset, BadNumberDot)

984

1007

985

1008

986−chompFractionHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1009+chompFractionHelp :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

987chompFractionHelp array startOffset offset length =

1010chompFractionHelp array startOffset offset length =

988 if length == 0 then

1011 if length == 0 then

989 Right (offset, length, readFloat array startOffset offset)

1012 Right (offset, length, readFloat array startOffset offset)

@@ -1002,7 +1025,7 @@ chompFractionHelp array startOffset offset length =

1002 Right (offset, length, readFloat array startOffset offset)

1025 Right (offset, length, readFloat array startOffset offset)

1003

1026

1004

1027

1005−chompExponent :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1028+chompExponent :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1006chompExponent array startOffset offset length =

1029chompExponent array startOffset offset length =

1007 if length == 0 then

1030 if length == 0 then

1008 Right (offset, length, readFloat array startOffset offset)

1031 Right (offset, length, readFloat array startOffset offset)

@@ -1019,13 +1042,13 @@ chompExponent array startOffset offset length =

1019 if length > 1 && isDigit (Text.unsafeIndex array (offset + 1)) then

1042 if length > 1 && isDigit (Text.unsafeIndex array (offset + 1)) then

1020 chompExponentHelp array startOffset (offset + 2) (length - 2)

1043 chompExponentHelp array startOffset (offset + 2) (length - 2)

1021 else

1044 else

1022− Left (error "TODO digits after +/-")

1045+ Left (offset, BadNumberExp)

1023

1046

1024 else

1047 else

1025− Left (error "TODO exponent is messed up")

1048+ Left (offset, BadNumberExp)

1026

1049

1027

1050

1028−chompExponentHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1051+chompExponentHelp :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1029chompExponentHelp array startOffset offset length =

1052chompExponentHelp array startOffset offset length =

1030 if length == 0 then

1053 if length == 0 then

1031 Right (offset, length, readFloat array startOffset offset)

1054 Right (offset, length, readFloat array startOffset offset)

@@ -1037,7 +1060,7 @@ chompExponentHelp array startOffset offset length =

1037 Right (offset, length, readFloat array startOffset offset)

1060 Right (offset, length, readFloat array startOffset offset)

1038

1061

1039

1062

1040−chompZero :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1063+chompZero :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1041chompZero array startOffset offset length =

1064chompZero array startOffset offset length =

1042 if length == 0 then

1065 if length == 0 then

1043 Right ( offset, length, L.IntNum 0 )

1066 Right ( offset, length, L.IntNum 0 )

@@ -1053,25 +1076,25 @@ chompZero array startOffset offset length =

1053 chompFraction array startOffset (offset + 1) (length - 1)

1076 chompFraction array startOffset (offset + 1) (length - 1)

1054

1077

1055 else if isDigit word then

1078 else if isDigit word then

1056− Left (error "TODO zero followed by more numbers")

1079+ Left (offset, BadNumberZero)

1057

1080

1058 else

1081 else

1059 Right ( offset, length, L.IntNum 0 )

1082 Right ( offset, length, L.IntNum 0 )

1060

1083

1061

1084

1062−chompHex :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1085+chompHex :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1063chompHex array startOffset offset length =

1086chompHex array startOffset offset length =

1064 if length == 0 then

1087 if length == 0 then

1065− Left (error "TODO need hex digits after 0x")

1088+ Left (offset, BadNumberHex)

1066

1089

1067 else if isHex (Text.unsafeIndex array offset) then

1090 else if isHex (Text.unsafeIndex array offset) then

1068 chompHexHelp array startOffset (offset + 1) (length - 1)

1091 chompHexHelp array startOffset (offset + 1) (length - 1)

1069

1092

1070 else

1093 else

1071− Left (error "TODO need hex digits!")

1094+ Left (offset, BadNumberHex)

1072

1095

1073

1096

1074−chompHexHelp :: Text.Array -> Int -> Int -> Int -> Either Error (Int, Int, L.Literal)

1097+chompHexHelp :: Text.Array -> Int -> Int -> Int -> Either (Int, Problem) (Int, Int, L.Literal)

1075chompHexHelp array startOffset offset length =

1098chompHexHelp array startOffset offset length =

1076 if length == 0 then

1099 if length == 0 then

1077 Right ( offset, length, readInt array startOffset offset )

1100 Right ( offset, length, readInt array startOffset offset )

src/Reporting/Error/Syntax.hs+52−4

@@ -1,6 +1,12 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3−module Reporting.Error.Syntax where

3+module Reporting.Error.Syntax

4+ ( Error(..)

5+ , ParseError(..)

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

7+ , toReport

8+ )

9+ where

5import Data.Text (Text)

11import Data.Text (Text)

@@ -11,8 +17,12 @@ import qualified Reporting.Helpers as Help

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

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

20+

21+-- ALL SYNTAX ERRORS

22+

23+

14data Error

24data Error

15− = Parse

25+ = Parse Problem

16 | BadFunctionName Int

26 | BadFunctionName Int

17 | BadPattern Text

27 | BadPattern Text

@@ -37,7 +47,45 @@ data Error

37 | UnboundTypeVarsInAlias Text [Text] [Text]

47 | UnboundTypeVarsInAlias Text [Text] [Text]

38 | UnusedTypeVarsInAlias Text [Text] [Text]

48 | UnusedTypeVarsInAlias Text [Text] [Text]

39 | MessyTypeVarsInAlias Text [Text] [Text] [Text]

49 | MessyTypeVarsInAlias Text [Text] [Text] [Text]

40− deriving (Show)

50+

51+

52+

53+-- PARSE ERRORS

54+

55+

56+data ParseError

57+ = ParseError !Int !Int !Problem

58+

59+

60+data Problem

61+ = Tab

62+ | EndOfFile Text

63+ | NewLineInString

64+ | BadEscape

65+ | BadChar

66+ | BadNumberDot

67+ | BadNumberEnd

68+ | BadNumberExp

69+ | BadNumberHex

70+ | BadNumberZero

71+ | BadChunkInQualifiedCapVar

72+ | HasType -- "A single colon is for type annotations. Maybe you want :: instead? Or maybe you are defining a type annotation, but there is whitespace before it?"

73+ | Equals -- "The = operator is reserved for defining variables. Maybe you want == instead? Or maybe you are defining a variable, but there is whitespace before it?"

74+ | Arrow -- "Arrows are reserved for cases and anonymous functions. Maybe you want > or >= instead?"

75+ | Pipe -- "Vertical bars are reserved for use in union type declarations. Maybe you want || instead?"

76+ | Dot -- "Dots are for record access. They cannot float around on their own!"

77+ | Theories [Theory]

78+

79+

80+data Theory

81+ = Keyword Text

82+ | Symbol Text

83+ | Variable

84+ | InfixOp

85+ | Digit

86+ | BadIndent

87+ | FreshLine

88+ | Expecting Text

@@ -47,7 +95,7 @@ data Error

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

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

48toReport _localizer err =

96toReport _localizer err =

49 case err of

97 case err of

50− Parse ->

98+ Parse _ ->

51 Report.report "PARSE ERROR" Nothing "Something is wrong." (text "TODO")

99 Report.report "PARSE ERROR" Nothing "Something is wrong." (text "TODO")

100

53 BadFunctionName arity ->

101 BadFunctionName arity ->