1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Warning
4  ( Warning(..)
5  , Context(..)
6  , toReport
7  )
8  where
9
10
11import Data.Monoid ((<>))
12import qualified Data.Name as Name
13
14import qualified AST.Canonical as Can
15import qualified AST.Utils.Type as Type
16import qualified Reporting.Annotation as A
17import qualified Reporting.Doc as D
18import qualified Reporting.Report as Report
19import qualified Reporting.Render.Code as Code
20import qualified Reporting.Render.Type as RT
21import qualified Reporting.Render.Type.Localizer as L
22
23
24
25-- ALL POSSIBLE WARNINGS
26
27
28data Warning
29  = UnusedImport A.Region Name.Name
30  | UnusedVariable A.Region Context Name.Name
31  | MissingTypeAnnotation A.Region Name.Name Can.Type
32
33
34data Context = Def | Pattern
35
36
37
38-- TO REPORT
39
40
41toReport :: L.Localizer -> Code.Source -> Warning -> Report.Report
42toReport localizer source warning =
43  case warning of
44    UnusedImport region moduleName ->
45      Report.Report "unused import" region [] $
46        Code.toSnippet source region Nothing
47          (
48            D.reflow $
49              "Nothing from the `" <> Name.toChars moduleName <> "` module is used in this file."
50          ,
51            "I recommend removing unused imports."
52          )
53
54    UnusedVariable region context name ->
55      let title = defOrPat context "unused definition" "unused variable" in
56      Report.Report title region [] $
57        Code.toSnippet source region Nothing
58          (
59            D.reflow $
60              "You are not using `" <> Name.toChars name <> "` anywhere."
61          ,
62            D.stack
63              [ D.reflow $
64                  "Is there a typo? Maybe you intended to use `" <> Name.toChars name
65                  <> "` somewhere but typed another name instead?"
66              , D.reflow $
67                  defOrPat context
68                    ( "If you are sure there is no typo, remove the definition.\
69                      \ This way future readers will not have to wonder why it is there!"
70                    )
71                    ( "If you are sure there is no typo, replace `" <> Name.toChars name
72                      <> "` with _ so future readers will not have to wonder why it is there!"
73                    )
74              ]
75          )
76
77    MissingTypeAnnotation region name inferredType ->
78        Report.Report "missing type annotation" region [] $
79          Code.toSnippet source region Nothing
80            (
81              D.reflow $
82                case Type.deepDealias inferredType of
83                  Can.TLambda _ _ ->
84                    "The `" <> Name.toChars name <> "` function has no type annotation."
85
86                  _ ->
87                    "The `" <> Name.toChars name <> "` definition has no type annotation."
88            ,
89              D.stack
90                [ "I inferred the type annotation myself though! You can copy it into your code:"
91                , D.green $ D.hang 4 $ D.sep $
92                    [ D.fromName name <> " :"
93                    , RT.canToDoc localizer RT.None inferredType
94                    ]
95                ]
96            )
97
98
99defOrPat :: Context -> a -> a -> a
100defOrPat context def pat =
101  case context of
102    Def -> def
103    Pattern -> pat
104
105