656bfb7 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Switch Reports to use Docs for pre and post hints

656bfb7Evan Czaplicki11 years ago

elm-compiler.cabal+2

compare with master

unifiedsplit

@@ -109,6 +109,8 @@ Library

109 Reporting.Error.Syntax,

110 Reporting.Error.Type,

111 Reporting.Region,

112+ Reporting.Render.Code,

113+ Reporting.Render.Type,

112 Reporting.Report,

114 Reporting.Report,

113 Reporting.Result,

115 Reporting.Result,

114 Reporting.Warning,

116 Reporting.Warning,

src/Elm/Compiler.hs+27−25

@@ -3,7 +3,7 @@ module Elm.Compiler

3 ( version

4 , parseDependencies

5 , compile, Context(..), Result(..)

6− , Dealiaser, dummyDealiaser

6+ , Localizer, dummyLocalizer

7 , Error, errorToString, errorToJson, printError

8 , Warning, warningToString, warningToJson, printWarning

9 )

@@ -11,6 +11,7 @@ module Elm.Compiler

12import qualified Data.Aeson as Json

13import qualified Data.Map as Map

14+import System.IO (Handle)

15import qualified AST.Module as Module

16import qualified AST.Module as Module

16import qualified AST.Module.Name as ModuleName

17import qualified AST.Module.Name as ModuleName

@@ -26,6 +27,7 @@ import qualified Parse.Parse as Parse

26import qualified Reporting.Annotation as A

27import qualified Reporting.Annotation as A

27import qualified Reporting.Error as Error

28import qualified Reporting.Error as Error

28import qualified Reporting.Render.Type as RenderType

29import qualified Reporting.Render.Type as RenderType

30+import qualified Reporting.Report as Report

29import qualified Reporting.Result as Result

31import qualified Reporting.Result as Result

30import qualified Reporting.Warning as Warning

32import qualified Reporting.Warning as Warning

@@ -65,7 +67,7 @@ compile

65 :: Context

67 :: Context

66 -> String

68 -> String

67 -> PublicModule.Interfaces

69 -> PublicModule.Interfaces

68− -> (Dealiaser, [Warning], Either [Error] Result)

70+ -> (Localizer, [Warning], Either [Error] Result)

70compile context source interfaces =

72compile context source interfaces =

71 let

73 let

@@ -81,7 +83,7 @@ compile context source interfaces =

82 return (Result docs interface javascript)

84 return (Result docs interface javascript)

83 in

85 in

84− ( maybe dummyDealiaser Dealiaser localizer

86+ ( maybe dummyLocalizer Localizer localizer

85 , map Warning warnings

87 , map Warning warnings

86 , Result.destruct (Left . map Error) Right rawResult

88 , Result.destruct (Left . map Error) Right rawResult

87 )

89 )

@@ -125,13 +127,13 @@ docsGen isExposed modul =

125

127

126-- DEALIASER

128-- DEALIASER

127

129

128−newtype Dealiaser =

130+newtype Localizer =

129− Dealiaser RenderType.Localizer

131+ Localizer RenderType.Localizer

130

132

131

133

132−dummyDealiaser :: Dealiaser

134+dummyLocalizer :: Localizer

133−dummyDealiaser =

135+dummyLocalizer =

134− Dealiaser Map.empty

136+ Localizer Map.empty

135

137

136

138

137-- ERRORS

139-- ERRORS

@@ -140,18 +142,18 @@ newtype Error =

140 Error (A.Located Error.Error)

142 Error (A.Located Error.Error)

141

143

142

144

143−errorToString :: Dealiaser -> String -> String -> Error -> String

145+errorToString :: Localizer -> String -> String -> Error -> String

144−errorToString (Dealiaser localizer) location source (Error err) =

146+errorToString (Localizer localizer) location source (Error (A.A region err)) =

145− Error.toString localizer location source err

147+ Report.toString location region (Error.toReport localizer err) source

146

148

147

149

148−printError :: Dealiaser -> String -> String -> Error -> IO ()

150+printError :: Handle -> Localizer -> String -> String -> Error -> IO ()

149−printError (Dealiaser localizer) location source (Error err) =

151+printError handle (Localizer localizer) location source (Error (A.A region err)) =

150− Error.print localizer location source err

152+ Report.toHandle handle location region (Error.toReport localizer err) source

151

153

152

154

153−errorToJson :: Dealiaser -> String -> Error -> Json.Value

155+errorToJson :: Localizer -> String -> Error -> Json.Value

154−errorToJson (Dealiaser localizer) location (Error err) =

156+errorToJson (Localizer localizer) location (Error err) =

155 Error.toJson localizer location err

157 Error.toJson localizer location err

156

158

157

159

@@ -161,18 +163,18 @@ newtype Warning =

161 Warning (A.Located Warning.Warning)

163 Warning (A.Located Warning.Warning)

162

164

163

165

164−warningToString :: Dealiaser -> String -> String -> Warning -> String

166+warningToString :: Localizer -> String -> String -> Warning -> String

165−warningToString (Dealiaser localizer) location source (Warning err) =

167+warningToString (Localizer localizer) location source (Warning (A.A region wrn)) =

166− Warning.toString localizer location source err

168+ Report.toString location region (Warning.toReport localizer wrn) source

167

169

168

170

169−printWarning :: Dealiaser -> String -> String -> Warning -> IO ()

171+printWarning :: Handle -> Localizer -> String -> String -> Warning -> IO ()

170−printWarning (Dealiaser localizer) location source (Warning err) =

172+printWarning handle (Localizer localizer) location source (Warning (A.A region wrn)) =

171− Warning.print localizer location source err

173+ Report.toHandle handle location region (Warning.toReport localizer wrn) source

172

174

173

175

174−warningToJson :: Dealiaser -> String -> Warning -> Json.Value

176+warningToJson :: Localizer -> String -> Warning -> Json.Value

175−warningToJson (Dealiaser localizer) location (Warning err) =

177+warningToJson (Localizer localizer) location (Warning wrn) =

176− Warning.toJson localizer location err

178+ Warning.toJson localizer location wrn

177

179

178

180

src/Generate/JavaScript/Port.hs+2−2

@@ -97,14 +97,14 @@ inbound name portType =

97 T.Normal tipe ->

98 _Port "inbound" `call`

99 [ StringLit () name

100− , StringLit () (RenderType.tipe Map.empty tipe)

100+ , StringLit () (show (RenderType.toDoc Map.empty tipe))

101 , toTypeFunction tipe

102 ]

103

104 T.Signal _root arg ->

105 _Port "inboundSignal" `call`

106 [ StringLit () name

107− , StringLit () (RenderType.tipe Map.empty arg)

107+ , StringLit () (show (RenderType.toDoc Map.empty arg))

108 , toTypeFunction arg

109 ]

110

src/Reporting/Error.hs+5−12

@@ -4,7 +4,6 @@ module Reporting.Error where

5import Data.Aeson ((.=))

6import qualified Data.Aeson as Json

7−import Prelude hiding (print)

9import qualified Reporting.Annotation as A

8import qualified Reporting.Annotation as A

10import qualified Reporting.Error.Canonicalize as Canonicalize

9import qualified Reporting.Error.Canonicalize as Canonicalize

@@ -16,8 +15,10 @@ import qualified Reporting.Render.Type as RenderType

16import qualified Reporting.Report as Report

15import qualified Reporting.Report as Report

18+

19-- ALL POSSIBLE ERRORS

21+

21data Error

22data Error

22 = Syntax Syntax.Error

23 = Syntax Syntax.Error

23 | Canonicalize Canonicalize.Error

24 | Canonicalize Canonicalize.Error

@@ -26,8 +27,10 @@ data Error

26 | Docs Docs.Error

27 | Docs Docs.Error

30+

29-- TO REPORT

31-- TO REPORT

33+

31toReport :: RenderType.Localizer -> Error -> Report.Report

34toReport :: RenderType.Localizer -> Error -> Report.Report

32toReport localizer err =

35toReport localizer err =

33 case err of

36 case err of

@@ -47,20 +50,10 @@ toReport localizer err =

47 Docs.toReport docsError

50 Docs.toReport docsError

50−-- TO STRING

51−

52−toString :: RenderType.Localizer -> String -> String -> A.Located Error -> String

53−toString localizer location source (A.A region err) =

54− Report.toString location region (toReport localizer err) source

55−

56−

57−print :: RenderType.Localizer -> String -> String -> A.Located Error -> IO ()

58−print localizer location source (A.A region err) =

59− Report.printError location region (toReport localizer err) source

60−

62-- TO JSON

54-- TO JSON

56+

64toJson :: RenderType.Localizer -> FilePath -> A.Located Error -> Json.Value

57toJson :: RenderType.Localizer -> FilePath -> A.Located Error -> Json.Value

65toJson localizer filePath (A.A region err) =

58toJson localizer filePath (A.A region err) =

66 let

59 let

src/Reporting/Error/Canonicalize.hs+87−40

@@ -1,9 +1,13 @@

