git.iko.soy/elk
on ff98144 help sign in
elk/src/Reporting/Warning.hs
115 lines 4.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Warning where
5import Data.Aeson ((.=))
6import qualified Data.Aeson as Json
7import qualified Text.PrettyPrint as P
8import Text.PrettyPrint ((<+>))
10import qualified AST.Module.Name as ModuleName
11import qualified AST.Type as Type
12import qualified Nitpick.Pattern as Pattern
13import qualified Reporting.Annotation as A
14import qualified Reporting.PrettyPrint as P
15import qualified Reporting.Report as Report
18-- ALL POSSIBLE WARNINGS
20data Warning
21 = UnusedImport ModuleName.Raw
22 | MissingTypeAnnotation String Type.Canonical
23 | InexhaustivePatternMatch [Pattern.Pattern]
24 | RedundantPatternMatch
27-- TO STRING
29toString :: P.Dealiaser -> String -> String -> A.Located Warning -> String
30toString dealiaser location source (A.A region warning) =
31 Report.toString location region (toReport dealiaser warning) source
34print :: P.Dealiaser -> String -> String -> A.Located Warning -> IO ()
35print dealiaser location source (A.A region warning) =
36 Report.printWarning location region (toReport dealiaser warning) source
39toReport :: P.Dealiaser -> Warning -> Report.Report
40toReport dealiaser warning =
41 case warning of
42 UnusedImport moduleName ->
43 Report.simple
44 "unused import"
45 ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")
46 ""
48 MissingTypeAnnotation name inferredType ->
49 Report.simple
50 "missing type annotation"
51 ("Top-level value `" ++ name ++ "` does not have a type annotation.")
52 ( "The type annotation you want looks something like this:\n\n"
53 ++ P.render (P.nest 4 typeDoc)
54 )
55 where
56 typeDoc =
57 P.hang
58 (P.text name <+> P.colon)
59 4
60 (P.pretty dealiaser False inferredType)
62 InexhaustivePatternMatch unhandled ->
63 Report.simple
64 "missing pattern"
65 "The following case expression does not handle all possible inputs."
66 ( "The following patterns are not being handled:\n"
67 ++ viewPatternList unhandled
68 ++ "\n\n"
69 ++ "If we get values like this, we have no choice but to crash! Normally this means\n"
70 ++ "you just added a new tag to a union type, but sometimes it can be because there\n"
71 ++ "is something very odd about the data you are modeling. In those rare cases, you\n"
72 ++ "probably want to either:\n"
73 ++ "\n"
74 ++ " 1. Rethink the model. Maybe some cases are \"impossible\" but it is still\n"
75 ++ " possible to construct such cases. Is there a way to model the values more\n"
76 ++ " precisely such that \"impossible\" values truly are impossible?\n"
77 ++ " 2. End the pattern match with a wildcard match that leads to an expression\n"
78 ++ " like: Debug.crash \"If you are reading this, I have made a mistake!\"\n"
79 ++ " Generally speaking, you do not want it to have to be this way."
80 )
82 RedundantPatternMatch ->
83 Report.simple
84 "redundant pattern"
85 "The following pattern is redundant."
86 "Any value with this shape will be handled by a previous pattern."
89-- TO JSON
91toJson :: P.Dealiaser -> FilePath -> A.Located Warning -> Json.Value
92toJson dealiaser filePath (A.A region warning) =
93 let
94 (maybeRegion, additionalFields) =
95 Report.toJson [] (toReport dealiaser warning)
96 in
97 Json.object $
98 [ "file" .= filePath
99 , "region" .= maybe region id maybeRegion
100 , "type" .= ("warning" :: String)
101 ]
102 ++ additionalFields
105-- PATTERN WARNINGS
107viewPatternList :: [Pattern.Pattern] -> String
108viewPatternList unhandledPatterns =
109 let
110 (showPatterns, rest) =
111 splitAt 4 unhandledPatterns
112 in
113 concatMap ((++) "\n ") $
114 map Pattern.toString showPatterns
115 ++ if null rest then [] else ["..."]