1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Docs
4  ( Error(..)
5  , SyntaxProblem(..)
6  , NameProblem(..)
7  , DefProblem(..)
8  , toReports
9  )
10  where
11
12
13import qualified Data.Name as Name
14import qualified Data.NonEmptyList as NE
15
16import Parse.Primitives (Row, Col)
17import Parse.Symbol (BadOperator(..))
18import qualified Reporting.Annotation as A
19import Reporting.Doc ((<>))
20import qualified Reporting.Doc as D
21import qualified Reporting.Render.Code as Code
22import qualified Reporting.Error.Syntax as E
23import qualified Reporting.Report as Report
24
25
26
27data Error
28  = NoDocs A.Region
29  | ImplicitExposing A.Region
30  | SyntaxProblem SyntaxProblem
31  | NameProblems (NE.List NameProblem)
32  | DefProblems (NE.List DefProblem)
33
34
35data SyntaxProblem
36  = Op Row Col
37  | OpBad BadOperator Row Col
38  | Name Row Col
39  | Space E.Space Row Col
40  | Comma Row Col
41  | BadEnd Row Col
42
43
44data NameProblem
45  = NameDuplicate Name.Name A.Region A.Region
46  | NameOnlyInDocs Name.Name A.Region
47  | NameOnlyInExports Name.Name A.Region
48
49
50data DefProblem
51  = NoComment Name.Name A.Region
52  | NoAnnotation Name.Name A.Region
53
54
55
56-- TO REPORTS
57
58
59toReports :: Code.Source -> Error -> NE.List Report.Report
60toReports source err =
61  case err of
62    NoDocs region ->
63      NE.singleton $
64      Report.Report "NO DOCS" region [] $
65        Code.toSnippet source region Nothing
66          (
67            D.reflow $
68              "You must have a documentation comment between the module\
69              \ declaration and the imports."
70          ,
71            D.reflow
72              "Learn more at <https://package.elm-lang.org/help/documentation-format>"
73          )
74
75    ImplicitExposing region ->
76      NE.singleton $
77      Report.Report "IMPLICIT EXPOSING" region [] $
78        Code.toSnippet source region Nothing
79          (
80            D.reflow $
81              "I need you to be explicit about what this module exposes:"
82          ,
83            D.reflow $
84              "A great API usually hides some implementation details, so it is rare that\
85              \ everything in the file should be exposed. And requiring package authors\
86              \ to be explicit about this is a way of adding another quality check before\
87              \ code gets published. So as you write out the public API, ask yourself if\
88              \ it will be easy to understand as people read the documentation!"
89          )
90
91    SyntaxProblem problem ->
92      NE.singleton $
93        toSyntaxProblemReport source problem
94
95    NameProblems problems ->
96      fmap (toNameProblemReport source) problems
97
98    DefProblems problems ->
99      fmap (toDefProblemReport source) problems
100
101
102
103-- SYNTAX PROBLEM
104
105
106toSyntaxProblemReport :: Code.Source -> SyntaxProblem -> Report.Report
107toSyntaxProblemReport source problem =
108  let
109    toSyntaxReport row col details =
110      let
111        region = toRegion row col
112      in
113      Report.Report "PROBLEM IN DOCS" region [] $
114        Code.toSnippet source region Nothing
115          ( D.reflow "I was partway through parsing your module documentation, but I got stuck here:"
116          , D.stack $
117              [ D.reflow details
118              , D.toSimpleHint $
119                  "Read through <https://package.elm-lang.org/help/documentation-format> for\
120                  \ tips on how to write module documentation!"
121              ]
122          )
123  in
124  case problem of
125    Op row col ->
126      toSyntaxReport row col $
127        "I am trying to parse an operator like (+) or (*) but something is going wrong."
128
129    OpBad _ row col ->
130      toSyntaxReport row col $
131        "I am trying to parse an operator like (+) or (*) but it looks like you are using\
132        \ a reserved symbol in this case."
133
134    Name row col ->
135      toSyntaxReport row col $
136        "I was expecting to see the name of another exposed value from this module."
137
138    Space space row col ->
139      E.toSpaceReport source space row col
140
141    Comma row col ->
142      toSyntaxReport row col $
143        "I was expecting to see a comma next."
144
145    BadEnd row col ->
146      toSyntaxReport row col $
147        "I am not really sure what I am getting stuck on though."
148
149
150toRegion :: Row -> Col -> A.Region
151toRegion row col =
152  let
153    pos = A.Position row col
154  in
155  A.Region pos pos
156
157
158
159-- NAME PROBLEM
160
161
162toNameProblemReport :: Code.Source -> NameProblem -> Report.Report
163toNameProblemReport source problem =
164  case problem of
165    NameDuplicate name r1 r2 ->
166      Report.Report "DUPLICATE DOCS" r2 [] $
167        Code.toPair source r1 r2
168          (
169            D.reflow $
170              "There can only be one `" <> Name.toChars name
171              <> "` in your module documentation, but it is listed twice:"
172          ,
173            "Remove one of them!"
174          )
175          (
176            D.reflow $
177              "There can only be one `" <> Name.toChars name
178              <> "` in your module documentation, but I see two. One here:"
179          ,
180            "And another one over here:"
181          ,
182            "Remove one of them!"
183          )
184
185    NameOnlyInDocs name region ->
186      Report.Report "DOCS MISTAKE" region [] $
187        Code.toSnippet source region Nothing
188          (
189            D.reflow $
190              "I do not see `" <> Name.toChars name
191              <> "` in the `exposing` list, but it is in your module documentation:"
192          ,
193            D.reflow $
194              "Does it need to be added to the `exposing` list as well? Or maybe you removed `"
195              <> Name.toChars name <> "` and forgot to delete it here?"
196          )
197
198    NameOnlyInExports name region ->
199      Report.Report "DOCS MISTAKE" region [] $
200        Code.toSnippet source region Nothing
201          (
202            D.reflow $
203              "I do not see `" <> Name.toChars name
204              <> "` in your module documentation, but it is in your `exposing` list:"
205          ,
206            D.stack
207              [ D.reflow $
208                  "Add a line like `@docs " <> Name.toChars name
209                  <> "` to your module documentation!"
210              , D.link "Note" "See" "docs" "for more guidance on writing high quality docs."
211              ]
212          )
213
214
215
216-- DEF PROBLEM
217
218
219toDefProblemReport :: Code.Source -> DefProblem -> Report.Report
220toDefProblemReport source problem =
221  case problem of
222    NoComment name region ->
223      Report.Report "NO DOCS" region [] $
224        Code.toSnippet source region Nothing
225          (
226            D.reflow $
227              "The `" <> Name.toChars name <> "` definition does not have a documentation comment."
228          ,
229            D.stack
230              [ D.reflow $
231                  "Add documentation with nice examples of how to use it!"
232              , D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
233              ]
234          )
235
236    NoAnnotation name region ->
237      Report.Report "NO TYPE ANNOTATION" region [] $
238        Code.toSnippet source region Nothing
239          (
240            D.reflow $
241              "The `" <> Name.toChars name <> "` definition does not have a type annotation."
242          ,
243            D.stack
244              [ D.reflow $
245                  "I use the type variable names from your annotations when generating docs. So if\
246                  \ you say `Html msg` in your type annotation, I can use `msg` in the docs and make\
247                  \ them a bit clearer. So add an annotation and try to use nice type variables!"
248              , D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
249              ]
250          )
251