1{-# OPTIONS_GHC -Wall #-}

2module Reporting.Error.Canonicalize where

4+import Control.Arrow (second)

5+import Text.PrettyPrint.ANSI.Leijen (indent, text)

4import qualified AST.Module.Name as ModuleName

7import qualified AST.Module.Name as ModuleName

5import qualified AST.Type as Type

8import qualified AST.Type as Type

6import qualified AST.Variable as Var

9import qualified AST.Variable as Var

10+import qualified Reporting.Annotation as A

7import qualified Reporting.Error.Helpers as Help

11import qualified Reporting.Error.Helpers as Help

8import qualified Reporting.Region as Region

12import qualified Reporting.Region as Region

9import qualified Reporting.Render.Type as RenderType

13import qualified Reporting.Render.Type as RenderType

@@ -20,8 +24,10 @@ data Error

20 | Port PortError

24 | Port PortError

27+

23-- VARIABLES

28-- VARIABLES

30+

25data VarError = VarError

31data VarError = VarError

26 { varKind :: String

32 { varKind :: String

27 , varName :: String

33 , varName :: String

@@ -42,8 +48,10 @@ variable kind name problem suggestions =

42 Var (VarError kind name problem suggestions)

48 Var (VarError kind name problem suggestions)

51+

45-- PATTERN

52-- PATTERN

54+

47data PatternError

55data PatternError

48 = PatternArgMismatch Var.Canonical Int Int

56 = PatternArgMismatch Var.Canonical Int Int

@@ -53,8 +61,10 @@ argMismatch name expected actual =

53 Pattern (PatternArgMismatch name expected actual)

61 Pattern (PatternArgMismatch name expected actual)

64+

56-- IMPORTS

65-- IMPORTS

67+

58data ImportError

68data ImportError

59 = ModuleNotFound [ModuleName.Raw]

69 = ModuleNotFound [ModuleName.Raw]

60 | ValueNotFound String [String]

70 | ValueNotFound String [String]

@@ -70,8 +80,10 @@ valueNotFound name value possibilities =

70 Import name (ValueNotFound value possibilities)

80 Import name (ValueNotFound value possibilities)

83+

73-- ALIASES

84-- ALIASES

86+

75data AliasError

87data AliasError

76 = ArgMismatch Var.Canonical Int Int

88 = ArgMismatch Var.Canonical Int Int

77 | SelfRecursive String [String] Type.Raw

89 | SelfRecursive String [String] Type.Raw

@@ -83,8 +95,10 @@ alias name expected actual =

83 Alias (ArgMismatch name expected actual)

95 Alias (ArgMismatch name expected actual)

98+

86-- PORTS

99-- PORTS

100

101+

88data PortError = PortError

102data PortError = PortError

89 { portName :: String

103 { portName :: String

90 , portIsInbound :: Bool

104 , portIsInbound :: Bool

@@ -105,11 +119,13 @@ port name isInbound rootType localType maybeMessage =

105 Port (PortError name isInbound rootType localType maybeMessage)

119 Port (PortError name isInbound rootType localType maybeMessage)

106

120

107

121

122+

108-- TO REPORT

123-- TO REPORT

109

124

125+

110namingError :: String -> String -> Report.Report

126namingError :: String -> String -> Report.Report

111namingError pre post =

127namingError pre post =

112− Report.simple "NAMING ERROR" pre post

128+ Report.report "NAMING ERROR" Nothing pre (text post)

113

129

114

130

115toReport :: RenderType.Localizer -> Error -> Report.Report

131toReport :: RenderType.Localizer -> Error -> Report.Report

@@ -154,25 +170,37 @@ toReport localizer err =

154 argMismatchReport "Type" var expected actual

170 argMismatchReport "Type" var expected actual

155

171

156 SelfRecursive name tvars tipe ->

172 SelfRecursive name tvars tipe ->

173+ Report.report

174+ "ALIAS PROBLEM"

175+ Nothing

157− Report.simple "ALIAS PROBLEM" "This type alias is recursive, forming an infinite type!" $

176+ "This type alias is recursive, forming an infinite type!"

158− "Type aliases are just names for more fundamental types, so I go through\n"

177+ (

159− ++ "and expand them all to know the real underlying type. The problem is that\n"

178+ Help.stack

179+ [ text $

160− ++ "when I expand a recursive type alias, it keeps getting bigger and bigger.\n"

180+ "When I expand a recursive type alias, it just keeps getting bigger and bigger.\n"

161− ++ "Dealiasing results in an infinitely large type! Try this instead:\n\n"

181+ ++ "So dealiasing results in an infinitely large type! Try this instead:"

182+ , indent 4 $

162− ++ error "TODO RenderType.typeDecl localizer name tvars tipe"

183+ RenderType.decl localizer name tvars [(name, [unsafePromote tipe])]

184+ , text $

163− ++ "\n\nThis creates a brand new type that cannot be expanded. It is similar types\n"

185+ "This creates a brand new type that cannot be expanded. Read more about this at:\n"

164− ++ "like List which are recursive, but do not get expanded into infinite types."

186+ ++ Help.hintLink "infinite-alias"

187+ ]

188+ )

165

189

166 MutuallyRecursive aliases ->

190 MutuallyRecursive aliases ->

191+ Report.report

192+ "ALIAS PROBLEM"

193+ Nothing

167− Report.simple "ALIAS PROBLEM" "This type alias is part of a mutually recursive set of type aliases." $

194+ "This type alias is part of a mutually recursive set of type aliases."

195+ ( Help.stack

168− "The following type aliases all depend on each other in some way:\n"

196+ [ text "The following type aliases are mutually recursive:"

169− ++ concatMap showName aliases ++ "\n\n"

197+ , error "TODO visual loop" aliases

170− ++ "The problem is that when you try to expand any of these type aliases, they\n"

198+ , text $

171− ++ "expand infinitely! To fix, first try to centralize them into one alias."

199+ "You need to convert at least one `type alias` into a `type`. This is a kind of\n"

172− where

200+ ++ "subtle distinction, so definitely read more about it here:\n"

173− showName (Region.Region start _, name, _, _) =

201+ ++ Help.hintLink "infinite-alias"

174− "\n " ++ name ++ replicate (65 - length name) ' '

202+ ]

175− ++ "line " ++ show (Region.line start)

203+ )

176

204

177 Import name importError ->

205 Import name importError ->

178 let moduleName = ModuleName.toString name

206 let moduleName = ModuleName.toString name

@@ -202,35 +230,34 @@ toReport localizer err =

202 let

230 let

203 boundPort =

231 boundPort =

204 if isInbound then "inbound port" else "outbound port"

232 if isInbound then "inbound port" else "outbound port"

205−

206− preHint =

207− "Trying to send " ++ maybe "an unsupported type" id maybeMessage

208− ++ " through " ++ boundPort ++ " `" ++ name ++ "`"

209−

210− postHint =

211− "The specific unsupported type is:\n"

212− ++ "\n"

213− ++ error "TODO P.render (P.nest 4 (RenderType.doc localizer localType))" ++ "\n"

214− ++ "\n"

215− ++ "The types of values that can flow through " ++ boundPort ++ "s include:\n"

216− ++ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples,\n"

217− ++ "Json.Values, and concrete records."

218 in

233 in

234+ Report.report

219− Report.simple "PORT ERROR" preHint postHint

235+ "PORT ERROR"

236+ Nothing

237+ ("Trying to send " ++ maybe "an unsupported type" id maybeMessage

238+ ++ " through " ++ boundPort ++ " `" ++ name ++ "`"

239+ )

240+ ( Help.stack

241+ [ text "The specific unsupported type is:"

242+ , indent 4 (RenderType.toDoc localizer localType)

243+ , text ("The types of values that can flow through " ++ boundPort ++ "s include:")

244+ , indent 4 $ Help.reflowParagraph $

245+ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\

246+ \ Tuples, Json.Values, and concrete records."

247+ ]

248+ )

220

249

221

250

222argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report

251argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report

223argMismatchReport kind var expected actual =

252argMismatchReport kind var expected actual =

224− let

253+ Report.report

225− preHint =

254+ "ARGUMENT"

255+ Nothing

226− kind ++ " " ++ Var.toString var ++ " has too "

256+ ( kind ++ " " ++ Var.toString var ++ " has too "

227 ++ (if actual < expected then "few" else "many")

257 ++ (if actual < expected then "few" else "many")

228 ++ " arguments."

258 ++ " arguments."

229−

259+ )

230− postHint =

231− "Expecting " ++ show expected ++ ", but got " ++ show actual ++ "."

260+ (text ("Expecting " ++ show expected ++ ", but got " ++ show actual ++ "."))

232− in

233− Report.simple "ARGUMENT" preHint postHint

234

261

235

262

236extractSuggestions :: Error -> Maybe [String]

263extractSuggestions :: Error -> Maybe [String]

@@ -261,3 +288,23 @@ extractSuggestions err =

261

288

262 Port _ ->

289 Port _ ->

263 Nothing

290 Nothing

291+

292+

293+unsafePromote :: Type.Raw -> Type.Canonical

294+unsafePromote (A.A _ rawType) =

295+ case rawType of

296+ Type.RLambda arg result ->

297+ Type.Lambda (unsafePromote arg) (unsafePromote result)

298+

299+ Type.RVar x ->

300+ Type.Var x

301+

302+ Type.RType (Var.Raw name) ->

303+ Type.Type (Var.local name)

304+

305+ Type.RApp func args ->

306+ Type.App (unsafePromote func) (map unsafePromote args)

307+

308+ Type.RRecord fields ext ->

309+ Type.Record (map (second unsafePromote) fields) (fmap unsafePromote ext)

310+

src/Reporting/Error/Docs.hs+32−19

@@ -1,10 +1,13 @@

1{-# OPTIONS_GHC -Wall #-}

2module Reporting.Error.Docs where

4+import Text.PrettyPrint.ANSI.Leijen (text)

4import qualified Reporting.Error.Helpers as Help

6import qualified Reporting.Error.Helpers as Help

5import qualified Reporting.Report as Report

7import qualified Reporting.Report as Report

10+

8data Error

11data Error

9 = NoDocs

12 = NoDocs

10 | OnlyInDocs String [String]

13 | OnlyInDocs String [String]

@@ -13,49 +16,59 @@ data Error

13 | NoType String

16 | NoType String

19+

16-- TO REPORT

20-- TO REPORT

22+

18toReport :: Error -> Report.Report

23toReport :: Error -> Report.Report

19toReport err =

24toReport err =

20 case err of

25 case err of

21 NoDocs ->

26 NoDocs ->

27+ Report.report

22− Report.simple "DOCUMENTATION ERROR"

28+ "DOCUMENTATION ERROR"

29+ Nothing

23 ( "You must have a documentation comment between the module declaration and the\n"

30 ( "You must have a documentation comment between the module declaration and the\n"

24 ++ "imports."

31 ++ "imports."

25 )

32 )

26− "Learn how at <http://package.elm-lang.org/help/documentation-format>"

33+ ( text "Learn more at <http://package.elm-lang.org/help/documentation-format>"

34+ )

28 OnlyInDocs name suggestions ->

36 OnlyInDocs name suggestions ->

37+ Report.report

29− Report.simple "DOCUMENTATION ERROR"

38+ "DOCUMENTATION ERROR"

39+ Nothing

30 ("Your module documentation includes `" ++ name ++ "` which is not exported.")

40 ("Your module documentation includes `" ++ name ++ "` which is not exported.")

41+ ( text $

31− ("Is it misspelled? Should it be exported? " ++ Help.maybeYouWant suggestions)

42+ "Is it misspelled? Should it be exported? "

43+ ++ Help.maybeYouWant suggestions

44+ )

33 OnlyInExports names ->

46 OnlyInExports names ->

34− Report.simple

47+ Report.report

35 "DOCUMENTATION ERROR"

48 "DOCUMENTATION ERROR"

49+ Nothing

36 ( "The following exports do not appear in your module documentation:\n"

50 ( "The following exports do not appear in your module documentation:\n"

37 ++ concatMap ("\n " ++) names

51 ++ concatMap ("\n " ++) names

38 )

52 )

53+ ( text $

39− ( "All exports must be listed in the module documentation after a @docs keyword.\n"

54+ "All exports must be listed in the module documentation after a @docs keyword.\n"

40− ++ "Learn how at <http://package.elm-lang.org/help/documentation-format>"

55+ ++ "Learn more at <http://package.elm-lang.org/help/documentation-format>"

41 )

56 )

43 NoComment name ->

58 NoComment name ->

59+ Report.report

44− Report.simple "DOCUMENTATION ERROR"

60+ "DOCUMENTATION ERROR"

61+ Nothing

45 ("The value `" ++ name ++ "` does not have a documentation comment.")

62 ("The value `" ++ name ++ "` does not have a documentation comment.")

46− ( "Documentation comments start with {-| and end with -}. They should provide a\n"

47− ++ "clear description of how they work, and ideally a small code example. This is\n"

48− ++ "extremely valuable for users checking out your package!\n\n"

49− ++ "If you think the docs are clearer without any words, you can use an empty\n"

50− ++ "comment {-|-} which should be used sparingly. Maybe you have a section of 20\n"

51− ++ "values all with the exact same type. The docs may read better if they are all\n"

52− ++ "described in one place.\n\n"

53− ++ "Learn more at <http://package.elm-lang.org/help/documentation-format>"

63+ ( text "Learn more at <http://package.elm-lang.org/help/documentation-format>"

54 )

64 )

56 NoType name ->

66 NoType name ->

67+ Report.report

57− Report.simple "MISSING ANNOTATION"

68+ "MISSING ANNOTATION"

69+ Nothing

58 ("The value `" ++ name ++ "` does not have a type annotation.")

70 ("The value `" ++ name ++ "` does not have a type annotation.")

71+ ( text $

59− ( "Adding type annotations is best practice and it gives you a chance to name\n"

72+ "Adding type annotations is best practice and it gives you a chance to name\n"

60− ++ "types and type variables so they are as easy as possible to understand!"

73+ ++ "types and type variables so they are as easy as possible to understand!"

61 )

74 )

src/Reporting/Error/Helpers.hs+101−2

@@ -1,15 +1,114 @@

1{-# OPTIONS_GHC -Wall #-}

2−module Reporting.Error.Helpers where

2+module Reporting.Error.Helpers

3+ ( (|>)

4+ , functionName, hintLink, stack, reflowParagraph

5+ , commaSep, capitalize, ordinalize

6+ , nearbyNames, distance, maybeYouWant

7+ )

8+ where

4import Data.Function (on)

10import Data.Function (on)

11+import qualified Data.Char as Char

5import qualified Data.List as List

12import qualified Data.List as List

6import qualified Text.EditDistance as Dist

13import qualified Text.EditDistance as Dist

14+import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), fillSep, hardline, text)

15+

16+import qualified AST.Helpers as Help

17+import qualified Elm.Compiler.Version as Compiler

18+import qualified Elm.Package as Pkg

19+

20+

21+

22+-- PIPES

23+

24+

25+(|>) :: a -> (a -> b) -> b

26+(|>) x f =

27+ f x

28+

29+

30+infixl 0 |>

31+

32+

33+

34+-- DOC HELPERS

35+

36+

37+functionName :: String -> String

38+functionName opName =

39+ if Help.isOp opName then

40+ "(" ++ opName ++ ")"

41+

42+ else

43+ "`" ++ opName ++ "`"

44+

45+

46+hintLink :: String -> String

47+hintLink fileName =

48+ "<https://github.com/elm-lang/elm-compiler/blob/"

49+ ++ Pkg.versionToString Compiler.version

50+ ++ "/hints/" ++ fileName ++ ".md>"

51+

52+

53+stack :: [Doc] -> Doc

54+stack list =

55+ case list of

56+ [] ->

57+ error "function `stack` requires a non-empty list of docs"

58+

59+ doc : docs ->

60+ List.foldl' (\a b -> a <> hardline <> hardline <> b) doc docs

61+

62+

63+reflowParagraph :: String -> Doc

64+reflowParagraph paragraph =

65+ fillSep (map text (words paragraph))

66+

67+

68+commaSep :: [String] -> String

69+commaSep tokens =

70+ case tokens of

71+ [token] ->

72+ " " ++ token

73+

74+ [token1,token2] ->

75+ " " ++ token1 ++ " and " ++ token2

76+

77+ _ ->

78+ " " ++ List.intercalate ", " (init tokens) ++ ", and " ++ last tokens

79+

80+

81+capitalize :: String -> String

82+capitalize string =

83+ case string of

84+ [] -> []

85+ c : cs ->

86+ Char.toUpper c : cs

87+

88+

89+ordinalize :: Int -> String

90+ordinalize number =

91+ let

92+ remainder10 =

93+ number `mod` 10

94+

95+ remainder100 =

96+ number `mod` 100

97+

98+ ending

99+ | remainder100 `elem` [11..13] = "th"

100+ | remainder10 == 1 = "st"

101+ | remainder10 == 2 = "nd"

102+ | remainder10 == 3 = "rd"

103+ | otherwise = "th"

104+ in

105+ show number ++ ending

106

8−import Elm.Utils ((|>))

107

108

11-- NEARBY NAMES

109-- NEARBY NAMES

110

111+

13nearbyNames :: (a -> String) -> a -> [a] -> [a]

112nearbyNames :: (a -> String) -> a -> [a] -> [a]

14nearbyNames format name names =

113nearbyNames format name names =

15 let editDistance =

114 let editDistance =

src/Reporting/Error/Pattern.hs+42−85

@@ -1,13 +1,15 @@

1{-# OPTIONS_GHC -Wall #-}

2module Reporting.Error.Pattern where

4−import qualified AST.Module.Name as ModuleName

4+import Text.PrettyPrint.ANSI.Leijen (text)

5−import qualified AST.Variable as Var

6import qualified Nitpick.Pattern as Pattern

7+import qualified Reporting.Error.Helpers as Help

7import qualified Reporting.Render.Type as RenderType

8import qualified Reporting.Render.Type as RenderType

8import qualified Reporting.Report as Report

9import qualified Reporting.Report as Report

12+

11data Error

13data Error

12 = Incomplete Origin [Pattern.Pattern]

14 = Incomplete Origin [Pattern.Pattern]

13 | Redundant

15 | Redundant

@@ -19,113 +21,68 @@ data Origin

19 | Case

21 | Case

24+

22-- TO REPORT

25-- TO REPORT

27+

24toReport :: RenderType.Localizer -> Error -> Report.Report

28toReport :: RenderType.Localizer -> Error -> Report.Report

25toReport _localizer err =

29toReport _localizer err =

26 case err of

30 case err of

27 Incomplete Arg unhandled ->

31 Incomplete Arg unhandled ->

28− Report.simple

32+ Report.report

29 "PARTIAL PATTERN"

33 "PARTIAL PATTERN"

34+ Nothing

30− "This argument does not cover all possible inputs."

35+ "This pattern does not cover all possible inputs."

31− ( "Any of these patterns can cause a crash:\n"

36+ (text (unhandledError unhandled toCaseMessage))

32− ++ viewPatternList unhandled

33− ++ "\n\n"

34− ++ partialExplanation unhandled

35− )

37 Incomplete LetBound unhandled ->

38 Incomplete LetBound unhandled ->

38− Report.simple

39+ Report.report

39 "PARTIAL PATTERN"

40 "PARTIAL PATTERN"

41+ Nothing

40 "The pattern used here does not cover all possible values."

42 "The pattern used here does not cover all possible values."

41− ( "Any of these patterns can cause a crash:\n"

43+ (text (unhandledError unhandled toCaseMessage))

42− ++ viewPatternList unhandled

43− ++ "\n\n"

44− ++ partialExplanation unhandled

45− )

47 Incomplete Case unhandled ->

45 Incomplete Case unhandled ->

48− Report.simple

46+ Report.report

49− "INCOMPLETE PATTERN MATCH"

47+ "MISSING PATTERNS"

48+ Nothing

50 "This `case` does not have branches for all possibilities."

49 "This `case` does not have branches for all possibilities."

51− ( "Any of these patterns can cause a crash:\n"

50+ (text (unhandledError unhandled newTagsMessage))

52− ++ viewPatternList unhandled

53− ++ "\n\n"

54− ++ incompleteExplanation

55− )

57 Redundant ->

52 Redundant ->

58− Report.simple

53+ Report.report

59 "REDUNDANT PATTERN"

54 "REDUNDANT PATTERN"

55+ Nothing

60− "The following pattern is redundant."

56+ "The following pattern is redundant. Remove it."

61− "Any value with this shape will be handled by a previous pattern."

57+ (text "Any value with this shape will be handled by a previous pattern.")

64−viewPatternList :: [Pattern.Pattern] -> String

60+unhandledError :: [Pattern.Pattern] -> String -> String

65−viewPatternList unhandledPatterns =

61+unhandledError unhandledPatterns relevantMessage =

66 let

62 let

67− (showPatterns, rest) =

63+ (visiblePatterns, rest) =

68 splitAt 4 unhandledPatterns

64 splitAt 4 unhandledPatterns

69− in

70− concatMap ((++) "\n ") $

71− map (Pattern.toString False) showPatterns

72− ++ if null rest then [] else ["..."]

73−

74−

75−partialExplanation :: [Pattern.Pattern] -> String

76−partialExplanation unhandledPatterns =

77−

78− "You probably want to switch to a `case` expression to handle all possible\n"

79− ++ "patterns in a simple way. If you think some cases are impossible, you can use\n"

80− ++ "`Debug.crash` to make that thinking explicit in your code.\n"

81− ++ "<http://package.elm-lang.org/packages/elm-lang/core/latest/Debug#crash>"

82− ++

83−

84− if isNothing unhandledPatterns then

85−

86− "\n\nSometimes you *know* a value will never be Nothing, though such cases are very\n"

87− ++ "rare. If you are certain you are in that case and that there is no better way\n"

88− ++ "to do things, I'd recommend creating a function `unsafe` that makes the danger\n"

89− ++ "explicit in the code. <https://github.com/elm-lang/core/issues/215>"

90−

91− else if isEmptyList unhandledPatterns then

92−

93− "\n\nSometimes you *know* a list cannot be empty, though such cases are relatively\n"

94− ++ "rare. If you are certain you are in that case and that there is no better\n"

95− ++ "way to do things, I'd recommend creating a function like `unsafe` that makes\n"

96− ++ "the danger explicit in the code. <https://github.com/elm-lang/core/issues/215>"

97−

98− else

99−

100− ""

101−

102−

103−isNothing :: [Pattern.Pattern] -> Bool

104−isNothing unhandledPatterns =

105− case unhandledPatterns of

106− [Pattern.Data (Var.Canonical (Var.Module moduleName) "Nothing") []] ->

107− moduleName == ModuleName.inCore ["Maybe"]

108−

109− _ ->

110− False

111

66+ patternList =

67+ map (Pattern.toString False) visiblePatterns

68+ ++ if null rest then [] else ["..."]

69+ in

70+ "You need to account for the following values:\n"

71+ ++ concatMap ("\n " ++) patternList ++ "\n"

72+ ++ "\n"

73+ ++ relevantMessage ++ "\n"

74+ ++ "\n"

75+ ++ "If you are seeing this error for the first time, check out these hints:\n"

76+ ++ Help.hintLink "missing-patterns" ++ "\n"

77+ ++ "The recommendations about `Debug.crash` and wildcard patterns are important!"

112

113−isEmptyList :: [Pattern.Pattern] -> Bool

114−isEmptyList unhandledPatterns =

115− case unhandledPatterns of

116− [Pattern.Data (Var.Canonical Var.BuiltIn "[]") []] ->

117− True

118

119− _ ->

80+toCaseMessage :: String

120− False

81+toCaseMessage =

82+ "Switch to a `case` expression to handle all possible patterns."

121

122

123−incompleteExplanation :: String

85+newTagsMessage :: String

124−incompleteExplanation =

86+newTagsMessage =

125− "Did you add a new tag to a union type? Add how it should be handled here and\n"

87+ "Did you add a new tag to a union type? Add a branch for it here!"

126− ++ "you will be all set!\n"

127− ++ "\n"

128− ++ "If you want to go quick and implement this later, you may want to look into\n"

129− ++ "using `Debug.crash` which has some cool error reporting abilities.\n"

130− ++ "<http://package.elm-lang.org/packages/elm-lang/core/latest/Debug#crash>"

131

src/Reporting/Error/Syntax.hs+125−83

@@ -4,9 +4,9 @@ module Reporting.Error.Syntax where

4import qualified Data.List as List

5import qualified Data.Set as Set

6import qualified Text.Parsec.Error as Parsec

7+import Text.PrettyPrint.ANSI.Leijen (dullyellow, hsep, text)

8−import qualified AST.Helpers as Help

9+import qualified Reporting.Error.Helpers as Help

9−import qualified AST.Type as Type

10import qualified Reporting.Render.Type as RenderType

11import qualified Reporting.Report as Report

@@ -23,160 +23,189 @@ data Error

23 | DuplicateValueDeclaration String

24 | DuplicateTypeDeclaration String

25 | DuplicateDefinition String

26− | UnboundTypeVarsInAlias String [String] String [String] Type.Raw

26+ | UnboundTypeVarsInAlias String [String] String [String]

27− | UnboundTypeVarsInUnion String [String] String [String] [(String, [Type.Raw])]

27+ | UnboundTypeVarsInUnion String [String] String [String]

30-- TO REPORT

32toReport :: RenderType.Localizer -> Error -> Report.Report

33−toReport localizer err =

33+toReport _localizer err =

34 case err of

35 Parse messages ->

36 parseErrorReport messages

38 BadFunctionName arity ->

39− Report.simple

39+ Report.report

40 "BAD FUNCTION DEFINITION"

41+ Nothing

41 "Complex patterns cannot be used as function names."

42 "Complex patterns cannot be used as function names."

43+ ( Help.reflowParagraph $

42− ( "This function definition has " ++ show arity ++ " arguments, but instead of a normal name like\n"

44+ "This function definition has " ++ show arity ++ " arguments, but instead\

43− ++ "`add` or `reverse` it has a pattern. There is no way to \"deconstruct\" a\n"

45+ \ of a normal name like `add` or `reverse` it has a pattern. There is no\

44− ++ "function with pattern matching, so this needs to be changed to a normal name."

46+ \ way to \"deconstruct\" a function with pattern matching, so this needs to\

47+ \ be changed to a normal name."

45 )

48 )

47 BadPattern name ->

50 BadPattern name ->

48− Report.simple

51+ Report.report

49 "BAD PATTERN"

52 "BAD PATTERN"

53+ Nothing

50 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")

54 ("The free variable `" ++ name ++ "` appears more than once in this pattern.")

55+ ( Help.stack

51− ( "Rename the variables so there are no duplicates.\n\n"

56+ [ text "Rename the variables so there are no duplicates."

57+ , Help.reflowParagraph $

52− ++ "In Elm, pattern matching works by binding these free variables to subsections\n"

58+ "In Elm, pattern matching works by binding these free variables to subsections\

53− ++ "of the matching value. It does not make sense to have the same name for two\n"

59+ \ of the matching value. It does not make sense to have the same name for two\

54− ++ "different subsections though! When you say `" ++ name ++ "` in some code, there\n"

60+ \ different subsections though! When you say `" ++ name ++ "` in some code, there\

55− ++ "is no way for me to know which subsection you mean!"

61+ \ is no way for me to know which subsection you mean!"

62+ ]

56 )

63 )

58 InfixDuplicate opName ->

65 InfixDuplicate opName ->

59− Report.simple

66+ Report.report

60 "INFIX OVERLAP"

67 "INFIX OVERLAP"

68+ Nothing

61− ("The infix declarations for " ++ operator ++ " must be removed.")

69+ ("The infix declarations for " ++ Help.functionName opName ++ " must be removed.")

70+ ( Help.reflowParagraph $

62− ("The precedence and associativity can only be set in one place, and\n"

71+ "The precedence and associativity of a particular operator can only be set in\

72+ \ one place in a code base, and " ++ Help.functionName opName

63− ++ "this information has already been set somewhere else."

73+ ++ " has already been set somewhere else."

64 )

74 )

65− where

66− operator =

67− if Help.isOp opName

68− then "(" ++ opName ++ ")"

69− else "`" ++ opName ++ "`"

71 TypeWithoutDefinition valueName ->

76 TypeWithoutDefinition valueName ->

72− Report.simple

77+ Report.report

73 "MISSING DEFINITION"

78 "MISSING DEFINITION"

79+ Nothing

74 ("There is a type annotation for `" ++ valueName ++ "` but there"

80 ("There is a type annotation for `" ++ valueName ++ "` but there"

75 ++ " is no corresponding definition!"

81 ++ " is no corresponding definition!"

76 )

82 )

83+ ( text $

77− ("Directly below the type annotation, put a definition like:\n\n"

84+ "Directly below the type annotation, put a definition like:\n\n"

78− ++ " " ++ valueName ++ " = 42"

85+ ++ " " ++ valueName ++ " = 42"

79 )

86 )

81 PortWithoutAnnotation portName ->

88 PortWithoutAnnotation portName ->

82− Report.simple

89+ Report.report

83 "PORT ERROR"

90 "PORT ERROR"

91+ Nothing

84 ("Port `" ++ portName ++ "` does not have a type annotation!")

92 ("Port `" ++ portName ++ "` does not have a type annotation!")

93+ ( text $

85− ("Directly above the port definition, I need something like this:\n\n"

94+ "Directly above the port definition, I need something like this:\n\n"

86− ++ " port " ++ portName ++ " : Signal Int"

95+ ++ " port " ++ portName ++ " : Signal Int"

87 )

96 )

90 UnexpectedPort ->

99 UnexpectedPort ->

91− Report.simple

100+ Report.report

92 "PORT ERROR"

101 "PORT ERROR"

102+ Nothing

93 "This module has ports, but ports can only appear in the main module."

103 "This module has ports, but ports can only appear in the main module."

104+ ( Help.reflowParagraph $

94− ( "Ports in library code would create hidden dependencies where importing a\n"

105+ "Ports in library code would create hidden dependencies where importing a\

95− ++ "module could bring in constraints not captured in the public API. Furthermore,\n"

106+ \ module could bring in constraints not captured in the public API. Furthermore,\

96− ++ "if the module is imported twice, do we send values out the port twice?"

107+ \ if the module is imported twice, do we send values out the port twice?"

97 )

108 )

109

99 DuplicateFieldName name ->

110 DuplicateFieldName name ->

100− Report.simple

111+ Report.report

101 "DUPLICATE FIELD"

112 "DUPLICATE FIELD"

113+ Nothing

102 ("This record has more than one field named `" ++ name ++ "`.")

114 ("This record has more than one field named `" ++ name ++ "`.")

103− "There can only be one. Do some renaming to make sure the names are distinct!"

115+ (text "There can only be one. Do some renaming to make sure the names are distinct!")

104

116

105 DuplicateValueDeclaration name ->

117 DuplicateValueDeclaration name ->

106− Report.simple

118+ Report.report

107 "DUPLICATE DEFINITION"

119 "DUPLICATE DEFINITION"

120+ Nothing

108− ("Naming multiple top-level values `" ++ name ++ "` makes things\n"

121+ ( "Naming multiple top-level values `" ++ name ++ "` makes things\n"

109 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"

122 ++ "ambiguous. When you say `" ++ name ++ "` which one do you want?"

110 )

123 )

124+ ( Help.reflowParagraph $

111− ("Find all the top-level values named `" ++ name ++ "` and\n"

125+ "Find all the top-level values named " ++ Help.functionName name

112− ++ "do some renaming. Make sure the names are distinct!"

126+ ++ " and do some renaming. Make sure the names are distinct!"

113 )

127 )

114

128

115 DuplicateTypeDeclaration name ->

129 DuplicateTypeDeclaration name ->

116− Report.simple

130+ Report.report

117 "DUPLICATE DEFINITION"

131 "DUPLICATE DEFINITION"

118− ("Naming multiple types `" ++ name ++ "` makes things ambiguous\n"

132+ Nothing

119− ++ "When you say `" ++ name ++ "` which one do you want?"

133+ ( "There are multiple types named `" ++ name ++ "` in this module."

120 )

134 )

135+ ( Help.reflowParagraph $

121− ("Find all the types named `" ++ name ++ "` and\n"

136+ "Search through this module, find all the types named `" ++ name

122− ++ "do some renaming. Make sure the names are distinct!"

137+ ++ "`, and give each of them a unique name."

123 )

138 )

124

139

125 DuplicateDefinition name ->

140 DuplicateDefinition name ->

126− Report.simple

141+ Report.report

127 "DUPLICATE DEFINITION"

142 "DUPLICATE DEFINITION"

143+ Nothing

128− ("Naming multiple values `" ++ name ++ "` in a single let-expression makes\n"

144+ ("There are multiple values named `" ++ name ++ "` in this let-expression."

129− ++ "things ambiguous. When you say `" ++ name ++ "` which one do you want?"

130 )

145 )

131− ("Find all the values named `" ++ name ++ "` in this let-expression and\n"

146+ ( Help.reflowParagraph $

132− ++ "do some renaming. Make sure the names are distinct!"

147+ "Search through this let-expression, find all the values named `" ++ name

148+ ++ "`, and give each of them a unique name."

133 )

149 )

134

150

135− UnboundTypeVarsInAlias typeName givenVars tvar tvars tipe ->

151+ UnboundTypeVarsInAlias typeName givenVars tvar tvars ->

136− unboundTypeVars typeName tvar tvars $

137− RenderType.aliasDecl localizer typeName (givenVars ++ tvar : tvars) tipe

152+ unboundTypeVars "type alias" typeName givenVars tvar tvars

138

153

139− UnboundTypeVarsInUnion typeName givenVars tvar tvars ctors ->

154+ UnboundTypeVarsInUnion typeName givenVars tvar tvars ->

140− unboundTypeVars typeName tvar tvars $

141− RenderType.typeDecl localizer typeName (givenVars ++ tvar : tvars) ctors

155+ unboundTypeVars "type" typeName givenVars tvar tvars

142

156

143

157

158+

144−unboundTypeVars :: String -> String -> [String] -> String -> Report.Report

159+unboundTypeVars :: String -> String -> [String] -> String -> [String] -> Report.Report

145−unboundTypeVars typeName tvar tvars revisedDeclaration =

160+unboundTypeVars declKind typeName givenVars tvar tvars =

146− Report.simple

161+ Report.report

147− "UNBOUND TYPE VARS"

162+ "UNBOUND TYPE VARIABLES"

148− ( "Not all type variables in `" ++ typeName ++ "` are listed, making sneaky\n"

163+ Nothing

149− ++ "type errors possible. Unbound type variables include: "

164+ ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"

150− ++ List.intercalate ", " (tvar:tvars)

165+ ++ Help.commaSep (tvar:tvars)

151 )

166 )

152− ( "You probably want this definition instead:\n"

167+ ( Help.stack

153− ++ concatMap ("\n "++) (lines revisedDeclaration) ++ "\n\n"

168+ [ text "You probably need to change the declaration like this:"

169+ , hsep $

170+ map text (declKind : typeName : givenVars)

171+ ++ map (dullyellow . text) (tvar : tvars)

172+ ++ map text ["=", "…"]

173+ , Help.reflowParagraph $

154− ++ "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\n"

174+ "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\

155− ++ "another where it is a Bool. When we explicitly list the type variables, type\n"

175+ \ another where it is a Bool. When we explicitly list the type variables, type\

156− ++ "checker can see that they are actually different types."

176+ \ checker can see that they are actually different types."

177+ ]

157 )

178 )

158

179

159

180

181+

160-- TAGGING PARSE ERRORS

182-- TAGGING PARSE ERRORS

161

183

184+

162newline :: String

185newline :: String

163newline = "NEWLINE"

186newline = "NEWLINE"

164

187

188+

165freshLine :: String

189freshLine :: String

166freshLine = "FRESH_LINE"

190freshLine = "FRESH_LINE"

167

191

192+

168whitespace :: String

193whitespace :: String

169whitespace = "WHITESPACE"

194whitespace = "WHITESPACE"

170

195

196+

171keyword :: String -> String

197keyword :: String -> String

172keyword kwd =

198keyword kwd =

173 "KEYWORD=" ++ kwd

199 "KEYWORD=" ++ kwd

174

200

201+

175unkeyword :: String -> Maybe String

202unkeyword :: String -> Maybe String

176unkeyword message =

203unkeyword message =

177− if List.isPrefixOf "KEYWORD=" message

204+ if List.isPrefixOf "KEYWORD=" message then

178− then Just (drop (length "KEYWORD=") message)

205+ Just (drop (length "KEYWORD=") message)

206+

207+ else

179− else Nothing

208+ Nothing

180

209

181

210

182-- REPORTING PARSE ERRORS

211-- REPORTING PARSE ERRORS

@@ -195,9 +224,10 @@ parseErrorReport messages =

195 Parsec.Expect msg ->

224 Parsec.Expect msg ->

196 let

225 let

197 msg' =

226 msg' =

198− if msg `elem` [whitespace, newline, freshLine]

227+ if msg `elem` [whitespace, newline, freshLine] then

199− then "whitespace"

228+ "whitespace"

200− else msg

229+ else

230+ msg

201 in

231 in

202 hint { _expected = Set.insert msg' (_expected hint) }

232 hint { _expected = Set.insert msg' (_expected hint) }

203

233

@@ -207,26 +237,38 @@ parseErrorReport messages =

207 (ParseHint msgs expects) =

237 (ParseHint msgs expects) =

208 foldr addMsg emptyHint messages

238 foldr addMsg emptyHint messages

209

239

210− preHint =

240+ (preHint, maybePost) =

211 case msgs of

241 case msgs of

212 [msg] ->

242 [msg] ->

213 case unkeyword msg of

243 case unkeyword msg of

214 Just kwd ->

244 Just kwd ->

215− "It looks like the keyword `" ++ kwd ++ "` is being used as a variable.\n"

245+ ( "It looks like the keyword `" ++ kwd ++ "` is being used as a variable."

216− ++ "Try renaming it to something else."

246+ , Just "Rename it to something else."

247+ )

248+

217 Nothing ->

249 Nothing ->

218− msg

250+ ( msg

251+ , Nothing

252+ )

219

253

254+ _ ->

220− _ -> "I ran into something unexpected when parsing your code!"

255+ ( "I ran into something unexpected when parsing your code!"

256+ , Nothing

257+ )

221

258

222 postHint =

259 postHint =

223− if Set.null expects

260+ if Set.null expects then

224− then ""

261+ "Maybe <http://elm-lang.org/docs/syntax> can help you figure it out."

262+

225− else

263+ else

226 "I am looking for one of the following things:\n"

264 "I am looking for one of the following things:\n"

227 ++ concatMap ("\n "++) (Set.toList expects)

265 ++ concatMap ("\n "++) (Set.toList expects)

228 in

266 in

267+ Report.report

229− Report.simple "SYNTAX PROBLEM" preHint postHint

268+ "SYNTAX PROBLEM"

269+ Nothing

270+ preHint

271+ (text (maybe postHint id maybePost))

230

272

231

273

232data ParseHint = ParseHint

274data ParseHint = ParseHint

src/Reporting/Error/Type.hs+232−245

@@ -1,10 +1,9 @@

1{-# OPTIONS_GHC -Wall #-}

2module Reporting.Error.Type where

4−import qualified Data.Char as Char

4+import qualified Data.Maybe as Maybe

5−import qualified Data.List as List

5+import Text.PrettyPrint.ANSI.Leijen (Doc, (<+>), equals, indent, text)

7−import qualified AST.Helpers as AstHelp

8import qualified AST.Type as Type

7import qualified AST.Type as Type

9import qualified AST.Variable as Var

8import qualified AST.Variable as Var

10import qualified Reporting.Error.Helpers as Help

9import qualified Reporting.Error.Helpers as Help

@@ -85,62 +84,52 @@ toReport localizer err =

85 Mismatch info ->

84 Mismatch info ->

86 mismatchToReport localizer info

85 mismatchToReport localizer info

88− InfiniteType name var tipe ->

87+ InfiniteType name overallType infiniteType ->

89− let

88+ infiniteTypeToReport localizer name overallType infiniteType

90− prettyVar =

91− error "TODO P.pretty localizer False var"

93− prettyType =

90+ BadMain tipe ->

94− error "TODO P.pretty localizer False tipe"

91+ Report.report

95− in

92+ "BAD MAIN TYPE"

96− Report.simple "INFINITE TYPE"

93+ Nothing

97− ( "I am inferring weird self-referential type for `" ++ name ++ "`"

94+ "The 'main' value has an unsupported type."

98− )

95+ ( Help.stack

99− ( "TODO - do a better job\n\n"

96+ [ Help.reflowParagraph $

100− ++ "The bit of the type that is self-referential looks like this:\n\n"

97+ "I need an Element, Html, (Signal Element), or (Signal Html) so I can render it\

101− ++ error "TODO P.render (P.nest 4 (prettyVar <+> P.equals <+> prettyType))"

98+ \ on screen, but you gave me:"

102− ++ "\n\nThe cause is often that the usage of `" ++ name ++ "` is flipped around.\n\n"

99+ , indent 4 (RenderType.toDoc localizer tipe)

103− ++ "Maybe you are inserting a data structure into an element? Maybe you are giving\n"

100+ ]

104− ++ "a function to an argument? Either way, something is probably backwards!\n\n"

105− ++ "Try breaking the code related to `" ++ name ++ "` into smaller pieces.\n"

106− ++ "Give each piece a name and try to write down its type."

107 )

101 )

108

102

109− BadMain tipe ->

103+

110− Report.simple "BAD MAIN TYPE" "The 'main' value has an unsupported type." $

104+

111− "I need an Element, Html, (Signal Element), or (Signal Html) so I can render it\n"

105+-- TYPE MISMATCHES

112− ++ "on screen, but you gave me:\n\n"

113− ++ RenderType.tipe localizer tipe

114

106

115

107

116mismatchToReport :: RenderType.Localizer -> Mismatch -> Report.Report

108mismatchToReport :: RenderType.Localizer -> Mismatch -> Report.Report

117mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

109mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

118 let

110 let

119 report =

111 report =

120− Report.Report "TYPE MISMATCH"

112+ Report.report "TYPE MISMATCH"

113+

114+ reasonHints =

115+ Maybe.maybeToList (fmap reasonToString maybeReason)

121

116

122− pretty tipe =

117+ cmpHint leftWords rightWords extraHints =

123− "\n\n"

118+ comparisonHint localizer leftType rightType leftWords rightWords (extraHints ++ reasonHints)

124− ++ RenderType.tipe localizer tipe

125− ++ "\n\n"

126 in

119 in

127 case hint of

120 case hint of

128 CaseBranch branchNumber region ->

121 CaseBranch branchNumber region ->

129 report

122 report

130 (Just region)

123 (Just region)

131− ( "The " ++ ordinalize (branchNumber -1) ++ " and " ++ ordinalize branchNumber

124+ ( "The " ++ ordinalPair branchNumber

132− ++ " branches of this `case` result in different types of values."

125+ ++ " branches of this `case` produce different types of values."

133 )

126 )

127+ ( cmpHint

134− ( "The " ++ ordinalize (branchNumber -1) ++ " branch results in this type of value:\n"

128+ ("The " ++ Help.ordinalize (branchNumber -1) ++ " branch has this type:")

135−

136− ++ pretty leftType

137−

138− ++ "And the " ++ ordinalize branchNumber ++ " branch results in this type:\n"

129+ ("But the " ++ Help.ordinalize branchNumber ++ " is:")

139−

130+ [ "All branches in a `case` must have the same type. So no matter\

140− ++ pretty rightType

141−

142− ++ "These branches should match so that no matter which one we take, we always get\n"

143− ++ "back the same type of value."

131+ \ which one we take, we always get back the same type of value."

132+ ]

144 )

133 )

145

134

146 Case ->

135 Case ->

@@ -155,72 +144,62 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

155 IfCondition ->

144 IfCondition ->

156 report

145 report

157 Nothing

146 Nothing

158− ( "This condition does not evaluate to a boolean value, True or False."

147+ "This condition does not evaluate to a boolean value, True or False."

159− )

148+ ( cmpHint

160− ( "Instead of Bool, it is resulting in:\n"

149+ "You have given me an condition with this type:"

161−

150+ "But I need it to be:"

162− ++ pretty rightType

163−

164− ++ "Note: Elm does not have \"truthiness\" such that ints and strings and lists\n"

151+ [ "Elm does not have \"truthiness\" such that ints and strings and lists\

165− ++ "are automatically converted to booleans. Do that conversion explicitly."

152+ \ are automatically converted to booleans. Do that conversion explicitly."

153+ ]

166 )

154 )

167

155

168 IfBranches ->

156 IfBranches ->

169 report

157 report

170 Nothing

158 Nothing

171− ( "The branches of this `if` result in different types of values."

159+ "The branches of this `if` produce different types of values."

172− )

160+ ( cmpHint

173− ( "The `then` branch results in:\n"

161+ "The `then` branch has type:"

174−

175− ++ pretty leftType

176−

177− ++ "And the `else` branch results in:\n"

162+ "But the `else` branch is:"

178−

179− ++ pretty rightType

180−

181− ++ "These need to match so that no matter which one we take, we always get\n"

163+ [ "These need to match so that no matter which branch we take, we\

182− ++ "back the same type of value."

164+ \ always get back the same type of value."

165+ ]

183 )

166 )

184

167

185 MultiIfBranch branchNumber region ->

168 MultiIfBranch branchNumber region ->

186 report

169 report

187 (Just region)

170 (Just region)

188− ( "The " ++ ordinalize branchNumber ++ " branch of this `if` results in an unexpected type of value."

171+ ( "The " ++ ordinalPair branchNumber

172+ ++ " branches of this `if` produce different types of values."

189 )

173 )

174+ ( cmpHint

190− ( "The " ++ ordinalize (branchNumber - 1) ++ " branch results in:\n"

175+ ("The " ++ Help.ordinalize (branchNumber - 1) ++ " branch has this type:")

191−

192− ++ pretty leftType

193−

194− ++ "And the "++ ordinalize branchNumber ++ " branch results in:\n"

176+ ("But the "++ Help.ordinalize branchNumber ++ " is:")

195−

196− ++ pretty rightType

197−

198− ++ "All branches should match so that no matter which one we take, we always get\n"

177+ [ "All the branches of an `if` need to match so that no matter which\

199− ++ "back the same type of value."

178+ \ one we take, we get back the same type of value overall."

179+ ]

200 )

180 )

201

181

202 If ->

182 If ->

203 report

183 report

204 Nothing

184 Nothing

205− ( "All the branches of this if-expression are consistent, but the overall\n"

185+ "All the branches of this `if` are consistent, but the overall\

206− ++ "type does not match how it is used elsewhere."

186+ \ type does not match how it is used elsewhere."

207− )

187+ ( cmpHint

208− ( "The `if` evaluates to something of type:\n"

188+ "The `if` evaluates to something of type:"

209−

210− ++ pretty leftType

211−

212− ++ "Which is fine, but the surrounding context wants it to be:\n"

189+ "Which is fine, but the surrounding context wants it to be:"

213−

190+ []

214− ++ pretty rightType

215−

216 )

191 )

217

192

218 ListElement elementNumber region ->

193 ListElement elementNumber region ->

219 report

194 report

220 (Just region)

195 (Just region)

196+ ("The " ++ ordinalPair elementNumber ++ " elements are different types of values.")

197+ ( cmpHint

221− ( "The " ++ ordinalize elementNumber ++ " element of this list is an unexpected type of value."

198+ ("The " ++ Help.ordinalize (elementNumber - 1) ++ " element has this type:")

222− )

199+ ("But the "++ Help.ordinalize elementNumber ++ " is:")

223− ( "All elements should be the same type of value so that we can iterate over the\nlist without running into unexpected values."

200+ [ "All elements should be the same type of value so that we can\

201+ \ iterate through the list without running into unexpected values."

202+ ]

224 )

203 )

225

204

226 List ->

205 List ->

@@ -229,56 +208,43 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

229 ( "All the elements in this list are the same type, but the overall\n"

208 ( "All the elements in this list are the same type, but the overall\n"

230 ++ "type does not match how it is used elsewhere."

209 ++ "type does not match how it is used elsewhere."

231 )

210 )

211+ ( cmpHint

232− ( "The list has type:\n"

212+ "The list has type:"

233−

234− ++ pretty leftType

235−

236− ++ "Which is fine, but the surrounding context wants it to be:\n"

213+ "Which is fine, but the surrounding context wants it to be:"

237−

214+ []

238− ++ pretty rightType

239 )

215 )

240

216

241 BinopLeft op region ->

217 BinopLeft op region ->

242 report

218 report

243 (Just region)

219 (Just region)

244− ("The left argument of " ++ prettyOperator op ++ " is causing a type mismatch.")

220+ ("The left argument of " ++ prettyName op ++ " is causing a type mismatch.")

245− ( prettyOperator op ++ " is expecting:"

221+ ( cmpHint

246−

222+ (prettyName op ++ " is expecting the left argument to be a:")

247− ++ pretty leftType

223+ "But the left argument is:"

248−

224+ []

249− ++ "But the value on the left has this type:"

250−

251− ++ pretty rightType

252 )

225 )

253

226

254 BinopRight op region ->

227 BinopRight op region ->

255 report

228 report

256 (Just region)

229 (Just region)

257− ( "The right argument of " ++ prettyOperator op ++ " is causing a type mismatch."

230+ ("The right argument of " ++ prettyName op ++ " is causing a type mismatch.")

258− )

231+ ( cmpHint

259− ( prettyOperator op ++ " is expecting:"

232+ (prettyName op ++ " is expecting the right argument to be a:")

260−

261− ++ pretty leftType

262−

263− ++ "But the value on the right has this type:"

233+ "But the right argument is:"

264−

234+ []

265− ++ pretty rightType

266 )

235 )

267

236

268 Binop op ->

237 Binop op ->

269 report

238 report

270 Nothing

239 Nothing

240+ ( "The two arguments to " ++ prettyName op ++

271− ( "The two arguments to " ++ prettyOperator op ++ " are fine, but the overall type of this expression\n"

241+ " are fine, but the overall type of this expression\

272− ++ "does not match how it is used elsewhere."

242+ \ does not match how it is used elsewhere."

273 )

243 )

244+ ( cmpHint

274− ( "The result of this binary operation is:\n"

245+ "The result of this binary operation is:"

275−

276− ++ pretty leftType

277−

278− ++ "Which is fine, but the surrounding context wants it to be:\n"

246+ "Which is fine, but the surrounding context wants it to be:"

279−

247+ []

280− ++ pretty rightType

281−

282 )

248 )

283

249

284 Function maybeName ->

250 Function maybeName ->

@@ -286,30 +252,24 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

286 Nothing

252 Nothing

287 ( "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."

253 ( "The return type of " ++ funcName maybeName ++ " is being used in unexpected ways."

288 )

254 )

255+ ( cmpHint

289− ( "The function results in a value with type:\n"

256+ "The function results in this type of value:"

290−

291− ++ pretty leftType

292−

293− ++ "Which is fine, but the surrounding context wants it to be:\n"

257+ "Which is fine, but the surrounding context wants it to be:"

294−

258+ []

295− ++ pretty rightType

296 )

259 )

297

260

298 UnexpectedArg maybeName index region ->

261 UnexpectedArg maybeName index region ->

299 report

262 report

300 (Just region)

263 (Just region)

301− ( "The " ++ ordinalize index ++ " argument to " ++ funcName maybeName

264+ ( "The " ++ Help.ordinalize index ++ " argument to " ++ funcName maybeName

302 ++ " is causing a mismatch."

265 ++ " is causing a mismatch."

303 )

266 )

267+ ( cmpHint

268+ ( Help.capitalize (funcName maybeName) ++ " is expecting the "

304− ( "The " ++ ordinalize index ++ " to " ++ funcName maybeName ++ " should be:"

269+ ++ Help.ordinalize index ++ " argument to be:"

305−

270+ )

306− ++ pretty leftType

307−

308− ++ "But it is:"

271+ "But it is:"

309−

272+ []

310− ++ pretty rightType

311−

312− ++ maybe "" reasonToString maybeReason

313 )

273 )

314

274

315 FunctionArity maybeName expected actual region ->

275 FunctionArity maybeName expected actual region ->

@@ -318,34 +278,29 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

318 in

278 in

319 report

279 report

320 (Just region)

280 (Just region)

321− ( capitalize (funcName maybeName) ++ " is expecting " ++ show expected

281+ ( Help.capitalize (funcName maybeName) ++ " is expecting " ++ show expected

322 ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."

282 ++ " argument" ++ s ++ ", but was given " ++ show actual ++ "."

323 )

283 )

324− ( error "TODO are the types interesting here?"

284+ (text "Maybe you forgot some parentheses somewhere?")

325− )

326

285

327 BadTypeAnnotation name ->

286 BadTypeAnnotation name ->

328 report

287 report

329 Nothing

288 Nothing

330− ( "The type annotation for `" ++ name ++ "` does not match its definition."

289+ ("The type annotation for " ++ Help.functionName name ++ " does not match its definition.")

331− )

290+ ( cmpHint

332− ( "Based on the actual definition, the type should be:\n"

291+ "The type annotation is saying:"

333−

292+ "But I am inferring that the definition has this type:"

334− ++ pretty rightType

293+ []

335 )

294 )

336

295

337 Instance name ->

296 Instance name ->

338 report

297 report

339 Nothing

298 Nothing

340− ( "This usage of `" ++ name ++ "` is causing a type mismatch."

299+ (Help.functionName name ++ " is being used in an unexpected way.")

341− )

300+ ( cmpHint

342− ( "Based on its definition, `" ++ name ++ "` has this type:"

301+ ("Based on its definition, " ++ Help.functionName name ++ " has this type:")

343−

344− ++ pretty leftType

345−

346− ++ "But you are trying to use it as:"

302+ "But you are trying to use it as:"

347−

303+ []

348− ++ pretty rightType

349 )

304 )

350

305

351 Literal name ->

306 Literal name ->

@@ -353,9 +308,10 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

353 Nothing

308 Nothing

354 ( "This " ++ name ++ " value is being used as if it is some other type of value."

309 ( "This " ++ name ++ " value is being used as if it is some other type of value."

355 )

310 )

356− ( "You are trying to use this " ++ name ++ " as this type:"

311+ ( cmpHint

357−

312+ ("The " ++ name ++ " definitely has this type:")

358− ++ pretty rightType

313+ ("But it is being used as:")

314+ []

359 )

315 )

360

316

361 Pattern patErr ->

317 Pattern patErr ->

@@ -364,71 +320,87 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

364 case patErr of

320 case patErr of

365 PVar name -> "variable `" ++ name ++ "`"

321 PVar name -> "variable `" ++ name ++ "`"

366 PAlias name -> "alias `" ++ name ++ "`"

322 PAlias name -> "alias `" ++ name ++ "`"

367− PData name -> "`" ++ name ++ "`"

323+ PData name -> "tag `" ++ name ++ "`"

368 PRecord -> "a record"

324 PRecord -> "a record"

369 in

325 in

370 report

326 report

371 Nothing

327 Nothing

372− ( "Problem with " ++ thing ++ " in this pattern match."

328+ ( Help.capitalize thing ++ " is causing problems in this pattern match."

373 )

329 )

330+ ( cmpHint

374− ( "This pattern matches things of type:"

331+ "This pattern matches things of type:"

375−

376− ++ pretty leftType

377−

378− ++ "But the values it will actually be trying to match are:"

332+ "But the values it will actually be trying to match are:"

379−

333+ []

380− ++ pretty rightType

381 )

334 )

382

335

383 Shader ->

336 Shader ->

384 report

337 report

385 Nothing

338 Nothing

386− ( "There is some problem with this GLSL shader."

339+ "There is some problem with this GLSL shader."

387− )

388 ( error "TODO generic error"

340 ( error "TODO generic error"

389 )

341 )

390

342

391 Range ->

343 Range ->

392 report

344 report

393 Nothing

345 Nothing

394− ( "The low and high members of this list range are not the same type of value."

346+ "The low and high members of this list range are not the same type of value."

395− )

347+ ( cmpHint

396− ( "The low end of the range has type:"

348+ "The low end of the range has type:"

397−

398− ++ pretty leftType

399−

400− ++ "But the high end is:"

349+ "But the high end is:"

401−

350+ []

402− ++ pretty rightType

403 )

351 )

404

352

405 Lambda ->

353 Lambda ->

406 report

354 report

407 Nothing

355 Nothing

408− ( "This anonymous function is being used in an unexpected way."

356+ "This anonymous function is being used in an unexpected way."

409− )

357+ ( cmpHint

410− ( "The anonymous function has type:"

358+ "The anonymous function has type:"

411−

412− ++ pretty leftType

413−

414− ++ "But you are trying to use it as:"

359+ "But you are trying to use it as:"

415−

360+ []

416− ++ pretty rightType

417 )

361 )

418

362

419 Record ->

363 Record ->

420 report

364 report

421 Nothing

365 Nothing

422− ( "This record is being used in an unexpected way."

366+ "This record is being used in an unexpected way."

423− )

367+ ( cmpHint

424− ( "The record has type:"

368+ "The record has type:"

369+ "But you are trying to use it as:"

370+ []

371+ )

372+

373+

374+comparisonHint

375+ :: RenderType.Localizer

376+ -> Type.Canonical

377+ -> Type.Canonical

378+ -> String

379+ -> String

380+ -> [String]

381+ -> Doc

382+comparisonHint localizer leftType rightType leftWords rightWords finalHints =

383+ let

384+ (leftDoc, rightDoc) =

385+ RenderType.diffToDocs localizer RenderType.Elide leftType rightType

386+ in

387+ Help.stack $

388+ [ Help.reflowParagraph leftWords

389+ , indent 4 leftDoc

390+ , Help.reflowParagraph rightWords

391+ , indent 4 rightDoc

392+ ]

393+ ++

394+ map Help.reflowParagraph finalHints

425

395

426− ++ pretty leftType

427

396

428− ++ "But you are trying to use it as:"

397+ordinalPair :: Int -> String

398+ordinalPair number =

399+ Help.ordinalize (number -1 ) ++ " and " ++ Help.ordinalize number

400+

429

401

430− ++ pretty rightType

402+

431− )

403+-- MISMTACH REASONS

432

404

433

405

434reasonToString :: Reason -> String

406reasonToString :: Reason -> String

@@ -445,12 +417,12 @@ reasonToString reason =

445 [] ->

417 [] ->

446 "These records look pretty different."

418 "These records look pretty different."

447

419

448− [(exp,act)] ->

420+ [(ex,ac)] ->

449− "Looks like a misspelling between field " ++ exp ++ " and " ++ act ++ "."

421+ "Looks like a misspelling between field " ++ ex ++ " and " ++ ac ++ "."

450

422

451 potentialTypos ->

423 potentialTypos ->

452 "There are some potential typos in the record field names.\n"

424 "There are some potential typos in the record field names.\n"

453− ++ concatMap (\(exp,act) -> "\n " ++ exp ++ " <=> " ++ act) potentialTypos

425+ ++ concatMap (\(ex,ac) -> "\n " ++ ex ++ " <=> " ++ ac) potentialTypos

454

426

455 NotRecord ->

427 NotRecord ->

456 "A record cannot be merged with other types of values."

428 "A record cannot be merged with other types of values."

@@ -467,29 +439,15 @@ similarNames otherKeys key =

467 map ((,) key) (filter (\key' -> Help.distance key key' == 1) otherKeys)

439 map ((,) key) (filter (\key' -> Help.distance key key' == 1) otherKeys)

468

440

469

441

470−

471genericMissingFieldsMessage :: String -> [String] -> String

442genericMissingFieldsMessage :: String -> [String] -> String

472genericMissingFieldsMessage latterOrFormer fields =

443genericMissingFieldsMessage latterOrFormer fields =

473− "A record in the " ++ latterOrFormer ++ " type is missing "

444+ "A record in the " ++ latterOrFormer ++ " type is missing field"

474− ++

445+ ++ Help.commaSep fields

475− case fields of

476− [key] ->

477− "field `" ++ key ++ "`"

478−

479− [key1,key2] ->

480− "fields " ++ key1 ++ " and " ++ key2

481

446

482− keys ->

483− "fields " ++ List.intercalate ", " (init keys) ++ ", and " ++ last keys

484

447

485−

486−prettyOperator :: Var.Canonical -> String

448+prettyName :: Var.Canonical -> String

487−prettyOperator (Var.Canonical _ opName) =

449+prettyName (Var.Canonical _ opName) =

488− if AstHelp.isOp opName then

489− "(" ++ opName ++ ")"

490−

491− else

492− "`" ++ opName ++ "`"

450+ Help.functionName opName

493

451

494

452

495funcName :: Maybe Var.Canonical -> String

453funcName :: Maybe Var.Canonical -> String

@@ -499,33 +457,62 @@ funcName maybeVar =

499 "this function"

457 "this function"

500

458

501 Just var ->

459 Just var ->

502− "function " ++ prettyOperator var

460+ "function " ++ prettyName var

503−

461+

504−

462+

463+

464+-- INFINITE TYPES

465+

466+

467+infiniteTypeToReport

468+ :: RenderType.Localizer

505−capitalize :: String -> String

469+ -> String

506−capitalize string =

470+ -> Type.Canonical

507− case string of

471+ -> Type.Canonical

508− [] -> []

472+ -> Report.Report

509− c : cs ->

473+infiniteTypeToReport localizer name overallType infiniteType =

510− Char.toUpper c : cs

474+ Report.report

511−

475+ "INFINITE TYPE"

512−

476+ Nothing

513−ordinalize :: Int -> String

477+ ( "I am inferring a weird self-referential type for " ++ Help.functionName name

514−ordinalize number =

478+ )

479+ ( Help.stack $

480+ explainInfiniteType localizer name overallType infiniteType

481+ ++

482+ [ text $

483+ "This can be very tricky to figure out, so definitely read the debugging hints:\n"

484+ ++ Help.hintLink "infinite-type"

485+ ]

486+ )

487+

488+

489+explainInfiniteType

490+ :: RenderType.Localizer

491+ -> String

492+ -> Type.Canonical

493+ -> Type.Canonical

494+ -> [Doc]

495+explainInfiniteType localizer name overallType infiniteType =

515 let

496 let

516− remainder10 =

497+ selfReference =

517− number `mod` 10

498+ text "?" <+> equals <+> RenderType.toDoc localizer infiniteType

518−

519− remainder100 =

520− number `mod` 100

521−

522− ending

523− | remainder100 `elem` [11..13] = "th"

524− | remainder10 == 1 = "st"

525− | remainder10 == 2 = "nd"

526− | remainder10 == 3 = "rd"

527− | otherwise = "th"

528 in

499 in

529− show number ++ ending

500+ case overallType of

530−

501+ Type.Var "?" ->

531−

502+ [ Help.reflowParagraph $

503+ "I cannot write down the actual type of " ++ Help.functionName name ++

504+ " because it is infinitely large (that's the problem!) so here it\

505+ \ is as an equation where `?` represents the type:"

506+ , indent 4 selfReference

507+ ]

508+

509+ _ ->

510+ [ Help.reflowParagraph $

511+ "I am inferring that " ++ Help.functionName name ++ " has this type:"

512+ , indent 4 (RenderType.toDoc localizer overallType)

513+ , Help.reflowParagraph $

514+ "The problem is in the `?` which seems to contain itself. I cannot show\

515+ \ you that type directly (because it is infinitely large!) so here it is\

516+ \ as an equation:"

517+ , indent 4 selfReference

518+ ]

src/Reporting/Render/Code.hsnew file+113

@@ -0,0 +1,113 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Reporting.Render.Code

3+ ( render

4+ )

5+ where

7+import Control.Applicative ((<|>))

8+import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullred, empty, text)

10+import qualified Reporting.Region as R

11+

12+

13+(|>) :: a -> (a -> b) -> b

14+(|>) a f =

15+ f a

16+

17+

18+(<==>) :: Doc -> Doc -> Doc

19+(<==>) a b =

20+ a <> hardline <> b

21+

22+

23+render :: Maybe R.Region -> R.Region -> String -> Doc

24+render maybeSubRegion region@(R.Region start end) source =

25+ let

26+ (R.Position startLine startColumn) = start

27+ (R.Position endLine endColumn) = end

28+

29+ relevantLines =

30+ lines source

31+ |> drop (startLine - 1)

32+ |> take (endLine - startLine + 1)

33+ in

34+ case relevantLines of

35+ [] ->

36+ empty

37+

38+ [sourceLine] ->

39+ singleLineRegion startLine sourceLine $

40+ case maybeSubRegion of

41+ Nothing ->

42+ (0, startColumn, endColumn, length sourceLine)

43+

44+ Just (R.Region s e) ->

45+ (startColumn, R.column s, R.column e, endColumn)

46+

47+ firstLine : rest ->

48+ let

49+ filteredFirstLine =

50+ replicate (startColumn - 1) ' '

51+ ++ drop (startColumn - 1) firstLine

52+

53+ filteredLastLine =

54+ take (endColumn) (last rest)

55+

56+ focusedRelevantLines =

57+ filteredFirstLine : init rest ++ [filteredLastLine]

58+

59+ lineNumbersWidth =

60+ length (show endLine)

61+

62+ subregion =

63+ maybeSubRegion <|> Just region

64+

65+ numberedLines =

66+ zipWith

67+ (addLineNumber subregion lineNumbersWidth)

68+ [startLine .. endLine]

69+ focusedRelevantLines

70+ in

71+ foldr (<==>) empty numberedLines

72+

73+

74+addLineNumber :: Maybe R.Region -> Int -> Int -> String -> Doc

75+addLineNumber maybeSubRegion width n line =

76+ let

77+ number =

78+ if n < 0 then " " else show n

79+

80+ lineNumber =

81+ replicate (width - length number) ' ' ++ number ++ "│"

82+

83+ spacer (R.Region start end) =

84+ if R.line start <= n && n <= R.line end then

85+ dullred (text ">")

86+ else

87+ text " "

88+ in

89+ text lineNumber

90+ <> maybe (text " ") spacer maybeSubRegion

91+ <> text line

92+

93+

94+singleLineRegion :: Int -> String -> (Int, Int, Int, Int) -> Doc

95+singleLineRegion lineNum sourceLine (start, innerStart, innerEnd, end) =

96+ let

97+ width =

98+ length (show lineNum)

99+

100+ underline =

101+ text (replicate (innerStart + width + 1) ' ')

102+ <>

103+ dullred (text (replicate (max 1 (innerEnd - innerStart)) '^'))

104+

105+ trimmedSourceLine =

106+ sourceLine

107+ |> drop (start - 1)

108+ |> take (end - start + 1)

109+ |> (++) (replicate (start - 1) ' ')

110+ in

111+ addLineNumber Nothing width lineNum trimmedSourceLine

112+ <==>

113+ underline

src/Reporting/Render/Type.hs+47−31

@@ -1,7 +1,6 @@

1module Reporting.Render.Type

2 ( Localizer

3 , decl

4− , aliasDecl

5 , annotation

4 , annotation

6 , toDoc

5 , toDoc

7 , diffToDocs

6 , diffToDocs

@@ -13,10 +12,11 @@ import Control.Arrow ((***), first)

13import qualified Data.Map as Map

12import qualified Data.Map as Map

14import qualified Data.Set as Set

13import qualified Data.Set as Set

15import Text.PrettyPrint.ANSI.Leijen

14import Text.PrettyPrint.ANSI.Leijen

16− ( Doc, (<+>), cat, colon, comma, dullyellow, equals, hang, hsep, indent

15+ ( Doc, (<>), (<+>), cat, colon, comma, dullyellow, equals, hang, hsep

17− , lbrace, lparen, rbrace, rparen, sep, text, vcat

16+ , indent, lbrace, lparen, parens, rbrace, rparen, sep, space, text, vcat

18 )

17 )

19+import qualified AST.Helpers as Help

20import qualified AST.Type as Type

21import qualified AST.Variable as Var

22import Reporting.Error.Helpers as Help

@@ -26,6 +26,21 @@ import Reporting.Error.Helpers as Help

26-- PUBLIC API FOR CREATING DOCS

29+toDoc :: Localizer -> Type.Canonical -> Doc

30+toDoc localizer tipe =

31+ docType localizer tipe

32+

33+

34+diffToDocs :: Localizer -> Style -> Type.Canonical -> Type.Canonical -> (Doc,Doc)

35+diffToDocs localizer style leftType rightType =

36+ case diff localizer style leftType rightType of

37+ Same doc ->

38+ (doc, doc)

39+

40+ Diff leftDoc rightDoc ->

41+ (leftDoc, rightDoc)

42+

43+

29decl :: Localizer -> String -> [String] -> [(String, [Type.Canonical])] -> Doc

44decl :: Localizer -> String -> [String] -> [(String, [Type.Canonical])] -> Doc

30decl localizer name vars tags =

45decl localizer name vars tags =

31 let

46 let

@@ -40,31 +55,25 @@ decl localizer name vars tags =

40 (map docTag tags)

55 (map docTag tags)

43−aliasDecl :: Localizer -> String -> [String] -> Type.Canonical -> Doc

58+annotation :: Localizer -> String -> Type.Canonical -> Doc

44−aliasDecl localizer name vars tipe =

59+annotation localizer name tipe =

60+ let

61+ docName =

62+ if Help.isOp name then parens (text name) else text name

63+ in

64+ case Type.collectLambdas tipe of

65+ parts@(_ : _ : _) ->

45− hang 4 $ vcat $

66+ hang 4 $ sep $

46− [ hsep (map text ("type" : name : vars) ++ [equals])

67+ docName

47− , docType localizer tipe

68+ : zipWith (<+>)

48− ]

69+ ((colon <> space) : repeat (text "->"))

49−

50−

51−annotation =

52− error "TODO"

53−

54−

55−toDoc :: Localizer -> Type.Canonical -> Doc

56−toDoc localizer tipe =

57− docType localizer tipe

70+ (map (docType localizer) parts)

58−

59−

60−diffToDocs :: Localizer -> Style -> Type.Canonical -> Type.Canonical -> (Doc,Doc)

61−diffToDocs localizer style leftType rightType =

62− case diff localizer style leftType rightType of

63− Same doc ->

64− (doc, doc)

66− Diff leftDoc rightDoc ->

72+ _ ->

67− (leftDoc, rightDoc)

73+ hang 4 $ sep $

74+ [ docName <+> colon

75+ , docType localizer tipe

76+ ]

@@ -430,8 +439,13 @@ docType localizer tipe =

430

439

431

440

432docLambda :: [Doc] -> Doc

441docLambda :: [Doc] -> Doc

433−docLambda (arg:rest) =

442+docLambda docs =

443+ case docs of

444+ [] ->

445+ error "cannot call docLambda with an empty list"

446+

447+ arg:rest ->

434− sep (arg : map (text "->" <+>) rest)

448+ sep (arg : map (text "->" <+>) rest)

435

449

436

450

437

451

@@ -480,8 +494,10 @@ docRecord style fields maybeExt =

480

494

481 (_, Just ext) ->

495 (_, Just ext) ->

482 sep

496 sep

497+ [ hang 4 $ sep $

483− [ lbrace <+> ext

498+ [ lbrace <+> ext

484− , indent 4 (cat (zipWith (<+>) (text "|" : repeat comma) fieldDocs))

499+ , cat (zipWith (<+>) (text "|" : repeat comma) fieldDocs)

500+ ]

485 , rbrace

501 , rbrace

486 ]

502 ]

487

503

src/Reporting/Report.hs+50−195

@@ -1,64 +1,44 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3module Reporting.Report

4− ( Report(Report)

4+ ( Report

5− , simple

5+ , report

6 , toString

7 , toJson

8− , printError, printWarning

8+ , toHandle

9+ )

9− ) where

10+ where

11−import Control.Applicative ((<|>))

12−import Control.Monad.Writer (Writer, execWriter, tell)

13import Data.Aeson ((.=))

12import Data.Aeson ((.=))

14import qualified Data.Aeson.Types as Json

13import qualified Data.Aeson.Types as Json

15−import System.Console.ANSI

14+import System.IO (Handle)

16−import System.IO (hPutStr, stderr)

15+import Text.PrettyPrint.ANSI.Leijen

16+ ( Doc, (<>), displayS, displayIO, dullcyan, fillSep, hardline, renderPretty, text

17+ )

18import qualified Reporting.Region as R

19import qualified Reporting.Region as R

20+import qualified Reporting.Render.Code as Code

21+

22+

23+

24+-- BUILD REPORTS

21data Report = Report

27data Report = Report

22 { _title :: String

28 { _title :: String

23 , _highlight :: Maybe R.Region

29 , _highlight :: Maybe R.Region

24− , _preHint :: String

30+ , _preHint :: Doc

25− , _postHint :: String

31+ , _postHint :: Doc

26 }

32 }

29−simple :: String -> String -> String -> Report

35+report :: String -> Maybe R.Region -> String -> Doc -> Report

30−simple title pre post =

36+report title highlight pre post =

31− Report title Nothing pre post

37+ Report title highlight (fillSep (map text (words pre))) post

32−

33−

34−toString :: String -> R.Region -> Report -> String -> String

35−toString location region report source =

36− execWriter (render plain location region report source)

37−

39−printError :: String -> R.Region -> Report -> String -> IO ()

40−printError location region report source =

41− render (ansi Error) location region report source

44−printWarning :: String -> R.Region -> Report -> String -> IO ()

41+-- REPORT TO JSON

45−printWarning location region report source =

46− render (ansi Warning) location region report source

47−

48−

49−render

50− :: (Monad m)

51− => Renderer m

52− -> String

53− -> R.Region

54− -> Report

55− -> String

56− -> m ()

57−render renderer location region (Report title highlight pre post) source =

58− do messageBar renderer title location

59− normal renderer (pre ++ "\n\n")

60− grabRegion renderer highlight region source

61− normal renderer ("\n" ++ if null post then "\n" else post ++ "\n\n\n")

64toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])

44toJson :: [Json.Pair] -> Report -> (Maybe R.Region, [Json.Pair])

@@ -66,177 +46,52 @@ toJson extraFields (Report title subregion pre post) =

66 let

46 let

67 fields =

47 fields =

68 [ "tag" .= title

48 [ "tag" .= title

69− , "overview" .= pre

49+ , "overview" .= displayS (renderPretty 1 80 pre) ""

70− , "details" .= post

50+ , "details" .= displayS (renderPretty 1 80 post) ""

71 ]

51 ]

72 in

52 in

73 (subregion, fields ++ extraFields)

53 (subregion, fields ++ extraFields)

76−-- RENDERING

77−

78−data Renderer m = Renderer

79− { normal :: String -> m ()

80− , header :: String -> m ()

81− , accent :: String -> m ()

82− }

83−

84−

85−plain :: Renderer (Writer String)

86−plain =

87− Renderer tell tell tell

57+-- REPORT TO DOC

90−data Type = Error | Warning

91−

92−

93−ansi :: Type -> Renderer IO

94−ansi tipe =

95− let

96− put =

97− hPutStr stderr

98−

99− put' intensity color string =

100− do hSetSGR stderr [SetColor Foreground intensity color]

101− put string

102− hSetSGR stderr [Reset]

103−

104− accentColor =

105− case tipe of

106− Error -> Red

107− Warning -> Yellow

108− in

109− Renderer

110− put

111− (put' Dull Cyan)

112− (put' Dull accentColor)

113

60+toDoc :: String -> R.Region -> Report -> String -> Doc

61+toDoc location region (Report title highlight preHint postHint) source =

62+ messageBar title location

63+ <> hardline <> hardline <>

64+ preHint

65+ <> hardline <>

66+ Code.render highlight region source

67+ <> hardline <>

68+ postHint

69+ <> hardline

114

115

116−

117−-- REPORT HEADER

118−

119−messageBar :: Renderer m -> String -> String -> m ()

72+messageBar :: String -> String -> Doc

120−messageBar renderer tag location =

73+messageBar tag location =

121 let

74 let

75+ usedSpace =

122− usedSpace = 4 + length tag + 1 + length location

76+ 4 + length tag + 1 + length location

123 in

77 in

124− header renderer $

78+ dullcyan $ text $

125− "-- " ++ tag ++ " "

126− ++ replicate (max 1 (80 - usedSpace)) '-'

79+ "-- " ++ tag ++ " " ++ replicate (max 1 (80 - usedSpace)) '-' ++ " " ++ location

127− ++ " " ++ location ++ "\n\n"

128−

129−

130−-- REGIONS

131−

132−grabRegion

133− :: (Monad m)

134− => Renderer m

135− -> Maybe R.Region

136− -> R.Region

137− -> String

138− -> m ()

139−grabRegion renderer maybeSubRegion region@(R.Region start end) source =

140− let

141− (R.Position startLine startColumn) = start

142− (R.Position endLine endColumn) = end

143

144− (|>) = flip ($)

145

146− relevantLines =

147− lines source

148− |> drop (startLine - 1)

149− |> take (endLine - startLine + 1)

150− in

151− case relevantLines of

152− [] ->

153− normal renderer ""

154−

155− [sourceLine] ->

156− singleLineRegion renderer startLine sourceLine $

157− case maybeSubRegion of

158− Nothing ->

159− (0, startColumn, endColumn, length sourceLine)

160−

161− Just (R.Region s e) ->

162− (startColumn, R.column s, R.column e, endColumn)

163−

164− firstLine : rest ->

165− let

166− filteredFirstLine =

167− replicate (startColumn - 1) ' '

168− ++ drop (startColumn - 1) firstLine

169−

170− filteredLastLine =

171− take (endColumn) (last rest)

172−

173− focusedRelevantLines =

174− filteredFirstLine : init rest ++ [filteredLastLine]

175−

176− lineNumbersWidth =

177− length (show endLine)

178−

179− subregion =

180− maybeSubRegion <|> Just region

181−

182− numberedLines =

183− zipWith

184− (addLineNumber renderer subregion lineNumbersWidth)

185− [startLine .. endLine]

186− focusedRelevantLines

187− in

188− mapM_ (\line -> line >> normal renderer "\n") numberedLines

189−

190−

191−addLineNumber

192− :: (Monad m)

193− => Renderer m

194− -> Maybe R.Region

195− -> Int

196− -> Int

197− -> String

198− -> m ()

199−addLineNumber renderer maybeSubRegion width n line =

200− let

201− number =

202− if n < 0 then " " else show n

203

204− lineNumber =

83+-- RENDER DOCS

205− replicate (width - length number) ' ' ++ number ++ "│"

206

207− spacer (R.Region start end) =

208− if R.line start <= n && n <= R.line end

209− then accent renderer ">"

210− else normal renderer " "

211− in

212− do normal renderer lineNumber

213− maybe (normal renderer " ") spacer maybeSubRegion

214− normal renderer line

215−

216−

217−singleLineRegion

218− :: (Monad m)

219− => Renderer m

220− -> Int

221− -> String

222− -> (Int, Int, Int, Int)

223− -> m ()

224−singleLineRegion renderer lineNum sourceLine (start, innerStart, innerEnd, end) =

225− let

226− width =

227− length (show lineNum)

228

229− underline =

86+toString :: String -> R.Region -> Report -> String -> String

230− replicate (innerStart + width + 1) ' '

87+toString location region rprt source =

231− ++ replicate (max 1 (innerEnd - innerStart)) '^'

88+ displayS

89+ (renderPretty 1 80 (toDoc location region rprt source))

90+ ""

232

233− (|>) = flip ($)

234

235− trimmedSourceLine =

93+toHandle :: Handle -> String -> R.Region -> Report -> String -> IO ()

236− sourceLine

94+toHandle handle location region rprt source =

237− |> drop (start - 1)

95+ displayIO

238− |> take (end - start + 1)

96+ handle

239− |> (++) (replicate (start - 1) ' ')

97+ (renderPretty 1 80 (toDoc location region rprt source))

240− in

241− do addLineNumber renderer Nothing width lineNum trimmedSourceLine

242− accent renderer $ "\n" ++ underline

src/Reporting/Warning.hs+16−15

@@ -4,54 +4,55 @@ module Reporting.Warning where

5import Data.Aeson ((.=))

6import qualified Data.Aeson as Json

7+import Text.PrettyPrint.ANSI.Leijen (text)

8import qualified AST.Module.Name as ModuleName

9import qualified AST.Module.Name as ModuleName

9import qualified AST.Type as Type

10import qualified AST.Type as Type

10import qualified Reporting.Annotation as A

11import qualified Reporting.Annotation as A

12+import qualified Reporting.Error.Helpers as Help

11import qualified Reporting.Report as Report

13import qualified Reporting.Report as Report

12import qualified Reporting.Render.Type as RenderType

14import qualified Reporting.Render.Type as RenderType

17+

15-- ALL POSSIBLE WARNINGS

18-- ALL POSSIBLE WARNINGS

20+

17data Warning

21data Warning

18 = UnusedImport ModuleName.Raw

22 = UnusedImport ModuleName.Raw

19 | MissingTypeAnnotation String Type.Canonical

23 | MissingTypeAnnotation String Type.Canonical

22−-- TO STRING

23−

24−toString :: RenderType.Localizer -> String -> String -> A.Located Warning -> String

25−toString localizer location source (A.A region warning) =

26− Report.toString location region (toReport localizer warning) source

28−

27+-- TO REPORT

29−print :: RenderType.Localizer -> String -> String -> A.Located Warning -> IO ()

30−print localizer location source (A.A region warning) =

31− Report.printWarning location region (toReport localizer warning) source

34toReport :: RenderType.Localizer -> Warning -> Report.Report

30toReport :: RenderType.Localizer -> Warning -> Report.Report

35toReport localizer warning =

31toReport localizer warning =

36 case warning of

32 case warning of

37 UnusedImport moduleName ->

33 UnusedImport moduleName ->

38− Report.simple

34+ Report.report

39 "unused import"

35 "unused import"

36+ Nothing

40 ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")

37 ("Module `" ++ ModuleName.toString moduleName ++ "` is unused.")

41− ""

38+ (text "Best to remove it. Don't save code quality for later!")

43 MissingTypeAnnotation name inferredType ->

40 MissingTypeAnnotation name inferredType ->

44− Report.simple

41+ Report.report

45 "missing type annotation"

42 "missing type annotation"

43+ Nothing

46− ("Top-level value `" ++ name ++ "` does not have a type annotation.")

44+ ("Top-level value " ++ Help.functionName name ++ " does not have a type annotation.")

47− ( "The type annotation you want looks something like this:\n\n"

45+ ( Help.stack

46+ [ text "I inferred the type annotation so you can copy it into your code:"

48− ++ RenderType.annotation name inferredType

47+ , RenderType.annotation localizer name inferredType

48+ ]

49 )

53-- TO JSON

55+

55toJson :: RenderType.Localizer -> FilePath -> A.Located Warning -> Json.Value

56toJson :: RenderType.Localizer -> FilePath -> A.Located Warning -> Json.Value

56toJson localizer filePath (A.A region warning) =

57toJson localizer filePath (A.A region warning) =

57 let

58 let

src/Type/Constrain/Literal.hs+2−2

@@ -14,8 +14,8 @@ constrain

14 -> T.Type

15 -> IO T.TypeConstraint

16constrain env region literal tipe =

17− do tipe' <- litType

17+ do definiteType <- litType

18− return (T.CEqual (Error.Literal name) region tipe tipe')

18+ return (T.CEqual (Error.Literal name) region definiteType tipe)

19 where

20 prim name =

21 return (Env.getType env name)

src/Validate.hs+2−2

@@ -403,7 +403,7 @@ checkDecl isRoot (A.A (region,_) decl) =

403 (v:vs) = Set.toList (Set.fromList unbound)

404 in

405 Result.throw region

406− (Error.UnboundTypeVarsInUnion name boundVars v vs ctors)

406+ (Error.UnboundTypeVarsInUnion name boundVars v vs)

407

408 D.TypeAlias name boundVars tipe ->

409 case findUnbound boundVars (freeVars tipe) of

@@ -415,7 +415,7 @@ checkDecl isRoot (A.A (region,_) decl) =

415 (v:vs) = Set.toList (Set.fromList unbound)

416 in

417 Result.throw region

418− (Error.UnboundTypeVarsInAlias name boundVars v vs tipe)

418+ (Error.UnboundTypeVarsInAlias name boundVars v vs)

419

420 D.Port _ ->

421 if isRoot