git.iko.soy/elk
on master help sign in
Get new errors working in Parse.Declaration
7a297d2Evan Czaplicki
compiler/src/Parse/Declaration.hs+150−120
compare with master
unifiedsplit
@@ -16,11 +16,11 @@ import qualified Parse.Expression as Expr
16import qualified Parse.Pattern as Pattern
16import qualified Parse.Pattern as Pattern
17import qualified Parse.Keyword as Keyword
17import qualified Parse.Keyword as Keyword
18import qualified Parse.Number as Number
18import qualified Parse.Number as Number
19+import qualified Parse.Space as Space
19import qualified Parse.Symbol as Symbol
20import qualified Parse.Symbol as Symbol
20import qualified Parse.Type as Type
21import qualified Parse.Type as Type
21import qualified Parse.Variable as Var
22import qualified Parse.Variable as Var
22−import Parse.Utils
23−import Parse.Primitives hiding (Parser, State)
23+import Parse.Primitives hiding (State)
24import qualified Parse.Primitives as P
24import qualified Parse.Primitives as P
25import qualified Reporting.Annotation as A
25import qualified Reporting.Annotation as A
26import qualified Reporting.Error.Syntax as E
26import qualified Reporting.Error.Syntax as E
@@ -37,10 +37,10 @@ data Decl
37 | Port Src.Port
37 | Port Src.Port
38
38
39
39
40−declaration :: SParser Decl
40+declaration :: Space.Parser E.Decl Decl
41declaration =
41declaration =
42 do start <- getPosition
42 do start <- getPosition
43− oneOf E.XXX
43+ oneOf E.DeclStart
44 [ typeDecl start
44 [ typeDecl start
45 , portDecl
45 , portDecl
46 , valueDecl start
46 , valueDecl start
@@ -52,120 +52,145 @@ declaration =
52
52
53
53
54{-# INLINE valueDecl #-}
54{-# INLINE valueDecl #-}
55−valueDecl :: A.Position -> SParser Decl
55+valueDecl :: A.Position -> Space.Parser E.Decl Decl
56valueDecl start =
56valueDecl start =
57− do name <- Var.lower
57+ do name <- Var.lower E.DeclStart
58 end <- getPosition
58 end <- getPosition
59− spaces
59+ specialize (E.DeclDef name) $
60+ do Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
60− oneOf E.XXX
61+ oneOf E.DeclDefEquals
61− [
62+ [
62− do word1 0x3A {-:-} E.XXX
63+ do word1 0x3A {-:-} E.DeclDefEquals
63− pushContext start (E.Annotation name)
64+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType
64− spaces
65− (tipe, _, space) <- Type.expression
65+ (tipe, _) <- specialize E.DeclDefType Type.expression
66− popContext ()
66+ Space.checkFreshLine E.DeclDefAlignment
67− checkAligned space
68− defName <- matchingName name
67+ defName <- chompMatchingName name
69− let (A.At (A.Region defStart _) _) = defName
68+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
70− pushContext defStart (E.Definition name)
71− spaces
72− decl <- valueHelp start defName (Just tipe) []
69+ chompDefArgsAndBody start defName (Just tipe) []
73− popContext decl
74− ,
70+ ,
75− do pushContext start (E.Definition name)
76− decl <- valueHelp start (A.at start end name) Nothing []
71+ chompDefArgsAndBody start (A.at start end name) Nothing []
77− popContext decl
78− ]
72+ ]
79−
73+
80−
74+
81−valueHelp :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> SParser Decl
75+chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.DeclDef Decl
82−valueHelp start name tipe revArgs =
76+chompDefArgsAndBody start name tipe revArgs =
83− oneOf E.XXX
77+ oneOf E.DeclDefEquals
84− [ do arg <- Pattern.term
78+ [ do arg <- specialize E.DeclDefArg Pattern.term
85− spaces
79+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
86− valueHelp start name tipe (arg : revArgs)
80+ chompDefArgsAndBody start name tipe (arg : revArgs)
87− , do word1 0x3D {-=-} E.XXX
81+ , do word1 0x3D {-=-} E.DeclDefEquals
88− spaces
82+ Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentBody
89− (body, end, space) <- Expr.expression
83+ (body, end) <- specialize E.DeclDefBody Expr.expression
84+ return
90− let value = A.at start end (Src.Value name (reverse revArgs) body tipe)
85+ ( Value (A.at start end (Src.Value name (reverse revArgs) body tipe))
91− return ( Value value, end, space )
86+ , end
87+ )
92 ]
88 ]
93
89
94
90
95−matchingName :: Name.Name -> Parser (A.Located Name.Name)
91+chompMatchingName :: Name.Name -> Parser E.DeclDef (A.Located Name.Name)
96−matchingName expectedName =
92+chompMatchingName expectedName =
93+ let
97− let (P.Parser parserL) = Var.lower in
94+ (P.Parser parserL) = Var.lower (E.DeclDefNameRepeat expectedName)
95+ in
98− P.Parser $ \state@(P.State _ _ _ sr sc ctx) cok eok cerr eerr ->
96+ P.Parser $ \state@(P.State _ _ _ sr sc) cok eok cerr eerr ->
99 let
97 let
100− cokL name newState@(P.State _ _ _ er ec _) =
98+ cokL name newState@(P.State _ _ _ er ec) =
101 if expectedName == name
99 if expectedName == name
102 then cok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
100 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)
104
102
105− eokL name newState@(P.State _ _ _ er ec _) =
103+ eokL name newState@(P.State _ _ _ er ec) =
106 if expectedName == name
104 if expectedName == name
107 then eok (A.At (A.Region (A.Position sr sc) (A.Position er ec)) name) newState
105 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)
109 in
107 in
110 parserL state cokL eokL cerr eerr
108 parserL state cokL eokL cerr eerr
111
109
112
110
113
111
114−-- TYPE ALIAS and UNION TYPES
112+-- TYPE DECLARATIONS
115
113
116
114
117{-# INLINE typeDecl #-}
115{-# INLINE typeDecl #-}
118−typeDecl :: A.Position -> SParser Decl
116+typeDecl :: A.Position -> Space.Parser E.Decl Decl
119typeDecl start =
117typeDecl start =
120− do Keyword.type_
118+ inContext E.DeclType (Keyword.type_ E.DeclStart) $
121− spaces
119+ do Space.chompAndCheckIndent E.DT_Space E.DT_IndentName
122− oneOf E.XXX
120+ oneOf E.DT_Name
123− [
121+ [
124− inContext E.TypeAlias Keyword.alias_ $
122+ inContext E.DT_Alias (Keyword.alias_ E.DT_Name) $
125− do spaces
123+ do Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals
126− (name, args) <- nameArgsEquals
124+ (name, args) <- chompAliasNameToEquals
127− (tipe, end, pos) <- Type.expression
125+ (tipe, end) <- specialize E.AliasBody Type.expression
128− let alias = A.at start end (Src.Alias name args tipe)
126+ let alias = A.at start end (Src.Alias name args tipe)
129− return (Alias alias, end, pos)
127+ return (Alias alias, end)
130− ,
128+ ,
131− do pushContext start E.TypeUnion
129+ specialize E.DT_Union $
132− (name, args) <- nameArgsEquals
130+ do (name, args) <- chompCustomNameToEquals
133− (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor
131+ (firstVariant, firstEnd) <- Type.variant
134− (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace
132+ (variants, end) <- chompVariants [firstVariant] firstEnd
135− let union = A.at start end (Src.Union name args ctors)
133+ let union = A.at start end (Src.Union name args variants)
136− popContext (Union union, end, pos)
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 )
137− ]
158+ ]
159+
160+
138
161
162+-- CUSTOM TYPES
139
163
140−nameArgsEquals :: Parser (A.Located Name.Name, [A.Located Name.Name])
141−nameArgsEquals =
142− do name <- addLocation Var.upper
143− spaces
144− nameArgsEqualsHelp name []
145
164
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 []
146
170
171+
147−nameArgsEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser (A.Located Name.Name, [A.Located Name.Name])
172+chompCustomNameToEqualsHelp :: A.Located Name.Name -> [A.Located Name.Name] -> Parser E.CustomType (A.Located Name.Name, [A.Located Name.Name])
148−nameArgsEqualsHelp name args =
173+chompCustomNameToEqualsHelp name args =
149− oneOf E.XXX
174+ oneOf E.CT_Equals
150− [ do arg <- addLocation Var.lower
175+ [ do arg <- addLocation (Var.lower E.CT_Equals)
151− spaces
176+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentEquals
152− nameArgsEqualsHelp name (arg:args)
177+ chompCustomNameToEqualsHelp name (arg:args)
153− , do word1 0x3D {-=-} E.XXX
178+ , do word1 0x3D {-=-} E.CT_Equals
154− spaces
179+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterEquals
155 return ( name, reverse args )
180 return ( name, reverse args )
156 ]
181 ]
157
182
158
183
159−chompConstructors :: [(A.Located Name.Name, [Src.Type])] -> A.Position -> SPos -> SParser [(A.Located Name.Name, [Src.Type])]
184+chompVariants :: [(A.Located Name.Name, [Src.Type])] -> A.Position -> Space.Parser E.CustomType [(A.Located Name.Name, [Src.Type])]
160−chompConstructors ctors end pos =
185+chompVariants variants end =
161− oneOf E.XXX
186+ oneOfWithFallback
162− [ do checkSpace pos
187+ [ do Space.checkIndent end E.CT_IndentBar
163− word1 0x7C {-|-} E.XXX
188+ word1 0x7C {-|-} E.CT_Bar
164− spaces
189+ Space.chompAndCheckIndent E.CT_Space E.CT_IndentAfterBar
165− (ctor, newEnd, newSpace) <- Type.unionConstructor
190+ (variant, newEnd) <- Type.variant
166− chompConstructors (ctor:ctors) newEnd newSpace
191+ chompVariants (variant:variants) newEnd
167− , return ( reverse ctors, end, pos )
168 ]
192 ]
193+ (reverse variants, end)
169
194
170
195
171
196
@@ -173,16 +198,16 @@ chompConstructors ctors end pos =
173
198
174
199
175{-# INLINE portDecl #-}
200{-# INLINE portDecl #-}
176−portDecl :: SParser Decl
201+portDecl :: Space.Parser E.Decl Decl
177portDecl =
202portDecl =
178− inContext E.Port Keyword.port_ $
203+ inContext E.Port (Keyword.port_ E.DeclStart) $
179− do spaces
204+ do Space.chompAndCheckIndent E.PortSpace E.PortIndentName
180− name <- addLocation Var.lower
205+ name <- addLocation (Var.lower E.PortName)
181− spaces
206+ Space.chompAndCheckIndent E.PortSpace E.PortIndentColon
182− word1 0x3A {-:-} E.XXX
207+ word1 0x3A {-:-} E.PortColon
183− spaces
208+ Space.chompAndCheckIndent E.PortSpace E.PortIndentType
184− (tipe, end, pos) <- Type.expression
209+ (tipe, end) <- specialize E.PortType Type.expression
185− return ( Port (Src.Port name tipe), end, pos )
210+ return ( Port (Src.Port name tipe), end )
186
211
187
212
188
213
@@ -191,27 +216,32 @@ portDecl =
191
216
192-- INVARIANT: always chomps to a freshline
217-- INVARIANT: always chomps to a freshline
193--
218--
194−infix_ :: Parser (A.Located Src.Binop)
219+infix_ :: Parser E.Module (A.Located Src.Binop)
195infix_ =
220infix_ =
221+ let
222+ err = E.Infix
223+ _err = \_ -> E.Infix
224+ in
196 do start <- getPosition
225 do start <- getPosition
197− inContext E.Infix Keyword.infix_ $
226+ Keyword.infix_ err
198− do spaces
227+ Space.chompAndCheckIndent _err err
199− associativity <-
228+ associativity <-
200− oneOf E.XXX
229+ oneOf err
201− [ Keyword.left_ >> return Binop.Left
230+ [ Keyword.left_ err >> return Binop.Left
202− , Keyword.right_ >> return Binop.Right
231+ , Keyword.right_ err >> return Binop.Right
203− , Keyword.non_ >> return Binop.Non
232+ , Keyword.non_ err >> return Binop.Non
204− ]
233+ ]
205− spaces
234+ Space.chompAndCheckIndent _err err
206− precedence <- Number.precedence
235+ precedence <- Number.precedence err
207− spaces
236+ Space.chompAndCheckIndent _err err
208− word1 0x28 {-(-} E.XXX
237+ word1 0x28 {-(-} err
209− op <- Symbol.binop
238+ op <- Symbol.operator err _err
210− word1 0x29 {-)-} E.XXX
239+ word1 0x29 {-)-} err
211− spaces
240+ Space.chompAndCheckIndent _err err
212− word1 0x3D {-=-} E.XXX
241+ word1 0x3D {-=-} err
213− spaces
242+ Space.chompAndCheckIndent _err err
214− name <- Var.lower
243+ name <- Var.lower err
215− end <- getPosition
244+ end <- getPosition
245+ Space.chomp _err
216− checkFreshLine =<< whitespace
246+ Space.checkFreshLine err
217− return (A.at start end (Src.Binop op associativity precedence name))
247+ return (A.at start end (Src.Binop op associativity precedence name))
compiler/src/Reporting/Error/Syntax.hs+1131−18
@@ -3,9 +3,13 @@
3module Reporting.Error.Syntax
3module Reporting.Error.Syntax
4 ( Error(..)
4 ( Error(..)
5 --
5 --
6+ , Module(..)
6 , Decl(..)
7 , Decl(..)
7− , Infix(..)
8+ , DeclType(..)
9+ , TypeAlias(..)
8 , CustomType(..)
10 , CustomType(..)
11+ , DeclDef(..)
12+ , Port(..)
9 --
13 --
10 , Expr(..)
14 , Expr(..)
11 , Record(..)
15 , Record(..)
@@ -65,33 +69,89 @@ data Error
65
69
66
70
67
71
68−-- DECLARATIONS
72+-- MODULE
69
73
70
74
71−data Decl
75+data Module
72 = Module Row Col
76 = Module Row Col
77+ | ModuleSpace Space Row Col
73 | Import Row Col
78 | Import Row Col
74− | Annotation Name.Name Type Row Col
79+ | Infix Row Col
75− | Definition Name.Name Def Row Col
80+ | Declarations Decl Row Col
76− | TypeAlias Name.Name Row Col
81+
77− | CustomType Name.Name CustomType Row Col
82+
78− | Port Name.Name Row Col
83+
79− | Infix Infix Row Col
84+-- DECLARATIONS
80− ----
85+
81− | EndlessDocComment Row Col
86+
87+data Decl
88+ = DeclStart Row Col
82 | DeclSpace Space Row Col
89 | 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
84
118
85
119
86−data Infix
120+
87− = Precedence Row Col
121+-- TYPE DECLARATIONS
88− | Associativity Row Col
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
89
141
90
142
91data CustomType
143data CustomType
92− = CT_Variant Row Col
93− | CT_Space Space 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
94− | CT_Type Type 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
95
155
96
156
97
157
@@ -397,3 +457,1056 @@ data Operator
397toReport :: Code.Source -> Error -> Report.Report
457toReport :: Code.Source -> Error -> Report.Report
398toReport source err =
458toReport source err =
399 error "TODO" source err
459 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+-}