1433e40 · elk · git.iko.soy

git.iko.soy/elk

Add some structure to parse errors

commit1433e40aafd6dcf62607a45208717ea5f0201ab5 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 9 Dec 2016, 15:32 (10 years ago) parentc6701ae

5 files changed+225−163

compare with master

unifiedsplit

src/Parse/Expression.hs+1−4 src/Parse/Helpers.hs+23−31 src/Parse/Parse.hs+6−4 src/Parse/Primitives.hs+143−120 src/Reporting/Error/Syntax.hs+52−4

src/Parse/Expression.hs+1−4

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

466466 (def, newEnd, newPos) <- definition

467467 letHelp start oldIndent (def:defs) newEnd newPos

468468

469− , do checkFreshline pos

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

471−

472469 , do setIndent oldIndent

473− keyword "in"

474470 checkSpace pos

471+ keyword "in"

475472 spaces

476473 (body, newEnd, newPos) <- expression

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

src/Parse/Helpers.hs+23−31

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

1414import qualified Data.Text as Text

1515import Data.Text (Text)

1616

17−import Parse.Primitives hiding (text)

18−import qualified Parse.Primitives as Prim

17+import Parse.Primitives

1918import qualified Reporting.Annotation as A

19+import qualified Reporting.Error.Syntax as E

2020import qualified Reporting.Region as R

2121

2222

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

