on master help sign in
Get new errors working in Parse.Declaration
commit7a297d25777601c7974de4766bc870f9ac9b4324 authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 25 Apr 2019, 19:51 (8 years ago) parent22a4264
2 files changed+1281−138
compiler/src/Parse/Declaration.hs+150−120 compiler/src/Reporting/Error/Syntax.hs+1131−18
compiler/src/Parse/Declaration.hs+150−120
@@ -16,11 +16,11 @@ import qualified Parse.Expression as Expr
1616import qualified Parse.Pattern as Pattern
1717import qualified Parse.Keyword as Keyword
1818import qualified Parse.Number as Number
19+import qualified Parse.Space as Space
1920import qualified Parse.Symbol as Symbol
2021import qualified Parse.Type as Type
2122import qualified Parse.Variable as Var
22−import Parse.Utils
23−import Parse.Primitives hiding (Parser, State)
23+import Parse.Primitives hiding (State)
2424import qualified Parse.Primitives as P
2525import qualified Reporting.Annotation as A
2626import qualified Reporting.Error.Syntax as E
@@ -37,10 +37,10 @@ data Decl
3737 | Port Src.Port
3838
3939
40−declaration :: SParser Decl
40+declaration :: Space.Parser E.Decl Decl
4141declaration =
4242 do start <- getPosition
43− oneOf E.XXX
43+ oneOf E.DeclStart
4444 [ typeDecl start
4545 , portDecl
4646 , valueDecl start
@@ -52,120 +52,145 @@ declaration =
5252
5353
5454{-# INLINE valueDecl #-}
55−valueDecl :: A.Position -> SParser Decl
55+valueDecl :: A.Position -> Space.Parser E.Decl Decl
5656valueDecl start =
57− do name <- Var.lower
57+ do name <- Var.lower E.DeclStart
5858 end <- getPosition
59− spaces
60− oneOf E.XXX
61− [
62− do word1 0x3A {-:-} E.XXX
63− pushContext start (E.Annotation name)
64− spaces
65− (tipe, _, space) <- Type.expression
66− popContext ()
67− checkAligned space
68− defName <- matchingName name
69− let (A.At (A.Region defStart _) _) = defName
70− pushContext defStart (E.Definition name)
71− spaces
72− decl <- valueHelp start defName (Just tipe) []
73− popContext decl
74− ,
75− do pushContext start (E.Definition name)
76− decl <- valueHelp start (A.at start end name) Nothing []
77− popContext decl
78− ]
79−
80−
81−valueHelp :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> SParser Decl
82−valueHelp start name tipe revArgs =
83− oneOf E.XXX
84− [ do arg <- Pattern.term
85− spaces
86− valueHelp start name tipe (arg : revArgs)
87− , do word1 0x3D {-=-} E.XXX
88− spaces
89− (body, end, space) <- Expr.expression
90− let value = A.at start end (Src.Value name (reverse revArgs) body tipe)
91− return ( Value value, end, space )
59+ specialize (E.DeclDef name) $
60+ do Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
61+ oneOf E.DeclDefEquals
62+ [
63+ do word1 0x3A {-:-} E.DeclDefEquals
64+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType
65+ (tipe, _) <- specialize E.DeclDefType Type.expression
66+ Space.checkFreshLine E.DeclDefAlignment
67+ defName <- chompMatchingName name
68+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
69+ chompDefArgsAndBody start defName (Just tipe) []
70+ ,
71+ chompDefArgsAndBody start (A.at start end name) Nothing []
72+ ]
73+
74+
75+chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.DeclDef Decl
76+chompDefArgsAndBody start name tipe revArgs =
77+ oneOf E.DeclDefEquals
78+ [ do arg <- specialize E.DeclDefArg Pattern.term
79+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
80+ chompDefArgsAndBody start name tipe (arg : revArgs)
81+ , do word1 0x3D {-=-} E.DeclDefEquals
82+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentBody
83+ (body, end) <- specialize E.DeclDefBody Expr.expression
84+ return
85+ ( Value (A.at start end (Src.Value name (reverse revArgs) body tipe))
86+ , end
87+ )
9288 ]
9389
9490
95−matchingName :: Name.Name -> Parser (A.Located Name.Name)
96−matchingName expectedName =
97− let (P.Parser parserL) = Var.lower in
98− P.Parser $ \state@(P.State _ _ _ sr sc ctx) cok eok cerr eerr ->
91+chompMatchingName :: Name.Name -> Parser E.DeclDef (A.Located Name.Name)
92+chompMatchingName expectedName =
93+ let
94+ (P.Parser parserL) = Var.lower (E.DeclDefNameRepeat expectedName)
95+ in
96+ P.Parser $ \state@(P.State _ _ _ sr sc) cok eok cerr eerr ->
9997 let
100− cokL name newState@(P.State _ _ _ er ec _) =
98+ cokL name newState@(P.State _ _ _ er ec) =
10199 if expectedName == name
102100 then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
103− else cerr sr sc ctx (E.MatchingName expectedName)
101+ else cerr sr sc (E.DeclDefNameMatch expectedName name)
104102
105− eokL name newState@(P.State _ _ _ er ec _) =
103+ eokL name newState@(P.State _ _ _ er ec) =
106104 if expectedName == name
107105 then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
108− else eerr sr sc ctx (E.MatchingName expectedName)
106+ else eerr sr sc (E.DeclDefNameMatch expectedName name)
109107 in
110108 parserL state cokL eokL cerr eerr
111109
112110
113111
114−-- TYPE ALIAS and UNION TYPES
112+-- TYPE DECLARATIONS
115113
116114
117115{-# INLINE typeDecl #-}
118−typeDecl :: A.Position -> SParser Decl
116+typeDecl :: A.Position -> Space.Parser E.Decl Decl
119117typeDecl start =
120− do Keyword.type_
121− spaces
122− oneOf E.XXX
123− [
124− inContext E.TypeAlias Keyword.alias_ $
125− do spaces
126− (name, args) <- nameArgsEquals
127− (tipe, end, pos) <- Type.expression
128− let alias = A.at start end (Src.Alias name args tipe)
129− return (Alias alias, end, pos)
130− ,
131− do pushContext start E.TypeUnion
132− (name, args) <- nameArgsEquals
133− (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
134− (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace
135− let union = A.at start end (Src.Union name args ctors)
136− popContext (Union union, end, pos)
137− ]
118+ inContext E.DeclType (Keyword.type_ E.DeclStart) $
119+ do Space.chompAndCheckIndent E.DT_Space E.DT_IndentName
120+ oneOf E.DT_Name
121+ [
122+ inContext E.DT_Alias (Keyword.alias_ E.DT_Name) $
123+ do Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals
124+ (name, args) <- chompAliasNameToEquals
125+ (tipe, end) <- specialize E.AliasBody Type.expression
126+ let alias = A.at start end (Src.Alias name args tipe)
127+ return (Alias alias, end)
128+ ,
129+ specialize E.DT_Union $
130+ do (name, args) <- chompCustomNameToEquals
131+ (firstVariant, firstEnd) <- Type.variant
132+ (variants, end) <- chompVariants [firstVariant] firstEnd
133+ let union = A.at start end (Src.Union name args variants)
134+ return (Union union, end)
135+ ]
136+
137+
138+
139+-- TYPE ALIASES
140+
141+
142+chompAliasNameToEquals :: Parser E.TypeAlias (A.Located Name.Name, [A.Located Name.Name])
143+chompAliasNameToEquals =
144+ do name <- addLocation (Var.upper E.AliasName)
145+ Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals
146+ chompAliasNameToEqualsHelp name []
147+
148+
149+chompAliasNameToEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser E.TypeAlias (A.Located Name.Name, [A.Located Name.Name])
150+chompAliasNameToEqualsHelp name args =
151+ oneOf E.AliasEquals
152+ [ do arg <- addLocation (Var.lower E.AliasEquals)
153+ Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals
154+ chompAliasNameToEqualsHelp name (arg:args)
155+ , do word1 0x3D {-=-} E.AliasEquals
156+ Space.chompAndCheckIndent E.AliasSpace E.AliasIndentBody
157+ return ( name, reverse args )
158+ ]
159+
160+
138161
162+-- CUSTOM TYPES
139163
140−nameArgsEquals :: Parser (A.Located Name.Name, [A.Located Name.Name])
141−nameArgsEquals =
142− do name <- addLocation Var.upper
143− spaces
144− nameArgsEqualsHelp name []
145164
165+chompCustomNameToEquals :: Parser E.CustomType (A.Located Name.Name, [A.Located Name.Name])
166+chompCustomNameToEquals =
167+ do name <- addLocation (Var.upper E.CT_Name)
168+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentEquals
169+ chompCustomNameToEqualsHelp name []
146170
147−nameArgsEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser (A.Located Name.Name, [A.Located Name.Name])
148−nameArgsEqualsHelp name args =
149− oneOf E.XXX
150− [ do arg <- addLocation Var.lower
151− spaces
152− nameArgsEqualsHelp name (arg:args)
153− , do word1 0x3D {-=-} E.XXX
154− spaces
171+
172+chompCustomNameToEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser E.CustomType (A.Located Name.Name, [A.Located Name.Name])
173+chompCustomNameToEqualsHelp name args =
174+ oneOf E.CT_Equals
175+ [ do arg <- addLocation (Var.lower E.CT_Equals)
176+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentEquals
177+ chompCustomNameToEqualsHelp name (arg:args)
178+ , do word1 0x3D {-=-} E.CT_Equals
179+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterEquals
155180 return ( name, reverse args )
156181 ]
157182
158183
159−chompConstructors :: [(A.Located Name.Name, [Src.Type])] -> A.Position -> SPos -> SParser [(A.Located Name.Name, [Src.Type])]
160−chompConstructors ctors end pos =
161− oneOf E.XXX
162− [ do checkSpace pos
163− word1 0x7C {-|-} E.XXX
164− spaces
165− (ctor, newEnd, newSpace) <- Type.unionConstructor
166− chompConstructors (ctor:ctors) newEnd newSpace
167− , return ( reverse ctors, end, pos )
184+chompVariants :: [(A.Located Name.Name, [Src.Type])] -> A.Position -> Space.Parser E.CustomType [(A.Located Name.Name, [Src.Type])]
185+chompVariants variants end =
186+ oneOfWithFallback
187+ [ do Space.checkIndent end E.CT_IndentBar
188+ word1 0x7C {-|-} E.CT_Bar
189+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterBar
190+ (variant, newEnd) <- Type.variant
191+ chompVariants (variant:variants) newEnd
168192 ]
193+ (reverse variants, end)
169194
170195
171196
@@ -173,16 +198,16 @@ chompConstructors ctors end pos =
173198
174199
175200{-# INLINE portDecl #-}
176−portDecl :: SParser Decl
201+portDecl :: Space.Parser E.Decl Decl
177202portDecl =
178− inContext E.Port Keyword.port_ $
179− do spaces
180− name <- addLocation Var.lower
181− spaces
182− word1 0x3A {-:-} E.XXX
183− spaces
184− (tipe, end, pos) <- Type.expression
185− return ( Port (Src.Port name tipe), end, pos )
203+ inContext E.Port (Keyword.port_ E.DeclStart) $
204+ do Space.chompAndCheckIndent E.PortSpace E.PortIndentName
205+ name <- addLocation (Var.lower E.PortName)
206+ Space.chompAndCheckIndent E.PortSpace E.PortIndentColon
207+ word1 0x3A {-:-} E.PortColon
208+ Space.chompAndCheckIndent E.PortSpace E.PortIndentType
209+ (tipe, end) <- specialize E.PortType Type.expression
210+ return ( Port (Src.Port name tipe), end )
186211
187212
188213
@@ -191,27 +216,32 @@ portDecl =
191216
192217-- INVARIANT: always chomps to a freshline
193218--
194−infix_ :: Parser (A.Located Src.Binop)
219+infix_ :: Parser E.Module (A.Located Src.Binop)
195220infix_ =
221+ let
222+ err = E.Infix
223+ _err = \_ -> E.Infix
224+ in
196225 do start <- getPosition
197− inContext E.Infix Keyword.infix_ $
198− do spaces
199− associativity <-
200− oneOf E.XXX
201− [ Keyword.left_ >> return Binop.Left
202− , Keyword.right_ >> return Binop.Right
203− , Keyword.non_ >> return Binop.Non
204− ]
205− spaces
206− precedence <- Number.precedence
207− spaces
208− word1 0x28 {-(-} E.XXX
209− op <- Symbol.binop
210− word1 0x29 {-)-} E.XXX
211− spaces
212− word1 0x3D {-=-} E.XXX
213− spaces
214− name <- Var.lower
215− end <- getPosition
216− checkFreshLine =<< whitespace
217− return (A.at start end (Src.Binop op associativity precedence name))
226+ Keyword.infix_ err
227+ Space.chompAndCheckIndent _err err
228+ associativity <-
229+ oneOf err
230+ [ Keyword.left_ err >> return Binop.Left
231+ , Keyword.right_ err >> return Binop.Right
232+ , Keyword.non_ err >> return Binop.Non
233+ ]
234+ Space.chompAndCheckIndent _err err
235+ precedence <- Number.precedence err
236+ Space.chompAndCheckIndent _err err
237+ word1 0x28 {-(-} err
238+ op <- Symbol.operator err _err
239+ word1 0x29 {-)-} err
240+ Space.chompAndCheckIndent _err err
241+ word1 0x3D {-=-} err
242+ Space.chompAndCheckIndent _err err
243+ name <- Var.lower err
244+ end <- getPosition
245+ Space.chomp _err
246+ Space.checkFreshLine err
247+ return (A.at start end (Src.Binop op associativity precedence name))
compiler/src/Reporting/Error/Syntax.hs+1131−18
@@ -3,9 +3,13 @@
33module Reporting.Error.Syntax
44 ( Error(..)
55 --
6+ , Module(..)
67 , Decl(..)
7− , Infix(..)
8+ , DeclType(..)
9+ , TypeAlias(..)
810 , CustomType(..)
11+ , DeclDef(..)
12+ , Port(..)
913 --
1014 , Expr(..)
1115 , Record(..)
@@ -65,33 +69,89 @@ data Error
6569
6670
6771
68−-- DECLARATIONS
72+-- MODULE
6973
7074
71−data Decl
75+data Module
7276 = Module Row Col
77+ | ModuleSpace Space Row Col
7378 | Import Row Col
74− | Annotation Name.Name Type Row Col
75− | Definition Name.Name Def Row Col
76− | TypeAlias Name.Name Row Col
77− | CustomType Name.Name CustomType Row Col
78− | Port Name.Name Row Col
79− | Infix Infix Row Col
80− ----
81− | EndlessDocComment Row Col
79+ | Infix Row Col
80+ | Declarations Decl Row Col
81+
82+
83+
84+-- DECLARATIONS
85+
86+
87+data Decl
88+ = DeclStart Row Col
8289 | DeclSpace Space Row Col
83− | DeclDeadend Row Col
90+ --
91+ | Port Port Row Col
92+ | DeclType DeclType Row Col
93+ | DeclDef Name.Name DeclDef Row Col
94+
95+
96+data DeclDef
97+ = DeclDefSpace Space Row Col
98+ | DeclDefEquals Row Col
99+ | DeclDefType Type Row Col
100+ | DeclDefAlignment Row Col
101+ | DeclDefArg Pattern Row Col
102+ | DeclDefBody Expr Row Col
103+ | DeclDefNameRepeat Name.Name Row Col
104+ | DeclDefNameMatch Name.Name Name.Name Row Col
105+ | DeclDefIndentType Row Col
106+ | DeclDefIndentEquals Row Col
107+ | DeclDefIndentBody Row Col
108+
109+
110+data Port
111+ = PortSpace Space Row Col
112+ | PortName Row Col
113+ | PortColon Row Col
114+ | PortType Type Row Col
115+ | PortIndentName Row Col
116+ | PortIndentColon Row Col
117+ | PortIndentType Row Col
84118
85119
86−data Infix
87− = Precedence Row Col
88− | Associativity Row Col
120+
121+-- TYPE DECLARATIONS
122+
123+
124+data DeclType
125+ = DT_Space Space Row Col
126+ | DT_Name Row Col
127+ | DT_Alias TypeAlias Row Col
128+ | DT_Union CustomType Row Col
129+ --
130+ | DT_IndentName Row Col
131+
132+
133+data TypeAlias
134+ = AliasSpace Space Row Col
135+ | AliasName Row Col
136+ | AliasEquals Row Col
137+ | AliasBody Type Row Col
138+ --
139+ | AliasIndentEquals Row Col
140+ | AliasIndentBody Row Col
89141
90142
91143data CustomType
92− = CT_Variant Row Col
93− | CT_Space Space Row Col
94− | CT_Type Type Row Col
144+ = CT_Space Space Row Col
145+ | CT_Name Row Col
146+ | CT_Equals Row Col
147+ | CT_Bar Row Col
148+ | CT_Variant Row Col
149+ | CT_VariantArg Type Row Col
150+ --
151+ | CT_IndentEquals Row Col
152+ | CT_IndentBar Row Col
153+ | CT_IndentAfterBar Row Col
154+ | CT_IndentAfterEquals Row Col
95155
96156
97157
@@ -397,3 +457,1056 @@ data Operator
397457toReport :: Code.Source -> Error -> Report.Report
398458toReport source err =
399459 error "TODO" source err
460+{-
461+ case err of
462+ CommentOnNothing region ->
463+ Report.Report "STRAY COMMENT" region [] $
464+ Report.toCodeSnippet source region Nothing
465+ (
466+ "This documentation comment is not followed by anything."
467+ ,
468+ D.reflow $
469+ "All documentation comments need to be right above the declaration they\
470+ \ describe. Maybe some code got deleted or commented out by accident? Or\
471+ \ maybe this comment is here by accident?"
472+ )
473+
474+ UnexpectedPort region ->
475+ Report.Report "UNEXPECTED PORTS" region [] $
476+ Report.toCodeSnippet source region Nothing
477+ (
478+ D.reflow $
479+ "You are declaring ports in a normal module."
480+ ,
481+ D.stack
482+ [ D.fillSep
483+ ["Switch","this","to","say",D.green "port module","instead,"
484+ ,"marking","that","this","module","contains","port","declarations."
485+ ]
486+ , D.link "Note"
487+ "Ports are not a traditional FFI for calling JS functions directly. They need a different mindset! Read"
488+ "ports"
489+ "to learn the syntax and how to use it effectively."
490+ ]
491+ )
492+
493+ NoPorts region ->
494+ Report.Report "NO PORTS" region [] $
495+ Report.toCodeSnippet source region Nothing
496+ (
497+ D.reflow $
498+ "This module does not declare any ports, but it says it will:"
499+ ,
500+ D.fillSep
501+ ["Switch","this","to",D.green "module"
502+ ,"and","you","should","be","all","set!"
503+ ]
504+ )
505+
506+ ParseError row col context expectation ->
507+ let
508+ pos = A.Position row col
509+ region = A.Region pos pos
510+ in
511+ case expectation of
512+ TODO ->
513+ error "TODO no parse error yet"
514+
515+ XXX ->
516+ error "TODO no parse error yet"
517+
518+ -- Parse.Utils
519+
520+ HasTab ->
521+ Report.Report "NO TABS" region [] $
522+ Report.toCodeSnippet source region Nothing
523+ (
524+ D.reflow $
525+ "I ran into a tab, but tabs are not allowed in Elm files."
526+ ,
527+ D.reflow $
528+ "Replace the tab with spaces."
529+ )
530+
531+ DocComment ->
532+ Report.Report "EXPECTING DOC COMMENT" region [] $
533+ Report.toCodeSnippet source region Nothing
534+ (
535+ D.reflow $
536+ "I was expecting a doc comment here:"
537+ ,
538+ D.reflowLink
539+ "Check out" "TODO" "for examples of doc comments."
540+ )
541+
542+ MultiCommentEnd startRow startCol ->
543+ let
544+ startRegion =
545+ A.Region
546+ (A.Position startRow startCol)
547+ (A.Position startRow (startCol + 3))
548+ in
549+ Report.Report "ENDLESS COMMENT" startRegion [] $
550+ Report.toCodeSnippet source startRegion Nothing
551+ (
552+ D.reflow $
553+ "I cannot find the end of this multi-line comment:"
554+ ,
555+ D.stack -- "{-"
556+ [ D.reflow "Add a -} somewhere after this to end the comment."
557+ , D.toSimpleHint
558+ "Multi-line comments can be nested in Elm, so {- {- -} -} is a comment\
559+ \ that happens to contain another comment. Like parentheses and curly braces,\
560+ \ the start and end markers must always be balanced. Maybe that is the problem?"
561+ ]
562+ )
563+
564+ -- Parse.Number
565+
566+ Number_Start ->
567+ Report.Report "EXPECTING NUMBER" region [] $
568+ Report.toCodeSnippet source region Nothing
569+ (
570+ D.reflow $
571+ "I was expecting to see a number here:"
572+ ,
573+ D.stack
574+ [ D.reflow $
575+ "I recognize numbers in the following formats:"
576+ , D.indent 4 $ D.vcat [ "42", "3.14", "6.022e23", "0x002B" ]
577+ , D.reflow $
578+ "So is there a way to write it like one of those?"
579+ ]
580+ )
581+
582+ Number_End ->
583+ Report.Report "WEIRD NUMBER" region [] $
584+ Report.toCodeSnippet source region Nothing
585+ (
586+ D.reflow $
587+ "I thought I was reading a number, but I ran into some weird stuff here:"
588+ ,
589+ D.stack
590+ [ D.reflow $
591+ "I recognize numbers in the following formats:"
592+ , D.indent 4 $ D.vcat [ "42", "3.14", "6.022e23", "0x002B" ]
593+ , D.reflow $
594+ "So is there a way to write it like one of those?"
595+ ]
596+ )
597+
598+ Number_Dot int ->
599+ Report.Report "WEIRD NUMBER" region [] $
600+ Report.toCodeSnippet source region Nothing
601+ (
602+ D.reflow $
603+ "Numbers cannot end with a dot like this:"
604+ ,
605+ D.fillSep
606+ ["Switching","to",D.green (D.fromChars (show int))
607+ ,"or",D.green (D.fromChars (show int ++ ".0"))
608+ ,"will","work","though!"
609+ ]
610+ )
611+
612+ Number_HexDigit ->
613+ Report.Report "WEIRD HEXIDECIMAL" region [] $
614+ Report.toCodeSnippet source region Nothing
615+ (
616+ D.reflow $
617+ "I thought I was reading a hexidecimal number until I got here:"
618+ ,
619+ D.stack
620+ [ D.reflow $
621+ "Valid hexidecimal digits include 0123456789abcdefABCDEF, so I can\
622+ \ only recognize things like this:"
623+ , D.indent 4 $ D.vcat [ "0x2B", "0x002B", "0x00ffb3" ]
624+ ]
625+ )
626+
627+ Number_NoLeadingZero ->
628+ Report.Report "LEADING ZEROS" region [] $
629+ Report.toCodeSnippet source region Nothing
630+ (
631+ D.reflow $
632+ "I do not accept numbers with leading zeros:"
633+ ,
634+ D.stack
635+ [ D.reflow $
636+ "Just delete the leading zeros and it should work!"
637+ , D.toSimpleNote $
638+ "Some languages let you to specify octal numbers by adding a leading zero.\
639+ \ So in C, writing 0111 is the same as writing 73. Some people are used to\
640+ \ that, but others probably want it to equal 111. Either path is going to\
641+ \ surprise people from certain backgrounds, so Elm tries to avoid this whole\
642+ \ situation."
643+ ]
644+ )
645+
646+ Precedence ->
647+ Report.Report "EXPECTING PRECEDENCE" region [] $
648+ Report.toCodeSnippet source region Nothing
649+ (
650+ D.reflow $
651+ "I was expecting the precedence here:"
652+ ,
653+ D.reflow $
654+ "I need a single digit between 0 and 9 inclusive."
655+ )
656+
657+ -- Parse.Utf8
658+
659+ CharStart ->
660+ Report.Report "EXPECTING A CHARACTER" region [] $
661+ Report.toCodeSnippet source region Nothing
662+ (
663+ D.reflow $
664+ "I was expecting a character here:"
665+ ,
666+ D.stack
667+ [ D.reflow $
668+ "Characters start and end with single quotes, like this:"
669+ , D.indent 4 $ D.vcat $
670+ [ "'a'"
671+ , "'b'"
672+ , "'ø'"
673+ , "'\\n'"
674+ , "'\\u{00F8}'"
675+ ]
676+ , D.reflow $
677+ "That last style lets you encode characters by their unicode\
678+ \ code point, so 'a' is equivalent to '\\u{0061}', 'ø' is\
679+ \ equivalent to '\\u{00F8}', and so on for all code points."
680+ ]
681+ )
682+
683+ CharEnd ->
684+ Report.Report "MISSING SINGLE QUOTE" region [] $
685+ Report.toCodeSnippet source region Nothing
686+ (
687+ D.reflow $
688+ "I thought I was parsing a character, but I got to the end of\
689+ \ the line without seeing the closing single quote:"
690+ ,
691+ D.stack
692+ [ D.reflow $
693+ "Characters start and end with single quotes, like this:"
694+ , D.indent 4 $ D.vcat $
695+ [ "'a'"
696+ , "'b'"
697+ , "'ø'"
698+ , "'\\n'"
699+ , "'\\u{00F8}'"
700+ ]
701+ , D.reflow $
702+ "That last style lets you encode characters by their unicode\
703+ \ code point, so 'a' is equivalent to '\\u{0061}', 'ø' is\
704+ \ equivalent to '\\u{00F8}', and so on for all code points."
705+ ]
706+ )
707+
708+ CharNotString startRow startCol ->
709+ let
710+ stringRegion =
711+ A.Region (A.Position startRow startCol) pos
712+ in
713+ Report.Report "NEEDS DOUBLE QUOTES" stringRegion [] $
714+ Report.toCodeSnippet source stringRegion Nothing
715+ (
716+ "The following string uses single quotes:"
717+ ,
718+ D.stack
719+ [ "Please switch to double quotes instead:"
720+ , D.indent 4 $
721+ D.dullyellow "'this'" <> " => " <> D.green "\"this\""
722+ , D.toSimpleNote $
723+ "Elm uses double quotes for strings like \"hello\", whereas it uses single\
724+ \ quotes for individual characters like 'a' and 'ø'. This distinction helps with\
725+ \ code like (String.any (\\c -> c == 'X') \"90210\") where you are inspecting\
726+ \ individual characters."
727+ ]
728+ )
729+
730+ StringStart ->
731+ Report.Report "EXPECTING A STRING" region [] $
732+ Report.toCodeSnippet source region Nothing
733+ (
734+ D.reflow $
735+ "I was expecting a string here:"
736+ ,
737+ D.fillSep
738+ ["Something","like"
739+ ,D.green "\"this\""
740+ ,"or"
741+ ,D.green "\"that\""
742+ ,"with","double","quotes."
743+ ]
744+ )
745+
746+ StringEnd_Single ->
747+ Report.Report "ENDLESS STRING" region [] $
748+ Report.toCodeSnippet source region Nothing
749+ (
750+ D.reflow $
751+ "I got to the end of the line without seeing the closing double quote:"
752+ ,
753+ D.stack
754+ [ D.fillSep $
755+ ["Strings","look","like",D.green "\"this\"","with","double"
756+ ,"quotes","on","each","end.","Is","the","closing","double"
757+ ,"quote","missing","in","your","code?"
758+ ]
759+ , D.link "Note" "Read" "TODO" "if you want a string that spans multiple lines."
760+ ]
761+ )
762+
763+ StringEnd_Multi startRow startCol ->
764+ let
765+ startRegion =
766+ A.Region
767+ (A.Position startRow startCol)
768+ (A.Position startRow (startCol + 3))
769+ in
770+ Report.Report "ENDLESS STRING" startRegion [] $
771+ Report.toCodeSnippet source startRegion Nothing
772+ (
773+ D.reflow $
774+ "I cannot find the end of this multi-line string:"
775+ ,
776+ D.stack
777+ [ D.reflow "Add a \"\"\" somewhere after this to end the string."
778+ , D.link "Hint" "Read" "TODO" "for more information on strings and multi-line strings."
779+ ]
780+ )
781+
782+ EscapeUnknown startCol endCol ->
783+ let
784+ escapeRegion =
785+ A.Region (A.Position row startCol) (A.Position row endCol)
786+ in
787+ Report.Report "UNKNOWN ESCAPE" escapeRegion [] $
788+ Report.toCodeSnippet source escapeRegion Nothing
789+ (
790+ D.reflow $
791+ "Backslashes always start escaped characters, but I do not recognize this one:"
792+ ,
793+ D.stack
794+ [ D.reflow $
795+ "Valid escape characters include:"
796+ , D.indent 4 $ D.vcat $
797+ [ "\\n"
798+ , "\\r"
799+ , "\\t"
800+ , "\\\""
801+ , "\\\'"
802+ , "\\\\"
803+ , "\\u{03BB}"
804+ ]
805+ , D.reflow $
806+ "The last one lets encode ANY character by its Unicode code\
807+ \ point, so use that for anything outside the ordinary six."
808+ ]
809+ )
810+
811+ BadUnicodeFormat startCol endCol ->
812+ let
813+ escapeRegion =
814+ A.Region (A.Position row startCol) (A.Position row endCol)
815+ in
816+ Report.Report "BAD UNICODE ESCAPE" escapeRegion [] $
817+ Report.toCodeSnippet source escapeRegion Nothing
818+ (
819+ D.reflow $
820+ "I ran into an invalid Unicode escape:"
821+ ,
822+ D.stack
823+ [ D.reflow $
824+ "Here are some examples of valid Unicode escapes:"
825+ , D.green $ D.indent 4 $ D.vcat $
826+ [ "\\u{0041}"
827+ , "\\u{03BB}"
828+ , "\\u{6728}"
829+ , "\\u{1F60A}"
830+ ]
831+ , D.reflow $
832+ "Notice that the code point is always surrounded by curly\
833+ \ braces. They are required!"
834+ ]
835+ )
836+
837+ BadUnicodeCode startCol endCol ->
838+ let
839+ escapeRegion =
840+ A.Region (A.Position row startCol) (A.Position row endCol)
841+ in
842+ Report.Report "BAD UNICODE ESCAPE" escapeRegion [] $
843+ Report.toCodeSnippet source escapeRegion Nothing
844+ (
845+ D.reflow $
846+ "This is not a valid code point:"
847+ ,
848+ D.reflow $
849+ "The valid code points are between 0 and 10FFFF inclusive."
850+ )
851+
852+ BadUnicodeLength startCol endCol numDigits badCode ->
853+ let
854+ escapeRegion =
855+ A.Region (A.Position row startCol) (A.Position row endCol)
856+ in
857+ Report.Report "BAD UNICODE ESCAPE" escapeRegion [] $
858+ Report.toCodeSnippet source escapeRegion Nothing $
859+ if numDigits < 4 then
860+ (
861+ D.reflow $
862+ "Every code point needs at least four digits:"
863+ ,
864+ let
865+ goodCode = replicate (4 - numDigits) '0' ++ showHex badCode ""
866+ escape = "\\u{" <> D.fromChars goodCode <> "}"
867+ in
868+ D.fillSep ["Try",D.green escape,"instead?"]
869+ )
870+
871+ else
872+ (
873+ D.reflow $
874+ "This code point has too many digits:"
875+ ,
876+ D.fillSep $
877+ ["Valid","code","points","are","between"
878+ ,D.green "\\u{0000}","and",D.green "\\u{10FFFF}" <> ","
879+ ,"so","try","trimming","any","leading","zeros","until"
880+ ,"you","have","between","four","and","six","digits."
881+ ]
882+ )
883+
884+ -- Parse.Shader
885+
886+ ShaderStart ->
887+ Report.Report "EXPECTING A SHADER" region [] $
888+ Report.toCodeSnippet source region Nothing $
889+ (
890+ D.reflow $
891+ "I was expecting a GLSL shader block here:"
892+ ,
893+ D.reflow $
894+ "These blocks start with [glsl| and end with |] and should be\
895+ \ filled with GLSL code."
896+ )
897+
898+ ShaderEnd startCol endCol ->
899+ let
900+ shaderRegion =
901+ A.Region (A.Position row startCol) (A.Position row endCol)
902+ in
903+ Report.Report "ENDLESS SHADER" shaderRegion [] $
904+ Report.toCodeSnippet source shaderRegion Nothing
905+ (
906+ D.reflow "I cannot find the end of this shader:"
907+ ,
908+ D.reflow "Add a |] somewhere after this to end the shader."
909+ )
910+
911+ ShaderProblem problem ->
912+ Report.Report "SHADER PROBLEM" region [] $
913+ Report.toCodeSnippet source region Nothing
914+ (
915+ D.reflow $
916+ "I ran into a problem while parsing this GLSL block."
917+ ,
918+ D.fromChars problem
919+ )
920+
921+ Operator ->
922+ Report.Report "EXPECTING AN OPERATOR" region [] $
923+ Report.toCodeSnippet source region Nothing
924+ (
925+ D.reflow $
926+ "I was expecting an operator here:"
927+ ,
928+ D.stack
929+ [ D.reflow "Some of the most common operators are:"
930+ , D.indent 4 $ D.vcat ["+","-","*","&&","||"]
931+ , D.reflow "Something like that!"
932+ ]
933+ )
934+
935+ ReservedOperator op ->
936+ error "TODO ReservedOperator" op
937+
938+ Wildcard ->
939+ Report.Report "EXPECTING A WILDCARD" region [] $
940+ Report.toCodeSnippet source region Nothing
941+ (
942+ D.reflow $
943+ "I was expecting a _ here:"
944+ ,
945+ D.reflow $
946+ "An underscore indicates that “I do not care about this value” and is\
947+ \ called a wildcard pattern because it will match with any type of values."
948+ )
949+
950+ WildcardNotVar startCol endCol ->
951+ let
952+ badRegion =
953+ A.Region (A.Position row startCol) (A.Position row endCol)
954+ in
955+ Report.Report "INVALID PATTERN" badRegion [] $
956+ Report.toCodeSnippet source badRegion Nothing
957+ (
958+ D.reflow $
959+ "I was expecting to see an underscore without any additional characters:"
960+ ,
961+ D.reflow $
962+ "There are two options. Either (1) remove the extra characters and ignore the\
963+ \ value or (2) remove the starting underscore to give the value a normal name."
964+ )
965+
966+ -- Parse.Pattern
967+
968+ Pattern ->
969+ error "TODO" context
970+{-
971+ case context of
972+ P.Frame r c
973+ P.NoContext ->
974+-}
975+
976+ FloatInPattern ->
977+ Report.Report "INVALID PATTERN" region [] $
978+ Report.toCodeSnippet source region Nothing
979+ (
980+ D.reflow $
981+ "I cannot pattern match with floating point numbers:"
982+ ,
983+ D.reflow $
984+ "Equality on floats can be unreliable, so you usually want to check that they\
985+ \ are nearby with some sort of (abs (actual - expected) < 0.001) check."
986+ )
987+
988+ FieldNamePattern ->
989+ Report.Report "EXPECTING A FIELD NAME" region [] $
990+ Report.toCodeSnippet source region Nothing
991+ (
992+ D.reflow $
993+ "I was expecting a field name here:"
994+ ,
995+ D.fillSep $
996+ ["A","name","like",D.dullyellow "id" <> ",",D.dullyellow "status" <> ","
997+ ,"or","whatever","field","you","want","to","access."
998+ ]
999+ )
1000+
1001+ -- Parse.Expression
1002+
1003+ MatchingName name ->
1004+ Report.Report "EXPECTING A DEFINITION" region [] $
1005+ Report.toCodeSnippet source region Nothing
1006+ (
1007+ D.reflow $
1008+ "I just saw the type annotation for `" ++ Name.toChars name
1009+ ++ "` so I was expecting to see its definition here:"
1010+ ,
1011+ D.reflow $
1012+ "Type annotations always appear directly above the relevant\
1013+ \ definition, without anything else (even doc comments) in between."
1014+ )
1015+-}
1016+
1017+{-
1018+ EndOfFile ->
1019+ Report.Report "EXPECTING END OF FILE" region [] $
1020+ Report.toCodeSnippet source region Nothing
1021+ (
1022+ D.reflow $
1023+ "I was not expecting to see anything more here:"
1024+ ,
1025+ D.reflow $
1026+ "I think I have read all the declarations in the file and that there is nothing\
1027+ \ left to see, so whatever I am running into is confusing me a lot!"
1028+ )
1029+
1030+-}
1031+{-
1032+
1033+ TypeWithBadDefinition region annName defName ->
1034+ Report.Report "ANNOTATION MISMATCH" region [] $
1035+ Report.toCodeSnippet source region Nothing
1036+ (
1037+ D.reflow $
1038+ "I see a `" <> Name.toChars annName
1039+ <> "` annotation, but it is followed by a `"
1040+ <> Name.toChars defName <> "` definition."
1041+ ,
1042+ D.fillSep
1043+ ["The","annotation","and","definition","names","must","match!"
1044+ ,"Is","there","a","typo","between"
1045+ , D.dullyellow (D.fromName annName)
1046+ ,"and"
1047+ , D.dullyellow (D.fromName defName) <> "?"
1048+ ]
1049+ )
1050+
1051+
1052+-- PARSE ERROR TO DOCS
1053+
1054+
1055+problemToDocs :: Problem -> (D.Doc, D.Doc)
1056+problemToDocs problem =
1057+ case problem of
1058+ Tab ->
1059+ (
1060+ "I ran into a tab, but tabs are not allowed in Elm files."
1061+ ,
1062+ "Replace the tab with spaces."
1063+ )
1064+
1065+ EndOfFile_Comment ->
1066+ (
1067+ "I got to the end of the file while parsing a multi-line comment."
1068+ ,
1069+ [
1070+ "Multi-line comments look like {- comment -}, and it looks like\
1071+ \ you are missing the closing marker."
1072+ ,
1073+ D.toSimpleHint $
1074+ "Nested multi-line comments like {- this {- and this -} -} are allowed.\
1075+ \ The opening and closing markers must be balanced though, just\
1076+ \ like parentheses in normal code. Maybe that is the problem?"
1077+ ]
1078+ )
1079+
1080+ EndOfFile_String ->
1081+ (
1082+ "I got to the end of the file while parsing a string."
1083+ ,
1084+ "Strings look like \"this\" with double quotes on each end.\
1085+ \ Is the closing double quote missing in your code?"
1086+ )
1087+
1088+ EndOfFile_MultiString ->
1089+ (
1090+ "I got to the end of the file while parsing a multi-line string."
1091+ ,
1092+ "Multi-line strings look like \"\"\"this\"\"\" with three double quotes\
1093+ \ on each end. Is the closing triple quote missing in your code?"
1094+ )
1095+
1096+ EndOfFile_Char ->
1097+ (
1098+ "I got to the end of the file while parsing a character."
1099+ ,
1100+ "Characters look like 'c' with single quotes on each end.\
1101+ \ Is the closing single quote missing in your code?"
1102+ )
1103+
1104+ NewLineInString ->
1105+ (
1106+ "This string is missing the closing quote."
1107+ ,
1108+ [
1109+ "Elm strings like \"this\" cannot contain newlines."
1110+ ,
1111+ D.toSimpleHint $
1112+ "For strings that CAN contain newlines, say \"\"\"this\"\"\" for Elm’s\
1113+ \ multi-line string syntax. It allows unescaped newlines and double quotes."
1114+ ]
1115+ )
1116+
1117+ NewLineInChar ->
1118+ (
1119+ "This character is missing the closing quote."
1120+ ,
1121+ "Elm characters must start and end with a single quote. Valid examples\n\
1122+ \ include 'a', 'b', '\n', 'ø', and '\\u{00F8}' for unicode code points."
1123+ )
1124+
1125+ BadNumberDot numberBeforeDot ->
1126+ (
1127+ "Numbers cannot end with a decimal points."
1128+ ,
1129+ let
1130+ number =
1131+ D.fromString (show numberBeforeDot)
1132+ in
1133+ "Saying " <> D.green number <> " or " <> D.green (number <> ".0") <> " will work though!"
1134+ )
1135+
1136+ BadNumberEnd ->
1137+ (
1138+ "Numbers cannot have letters or underscores in them."
1139+ ,
1140+ "Maybe a space is missing between a number and a variable?"
1141+ )
1142+
1143+ BadNumberExp ->
1144+ (
1145+ "If you put the letter E in a number, it should followed by more digits."
1146+ ,
1147+ "If you want to say 1000, you can also say 1e3.\
1148+ \ You cannot just end it with an E though!"
1149+ )
1150+
1151+ BadNumberHex ->
1152+ (
1153+ "I see the start of a hex number, but not the end."
1154+ ,
1155+ "A hex number looks like 0x123ABC, where the 0x is followed by hexidecimal\
1156+ \ digits. Valid hexidecimal digits include: 0123456789abcdefABCDEF"
1157+ )
1158+
1159+ BadNumberZero ->
1160+ (
1161+ "Normal numbers cannot start with zeros. Take the zeros off the front."
1162+ ,
1163+ "Only numbers like 0x0040 or 0.25 can start with a zero."
1164+ )
1165+
1166+ BadUnderscore _ ->
1167+ (
1168+ "Variable names cannot start with an underscore like this:"
1169+ ,
1170+ "Delete the underscore and it shoulld be fine!"
1171+ )
1172+
1173+ BadOp op stack ->
1174+ case op of
1175+ HasType ->
1176+ badOp stack "A" "\"has type\" operator"
1177+ "type annotations and record types"
1178+ "Maybe you want :: instead? Or maybe something is indented too much?"
1179+
1180+ Equals ->
1181+ (
1182+ "I was not expecting this equals sign"
1183+ <> contextToString " here" " while parsing " stack <> "."
1184+ ,
1185+ toBadEqualsHint stack
1186+ )
1187+
1188+ Arrow ->
1189+ if isCaseRelated stack then
1190+ (
1191+ "I ran into a stray arrow while parsing this `case` expression."
1192+ ,
1193+ D.reflow $
1194+ "All branches in a `case` must be indented the exact\
1195+ \ same amount, so the patterns are vertically\
1196+ \ aligned. Maybe this branch is indented too much?"
1197+ )
1198+
1199+ else
1200+ badOp stack "An" "arrow"
1201+ "cases expressions and anonymous functions"
1202+ "Maybe you want > or >= instead?"
1203+
1204+ Pipe ->
1205+ badOp stack "A" "vertical bar"
1206+ "type declarations"
1207+ "Maybe you want || instead?"
1208+
1209+ Dot ->
1210+ (
1211+ "I was not expecting this dot."
1212+ ,
1213+ D.reflow $
1214+ "Dots are for record access and decimal points, so\
1215+ \ they cannot float around on their own. Maybe\
1216+ \ there is some extra whitespace?"
1217+ )
1218+
1219+ Theories stack allTheories ->
1220+ (
1221+ D.reflow $
1222+ "Something went wrong while parsing " <> contextToString "your code" "" stack <> "."
1223+ ,
1224+ case Set.toList (Set.fromList allTheories) of
1225+ [] ->
1226+ D.stack
1227+ [ D.reflow $
1228+ "I do not have any suggestions though!"
1229+ , D.reflow $
1230+ "Can you get it down to a <http://sscce.org> and share it at\
1231+ \ <https://github.com/elm/error-message-catalog/issues>?\
1232+ \ That way we can figure out how to give better advice!"
1233+ ]
1234+
1235+ [theory] ->
1236+ D.reflow $
1237+ "I was expecting to see "
1238+ <> addPeriod (theoryToString stack theory)
1239+
1240+ theories ->
1241+ D.vcat $
1242+ [ "I was expecting:"
1243+ , ""
1244+ ]
1245+ ++ map (bullet . theoryToString stack) theories
1246+ )
1247+
1248+
1249+
1250+-- BAD OP HELPERS
1251+
1252+
1253+badOp :: ContextStack -> String -> String -> String -> String -> ( D.Doc, D.Doc )
1254+badOp stack article opName setting hint =
1255+ (
1256+ D.reflow $
1257+ "I was not expecting this " <> opName
1258+ <> contextToString " here" " while parsing " stack <> "."
1259+ ,
1260+ D.reflow $
1261+ article <> " " <> opName <> " should only appear in "
1262+ <> setting <> ". " <> hint
1263+ )
1264+
1265+
1266+toBadEqualsHint :: ContextStack -> D.Doc
1267+toBadEqualsHint stack =
1268+ case stack of
1269+ [] ->
1270+ D.reflow $
1271+ "Maybe you want == instead? Or maybe something is indented too much?"
1272+
1273+ (ExprRecord, _) : _ ->
1274+ D.reflow $
1275+ "Records look like { x = 3, y = 4 } with the equals sign right\
1276+ \ after the field name. Maybe you forgot a comma?"
1277+
1278+ (Definition _, _) : rest ->
1279+ D.reflow $
1280+ "Maybe this is supposed to be a separate definition? If so, it\
1281+ \ is indented too far. "
1282+ <>
1283+ if any ((==) ExprLet . fst) rest then
1284+ "All definitions in a `let` expression must be vertically aligned."
1285+ else
1286+ "Spaces are not allowed before top-level definitions."
1287+
1288+ _ : rest ->
1289+ toBadEqualsHint rest
1290+
1291+
1292+
1293+isCaseRelated :: ContextStack -> Bool
1294+isCaseRelated stack =
1295+ case stack of
1296+ [] ->
1297+ False
1298+
1299+ (context, _) : rest ->
1300+ context == ExprCase || isCaseRelated rest
1301+
1302+
1303+
1304+-- CONTEXT
1305+
1306+
1307+contextToString :: String -> String -> ContextStack -> String
1308+contextToString defaultString prefixString stack =
1309+ case stack of
1310+ [] ->
1311+ defaultString
1312+
1313+ (context, _) : rest ->
1314+ let anchor = getAnchor rest in
1315+ prefixString <>
1316+ case context of
1317+ ExprIf -> "an `if` expression" <> anchor
1318+ ExprLet -> "a `let` expression" <> anchor
1319+ ExprFunc -> "an anonymous function" <> anchor
1320+ ExprCase -> "a `case` expression" <> anchor
1321+ ExprList -> "a list" <> anchor
1322+ ExprTuple -> "an expression (in parentheses)" <> anchor
1323+ ExprRecord -> "a record" <> anchor
1324+ Definition name -> Name.toChars name <> "'s definition"
1325+ Annotation name -> Name.toChars name <> "'s type annotation"
1326+ TypeTuple -> "a type (in parentheses)" <> anchor
1327+ TypeRecord -> "a record type" <> anchor
1328+ PatternList -> "a list pattern" <> anchor
1329+ PatternTuple -> "a pattern (in parentheses)" <> anchor
1330+ PatternRecord -> "a record pattern" <> anchor
1331+ Module -> "a module declaration"
1332+ Import -> "an import"
1333+ TypeUnion -> "a union type"
1334+ TypeAlias -> "a type alias"
1335+ Infix -> "an infix declaration"
1336+ Port -> "a port declaration"
1337+
1338+
1339+getAnchor :: ContextStack -> String
1340+getAnchor stack =
1341+ case stack of
1342+ [] ->
1343+ ""
1344+
1345+ (context, _) : rest ->
1346+ case context of
1347+ Definition name ->
1348+ " in " <> Name.toChars name <> "'s definition"
1349+
1350+ Annotation name ->
1351+ " in " <> Name.toChars name <> "'s type annotation"
1352+
1353+ _ ->
1354+ getAnchor rest
1355+
1356+
1357+
1358+-- THEORY HELPERS
1359+
1360+
1361+bullet :: String -> D.Doc
1362+bullet point =
1363+ D.hang 4 (" - " <> D.fillSep (map D.fromString (words point)))
1364+
1365+
1366+addPeriod :: String -> String
1367+addPeriod msg =
1368+ if last msg `elem` ['`', ')', '.', '!', '?'] then
1369+ msg
1370+ else
1371+ msg <> "."
1372+
1373+
1374+theoryToString :: ContextStack -> Theory -> String
1375+theoryToString context theory =
1376+ case theory of
1377+ Keyword keyword ->
1378+ "the `" <> keyword <> "` keyword"
1379+
1380+ Symbol symbol ->
1381+ case symbol of
1382+ "=" -> equalsTheory context
1383+ "->" -> "an arrow (->) followed by an expression"
1384+ ":" -> "the \"has type\" symbol (:) followed by a type"
1385+ "," -> "a comma"
1386+ "|" -> barTheory context
1387+ "::" -> "the cons operator (::) followed by more list elements"
1388+ "." -> "a dot (.)"
1389+ "-" -> "a minus sign (-)"
1390+ "_" -> "an underscore"
1391+ "(" -> "a left paren, for grouping or starting tuples"
1392+ ")" -> "a closing paren"
1393+ "[" -> "a left square bracket, for starting lists"
1394+ "]" -> "a right square bracket, to end a list"
1395+ "{" -> "a left curly brace, for starting records"
1396+ "}" -> "a right curly brace, to end a record"
1397+ "{-|" -> "a doc comment, like {-| this -}" --}
1398+ _ -> "the (" <> symbol <> ") symbol"
1399+
1400+ LowVar ->
1401+ "a lower-case variable, like `x` or `user`"
1402+
1403+ CapVar ->
1404+ "an upper-case variable, like `Maybe` or `Just`"
1405+
1406+ InfixOp ->
1407+ "an infix operator, like (+) or (==)"
1408+
1409+ Digit ->
1410+ "a digit from 0 to 9"
1411+
1412+ BadSpace ->
1413+ badSpace context
1414+
1415+ Expecting next ->
1416+ case next of
1417+ Decl -> "a declaration, like `x = 5` or `type alias Model = { ... }`"
1418+ Expr -> "an expression, like x or 42"
1419+ AfterOpExpr op -> "an expression after that (" <> Name.toChars op <> ") operator, like x or 42"
1420+ ElseBranch -> "an `else` branch. An `if` must handle both possibilities."
1421+ Arg -> "an argument, like `name` or `total`"
1422+ Pattern -> "a pattern, like `name` or (Just x)"
1423+ Type -> "a type, like Int or (List String)"
1424+ Listing -> "a list of exposed values and types, like (..) or (x,y,z)"
1425+ Exposing -> "something like `exposing (..)`"
1426+
1427+
1428+equalsTheory :: ContextStack -> String
1429+equalsTheory stack =
1430+ case stack of
1431+ [] ->
1432+ "an equals sign (=)"
1433+
1434+ (context, _) : rest ->
1435+ case context of
1436+ ExprRecord -> "an equals sign (=) followed by an expression"
1437+ Definition name -> "an equals sign (=) followed by " <> Name.toChars name <> "'s definition"
1438+ TypeUnion -> "an equals sign (=) followed by the first union type constructor"
1439+ TypeAlias -> "an equals sign (=) followed by the aliased type"
1440+ _ -> equalsTheory rest
1441+
1442+
1443+barTheory :: ContextStack -> String
1444+barTheory stack =
1445+ case stack of
1446+ [] ->
1447+ "a vertical bar (|)"
1448+
1449+ (context, _) : rest ->
1450+ case context of
1451+ ExprRecord -> "a vertical bar (|) followed by the record fields you want to update"
1452+ TypeRecord -> "a vertical bar (|) followed by some record field types"
1453+ TypeUnion -> "a vertical bar (|) followed by more union type constructors"
1454+ _ -> barTheory rest
1455+
1456+
1457+badSpace :: ContextStack -> String
1458+badSpace stack =
1459+ case stack of
1460+ [] ->
1461+ "more indentation? I was not done with that last thing yet."
1462+
1463+ (context, _) : rest ->
1464+ case context of
1465+ ExprIf -> "the end of that `if`" <> badSpaceExprEnd rest
1466+ ExprLet -> "the end of that `let`" <> badSpaceExprEnd rest
1467+ ExprFunc -> badSpace rest
1468+ ExprCase -> "more of that `case`" <> badSpaceExprEnd rest
1469+ ExprList -> "the end of that list" <> badSpaceExprEnd rest
1470+ ExprTuple -> "a closing paren" <> badSpaceExprEnd rest
1471+ ExprRecord -> "the end of that record" <> badSpaceExprEnd rest
1472+ Definition name -> "the rest of " <> Name.toChars name <> "'s definition" <> badSpaceExprEnd stack
1473+ Annotation name -> "the rest of " <> Name.toChars name <> "'s type annotation" <> badSpaceEnd
1474+ TypeTuple -> "a closing paren" <> badSpaceEnd
1475+ TypeRecord -> "the end of that record" <> badSpaceEnd
1476+ PatternList -> "the end of that list" <> badSpaceEnd
1477+ PatternTuple -> "a closing paren" <> badSpaceEnd
1478+ PatternRecord -> "the end of that record" <> badSpaceEnd
1479+ Module -> "something like `module Main exposing (..)`"
1480+ Import -> "something like `import Html exposing (..)`"
1481+ TypeUnion -> "more of that union type" <> badSpaceEnd
1482+ TypeAlias -> "more of that type alias" <> badSpaceEnd
1483+ Infix -> "more of that infix declaration" <> badSpaceEnd
1484+ Port -> "more of that port declaration" <> badSpaceEnd
1485+
1486+
1487+badSpaceEnd :: String
1488+badSpaceEnd =
1489+ ". Maybe you forgot some code? Or you need more indentation?"
1490+
1491+
1492+badSpaceExprEnd :: ContextStack -> String
1493+badSpaceExprEnd stack =
1494+ case stack of
1495+ [] ->
1496+ badSpaceEnd
1497+
1498+ (Definition name, A.Position _ column) : _ ->
1499+ let
1500+ ending =
1501+ if column <= 1 then
1502+ "to be indented?"
1503+ else
1504+ "more indentation? (Try " <> show (column + 1) <> "+ spaces.)"
1505+ in
1506+ ". Maybe you forgot some code? Or maybe the body of `"
1507+ <> Name.toChars name
1508+ <> "` needs " <> ending
1509+
1510+ _ : rest ->
1511+ badSpaceExprEnd rest
1512+-}