5555 [ do var <- capVar

5656 qualifiedVarHelp allCaps (var:vars)

5757 , if allCaps then

58− failure False -- TODO

58+ failure E.BadChunkInQualifiedCapVar

5959 else

6060 do var <- lowVar

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

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

7171{-# INLINE equals #-}

7272equals :: Parser ()

7373equals =

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

75− Prim.text "="

74+ symbol "="

7675

7776

7877{-# INLINE rightArrow #-}

7978rightArrow :: Parser ()

8079rightArrow =

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

82− Prim.text "->"

80+ symbol "->"

8381

8482

8583{-# INLINE hasType #-}

8684hasType :: Parser ()

8785hasType =

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

89− Prim.text ":"

86+ symbol ":"

9087

9188

9289{-# INLINE comma #-}

9390comma :: Parser ()

9491comma =

95− expecting "a comma ','" $

96− Prim.text ","

92+ symbol ","

9793

9894

9995{-# INLINE pipe #-}

10096pipe :: Parser ()

10197pipe =

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

103− Prim.text "|"

98+ symbol "|"

10499

105100

106101{-# INLINE cons #-}

107102cons :: Parser ()

108103cons =

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

110− Prim.text "::"

104+ symbol "::"

111105

112106

113107{-# INLINE dot #-}

114108dot :: Parser ()

115109dot =

116− expecting "a dot '.'" $

117− Prim.text "."

110+ symbol "."

118111

119112

120113{-# INLINE minus #-}

121114minus :: Parser ()

122115minus =

123− Prim.text "-"

116+ symbol "-"

124117

125118

126119{-# INLINE underscore #-}

127120underscore :: Parser ()

128121underscore =

129− expecting "a wildcard '_'" $

130− Prim.text "_"

122+ symbol "_"

131123

132124

133125{-# INLINE lambda #-}

134126lambda :: Parser ()

135127lambda =

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

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

137129

138130

139131

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

143135{-# INLINE leftParen #-}

144136leftParen :: Parser ()

145137leftParen =

146− Prim.text "("

138+ symbol "("

147139

148140

149141{-# INLINE rightParen #-}

150142rightParen :: Parser ()

151143rightParen =

152− Prim.text ")"

144+ symbol ")"

153145

154146

155147{-# INLINE leftSquare #-}

156148leftSquare :: Parser ()

157149leftSquare =

158− Prim.text "["

150+ symbol "["

159151

160152

161153{-# INLINE rightSquare #-}

162154rightSquare :: Parser ()

163155rightSquare =

164− Prim.text "]"

156+ symbol "]"

165157

166158

167159{-# INLINE leftCurly #-}

168160leftCurly :: Parser ()

169161leftCurly =

170− Prim.text "{"

162+ symbol "{"

171163

172164

173165{-# INLINE rightCurly #-}

174166rightCurly :: Parser ()

175167rightCurly =

176− Prim.text "}"

168+ symbol "}"

177169

178170

179171

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

200192 indent <- getIndent

201193 if col > indent && col > 1

202194 then return ()

203− else failure False -- TODO

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

204196

205197

206198checkSpace :: SPos -> Parser ()

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

208200 do indent <- getIndent

209201 if col > indent && col > 1

210202 then return ()

211− else deadend False -- TODO

203+ else deadend E.BadIndent

212204

213205

214206checkAligned :: SPos -> Parser ()

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

216208 do indent <- getIndent

217209 if col == indent

218210 then return ()

219− else deadend False -- TODO

211+ else deadend E.BadIndent

220212

221213

222214checkFreshline :: SPos -> Parser ()

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

224216 if col == 1

225217 then return ()

226− else deadend False -- TODO

218+ else deadend E.FreshLine

src/Parse/Parse.hs+6−4

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

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

22module Parse.Parse (program) where

4−import qualified Data.Text as Text

54import Data.Text (Text)

76import qualified AST.Declaration as Decl

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

1110import Parse.Helpers

1211import qualified Parse.Module as Parse (header)

1312import qualified Parse.Declaration as Parse (declaration)

13+import qualified Reporting.Annotation as A

14+import qualified Reporting.Result as Result

1415import qualified Validate

1516

1617

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

2223program pkgName src =

2324 case run (chompProgram pkgName) src of

2425 Right modul ->

25− Validate.validate modul

26+ Validate.validate modul

27+

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

29+ Result.throw region syntaxError

2630

27− Left err ->

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

2931

3032

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

src/Parse/Primitives.hs+143−120

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

55 , run

66 , try, failure, deadend, expecting, endOfFile

77 , oneOf

8− , text, keyword, keywords

8+ , symbol, keyword, keywords

99 , lowVar, capVar, infixOp

1010 , getPosition, getCol

1111 , getIndent, setIndent

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

3434

3535import qualified AST.Helpers as Help (isSymbol)

3636import 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(..) )

3740import qualified Reporting.Region as Region

3841

3942

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

4750 :: forall b.

4851 State

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

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

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

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

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

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

5356 -> b

5457 }

5558

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

6770

6871data Result a

6972 = Ok a State

70− | Err Error

73+ | Err ParseError

7174

7275

73−data Error

74− = Error !Int !Int

75− deriving (Show)

76+{-# INLINE noTheory #-}

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

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])

7686

7787

7888

7989-- RUN PARSER

8090

8191

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

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

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

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

8595 Ok value _ ->

8696 Right value

8797

88− Err err ->

89− Left err

98+ Err (ParseError row col problem) ->

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))

90104

91105

92106

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

99113 _run parser state cok eerr eok eerr

100114

101115

102−failure :: error -> Parser a

103−failure _msg =

116+failure :: Problem -> Parser a

117+failure problem =

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

105− cerr (Error row col)

119+ cerr (ParseError row col problem)

106120

107121

108−deadend :: error -> Parser a

109−deadend _msg =

122+deadend :: Theory -> Parser a

123+deadend theory =

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

111− eerr (Error row col)

125+ eerr (loneTheory row col theory)

112126

113127

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

115−expecting _msg parser =

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

129+expecting description parser =

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

117131 let

118− eok' x s = eok x s

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

132+ eok' x s =

133+ eok x s

134+

135+ eerr' _ =

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

120137 in

121138 _run parser state cok cerr eok' eerr'

122139

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

128145 eok () state

129146

130147 else

131− eerr (Error row col)

148+ eerr (noTheory row col)

132149

133150

134151

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

151168

152169instance Applicative.Applicative Parser where

153170 pure = return

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

171+ (<*>) = ap

155172

156173

157174instance Applicative.Alternative Parser where

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

167184allTheOptionsFailed :: Parser a

168185allTheOptionsFailed =

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

170− eerr (Error row col)

187+ eerr (noTheory row col)

171188

172189

173190oneOfHelp :: Parser a -> Parser a -> Parser a

174191oneOfHelp parser1 parser2 =

175192 Parser $ \state cok cerr eok eerr ->

176193 let

177− meerr err =

194+ eerr1 err1 =

178195 let

179− neok y state' = eok y state'

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

196+ eok2 y state' = eok y state'

197+ eerr2 err2 = eerr (mergeErrors err1 err2)

181198 in

182− _run parser2 state cok cerr neok neerr

199+ _run parser2 state cok cerr eok2 eerr2

183200 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

185215

186216

187217

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

189219

190220

191221instance Monad Parser where

192− return x =

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

194− eok x state

222+ return value =

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

224+ eok value state

195225

196− parser >>= callback =

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

198− let

199− cok' x state1 =

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

226+ parser >>= callback =

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

228+ let

229+ cok' value newState =

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

205231

206− eok' x state1 =

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

212− in

213− _run parser state cok' cerr eok' eerr

232+ eok' value newState =

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

234+ in

235+ _run parser state cok' cerr eok' eerr

214236

215237

216238

217239-- TEXT

218240

219241

220−text :: Text -> Parser ()

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

242+symbol :: Text -> Parser ()

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

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

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

224246 let

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

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

229251

230252 else

231− eerr (Error row col)

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

232254

233255

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

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

255277

256278

257279keyword :: Text -> Parser ()

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

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

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

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

261283

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

263− eerr (error "TODO keyword 1")

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

286+

264287 else

265288 let

266289 (# newRow, newCol #) =

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

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

270293

271294 else

272− eerr (Error row col)

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

273296

274297

275298keywords :: Set.Set Text

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

305328varPrim isGoodFirstChar =

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

307330 if length == 0 then

308− eerr (error "TODO varPrim")

331+ eerr (loneTheory row col Variable)

309332

310333 else

311334 let

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

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

329352 in

330353 if Set.member copiedText keywords then

331− eerr (Error row newCol)

354+ eerr (loneTheory row newCol Variable)

332355 else

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

334357

335358 else

336− eerr (error "TODO varPrim 2")

359+ eerr (loneTheory row col Variable)

337360

338361

339362{-# INLINE peek #-}

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

390413infixOp =

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

392415 if length == 0 then

393− eerr (Error row col)

416+ eerr (loneTheory row col InfixOp)

394417

395418 else

396419 case infixOpHelp array offset length row col of

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

408431 return mutableArray

409432 in

410433 if size == 0 then

411− eerr (Error row col)

434+ eerr (loneTheory row col InfixOp)

412435

413436 else

414437 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?"

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

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

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?"

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

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

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

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

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

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

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

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

421444

422445

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)

424447infixOpHelp array offset length row col =

425448 if length == 0 then

426− Left (Error row col)

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

427450

428451 else

429452 let

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

484507 (State array newOffset newLength indent newRow newCol)

485508

486509

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 )

488511eatSpaces array offset length row col =

489512 if length == 0 then

490513 Right ( offset, length, row, col )

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

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

508531

509532 0x0009 {- \t -} ->

510− Left (Error row col)

533+ Left (ParseError row col Tab)

511534

512535 _ ->

513536 Right ( offset, length, row, col )

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

517540-- LINE COMMENTS

518541

519542

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 )

521544eatLineComment array offset length row col =

522545 if length == 1 then

523546 Right ( offset, length, row, col )

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

531554 Right ( offset, length, row, col )

532555

533556

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 )

535558eatLineCommentHelp array offset length row col =

536559 if length == 0 then

537560 Right ( offset, length, row, col )

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

554577-- MULTI COMMENTS

555578

556579

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 )

558581eatMultiComment array offset length row col =

559582 if length <= 2 then

560583 Right ( offset, length, row, col )

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

573596 Right ( offset, length, row, col )

574597

575598

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 )

577600eatMultiCommentHelp array offset length row col openComments =

578601 if length == 0 then

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

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

580603

581604 else

582605 let

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

612635

613636docComment :: Parser Text

614637docComment =

615− do text "{-|"

638+ do symbol "{-|"

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

617640 case eatMultiCommentHelp array offset length row col 1 of

618641 Left err ->

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

642665string =

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

644667 if length == 0 then

645− eerr (Error row col)

668+ eerr (noTheory row col)

646669

647670 else

648671 let

649672 !word = Text.unsafeIndex array offset

650673 in

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

652− eerr (Error row col)

675+ eerr (noTheory row col)

653676

654677 else

655678 let

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

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

661684 in

662685 case stringResult of

663− Left msg ->

664− cerr msg

686+ Left err ->

687+ cerr err

665688

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

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

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

677700-- SINGLE STRINGS

678701

679702

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 )

681704singleString array offset length row col initialOffset builder =

682705 if length == 0 then

683− Left (Error row col)

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

684707

685708 else

686709 let

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

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

699722

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

701− Left (Error row col)

724+ Left (ParseError row col NewLineInString)

702725

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

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

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

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

721744

722745

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

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

724747eatEscape array offset length row col =

725748 if length == 0 then

726− Left (Error row col)

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

727750

728751 else

729752 case Text.unsafeIndex array offset of

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

740763 0x0078 {- x -} ->

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

742765 Nothing ->

743− Left (Error row col)

766+ Left (ParseError row col BadEscape)

744767

745768 Just (newOffset, code) ->

746769 if code <= 0x10FFFF then

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

748771 else

749− Left (Error row col)

772+ Left (ParseError row col BadEscape)

750773

751774 _ ->

752− Left (Error row col)

775+ Left (ParseError row col BadEscape)

753776

754777

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

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

778801-- MULTI STRINGS

779802

780803

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 )

782805multiString array offset length row col initialOffset builder =

783806 if length == 0 then

784− Left (Error row col)

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

785808

786809 else

787810 let

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

826849character =

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

828851 if length == 0 then

829− eerr (Error row col)

852+ eerr (noTheory row col)

830853

831854 else

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

833− eerr (Error row col)

856+ eerr (noTheory row col)

834857

835858 else if length < 3 then

836− cerr (Error row col)

859+ cerr (ParseError row col BadChar)

837860

838861 else

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

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

846869 !newLength = length - size - 1

847870 in

848871 if newLength == 0 then

849− cerr (Error row col)

872+ cerr (ParseError row col BadChar)

850873

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

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

853876

854877 else

855− cerr (Error row col)

878+ cerr (ParseError row col BadChar)

856879

857880

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

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

859882characterHelp array offset length row col =

860883 let

861884 !word = Text.unsafeIndex array offset

862885 in

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

864− Left (Error row col)

887+ Left (ParseError row col BadChar)

865888

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

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

868891

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

870− Left (Error row col)

893+ Left (ParseError row col BadChar)

871894

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

873896 Right (1, unsafeChr word)

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

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

877900

878901 else

879− Left (Error row col)

902+ Left (ParseError row col BadChar)

880903

881904

882905

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

887910digit =

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

889912 if length == 0 then

890− eerr (Error row col)

913+ eerr (loneTheory row col Digit)

891914

892915 else

893916 let

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

898921 (fromIntegral (word - 0x0030))

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

900923 else

901− eerr (Error row col)

924+ eerr (loneTheory row col Digit)

902925

903926

904927

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

909932number =

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

911934 if length == 0 then

912− eerr (Error row col)

935+ eerr (noTheory row col)

913936

914937 else

915938 let

916939 !word = Text.unsafeIndex array offset

917940 in

918941 if not (isDigit word) then

919− eerr (Error row col)

942+ eerr (noTheory row col)

920943

921944 else

922945 let

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

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

928951 in

929952 case chompResults of

930− Left err ->

931− cerr err

953+ Left (newOffset, problem) ->

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

932955

933956 Right (newOffset, newLength, literal) ->

934957 if isDirtyEnd array newOffset newLength then

935− cerr (Error row col)

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

936959

937960 else

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

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

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

951974

952975

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)

954977chompInt array startOffset offset length =

955978 if length == 0 then

956979

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

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

972995

973996

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)

975998chompFraction array startOffset offset length =

976999 if length == 0 then

977− Left (error "TODO chompFraction")

1000+ Left (offset, BadNumberDot)

9781001

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

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

9811004

9821005 else

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

1006+ Left (offset, BadNumberDot)

9841007

9851008

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)

9871010chompFractionHelp array startOffset offset length =

9881011 if length == 0 then

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

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

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

10031026

10041027

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)

10061029chompExponent array startOffset offset length =

10071030 if length == 0 then

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

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

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

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

10211044 else

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

1045+ Left (offset, BadNumberExp)

10231046

10241047 else

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

1048+ Left (offset, BadNumberExp)

10261049

10271050

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)

10291052chompExponentHelp array startOffset offset length =

10301053 if length == 0 then

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

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

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

10381061

10391062

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)

10411064chompZero array startOffset offset length =

10421065 if length == 0 then

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

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

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

10541077

10551078 else if isDigit word then

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

1079+ Left (offset, BadNumberZero)

10571080

10581081 else

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

10601083

10611084

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)

10631086chompHex array startOffset offset length =

10641087 if length == 0 then

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

1088+ Left (offset, BadNumberHex)

10661089

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

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

10691092

10701093 else

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

1094+ Left (offset, BadNumberHex)

10721095

10731096

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)

10751098chompHexHelp array startOffset offset length =

10761099 if length == 0 then

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

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

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

11{-# OPTIONS_GHC -Wall #-}

22{-# 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

410

511import Data.Text (Text)

612

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

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

1218

1319

20+

21+-- ALL SYNTAX ERRORS

22+

23+

1424data Error

15− = Parse

25+ = Parse Problem

1626 | BadFunctionName Int

1727 | BadPattern Text

1828

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

3747 | UnboundTypeVarsInAlias Text [Text] [Text]

3848 | UnusedTypeVarsInAlias Text [Text] [Text]

3949 | 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

4189

4290

4391

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

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

4896toReport _localizer err =

4997 case err of

50− Parse ->

98+ Parse _ ->

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

52100

53101 BadFunctionName arity ->