2feb357 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Begin upgrade of Reporting code from String to Text

2feb357Evan Czaplicki10 years ago

elm-compiler.cabal+1−1

compare with master

unifiedsplit

@@ -114,10 +114,10 @@ Library

114 Reporting.Error,

115 Reporting.Error.Canonicalize,

116 Reporting.Error.Docs,

117− Reporting.Error.Helpers,

118 Reporting.Error.Pattern,

117 Reporting.Error.Pattern,

119 Reporting.Error.Syntax,

118 Reporting.Error.Syntax,

120 Reporting.Error.Type,

119 Reporting.Error.Type,

120+ Reporting.Helpers,

121 Reporting.Region,

122 Reporting.Render.Code,

123 Reporting.Render.Type,

src/AST/Helpers.hs+10−4

@@ -1,8 +1,9 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE OverloadedStrings #-}

3−module AST.Helpers where

3+module AST.Helpers (isTuple, isOp, isSymbol) where

5import qualified Data.Char as Char

6+import qualified Data.Set as Set

6import qualified Data.Text as Text

7import qualified Data.Text as Text

7import Data.Text (Text)

8import Data.Text (Text)

@@ -22,11 +23,16 @@ isTuple name =

22-- INFIX OPERATORS

23-- INFIX OPERATORS

25−isOp :: String -> Bool

26+isOp :: Text -> Bool

26isOp name =

27isOp name =

27− all isSymbol name

28+ Text.all isSymbol name

30isSymbol :: Char -> Bool

31isSymbol :: Char -> Bool

31isSymbol c =

32isSymbol c =

32− elem c ("+-/*=.<>:&|^?%#@~!" :: String)

33+ Set.member c validSymbols

34+

35+

36+validSymbols :: Set.Set Char

37+validSymbols =

38+ Set.fromList "+-/*=.<>:&|^?%#@~!"

src/AST/Pattern.hs+5

@@ -120,6 +120,11 @@ toString var =

120 LazyText.unpack (toLazyText (toBuilder False var))

121

122

123+toText :: Canonical -> Text

124+toText var =

125+ LazyText.toStrict (toLazyText (toBuilder False var))

126+

127+

123toBuilder :: Bool -> Canonical -> Builder

128toBuilder :: Bool -> Canonical -> Builder

124toBuilder needsParens (A.A _ pattern) =

129toBuilder needsParens (A.A _ pattern) =

125 case pattern of

130 case pattern of

src/Canonicalize.hs+4−9

@@ -2,12 +2,11 @@

2module Canonicalize (module') where

4import Prelude hiding (last)

5+import qualified Data.Foldable as T

5import qualified Data.List as List

6import qualified Data.List as List

6import qualified Data.Map as Map

7import qualified Data.Map as Map

7import qualified Data.Maybe as Maybe

8import qualified Data.Maybe as Maybe

8import qualified Data.Set as Set

9import qualified Data.Set as Set

9−import qualified Data.Foldable as T

10−import qualified Data.Text as Text

11import Data.Text (Text)

10import Data.Text (Text)

13import Elm.Utils ((|>))

12import Elm.Utils ((|>))

@@ -31,7 +30,7 @@ import qualified Docs.Centralize as Docs

31import qualified Reporting.Annotation as A

30import qualified Reporting.Annotation as A

32import qualified Reporting.Error as Error

31import qualified Reporting.Error as Error

33import qualified Reporting.Error.Canonicalize as CError

32import qualified Reporting.Error.Canonicalize as CError

34−import qualified Reporting.Error.Helpers as ErrorHelp

33+import qualified Reporting.Helpers as Help

35import qualified Reporting.Region as Region

34import qualified Reporting.Region as Region

36import qualified Reporting.Render.Type as RenderType

35import qualified Reporting.Render.Type as RenderType

37import qualified Reporting.Result as Result

36import qualified Reporting.Result as Result

@@ -218,12 +217,8 @@ manyNotFound region nameList possibilities =

218

217

219notFound :: Region.Region -> [Text] -> Text -> A.Located CError.Error

218notFound :: Region.Region -> [Text] -> Text -> A.Located CError.Error

220notFound region possibilities badName =

219notFound region possibilities badName =

221− let

222− badNameString =

223− Text.unpack badName

224− in

225− A.A region $ CError.Export badNameString $

220+ A.A region $ CError.Export badName $

226− ErrorHelp.nearbyNames id badNameString (map Text.unpack possibilities)

221+ Help.nearbyNames id badName possibilities

227

222

228

223

229allUnique :: [A.Located Var.Value] -> CResult ()

224allUnique :: [A.Located Var.Value] -> CResult ()

src/Canonicalize/Effects.hs+8−7

@@ -1,7 +1,8 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

1module Canonicalize.Effects (canonicalize, toValues, checkPortType) where

3module Canonicalize.Effects (canonicalize, toValues, checkPortType) where

3import qualified Data.Foldable as F

5import qualified Data.Foldable as F

4−import qualified Data.Text as Text

5import Data.Text (Text)

6import Data.Text (Text)

7import qualified AST.Effects as Effects

8import qualified AST.Effects as Effects

@@ -77,9 +78,9 @@ figureOutKind region name rootType =

77 Result.throw region (Error.BadPort name rootType)

78 Result.throw region (Error.BadPort name rootType)

80−makeError :: R.Region -> Text -> T.Canonical -> Maybe String -> A.Located Error.Error

81+makeError :: R.Region -> Text -> T.Canonical -> Maybe Text -> A.Located Error.Error

81makeError region name tipe maybeMessage =

82makeError region name tipe maybeMessage =

82− A.A region (Error.port (Text.unpack name) tipe maybeMessage)

83+ A.A region (Error.port name tipe maybeMessage)

@@ -88,16 +89,16 @@ makeError region name tipe maybeMessage =

89checkPortType

90checkPortType

90 :: (Monoid i)

91 :: (Monoid i)

91− => (T.Canonical -> Maybe String -> A.Located e)

92+ => (T.Canonical -> Maybe Text -> A.Located e)

92 -> T.Canonical

93 -> T.Canonical

93 -> Result.Result i w e ()

94 -> Result.Result i w e ()

94−checkPortType makeError tipe =

95+checkPortType mkError tipe =

95 let

96 let

96 check =

97 check =

97− checkPortType makeError

98+ checkPortType mkError

99 throw maybeMsg =

100 throw maybeMsg =

100− Result.throwMany [makeError tipe maybeMsg]

101+ Result.throwMany [mkError tipe maybeMsg]

101 in

102 in

102 case tipe of

103 case tipe of

103 T.Aliased _ args aliasedType ->

104 T.Aliased _ args aliasedType ->

src/Canonicalize/Environment.hs+1−2

@@ -167,5 +167,4 @@ toLocalizer (Env _ _ unions aliases _ _) =

167 add (key,value) dict =

168 Map.insertWith (\v v' -> if Text.length v < Text.length v' then v else v') key value dict

169 in

170− Map.map Text.unpack $

171− foldr add Map.empty (unionPairs ++ aliasPairs)

170+ foldr add Map.empty (unionPairs ++ aliasPairs)

src/Canonicalize/Setup.hs+4−5

@@ -8,7 +8,6 @@ import qualified Data.Graph as Graph

8import qualified Data.Map as Map

9import qualified Data.Maybe as Maybe

10import Data.Monoid ((<>))

11−import qualified Data.Text as Text

12import Data.Text (Text)

11import Data.Text (Text)

14import qualified AST.Declaration as D

13import qualified AST.Declaration as D

@@ -22,7 +21,7 @@ import qualified AST.Variable as Var

22import Elm.Utils ((|>))

21import Elm.Utils ((|>))

23import qualified Reporting.Annotation as A

22import qualified Reporting.Annotation as A

24import qualified Reporting.Error.Canonicalize as Error

23import qualified Reporting.Error.Canonicalize as Error

25−import qualified Reporting.Error.Helpers as Error

24+import qualified Reporting.Helpers as Help (nearbyNames)

26import qualified Reporting.Region as R

25import qualified Reporting.Region as R

27import qualified Reporting.Result as Result

26import qualified Reporting.Result as Result

28import qualified Canonicalize.Environment as Env

27import qualified Canonicalize.Environment as Env

@@ -87,7 +86,7 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

87 allInterfaces

86 allInterfaces

88 |> Map.keys

87 |> Map.keys

89 |> map ModuleName._module

88 |> map ModuleName._module

90− |> Error.nearbyNames ModuleName.toString rawImportName

89+ |> Help.nearbyNames ModuleName.toText rawImportName

91 |> Error.moduleNotFound rawImportName

90 |> Error.moduleNotFound rawImportName

92 |> Result.throw region

91 |> Result.throw region

@@ -100,7 +99,7 @@ importToPatches importDict allInterfaces (A.A region (rawImportName, method)) =

100 listing

99 listing

101

100

102 qualifier =

101 qualifier =

103− maybe (Text.pack (ModuleName.toString rawImportName)) id maybeAlias

102+ maybe (ModuleName.toText rawImportName) id maybeAlias

104

103

105 infixPatches =

104 infixPatches =

106 map (infixToPatch (Var.fromModule importName)) (Module.iFixities interface)

105 map (infixToPatch (Var.fromModule importName)) (Module.iFixities interface)

@@ -175,7 +174,7 @@ valueToPatches region moduleName interface value =

175 notFound getNames x =

174 notFound getNames x =

176 Module.iExports interface

175 Module.iExports interface

177 |> getNames

176 |> getNames

178− |> Error.nearbyNames Text.unpack x

177+ |> Help.nearbyNames id x

179 |> Error.valueNotFound (ModuleName._module moduleName) x

178 |> Error.valueNotFound (ModuleName._module moduleName) x

180 |> Result.throw region

179 |> Result.throw region

181 in

180 in

src/Canonicalize/Variable.hs+13−12

@@ -2,6 +2,7 @@

2{-# LANGUAGE OverloadedStrings #-}

3module Canonicalize.Variable (Result, variable, tvar, pvar) where

5+import Data.Monoid ((<>))

5import qualified Data.Either as Either

6import qualified Data.Either as Either

6import qualified Data.Map as Map

7import qualified Data.Map as Map

7import qualified Data.Set as Set

8import qualified Data.Set as Set

@@ -14,7 +15,7 @@ import qualified AST.Type as Type

14import qualified AST.Variable as Var

15import qualified AST.Variable as Var

15import qualified Canonicalize.Environment as Env

16import qualified Canonicalize.Environment as Env

16import qualified Reporting.Error.Canonicalize as Error

17import qualified Reporting.Error.Canonicalize as Error

17−import qualified Reporting.Error.Helpers as Error

18+import qualified Reporting.Helpers as Help (nearbyNames)

18import qualified Reporting.Region as R

19import qualified Reporting.Region as R

19import qualified Reporting.Result as Result

20import qualified Reporting.Result as Result

20import qualified Reporting.Warning as Warning

21import qualified Reporting.Warning as Warning

@@ -151,7 +152,7 @@ preferLocals' region env extract kind possibilities var =

151 ambiguous possibleVars =

152 ambiguous possibleVars =

152 Result.throw region (Error.variable kind var Error.Ambiguous vars)

153 Result.throw region (Error.variable kind var Error.Ambiguous vars)

153 where

154 where

154− vars = map (Text.pack . Var.toString . extract) possibleVars

155+ vars = map (Var.toText . extract) possibleVars

155

156

157

157isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool

158isLocal :: ModuleName.Canonical -> Var.Canonical -> Bool

@@ -195,16 +196,16 @@ toVarName var =

195 xs -> Right (Text.intercalate "." (init xs), last xs)

196 xs -> Right (Text.intercalate "." (init xs), last xs)

196

197

198

198−noQualifier :: VarName -> String

199+noQualifier :: VarName -> Text

199noQualifier name =

200noQualifier name =

200 case name of

201 case name of

201− Right (_, x) -> Text.unpack x

202+ Right (_, x) -> x

202− Left x -> Text.unpack x

203+ Left x -> x

203

204

205

205−qualifiedToString :: (ModuleName.Raw, Text) -> Text

206+qualifiedToText :: (ModuleName.Raw, Text) -> Text

206−qualifiedToString (modul, name) =

207+qualifiedToText (modul, name) =

207− Text.pack (ModuleName.toString modul ++ "." ++ Text.unpack name)

208+ ModuleName.toText modul <> "." <> name

208

209

210

210isOp :: VarName -> Bool

211isOp :: VarName -> Bool

@@ -240,11 +241,11 @@ exposedProblem name possibleNames =

240 let (exposed, qualified) =

241 let (exposed, qualified) =

241 possibleNames

242 possibleNames

242 |> filter (\n -> isOp name == isOp n)

243 |> filter (\n -> isOp name == isOp n)

243− |> Error.nearbyNames noQualifier name

244+ |> Help.nearbyNames noQualifier name

244 |> Either.partitionEithers

245 |> Either.partitionEithers

245 in

246 in

246 ( Error.ExposedUnknown

247 ( Error.ExposedUnknown

247− , exposed ++ map qualifiedToString qualified

248+ , exposed ++ map qualifiedToText qualified

248 )

249 )

249

250

251

@@ -259,11 +260,11 @@ qualifiedProblem moduleName name allQualified =

259 , allQualified

260 , allQualified

260 |> filter ((==) moduleName . fst)

261 |> filter ((==) moduleName . fst)

261 |> map snd

262 |> map snd

262− |> Error.nearbyNames Text.unpack name

263+ |> Help.nearbyNames id name

263 )

264 )

264

265

265 False ->

266 False ->

266 ( Error.UnknownQualifier moduleName name

267 ( Error.UnknownQualifier moduleName name

267 , Set.toList availableModules

268 , Set.toList availableModules

268− |> Error.nearbyNames Text.unpack moduleName

269+ |> Help.nearbyNames id moduleName

269 )

270 )

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

@@ -43,7 +43,7 @@ fresh =

44define :: Maybe ModuleName.Canonical -> Text -> JS.Expr -> [JS.Stmt]

45define maybeHome name body =

46− if not (Help.isOp (Text.unpack name)) then

46+ if not (Help.isOp name) then

47 let

48 jsName =

49 maybe unqualified qualified maybeHome name

@@ -74,7 +74,7 @@ define maybeHome name body =

75canonical :: Var.Canonical -> JS.Expr

76canonical (Var.Canonical home name) =

77− if Help.isOp (Text.unpack name) then

77+ if Help.isOp name then

78 JS.BracketRef (JS.ref (getOpsDictName home)) (JS.String name)

80 else

src/Nitpick/Pattern.hs+5−4

@@ -3,12 +3,13 @@

3module Nitpick.Pattern

4 ( Pattern(..)

5 , fromCanonicalPattern

6− , toString

6+ , toText

7 )

8 where

10import qualified Data.List as List

11import Data.Monoid ((<>))

12+import Data.Text (Text)

12import qualified Data.Text.Lazy as LazyText

13import qualified Data.Text.Lazy as LazyText

13import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

14import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

@@ -61,9 +62,9 @@ fromCanonicalPattern (A.A _ pattern) =

61-- TO STRING

62-- TO STRING

64−toString :: Pattern -> String

65+toText :: Pattern -> Text

65−toString pattern =

66+toText pattern =

66− LazyText.unpack (toLazyText (toBuilder False pattern))

67+ LazyText.toStrict (toLazyText (toBuilder False pattern))

69toBuilder :: Bool -> Pattern -> Builder

70toBuilder :: Bool -> Pattern -> Builder

src/Nitpick/TopLevelTypes.hs+1−2

@@ -5,7 +5,6 @@ module Nitpick.TopLevelTypes (topLevelTypes) where

5import qualified Data.Foldable as F

6import Data.Map ((!))

7import qualified Data.Map as Map

8−import qualified Data.Text as Text

9import Data.Text (Text)

8import Data.Text (Text)

11import qualified AST.Expression.Canonical as Can

10import qualified AST.Expression.Canonical as Can

@@ -65,7 +64,7 @@ checkAnnotation typeEnv (Can.Def _ (A.A region pattern) _ maybeType) =

65 (P.Var name, Nothing) ->

64 (P.Var name, Nothing) ->

66 let

65 let

67 warning =

66 warning =

68− Warning.MissingTypeAnnotation (Text.unpack name) (typeEnv ! name)

67+ Warning.MissingTypeAnnotation name (typeEnv ! name)

69 in

68 in

70 Result.warn region warning ()

69 Result.warn region warning ()

src/Reporting/Annotation.hs+2−1

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

1module Reporting.Annotation where

3import Prelude hiding (map)

4+import Data.Text (Text)

4import qualified Reporting.Region as R

5import qualified Reporting.Region as R

@@ -17,7 +18,7 @@ type Located a =

19type Commented a =

20type Commented a =

20− Annotated (R.Region, Maybe String) a

21+ Annotated (R.Region, Maybe Text) a

src/Reporting/Error/Canonicalize.hs+96−81

@@ -1,9 +1,11 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module Reporting.Error.Canonicalize where

3module Reporting.Error.Canonicalize where

4import Control.Arrow ((***))

5import Control.Arrow ((***))

5import qualified Data.Char as Char

6import qualified Data.Char as Char

6−import Text.PrettyPrint.ANSI.Leijen (Doc, dullyellow, fillSep, indent, text)

7+import qualified Data.Text as Text

8+import Data.Text (Text)

8import qualified AST.Declaration as Decl

10import qualified AST.Declaration as Decl

9import qualified AST.Expression.Canonical as Canonical

11import qualified AST.Expression.Canonical as Canonical

@@ -12,10 +14,17 @@ import qualified AST.Pattern as P

12import qualified AST.Type as Type

14import qualified AST.Type as Type

13import qualified AST.Variable as Var

15import qualified AST.Variable as Var

14import qualified Reporting.Annotation as A

16import qualified Reporting.Annotation as A

15−import qualified Reporting.Error.Helpers as Help

16import qualified Reporting.Region as Region

17import qualified Reporting.Region as Region

17import qualified Reporting.Render.Type as RenderType

18import qualified Reporting.Render.Type as RenderType

18import qualified Reporting.Report as Report

19import qualified Reporting.Report as Report

20+import qualified Reporting.Helpers as Help

21+import Reporting.Helpers

22+ ( Doc, (<>), dullyellow, fillSep, i2t, indent, maybeYouWant, reflowParagraph, text

23+ )

24+

25+

26+

27+-- CANONICALIZATION ERRORS

21data Error

30data Error

@@ -25,32 +34,33 @@ data Error

25 | Pattern PatternError

34 | Pattern PatternError

26 | Alias AliasError

35 | Alias AliasError

27 | Import ModuleName.Raw ImportError

36 | Import ModuleName.Raw ImportError

28− | Export String [String]

37+ | Export Text [Text]

29− | DuplicateExport String

38+ | DuplicateExport Text

30 | Port PortError

39 | Port PortError

31− | BadPort String Type.Canonical

40+ | BadPort Text Type.Canonical

35-- VARIABLES

44-- VARIABLES

38−data VarError = VarError

47+data VarError =

48+ VarError

39− { varKind :: String

49+ { varKind :: Text

40− , varName :: String

50+ , varName :: Text

41 , varProblem :: VarProblem

51 , varProblem :: VarProblem

42− , varSuggestions :: [String]

52+ , varSuggestions :: [Text]

43 }

53 }

46data VarProblem

56data VarProblem

47 = Ambiguous

57 = Ambiguous

48− | UnknownQualifier String String

58+ | UnknownQualifier Text Text

49− | QualifiedUnknown String String

59+ | QualifiedUnknown Text Text

50 | ExposedUnknown

60 | ExposedUnknown

53−variable :: String -> String -> VarProblem -> [String] -> Error

63+variable :: Text -> Text -> VarProblem -> [Text] -> Error

54variable kind name problem suggestions =

64variable kind name problem suggestions =

55 Var (VarError kind name problem suggestions)

65 Var (VarError kind name problem suggestions)

@@ -74,7 +84,7 @@ argMismatch name expected actual =

75data ImportError

85data ImportError

76 = ModuleNotFound [ModuleName.Raw]

86 = ModuleNotFound [ModuleName.Raw]

77− | ValueNotFound String [String]

87+ | ValueNotFound Text [Text]

80moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error

90moduleNotFound :: ModuleName.Raw -> [ModuleName.Raw] -> Error

@@ -82,7 +92,7 @@ moduleNotFound name possibilities =

82 Import name (ModuleNotFound possibilities)

92 Import name (ModuleNotFound possibilities)

85−valueNotFound :: ModuleName.Raw -> String -> [String] -> Error

95+valueNotFound :: ModuleName.Raw -> Text -> [Text] -> Error

86valueNotFound name value possibilities =

96valueNotFound name value possibilities =

87 Import name (ValueNotFound value possibilities)

97 Import name (ValueNotFound value possibilities)

@@ -93,8 +103,8 @@ valueNotFound name value possibilities =

103

94data AliasError

104data AliasError

95 = ArgMismatch Var.Canonical Int Int

105 = ArgMismatch Var.Canonical Int Int

96− | SelfRecursive String [String] Type.Raw

106+ | SelfRecursive Text [Text] Type.Raw

97− | MutuallyRecursive [(Region.Region, String, [String], Type.Raw)]

107+ | MutuallyRecursive [(Region.Region, Text, [Text], Type.Raw)]

108

109

100alias :: Var.Canonical -> Int -> Int -> Error

110alias :: Var.Canonical -> Int -> Int -> Error

@@ -108,13 +118,13 @@ alias name expected actual =

108

118

109data PortError =

119data PortError =

110 PortError

120 PortError

111− { portName :: String

121+ { portName :: Text

112 , portType :: Type.Canonical

122 , portType :: Type.Canonical

113− , portMessage :: Maybe String

123+ , portMessage :: Maybe Text

114 }

124 }

115

125

116

126

117−port :: String -> Type.Canonical -> Maybe String -> Error

127+port :: Text -> Type.Canonical -> Maybe Text -> Error

118port name tipe maybeMessage =

128port name tipe maybeMessage =

119 Port (PortError name tipe maybeMessage)

129 Port (PortError name tipe maybeMessage)

120

130

@@ -123,7 +133,7 @@ port name tipe maybeMessage =

123-- TO REPORT

133-- TO REPORT

124

134

125

135

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

136+namingError :: Text -> Text -> Report.Report

127namingError pre post =

137namingError pre post =

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

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

129

139

@@ -132,49 +142,49 @@ toReport :: RenderType.Localizer -> Error -> Report.Report

132toReport localizer err =

142toReport localizer err =

133 case err of

143 case err of

134 Var (VarError kind name problem suggestions) ->

144 Var (VarError kind name problem suggestions) ->

135− let var = kind ++ " `" ++ name ++ "`"

145+ let var = kind <> " `" <> name <> "`"

136 in

146 in

137 case problem of

147 case problem of

138 Ambiguous ->

148 Ambiguous ->

139 namingError

149 namingError

140− ("This usage of " ++ var ++ " is ambiguous.")

150+ ("This usage of " <> var <> " is ambiguous.")

141− (Help.maybeYouWant suggestions)

151+ (maybeYouWant suggestions)

142

152

143 UnknownQualifier qualifier localName ->

153 UnknownQualifier qualifier localName ->

144 namingError

154 namingError

145− ("Cannot find " ++ var ++ ".")

155+ ("Cannot find " <> var <> ".")

146− ( "No module called `" ++ qualifier ++ "` has been imported. "

156+ ( "No module called `" <> qualifier <> "` has been imported. "

147− ++ Help.maybeYouWant (map (\modul -> modul ++ "." ++ localName) suggestions)

157+ <> maybeYouWant (map (\modul -> modul <> "." <> localName) suggestions)

148 )

158 )

149

159

150 QualifiedUnknown qualifier localName ->

160 QualifiedUnknown qualifier localName ->

151 namingError

161 namingError

152− ("Cannot find " ++ var ++ ".")

162+ ("Cannot find " <> var <> ".")

153− ( "`" ++ qualifier ++ "` does not expose `" ++ localName ++ "`. "

163+ ( "`" <> qualifier <> "` does not expose `" <> localName <> "`. "

154− ++ Help.maybeYouWant (map (\v -> qualifier ++ "." ++ v) suggestions)

164+ <> maybeYouWant (map (\v -> qualifier <> "." <> v) suggestions)

155 )

165 )

156

166

157 ExposedUnknown ->

167 ExposedUnknown ->

158 namingError

168 namingError

159− ("Cannot find " ++ var)

169+ ("Cannot find " <> var)

160− (Help.maybeYouWant suggestions)

170+ (maybeYouWant suggestions)

161

171

162 BadRecursion region def defs ->

172 BadRecursion region def defs ->

163 case defs of

173 case defs of

164 [] ->

174 [] ->

165− badSelfRecursion region (defToString def)

175+ badSelfRecursion region (defToText def)

166

176

167 _ ->

177 _ ->

168− badMutualRecursion region (defToString def) (map (defToString) defs)

178+ badMutualRecursion region (defToText def) (map (defToText) defs)

169

179

170 BadInfix region _prec (Var.Canonical _ name1) _assoc1 (Var.Canonical _ name2) _assoc2 ->

180 BadInfix region _prec (Var.Canonical _ name1) _assoc1 (Var.Canonical _ name2) _assoc2 ->

171 Report.report

181 Report.report

172 "INFIX PROBLEM"

182 "INFIX PROBLEM"

173 (Just region)

183 (Just region)

174− ("You cannot mix (" ++ name1 ++ ") and (" ++ name2 ++ ") without parentheses.")

184+ ("You cannot mix (" <> name1 <> ") and (" <> name2 <> ") without parentheses." )

175 (

185 (

176 Help.stack

186 Help.stack

177− [ Help.reflowParagraph $

187+ [ reflowParagraph $

178 "I do not know how to group these expressions. Add parentheses for me!"

188 "I do not know how to group these expressions. Add parentheses for me!"

179 ]

189 ]

180 )

190 )

@@ -196,15 +206,15 @@ toReport localizer err =

196 "This type alias is recursive, forming an infinite type!"

206 "This type alias is recursive, forming an infinite type!"

197 (

207 (

198 Help.stack

208 Help.stack

199− [ Help.reflowParagraph $

209+ [ reflowParagraph $

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

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

201 \ So dealiasing results in an infinitely large type! Try this instead:"

211 \ So dealiasing results in an infinitely large type! Try this instead:"

202 , indent 4 $

212 , indent 4 $

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

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

204 , text $

214 , text $

205 "This is kind of a subtle distinction. I suggested the naive fix, but you can\n"

215 "This is kind of a subtle distinction. I suggested the naive fix, but you can\n"

206− ++ "often do something a bit nicer. So I would recommend reading more at:\n"

216+ <> "often do something a bit nicer. So I would recommend reading more at:\n"

207− ++ Help.hintLink "recursive-alias"

217+ <> Help.hintLink "recursive-alias"

208 ]

218 ]

209 )

219 )

210

220

@@ -216,52 +226,52 @@ toReport localizer err =

216 ( Help.stack

226 ( Help.stack

217 [ text "The following type aliases are mutually recursive:"

227 [ text "The following type aliases are mutually recursive:"

218 , indent 4 (Help.drawCycle (map (\(_, name, _, _) -> name) aliases))

228 , indent 4 (Help.drawCycle (map (\(_, name, _, _) -> name) aliases))

219− , Help.reflowParagraph $

229+ , reflowParagraph $

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

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

221 \ subtle distinction, so definitely read up on this before you make a fix: "

231 \ subtle distinction, so definitely read up on this before you make a fix: "

222− ++ Help.hintLink "recursive-alias"

232+ <> Help.hintLink "recursive-alias"

223 ]

233 ]

224 )

234 )

225

235

226 Import name importError ->

236 Import name importError ->

227− let moduleName = ModuleName.toString name

237+ let moduleName = ModuleName.toText name

228 in

238 in

229 case importError of

239 case importError of

230 ModuleNotFound suggestions ->

240 ModuleNotFound suggestions ->

231 namingError

241 namingError

232− ("Could not find a module named `" ++ moduleName ++ "`")

242+ ("Could not find a module named `" <> moduleName <> "`")

233− (Help.maybeYouWant (map ModuleName.toString suggestions))

243+ (maybeYouWant suggestions)

234

244

235 ValueNotFound value suggestions ->

245 ValueNotFound value suggestions ->

236 namingError

246 namingError

237− ("Module `" ++ moduleName ++ "` does not expose `" ++ value ++ "`")

247+ ("Module `" <> moduleName <> "` does not expose `" <> value <> "`")

238− (Help.maybeYouWant suggestions)

248+ (maybeYouWant suggestions)

239

249

240 Export name suggestions ->

250 Export name suggestions ->

241 namingError

251 namingError

242− ("Could not export `" ++ name ++ "` which is not defined in this module.")

252+ ("Could not export `" <> name <> "` which is not defined in this module.")

243− (Help.maybeYouWant suggestions)

253+ (maybeYouWant suggestions)

244

254

245 DuplicateExport name ->

255 DuplicateExport name ->

246 namingError

256 namingError

247− ("You are trying to export `" ++ name ++ "` multiple times!")

257+ ("You are trying to export `" <> name <> "` multiple times!")

248 "Remove duplicates until there is only one listed."

258 "Remove duplicates until there is only one listed."

249

259

250 Port (PortError name tipe maybeMessage) ->

260 Port (PortError name tipe maybeMessage) ->

251 let

261 let

252 context =

262 context =

253− maybe "" (" the following " ++ ) maybeMessage

263+ maybe "" (" the following " <> ) maybeMessage

254 in

264 in

255 Report.report

265 Report.report

256 "PORT ERROR"

266 "PORT ERROR"

257 Nothing

267 Nothing

258− ("Port `" ++ name ++ "` is trying to communicate an unsupported type."

268+ ("Port `" <> name <> "` is trying to communicate an unsupported type."

259 )

269 )

260 ( Help.stack

270 ( Help.stack

261− [ text ("The specific unsupported type is" ++ context ++ ":")

271+ [ text ("The specific unsupported type is" <> context <> ":")

262 , indent 4 (RenderType.toDoc localizer tipe)

272 , indent 4 (RenderType.toDoc localizer tipe)

263 , text "The types of values that can flow through in and out of Elm include:"

273 , text "The types of values that can flow through in and out of Elm include:"

264− , indent 4 $ Help.reflowParagraph $

274+ , indent 4 $ reflowParagraph $

265 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\

275 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\

266 \ Tuples, Json.Values, and concrete records."

276 \ Tuples, Json.Values, and concrete records."

267 -- TODO add a note about custom decoders and encoders when they exist!

277 -- TODO add a note about custom decoders and encoders when they exist!

@@ -272,35 +282,38 @@ toReport localizer err =

272 Report.report

282 Report.report

273 "PORT ERROR"

283 "PORT ERROR"

274 Nothing

284 Nothing

275− ("Port `" ++ name ++ "` has an invalid type."

285+ ("Port `" <> name <> "` has an invalid type."

276 )

286 )

277 ( Help.stack

287 ( Help.stack

278 [ text ("You are saying it should be:")

288 [ text ("You are saying it should be:")

279 , indent 4 (RenderType.toDoc localizer tipe)

289 , indent 4 (RenderType.toDoc localizer tipe)

280− , Help.reflowParagraph $

290+ , reflowParagraph $

281 "But you need to use the particular format described here:\

291 "But you need to use the particular format described here:\

282 \ <http://guide.elm-lang.org/interop/javascript.html#ports>"

292 \ <http://guide.elm-lang.org/interop/javascript.html#ports>"

283 ]

293 ]

284 )

294 )

285

295

286

296

287−argMismatchReport :: String -> Var.Canonical -> Int -> Int -> Report.Report

297+argMismatchReport :: Text -> Var.Canonical -> Int -> Int -> Report.Report

288argMismatchReport kind var expected actual =

298argMismatchReport kind var expected actual =

289 let

299 let

290 numArgs =

300 numArgs =

291 "too "

301 "too "

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

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

293− ++ " arguments"

303+ <> " arguments"

294 in

304 in

295 Report.report

305 Report.report

296− (map Char.toUpper numArgs)

306+ (Text.map Char.toUpper numArgs)

297 Nothing

307 Nothing

298− ( kind ++ " " ++ Var.toString var ++ " has " ++ numArgs ++ "."

308+ ( kind <> " " <> Var.toText var <> " has " <> numArgs <> "."

299 )

309 )

310+ ( text $

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

311+ "Expecting " <> i2t expected <> ", but got " <> i2t actual <> "."

312+ )

313+

301

314

302

315

303−extractSuggestions :: Error -> Maybe [String]

316+extractSuggestions :: Error -> Maybe [Text]

304extractSuggestions err =

317extractSuggestions err =

305 case err of

318 case err of

306 Var (VarError _ _ _ suggestions) ->

319 Var (VarError _ _ _ suggestions) ->

@@ -321,7 +334,7 @@ extractSuggestions err =

321 Import _ importError ->

334 Import _ importError ->

322 case importError of

335 case importError of

323 ModuleNotFound suggestions ->

336 ModuleNotFound suggestions ->

324− Just (map ModuleName.toString suggestions)

337+ Just (map ModuleName.toText suggestions)

325

338

326 ValueNotFound _ suggestions ->

339 ValueNotFound _ suggestions ->

327 Just suggestions

340 Just suggestions

@@ -362,50 +375,52 @@ unsafePromote (A.A _ rawType) =

362-- BAD RECURSION

375-- BAD RECURSION

363

376

364

377

365−badSelfRecursion :: Region.Region -> String -> Report.Report

378+badSelfRecursion :: Region.Region -> Text -> Report.Report

366badSelfRecursion region name =

379badSelfRecursion region name =

367 let

380 let

368 header =

381 header =

369− Help.functionName name ++ " is defined directly in terms of itself, causing an infinite loop."

382+ Help.functionName name <> " is defined directly in terms of itself, causing an infinite loop."

370 in

383 in

371 Report.report "BAD RECURSION" (Just region) header $

384 Report.report "BAD RECURSION" (Just region) header $

372 Help.stack

385 Help.stack

373 [ badSelfRecursionHelp "Maybe you are trying to mutate a variable?" $

386 [ badSelfRecursionHelp "Maybe you are trying to mutate a variable?" $

374− "Elm does not have mutation, so when I see " ++ Help.functionName name

387+ "Elm does not have mutation, so when I see " <> Help.functionName name

375− ++ " defined in terms of " ++ Help.functionName name

388+ <> " defined in terms of " <> Help.functionName name

376− ++ ", I treat it as a recursive definition. Try giving the new value a new name!"

389+ <> ", I treat it as a recursive definition. Try giving the new value a new name!"

377 , badSelfRecursionHelp "Maybe you DO want a recursive value?" $

390 , badSelfRecursionHelp "Maybe you DO want a recursive value?" $

378− "To define " ++ Help.functionName name ++ " we need to know what " ++ Help.functionName name

391+ "To define " <> Help.functionName name <> " we need to know what " <> Help.functionName name

379− ++ " is, so let’s expand it. Wait, but now we need to know what " ++ Help.functionName name

392+ <> " is, so let’s expand it. Wait, but now we need to know what " <> Help.functionName name

380− ++ " is, so let’s expand it... This will keep going infinitely!"

393+ <> " is, so let’s expand it... This will keep going infinitely!"

381 , badSelfRecursionHelp "To really learn what is going on and how to fix it, check out:" $

394 , badSelfRecursionHelp "To really learn what is going on and how to fix it, check out:" $

382 Help.hintLink "bad-recursion"

395 Help.hintLink "bad-recursion"

383 ]

396 ]

384

397

385

398

386−badSelfRecursionHelp :: String -> String -> Doc

399+badSelfRecursionHelp :: Text -> Text -> Doc

387badSelfRecursionHelp intro body =

400badSelfRecursionHelp intro body =

401+ fillSep $

388− fillSep $ map (dullyellow . text) (words intro) ++ map text (words body)

402+ map (dullyellow . text) (Text.words intro)

403+ ++ map text (Text.words body)

389

404

390

405

391−badMutualRecursion :: Region.Region -> String -> [String] -> Report.Report

406+badMutualRecursion :: Region.Region -> Text -> [Text] -> Report.Report

392badMutualRecursion region name names =

407badMutualRecursion region name names =

393 let

408 let

394 header =

409 header =

395− Help.functionName name ++ " is defined in terms of itself in a sneaky way, causing an infinite loop."

410+ Help.functionName name <> " is defined in terms of itself in a sneaky way, causing an infinite loop."

396 in

411 in

397 Report.report "BAD RECURSION" (Just region) header $

412 Report.report "BAD RECURSION" (Just region) header $

398 Help.stack

413 Help.stack

399− [ Help.reflowParagraph $

414+ [ reflowParagraph $

400 "The following definitions depend directly on each other:"

415 "The following definitions depend directly on each other:"

401 , indent 4 $ Help.drawCycle (name : names)

416 , indent 4 $ Help.drawCycle (name : names)

402− , Help.reflowParagraph $

417+ , reflowParagraph $

403 "You seem to have a fairly tricky case, so I very highly recommend reading this: "

418 "You seem to have a fairly tricky case, so I very highly recommend reading this: "

404− ++ Help.hintLink "bad-recursion"

419+ <> Help.hintLink "bad-recursion"

405− ++ " It will help you really understand the problem and how to fix it. Read it!"

420+ <> " It will help you really understand the problem and how to fix it. Read it!"

406 ]

421 ]

407

422

408

423

409−defToString :: Canonical.Def -> String

424+defToText :: Canonical.Def -> Text

410−defToString (Canonical.Def _ pattern _ _) =

425+defToText (Canonical.Def _ pattern _ _) =

411− P.toString False pattern

426+ P.toText pattern

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

@@ -1,19 +1,21 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module Reporting.Error.Docs where

3module Reporting.Error.Docs where

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

5+import Data.Text (Text)

6−import qualified Reporting.Error.Helpers as Help

7import qualified Reporting.Report as Report

8+import qualified Reporting.Helpers as Help

9+import Reporting.Helpers ((<>), text)

11data Error

13data Error

12 = NoDocs

14 = NoDocs

13− | OnlyInDocs String [String]

15+ | OnlyInDocs Text [Text]

14− | OnlyInExports [String]

16+ | OnlyInExports [Text]

15− | NoComment String

17+ | NoComment Text

16− | NoType String

18+ | NoType Text

@@ -27,8 +29,8 @@ toReport err =

27 Report.report

29 Report.report

28 "DOCUMENTATION ERROR"

30 "DOCUMENTATION ERROR"

29 Nothing

31 Nothing

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

32+ ( "You must have a documentation comment between the module\

31− ++ "imports."

33+ \ declaration and the imports."

32 )

34 )

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

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

34 )

36 )

@@ -37,29 +39,30 @@ toReport err =

37 Report.report

39 Report.report

38 "DOCUMENTATION ERROR"

40 "DOCUMENTATION ERROR"

39 Nothing

41 Nothing

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

42+ ("Your module documentation includes `" <> name <> "` which is not exported."

43+ )

41 ( text $

44 ( text $

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

45 "Is it misspelled? Should it be exported? "

43− ++ Help.maybeYouWant suggestions

46+ <> Help.maybeYouWant suggestions

44 )

47 )

46 OnlyInExports names ->

49 OnlyInExports names ->

47 Report.report

50 Report.report

48 "DOCUMENTATION ERROR"

51 "DOCUMENTATION ERROR"

49 Nothing

52 Nothing

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

53+ ( "The following exports do not appear in your module documentation: "

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

54+ <> Help.commaSep names

52 )

55 )

53 ( text $

56 ( text $

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

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

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

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

56 )

59 )

58 NoComment name ->

61 NoComment name ->

59 Report.report

62 Report.report

60 "DOCUMENTATION ERROR"

63 "DOCUMENTATION ERROR"

61 Nothing

64 Nothing

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

65+ ("The value `" <> name <> "` does not have a documentation comment.")

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

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

64 )

67 )

@@ -67,8 +70,8 @@ toReport err =

67 Report.report

70 Report.report

68 "MISSING ANNOTATION"

71 "MISSING ANNOTATION"

69 Nothing

72 Nothing

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

73+ ("The value `" <> name <> "` does not have a type annotation.")

71 ( text $

74 ( text $

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

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

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

76+ <> "types and type variables so they are as easy as possible to understand!"

74 )

77 )

src/Reporting/Error/Pattern.hs+18−15

@@ -1,13 +1,16 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module Reporting.Error.Pattern where

3module Reporting.Error.Pattern where

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

5+import Data.Text (Text)

6+import qualified Data.Text as Text

6import qualified Nitpick.Pattern as Pattern

8import qualified Nitpick.Pattern as Pattern

7−import qualified Reporting.Error.Helpers as Help

8import qualified Reporting.Render.Type as RenderType

9import qualified Reporting.Render.Type as RenderType

9import qualified Reporting.Region as Region

10import qualified Reporting.Region as Region

10import qualified Reporting.Report as Report

11import qualified Reporting.Report as Report

12+import qualified Reporting.Helpers as Help

13+import Reporting.Helpers ((<>), text)

@@ -54,39 +57,39 @@ toReport _localizer err =

54 Report.report

57 Report.report

55 "REDUNDANT PATTERN"

58 "REDUNDANT PATTERN"

56 (Just region)

59 (Just region)

57− ("The " ++ Help.ordinalize index ++ " pattern is redundant. Remove it.")

60+ ("The " <> Help.ordinalize index <> " pattern is redundant. Remove it.")

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

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

61−unhandledError :: [Pattern.Pattern] -> String -> String

64+unhandledError :: [Pattern.Pattern] -> Text -> Text

62unhandledError unhandledPatterns relevantMessage =

65unhandledError unhandledPatterns relevantMessage =

63 let

66 let

64 (visiblePatterns, rest) =

67 (visiblePatterns, rest) =

65 splitAt 4 unhandledPatterns

68 splitAt 4 unhandledPatterns

67 patternList =

70 patternList =

68− map Pattern.toString visiblePatterns

71+ map Pattern.toText visiblePatterns

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

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

71 noun =

74 noun =

72 if length unhandledPatterns == 1 then "pattern" else "patterns"

75 if length unhandledPatterns == 1 then "pattern" else "patterns"

73 in

76 in

74− "You need to account for the following " ++ noun ++ ":\n"

77+ "You need to account for the following " <> noun <> ":\n"

75− ++ concatMap ("\n " ++) patternList ++ "\n"

78+ <> Text.concat (map ("\n " <>) patternList) <> "\n"

76− ++ "\n"

79+ <> "\n"

77− ++ relevantMessage ++ "\n"

80+ <> relevantMessage <> "\n"

78− ++ "\n"

81+ <> "\n"

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

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

80− ++ Help.hintLink "missing-patterns" ++ "\n"

83+ <> Help.hintLink "missing-patterns" <> "\n"

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

84+ <> "The recommendations about wildcard patterns and `Debug.crash` are important!"

84−toCaseMessage :: String

87+toCaseMessage :: Text

85toCaseMessage =

88toCaseMessage =

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

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

89−missingBranchesMessage :: Int -> String

92+missingBranchesMessage :: Int -> Text

90missingBranchesMessage numUnhandled =

93missingBranchesMessage numUnhandled =

91 if numUnhandled == 1 then

94 if numUnhandled == 1 then

92 "Add a branch to cover this pattern!"

95 "Add a branch to cover this pattern!"

src/Reporting/Error/Syntax.hs+65−219

@@ -1,52 +1,54 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2module Reporting.Error.Syntax where

3module Reporting.Error.Syntax where

4−import qualified Data.List as List

5+import Data.Text (Text)

5−import qualified Data.Set as Set

6−import qualified Text.Parsec.Error as Parsec

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

9−import qualified Reporting.Error.Helpers as Help

10import qualified Reporting.Render.Type as RenderType

7import qualified Reporting.Render.Type as RenderType

11import qualified Reporting.Region as Region

8import qualified Reporting.Region as Region

12import qualified Reporting.Report as Report

9import qualified Reporting.Report as Report

10+import qualified Reporting.Helpers as Help

11+import Reporting.Helpers ((<>), dullyellow, hsep, i2t, text)

15data Error

14data Error

16− = Parse [Parsec.Message]

15+ = Parse

17 | BadFunctionName Int

16 | BadFunctionName Int

18− | BadPattern String

17+ | BadPattern Text

20 | CommentOnNothing

19 | CommentOnNothing

22 | SettingsOnNormalModule

21 | SettingsOnNormalModule

23 | SettingsOnPortModule

22 | SettingsOnPortModule

24− | DuplicateSettingOnEffectModule String

23+ | DuplicateSettingOnEffectModule Text

25− | BadSettingOnEffectModule String

24+ | BadSettingOnEffectModule Text

26 | NoSettingsOnEffectModule

25 | NoSettingsOnEffectModule

27− | MissingManagerOnEffectModule String

26+ | MissingManagerOnEffectModule Text

28− | UnexpectedPort String

27+ | UnexpectedPort Text

29−

28+

30− | TypeWithoutDefinition String

29+ | TypeWithoutDefinition Text

30+

31+ | DuplicateArgument Text Text

32+ | DuplicateFieldName Region.Region Text

33+ | DuplicateValueDeclaration Text

34+ | DuplicateTypeDeclaration Text

35+ | DuplicateDefinition Text

36+ | UnboundTypeVarsInUnion Text [Text] [Text]

37+ | UnboundTypeVarsInAlias Text [Text] [Text]

38+ | UnusedTypeVarsInAlias Text [Text] [Text]

39+ | MessyTypeVarsInAlias Text [Text] [Text] [Text]

40+ deriving (Show)

32− | DuplicateArgument String String

33− | DuplicateFieldName Region.Region String

34− | DuplicateValueDeclaration String

35− | DuplicateTypeDeclaration String

36− | DuplicateDefinition String

37− | UnboundTypeVarsInUnion String [String] [String]

38− | UnboundTypeVarsInAlias String [String] [String]

39− | UnusedTypeVarsInAlias String [String] [String]

40− | MessyTypeVarsInAlias String [String] [String] [String]

43-- TO REPORT

44-- TO REPORT

46+

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

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

46toReport _localizer err =

48toReport _localizer err =

47 case err of

49 case err of

48− Parse messages ->

50+ Parse ->

49− parseErrorReport messages

51+ Report.report "PARSE ERROR" Nothing "Something is wrong." (text "TODO")

51 BadFunctionName arity ->

53 BadFunctionName arity ->

52 Report.report

54 Report.report

@@ -54,7 +56,7 @@ toReport _localizer err =

54 Nothing

56 Nothing

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

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

56 ( Help.reflowParagraph $

58 ( Help.reflowParagraph $

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

59+ "This function definition has " <> i2t arity <> " arguments, but instead\

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

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

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

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

60 \ be changed to a normal name."

62 \ be changed to a normal name."

@@ -64,13 +66,13 @@ toReport _localizer err =

64 Report.report

66 Report.report

65 "BAD PATTERN"

67 "BAD PATTERN"

66 Nothing

68 Nothing

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

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

68 ( Help.stack

70 ( Help.stack

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

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

70 , Help.reflowParagraph $

72 , Help.reflowParagraph $

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

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

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

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

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

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

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

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

75 ]

77 ]

76 )

78 )

@@ -113,17 +115,17 @@ toReport _localizer err =

113 Report.report

115 Report.report

114 "EFFECT MODULE PROBLEM"

116 "EFFECT MODULE PROBLEM"

115 Nothing

117 Nothing

116− ("You have defined " ++ Help.functionName name ++ " multiple times.")

118+ ("You have defined " <> Help.functionName name <> " multiple times.")

117 ( Help.reflowParagraph $

119 ( Help.reflowParagraph $

118− "There can only be one " ++ Help.functionName name

120+ "There can only be one " <> Help.functionName name

119− ++ " though! Remove until there is one left."

121+ <> " though! Remove until there is one left."

120 )

122 )

121

123

122 BadSettingOnEffectModule name ->

124 BadSettingOnEffectModule name ->

123 Report.report

125 Report.report

124 "EFFECT MODULE PROBLEM"

126 "EFFECT MODULE PROBLEM"

125 Nothing

127 Nothing

126− ("Setting " ++ Help.functionName name ++ " is not recognized.")

128+ ("Setting " <> Help.functionName name <> " is not recognized.")

127 ( Help.reflowParagraph $

129 ( Help.reflowParagraph $

128 "Remove this entry and you should be all set!"

130 "Remove this entry and you should be all set!"

129 )

131 )

@@ -144,7 +146,7 @@ toReport _localizer err =

144 Report.report

146 Report.report

145 "EFFECT MODULE PROBLEM"

147 "EFFECT MODULE PROBLEM"

146 Nothing

148 Nothing

147− ("You are defining an effect module, but there is no " ++ Help.functionName name ++ " defined.")

149+ ("You are defining an effect module, but there is no " <> Help.functionName name <> " defined.")

148 ( Help.reflowParagraph $

150 ( Help.reflowParagraph $

149 "There is a small set of top-level functions and values that must be defined\

151 "There is a small set of top-level functions and values that must be defined\

150 \ in any complete effect module. The best thing is probably to just read more\

152 \ in any complete effect module. The best thing is probably to just read more\

@@ -156,7 +158,7 @@ toReport _localizer err =

156 Report.report

158 Report.report

157 "BAD PORT"

159 "BAD PORT"

158 Nothing

160 Nothing

159− ("You are declaring port " ++ Help.functionName name ++ " in a normal module.")

161+ ("You are declaring port " <> Help.functionName name <> " in a normal module.")

160 ( Help.reflowParagraph $

162 ( Help.reflowParagraph $

161 "All ports must be defined in a `port module`. You should probably have just\

163 "All ports must be defined in a `port module`. You should probably have just\

162 \ one of these for your project. This way all of your foreign interactions\

164 \ one of these for your project. This way all of your foreign interactions\

@@ -167,67 +169,67 @@ toReport _localizer err =

167 Report.report

169 Report.report

168 "MISSING DEFINITION"

170 "MISSING DEFINITION"

169 Nothing

171 Nothing

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

172+ ("There is a type annotation for `" <> valueName <> "` but there"

171− ++ " is no corresponding definition!"

173+ <> " is no corresponding definition!"

172 )

174 )

173 ( text $

175 ( text $

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

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

175− ++ " " ++ valueName ++ " = 42"

177+ <> " " <> valueName <> " = 42"

176 )

178 )

177

179

178 DuplicateArgument funcName argName ->

180 DuplicateArgument funcName argName ->

179 Report.report

181 Report.report

180 "DUPLICATE ARGUMENT"

182 "DUPLICATE ARGUMENT"

181 Nothing

183 Nothing

182− ( "The name `" ++ argName

184+ ( "The name `" <> argName

183− ++ "` is used more than once in the arguments of `"

185+ <> "` is used more than once in the arguments of "

184− ++ funcName ++ "`."

186+ <> Help.functionName funcName <> "."

185 )

187 )

186 ( Help.reflowParagraph $

188 ( Help.reflowParagraph $

187− "Rename things until `" ++ argName ++ "` is used only once.\

189+ "Rename things until `" <> argName <> "` is used only once.\

188 \ Otherwise how can we tell which one you want when you\

190 \ Otherwise how can we tell which one you want when you\

189− \ say `" ++ argName ++ "` it in the body of your function?"

191+ \ say `" <> argName <> "` it in the body of your function?"

190 )

192 )

191

193

192 DuplicateFieldName region name ->

194 DuplicateFieldName region name ->

193 Report.report

195 Report.report

194 "DUPLICATE FIELD"

196 "DUPLICATE FIELD"

195 (Just region)

197 (Just region)

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

198+ ("This record has more than one field named `" <> name <> "`.")

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

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

198

200

199 DuplicateValueDeclaration name ->

201 DuplicateValueDeclaration name ->

200 Report.report

202 Report.report

201 "DUPLICATE DEFINITION"

203 "DUPLICATE DEFINITION"

202 Nothing

204 Nothing

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

205+ ( "Naming multiple top-level values " <> Help.functionName name <> " makes things\n"

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

206+ <> "ambiguous. When you say " <> Help.functionName name <> " which one do you want?"

205 )

207 )

206 ( Help.reflowParagraph $

208 ( Help.reflowParagraph $

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

209+ "Find all the top-level values named " <> Help.functionName name

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

210+ <> " and do some renaming. Make sure the names are distinct!"

209 )

211 )

210

212

211 DuplicateTypeDeclaration name ->

213 DuplicateTypeDeclaration name ->

212 Report.report

214 Report.report

213 "DUPLICATE DEFINITION"

215 "DUPLICATE DEFINITION"

214 Nothing

216 Nothing

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

217+ ( "There are multiple types named `" <> name <> "` in this module."

216 )

218 )

217 ( Help.reflowParagraph $

219 ( Help.reflowParagraph $

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

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

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

221+ <> name <> "`, and give each of them a unique name."

220 )

222 )

221

223

222 DuplicateDefinition name ->

224 DuplicateDefinition name ->

223 Report.report

225 Report.report

224 "DUPLICATE DEFINITION"

226 "DUPLICATE DEFINITION"

225 Nothing

227 Nothing

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

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

227 )

229 )

228 ( Help.reflowParagraph $

230 ( Help.reflowParagraph $

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

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

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

232+ <> name <> "`, and give each of them a unique name."

231 )

233 )

232

234

233 UnboundTypeVarsInUnion typeName givenVars unbound ->

235 UnboundTypeVarsInUnion typeName givenVars unbound ->

@@ -240,8 +242,8 @@ toReport _localizer err =

240 Report.report

242 Report.report

241 "UNUSED TYPE VARIABLES"

243 "UNUSED TYPE VARIABLES"

242 Nothing

244 Nothing

243− ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "

245+ ( "Type alias `" <> typeName <> "` cannot have unused type variables: "

244− ++ Help.commaSep unused

246+ <> Help.commaSep unused

245 )

247 )

246 ( Help.stack

248 ( Help.stack

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

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

@@ -254,15 +256,15 @@ toReport _localizer err =

254 Report.report

256 Report.report

255 "TYPE VARIABLE PROBLEMS"

257 "TYPE VARIABLE PROBLEMS"

256 Nothing

258 Nothing

257− ( "Type alias `" ++ typeName ++ "` has some problems with type variables."

259+ ( "Type alias `" <> typeName <> "` has some problems with type variables."

258 )

260 )

259 ( Help.stack

261 ( Help.stack

260 [ Help.reflowParagraph $

262 [ Help.reflowParagraph $

261 "The declaration says it uses certain type variables ("

263 "The declaration says it uses certain type variables ("

262− ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "

264+ <> Help.commaSep unused <> ") but they do not appear in the aliased type. "

263− ++ "Furthermore, the aliased type says it uses type variables ("

265+ <> "Furthermore, the aliased type says it uses type variables ("

264− ++ Help.commaSep unbound

266+ <> Help.commaSep unbound

265− ++ ") that do not appear in the declaration."

267+ <> ") that do not appear in the declaration."

266 , text "You probably need to change the declaration like this:"

268 , text "You probably need to change the declaration like this:"

267 , dullyellow $ hsep $

269 , dullyellow $ hsep $

268 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])

270 map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "..."])

@@ -270,13 +272,13 @@ toReport _localizer err =

270 )

272 )

271

273

272

274

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

275+unboundTypeVars :: Text -> Text -> [Text] -> [Text] -> Report.Report

274unboundTypeVars declKind typeName givenVars unboundVars =

276unboundTypeVars declKind typeName givenVars unboundVars =

275 Report.report

277 Report.report

276 "UNBOUND TYPE VARIABLES"

278 "UNBOUND TYPE VARIABLES"

277 Nothing

279 Nothing

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

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

279− ++ Help.commaSep unboundVars

281+ <> Help.commaSep unboundVars

280 )

282 )

281 ( Help.stack

283 ( Help.stack

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

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

@@ -285,164 +287,8 @@ unboundTypeVars declKind typeName givenVars unboundVars =

285 ++ map (dullyellow . text) unboundVars

287 ++ map (dullyellow . text) unboundVars

286 ++ map text ["=", "..."]

288 ++ map text ["=", "..."]

287 , Help.reflowParagraph $

289 , Help.reflowParagraph $

288− "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ head unboundVars ++

290+ "Here's why. Imagine one `" <> typeName <> "` where `" <> head unboundVars <>

289 "` is an Int and another where it is a Bool. When we explicitly list the type\

291 "` is an Int and another where it is a Bool. When we explicitly list the type\

290 \ variables, the type checker can see that they are actually different types."

292 \ variables, the type checker can see that they are actually different types."

291 ]

293 ]

292 )

294 )

293−

294−

295−

296−-- TAGGING PARSE ERRORS

297−

298−

299−newline :: String

300−newline = "NEWLINE"

301−

302−

303−freshLine :: String

304−freshLine = "FRESH_LINE"

305−

306−

307−whitespace :: String

308−whitespace = "WHITESPACE"

309−

310−

311−tab :: String

312−tab = "TAB"

313−

314−

315−singleQuotes :: String

316−singleQuotes = "SINGLE_QUOTES"

317−

318−

319−keyword :: String -> String

320−keyword kwd =

321− "KEYWORD=" ++ kwd

322−

323−

324−prime :: String -> String

325−prime var =

326− "PRIME=" ++ var

327−

328−

329−data SpecialMessage

330− = MsgKeyword String

331− | MsgPrime String

332− | MsgSingleQuotes

333− | MsgTab

334−

335−

336−extractSpecialMessage :: String -> Maybe SpecialMessage

337−extractSpecialMessage message =

338− if List.isPrefixOf "KEYWORD=" message then

339− Just $ MsgKeyword (drop (length "KEYWORD=") message)

340−

341− else if List.isPrefixOf "PRIME=" message then

342− Just $ MsgPrime (drop (length "PRIME=") message)

343−

344− else if tab == message then

345− Just MsgTab

346−

347− else if singleQuotes == message then

348− Just MsgSingleQuotes

349−

350− else

351− Nothing

352−

353−

354−-- REPORTING PARSE ERRORS

355−

356−parseErrorReport :: [Parsec.Message] -> Report.Report

357−parseErrorReport messages =

358− let

359− addMsg message hint =

360− case message of

361− Parsec.SysUnExpect _msg ->

362− hint

363−

364− Parsec.UnExpect _msg ->

365− hint

366−

367− Parsec.Expect msg ->

368− let

369− msg' =

370− if msg `elem` [whitespace, newline, freshLine] then

371− "whitespace"

372− else

373− msg

374− in

375− if msg == tab then

376− -- Our parser looks for tab so it can throw a custom tab error message.

377− -- Exclude tabs from the list of expected tokens so that no one thinks they are supported.

378− hint

379− else

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

381−

382− Parsec.Message msg ->

383− hint { _messages = msg : _messages hint }

384−

385− (ParseHint msgs expects) =

386− foldr addMsg emptyHint messages

387−

388− (preHint, maybePost) =

389− case msgs of

390− [msg] ->

391− case extractSpecialMessage msg of

392− Just (MsgKeyword kwd) ->

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

394− , Just "Rename it to something else."

395− )

396−

397− Just (MsgPrime var) ->

398− ( "Ran into a single quote in a variable name. This was removed in 0.18!"

399− , Just $

400− "Change it to a number or an underscore, like " ++ var ++ "_ or " ++ var

401− ++ "1\n\nOr better yet, choose a more descriptive name!"

402− )

403−

404− Just MsgTab ->

405− ( "A tab character was found, but all whitespace (including indentation) must be spaces not tabs."

406− , Just "I am looking for spaces, not tabs."

407− )

408−

409− Just MsgSingleQuotes ->

410− ( "It likes you are trying to create a string with single quotes."

411− , Just "Switch from ' to \" and you should be all set!"

412− )

413−

414− Nothing ->

415− ( msg

416− , Nothing

417− )

418−

419− _ ->

420− ( "I ran into something unexpected when parsing your code!"

421− , Nothing

422− )

423−

424− postHint =

425− if Set.null expects then

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

427−

428− else

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

430− ++ concatMap ("\n "++) (Set.toList expects)

431− in

432− Report.report

433− "SYNTAX PROBLEM"

434− Nothing

435− preHint

436− (text (maybe postHint id maybePost))

437−

438−

439−data ParseHint = ParseHint

440− { _messages :: [String]

441− , _expected :: Set.Set String

442− }

443− deriving (Show)

444−

445−

446−emptyHint :: ParseHint

447−emptyHint =

448− ParseHint [] Set.empty

src/Reporting/Error/Type.hs+188−166

@@ -1,22 +1,32 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Error.Type where

3+module Reporting.Error.Type

4+ ( Error(..)

5+ , Mismatch(..), Hint(..)

6+ , Reason(..), VarType(..)

7+ , Pattern(..)

8+ , toReport

9+ , flipReason

10+ )

11+ where

4import Control.Arrow (first, second)

13import Control.Arrow (first, second)

5−import qualified Data.List as List

6import qualified Data.Map as Map

14import qualified Data.Map as Map

7import qualified Data.Maybe as Maybe

15import qualified Data.Maybe as Maybe

8−import Text.PrettyPrint.ANSI.Leijen

16+import qualified Data.Text as Text

9− ( Doc, (<>), (<+>), colon, dullyellow

17+import Data.Text (Text)

10− , fillSep, indent, text, underline, vcat

11− )

13import qualified AST.Helpers as Help

19import qualified AST.Helpers as Help

14import qualified AST.Type as Type

20import qualified AST.Type as Type

15import qualified AST.Variable as Var

21import qualified AST.Variable as Var

16−import qualified Reporting.Error.Helpers as Help

17import qualified Reporting.Region as Region

22import qualified Reporting.Region as Region

18import qualified Reporting.Render.Type as RenderType

23import qualified Reporting.Render.Type as RenderType

19import qualified Reporting.Report as Report

24import qualified Reporting.Report as Report

25+import qualified Reporting.Helpers as Help

26+import Reporting.Helpers

27+ ( Doc, (<>), (<+>), capitalize, colon, dullyellow, fillSep, functionName

28+ , i2t, indent, ordinalize, reflowParagraph, stack, text, underline, vcat

29+ )

@@ -26,8 +36,8 @@ import qualified Reporting.Report as Report

26data Error

36data Error

27 = Mismatch Mismatch

37 = Mismatch Mismatch

28 | BadMain Type.Canonical

38 | BadMain Type.Canonical

29− | BadFlags Type.Canonical (Maybe String)

39+ | BadFlags Type.Canonical (Maybe Text)

30− | InfiniteType String Type.Canonical

40+ | InfiniteType Text Type.Canonical

33data Mismatch = MismatchInfo

43data Mismatch = MismatchInfo

@@ -39,8 +49,8 @@ data Mismatch = MismatchInfo

41data Reason

51data Reason

42− = BadFields [(String, Maybe Reason)]

52+ = BadFields [(Text, Maybe Reason)]

43− | MessyFields [String] [String] [String]

53+ | MessyFields [Text] [Text] [Text]

44 | IntFloat

54 | IntFloat

45 | TooLongComparableTuple Int

55 | TooLongComparableTuple Int

46 | MissingArgs Int

56 | MissingArgs Int

@@ -52,7 +62,7 @@ data VarType

52 | Comparable

62 | Comparable

53 | Appendable

63 | Appendable

54 | CompAppend

64 | CompAppend

55− | Rigid (Maybe String)

65+ | Rigid (Maybe Text)

58data Hint

68data Hint

@@ -70,24 +80,24 @@ data Hint

70 | Function (Maybe Var.Canonical)

80 | Function (Maybe Var.Canonical)

71 | UnexpectedArg (Maybe Var.Canonical) Int Int Region.Region

81 | UnexpectedArg (Maybe Var.Canonical) Int Int Region.Region

72 | FunctionArity (Maybe Var.Canonical) Int Int Region.Region

82 | FunctionArity (Maybe Var.Canonical) Int Int Region.Region

73− | ReturnType String Int Int Region.Region

83+ | ReturnType Text Int Int Region.Region

74− | Instance String

84+ | Instance Text

75− | Literal String

85+ | Literal Text

76 | Pattern Pattern

86 | Pattern Pattern

77 | Shader

87 | Shader

78 | Lambda

88 | Lambda

79− | Access (Maybe String) String

89+ | Access (Maybe Text) Text

80 | Record

90 | Record

81 -- effect manager problems

91 -- effect manager problems

82− | Manager String

92+ | Manager Text

83− | State String

93+ | State Text

84 | SelfMsg

94 | SelfMsg

87data Pattern

97data Pattern

88− = PVar String

98+ = PVar Text

89− | PAlias String

99+ | PAlias Text

90− | PData String

100+ | PCtor Var.Canonical

91 | PRecord

101 | PRecord

102

103

@@ -109,8 +119,8 @@ toReport localizer err =

109 "BAD MAIN TYPE"

119 "BAD MAIN TYPE"

110 Nothing

120 Nothing

111 "The `main` value has an unsupported type."

121 "The `main` value has an unsupported type."

112− ( Help.stack

122+ ( stack

113− [ Help.reflowParagraph $

123+ [ reflowParagraph $

114 "I need Html, Svg, or a Program so I have something to render on\

124 "I need Html, Svg, or a Program so I have something to render on\

115 \ screen, but you gave me:"

125 \ screen, but you gave me:"

116 , indent 4 (RenderType.toDoc localizer tipe)

126 , indent 4 (RenderType.toDoc localizer tipe)

@@ -120,24 +130,25 @@ toReport localizer err =

120 BadFlags tipe maybeMessage ->

130 BadFlags tipe maybeMessage ->

121 let

131 let

122 context =

132 context =

123− maybe "" (" the following " ++ ) maybeMessage

133+ maybe "" (" the following " <> ) maybeMessage

124 in

134 in

125 Report.report

135 Report.report

126 "BAD FLAGS"

136 "BAD FLAGS"

127 Nothing

137 Nothing

128 ("Your `main` is demanding an unsupported type as a flag."

138 ("Your `main` is demanding an unsupported type as a flag."

129 )

139 )

130− ( Help.stack

140+ ( stack

131− [ text ("The specific unsupported type is" ++ context ++ ":")

141+ [ text ("The specific unsupported type is" <> context <> ":")

132 , indent 4 (RenderType.toDoc localizer tipe)

142 , indent 4 (RenderType.toDoc localizer tipe)

133 , text "The types of values that can flow through in and out of Elm include:"

143 , text "The types of values that can flow through in and out of Elm include:"

134− , indent 4 $ Help.reflowParagraph $

144+ , indent 4 $ reflowParagraph $

135 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\

145 "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\

136 \ Tuples, Json.Values, and concrete records."

146 \ Tuples, Json.Values, and concrete records."

137 ]

147 ]

138 )

148 )

139

149

140

150

151+

141-- TYPE MISMATCHES

152-- TYPE MISMATCHES

142

153

143

154

@@ -152,18 +163,18 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

152

163

153 cmpHint leftWords rightWords extraHints =

164 cmpHint leftWords rightWords extraHints =

154 comparisonHint localizer leftType rightType leftWords rightWords

165 comparisonHint localizer leftType rightType leftWords rightWords

155− (typicalHints ++ map toHint extraHints)

166+ (typicalHints <> map toHint extraHints)

156 in

167 in

157 case hint of

168 case hint of

158 CaseBranch branchNumber region ->

169 CaseBranch branchNumber region ->

159 report

170 report

160 (Just region)

171 (Just region)

161− ( "The " ++ ordinalPair branchNumber

172+ ( "The " <> ordinalPair branchNumber

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

173+ <> " branches of this `case` produce different types of values."

163 )

174 )

164 ( cmpHint

175 ( cmpHint

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

176+ ("The " <> ordinalize (branchNumber - 1) <> " branch has this type:")

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

177+ ("But the " <> ordinalize branchNumber <> " is:")

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

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

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

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

169 ]

180 ]

@@ -173,7 +184,7 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

173 report

184 report

174 Nothing

185 Nothing

175 ( "All the branches of this case-expression are consistent, but the overall\n"

186 ( "All the branches of this case-expression are consistent, but the overall\n"

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

187+ <> "type does not match how it is used elsewhere."

177 )

188 )

178 ( cmpHint

189 ( cmpHint

179 "The `case` evaluates to something of type:"

190 "The `case` evaluates to something of type:"

@@ -208,12 +219,12 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

208 MultiIfBranch branchNumber region ->

219 MultiIfBranch branchNumber region ->

209 report

220 report

210 (Just region)

221 (Just region)

211− ( "The " ++ ordinalPair branchNumber

222+ ( "The " <> ordinalPair branchNumber

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

223+ <> " branches of this `if` produce different types of values."

213 )

224 )

214 ( cmpHint

225 ( cmpHint

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

226+ ("The " <> ordinalize (branchNumber - 1) <> " branch has this type:")

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

227+ ("But the "<> ordinalize branchNumber <> " is:")

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

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

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

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

219 ]

230 ]

@@ -233,10 +244,10 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

233 ListElement elementNumber region ->

244 ListElement elementNumber region ->

234 report

245 report

235 (Just region)

246 (Just region)

236− ("The " ++ ordinalPair elementNumber ++ " entries in this list are different types of values.")

247+ ("The " <> ordinalPair elementNumber <> " entries in this list are different types of values.")

237 ( cmpHint

248 ( cmpHint

238− ("The " ++ Help.ordinalize (elementNumber - 1) ++ " entry has this type:")

249+ ("The " <> ordinalize (elementNumber - 1) <> " entry has this type:")

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

250+ ("But the "<> ordinalize elementNumber <> " is:")

240 [ "Every entry in a list needs to be the same type of value.\

251 [ "Every entry in a list needs to be the same type of value.\

241 \ This way you never run into unexpected values partway through.\

252 \ This way you never run into unexpected values partway through.\

242 \ To mix different types in a single list, create a \"union type\" as\

253 \ To mix different types in a single list, create a \"union type\" as\

@@ -247,8 +258,8 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

247 List ->

258 List ->

248 report

259 report

249 Nothing

260 Nothing

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

261+ ( "All the elements in this list are the same type, but the overall\

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

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

252 )

263 )

253 ( cmpHint

264 ( cmpHint

254 "The list has type:"

265 "The list has type:"

@@ -259,9 +270,9 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

259 BinopLeft op region ->

270 BinopLeft op region ->

260 report

271 report

261 (Just region)

272 (Just region)

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

273+ ("The left argument of " <> varName op <> " is causing a type mismatch.")

263 ( cmpHint

274 ( cmpHint

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

275+ (varName op <> " is expecting the left argument to be a:")

265 "But the left argument is:"

276 "But the left argument is:"

266 (binopHint op leftType rightType)

277 (binopHint op leftType rightType)

267 )

278 )

@@ -269,13 +280,13 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

269 BinopRight op region ->

280 BinopRight op region ->

270 report

281 report

271 (Just region)

282 (Just region)

272− ("The right side of " ++ prettyName op ++ " is causing a type mismatch.")

283+ ("The right side of " <> varName op <> " is causing a type mismatch.")

273 ( cmpHint

284 ( cmpHint

274− (prettyName op ++ " is expecting the right side to be a:")

285+ (varName op <> " is expecting the right side to be a:")

275 "But the right side is:"

286 "But the right side is:"

276 ( binopHint op leftType rightType

287 ( binopHint op leftType rightType

277 ++

288 ++

278− [ "With operators like " ++ prettyName op ++ " I always check the left\

289+ [ "With operators like " <> varName op <> " I always check the left\

279 \ side first. If it seems fine, I assume it is correct and check the right\

290 \ side first. If it seems fine, I assume it is correct and check the right\

280 \ side. So the problem may be in how the left and right arguments interact."

291 \ side. So the problem may be in how the left and right arguments interact."

281 ]

292 ]

@@ -285,7 +296,7 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

285 Binop op ->

296 Binop op ->

286 report

297 report

287 Nothing

298 Nothing

288− ( "The two arguments to " ++ prettyName op ++

299+ ( "The two arguments to " <> varName op <>

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

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

290 \ does not match how it is used elsewhere."

301 \ does not match how it is used elsewhere."

291 )

302 )

@@ -298,7 +309,7 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

298 Function maybeName ->

309 Function maybeName ->

299 report

310 report

300 Nothing

311 Nothing

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

312+ ( "The return type of " <> maybeFuncName maybeName <> " is being used in unexpected ways."

302 )

313 )

303 ( cmpHint

314 ( cmpHint

304 "The function results in this type of value:"

315 "The function results in this type of value:"

@@ -309,9 +320,9 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

309 UnexpectedArg maybeName 1 1 region ->

320 UnexpectedArg maybeName 1 1 region ->

310 report

321 report

311 (Just region)

322 (Just region)

312− ("The argument to " ++ funcName maybeName ++ " is causing a mismatch.")

323+ ("The argument to " <> maybeFuncName maybeName <> " is causing a mismatch.")

313 ( cmpHint

324 ( cmpHint

314− (Help.capitalize (funcName maybeName) ++ " is expecting the argument to be:")

325+ (capitalize (maybeFuncName maybeName) <> " is expecting the argument to be:")

315 "But it is:"

326 "But it is:"

316 (functionHint maybeName)

327 (functionHint maybeName)

317 )

328 )

@@ -319,12 +330,12 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

319 UnexpectedArg maybeName index _totalArgs region ->

330 UnexpectedArg maybeName index _totalArgs region ->

320 report

331 report

321 (Just region)

332 (Just region)

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

333+ ( "The " <> ordinalize index <> " argument to " <> maybeFuncName maybeName

323− ++ " is causing a mismatch."

334+ <> " is causing a mismatch."

324 )

335 )

325 ( cmpHint

336 ( cmpHint

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

337+ ( capitalize (maybeFuncName maybeName) <> " is expecting the "

327− ++ Help.ordinalize index ++ " argument to be:"

338+ <> ordinalize index <> " argument to be:"

328 )

339 )

329 "But it is:"

340 "But it is:"

330 ( functionHint maybeName

341 ( functionHint maybeName

@@ -335,23 +346,23 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

335 [ "I always figure out the type of arguments from left to right. If an argument\

346 [ "I always figure out the type of arguments from left to right. If an argument\

336 \ is acceptable when I check it, I assume it is \"correct\" in subsequent checks.\

347 \ is acceptable when I check it, I assume it is \"correct\" in subsequent checks.\

337 \ So the problem may actually be in how previous arguments interact with the "

348 \ So the problem may actually be in how previous arguments interact with the "

338− ++ Help.ordinalize index ++ "."

349+ <> ordinalize index <> "."

339 ]

350 ]

340 )

351 )

341 )

352 )

342

353

343 FunctionArity maybeName 0 actual region ->

354 FunctionArity maybeName 0 actual region ->

344 let

355 let

345− arg =

356+ args =

346− if actual == 1 then "an argument" else show actual ++ " arguments"

357+ if actual == 1 then "an argument" else i2t actual <> " arguments"

347

358

348 preHint =

359 preHint =

349 case maybeName of

360 case maybeName of

350 Nothing ->

361 Nothing ->

351− "You are giving " ++ arg ++ " to something that is not a function!"

362+ "You are giving " <> args <> " to something that is not a function!"

352

363

353 Just name ->

364 Just name ->

354− prettyName name ++ " is not a function, but you are giving it " ++ arg ++ "!"

365+ varName name <> " is not a function, but you are giving it " <> args <> "!"

355 in

366 in

356 report

367 report

357 (Just region)

368 (Just region)

@@ -361,8 +372,8 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

361 FunctionArity maybeName expected actual region ->

372 FunctionArity maybeName expected actual region ->

362 report

373 report

363 (Just region)

374 (Just region)

364− ( Help.capitalize (funcName maybeName) ++ " is expecting "

375+ ( capitalize (maybeFuncName maybeName) <> " is expecting "

365− ++ Help.args expected ++ ", but was given " ++ show actual ++ "."

376+ <> Help.args expected <> ", but was given " <> i2t actual <> "."

366 )

377 )

367 (text "Maybe you forgot some parentheses? Or a comma?")

378 (text "Maybe you forgot some parentheses? Or a comma?")

368

379

@@ -370,9 +381,9 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

370 if typeArity == 0 || argArity == 0 then

381 if typeArity == 0 || argArity == 0 then

371 report

382 report

372 (Just region)

383 (Just region)

373− ("The definition of " ++ Help.functionName name ++ " does not match its type annotation.")

384+ ("The definition of " <> functionName name <> " does not match its type annotation.")

374 ( cmpHint

385 ( cmpHint

375− ( "The type annotation for " ++ Help.functionName name ++ " says it is a:"

386+ ( "The type annotation for " <> functionName name <> " says it is a:"

376 )

387 )

377 "But the definition (shown above) is a:"

388 "But the definition (shown above) is a:"

378 (arityHint typeArity argArity)

389 (arityHint typeArity argArity)

@@ -381,20 +392,24 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

381 else

392 else

382 report

393 report

383 (Just region)

394 (Just region)

384− ("The definition of " ++ Help.functionName name ++ " does not match its type annotation.")

395+ ("The definition of " <> functionName name <> " does not match its type annotation.")

385 ( cmpHint

396 ( cmpHint

386− ( "The type annotation for " ++ Help.functionName name ++ " says it always returns:"

397+ ( "The type annotation for " <> functionName name <> " says it always returns:"

387 )

398 )

388 "But the returned value (shown above) is a:"

399 "But the returned value (shown above) is a:"

389 (arityHint typeArity argArity)

400 (arityHint typeArity argArity)

390 )

401 )

391

402

392− Instance name ->

403+ Instance var ->

404+ let

405+ name =

406+ functionName var

407+ in

393 report

408 report

394 Nothing

409 Nothing

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

410+ (name <> " is being used in an unexpected way.")

396 ( cmpHint

411 ( cmpHint

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

412+ ("Based on its definition, " <> name <> " has this type:")

398 "But you are trying to use it as:"

413 "But you are trying to use it as:"

399 []

414 []

400 )

415 )

@@ -402,10 +417,10 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

402 Literal name ->

417 Literal name ->

403 report

418 report

404 Nothing

419 Nothing

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

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

406 )

421 )

407 ( cmpHint

422 ( cmpHint

408− ("The " ++ name ++ " definitely has this type:")

423+ ("The " <> name <> " definitely has this type:")

409 ("But it is being used as:")

424 ("But it is being used as:")

410 []

425 []

411 )

426 )

@@ -414,15 +429,24 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

414 let

429 let

415 thing =

430 thing =

416 case patErr of

431 case patErr of

432+ PVar name ->

417− PVar name -> "variable `" ++ name ++ "`"

433+ "variable `" <> name <> "`"

434+

418− PAlias name -> "alias `" ++ name ++ "`"

435+ PAlias name ->

436+ "alias `" <> name <> "`"

437+

438+ PRecord ->

419− PRecord -> "this record"

439+ "this record"

420− PData name ->

440+

421− if Help.isTuple name then "this tuple" else "tag `" ++ name ++ "`"

441+ PCtor (Var.Canonical Var.BuiltIn name) | Help.isTuple name ->

442+ "this tuple"

443+

444+ PCtor name ->

445+ "tag `" <> Var.toText name <> "`"

422 in

446 in

423 report

447 report

424 Nothing

448 Nothing

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

449+ ( capitalize thing <> " is causing problems in this pattern match."

426 )

450 )

427 ( cmpHint

451 ( cmpHint

428 "The pattern matches things of type:"

452 "The pattern matches things of type:"

@@ -452,25 +476,23 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

452

476

453 Access (Just body) field ->

477 Access (Just body) field ->

454 let

478 let

455− header =

456− "`" ++ body ++ "` does not have a field named `" ++ field ++ "`."

479+ header = "`" <> body <> "` does not have a field named `" <> field <> "`."

457 in

480 in

458− report Nothing header $ Help.stack $

481+ report Nothing header $ stack $

459− [ Help.reflowParagraph $ "The type of `" ++ body ++ "` is:"

482+ [ reflowParagraph $ "The type of `" <> body <> "` is:"

460 , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType

483 , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType

461− , Help.reflowParagraph $ "Which does not contain a field named `" ++ field ++ "`."

484+ , reflowParagraph $ "Which does not contain a field named `" <> field <> "`."

462 ]

485 ]

463 ++ typicalHints

486 ++ typicalHints

464

487

465 Access Nothing field ->

488 Access Nothing field ->

466 let

489 let

467− header =

468− "Cannot access a field named `" ++ field ++ "`."

490+ header = "Cannot access a field named `" <> field <> "`."

469 in

491 in

470− report Nothing header $ Help.stack $

492+ report Nothing header $ stack $

471− [ Help.reflowParagraph $ "You are trying to get `" ++ field ++ "` from a value with this type:"

493+ [ reflowParagraph $ "You are trying to get `" <> field <> "` from a value with this type:"

472 , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType

494 , indent 4 $ dullyellow $ RenderType.toDoc localizer leftType

473− , Help.reflowParagraph $ "It is not in there!"

495+ , reflowParagraph $ "It is not in there!"

474 ]

496 ]

475 ++ typicalHints

497 ++ typicalHints

476

498

@@ -487,9 +509,9 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

487 Manager name ->

509 Manager name ->

488 report

510 report

489 Nothing

511 Nothing

490− ("The `" ++ name ++ "` in your effect manager has a weird type.")

512+ ("The `" <> name <> "` in your effect manager has a weird type.")

491 ( cmpHint

513 ( cmpHint

492− ("Your `" ++ name ++ "` function has this type:")

514+ ("Your `" <> name <> "` function has this type:")

493 "But it needs to have a type like this:"

515 "But it needs to have a type like this:"

494 [ "You can read more about setting up effect managers properly here:\

516 [ "You can read more about setting up effect managers properly here:\

495 \ <http://guide.elm-lang.org/effect_managers/>"

517 \ <http://guide.elm-lang.org/effect_managers/>"

@@ -500,11 +522,11 @@ mismatchToReport localizer (MismatchInfo hint leftType rightType maybeReason) =

500 report

522 report

501 Nothing

523 Nothing

502 ( "Your effect manager creates a certain type of state with `init`, but your `"

524 ( "Your effect manager creates a certain type of state with `init`, but your `"

503− ++ name ++ "` function expects a different kind of state."

525+ <> name <> "` function expects a different kind of state."

504 )

526 )

505 ( cmpHint

527 ( cmpHint

506 "The state created by `init` has this type:"

528 "The state created by `init` has this type:"

507− ("But `" ++ name ++ "` expects state of this type:")

529+ ("But `" <> name <> "` expects state of this type:")

508 [ "Make the two state types match and you should be all set! More info here:\

530 [ "Make the two state types match and you should be all set! More info here:\

509 \ <http://guide.elm-lang.org/effect_managers/>"

531 \ <http://guide.elm-lang.org/effect_managers/>"

510 ]

532 ]

@@ -529,8 +551,8 @@ comparisonHint

529 :: RenderType.Localizer

551 :: RenderType.Localizer

530 -> Type.Canonical

552 -> Type.Canonical

531 -> Type.Canonical

553 -> Type.Canonical

532− -> String

554+ -> Text

533− -> String

555+ -> Text

534 -> [Doc]

556 -> [Doc]

535 -> Doc

557 -> Doc

536comparisonHint localizer leftType rightType leftWords rightWords finalHints =

558comparisonHint localizer leftType rightType leftWords rightWords finalHints =

@@ -538,10 +560,10 @@ comparisonHint localizer leftType rightType leftWords rightWords finalHints =

538 (leftDoc, rightDoc) =

560 (leftDoc, rightDoc) =

539 RenderType.diffToDocs localizer leftType rightType

561 RenderType.diffToDocs localizer leftType rightType

540 in

562 in

541− Help.stack $

563+ stack $

542− [ Help.reflowParagraph leftWords

564+ [ reflowParagraph leftWords

543 , indent 4 leftDoc

565 , indent 4 leftDoc

544− , Help.reflowParagraph rightWords

566+ , reflowParagraph rightWords

545 , indent 4 rightDoc

567 , indent 4 rightDoc

546 ]

568 ]

547 ++

569 ++

@@ -552,7 +574,7 @@ comparisonHint localizer leftType rightType leftWords rightWords finalHints =

552-- BINOP HINTS

574-- BINOP HINTS

553

575

554

576

555−binopHint :: Var.Canonical -> Type.Canonical -> Type.Canonical -> [String]

577+binopHint :: Var.Canonical -> Type.Canonical -> Type.Canonical -> [Text]

556binopHint op leftType rightType =

578binopHint op leftType rightType =

557 let

579 let

558 leftString =

580 leftString =

@@ -561,12 +583,12 @@ binopHint op leftType rightType =

561 rightString =

583 rightString =

562 show (RenderType.toDoc Map.empty rightType)

584 show (RenderType.toDoc Map.empty rightType)

563 in

585 in

564− if Var.is ["Basics"] "+" op && elem "String" [leftString, rightString] then

586+ if Var.is "Basics" "+" op && elem "String" [leftString, rightString] then

565− [ "To append strings in Elm, you need to use the (++) operator, not (+). "

587+ [ "To append strings in Elm, you need to use the (++) operator, not (+).\

566− ++ "<http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#++>"

588+ \ <http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#++>"

567 ]

589 ]

568

590

569− else if Var.is ["Basics"] "/" op && elem "Int" [leftString, rightString] then

591+ else if Var.is "Basics" "/" op && elem "Int" [leftString, rightString] then

570 [ "The (/) operator is specifically for floating point division, and (//) is\

592 [ "The (/) operator is specifically for floating point division, and (//) is\

571 \ for integer division. You may need to do some conversions between ints and\

593 \ for integer division. You may need to do some conversions between ints and\

572 \ floats to get both arguments matching the division operator you want."

594 \ floats to get both arguments matching the division operator you want."

@@ -580,14 +602,14 @@ binopHint op leftType rightType =

580-- FUNCTION HINTS

602-- FUNCTION HINTS

581

603

582

604

583−functionHint :: Maybe Var.Canonical -> [String]

605+functionHint :: Maybe Var.Canonical -> [Text]

584functionHint maybeName =

606functionHint maybeName =

585 case maybeName of

607 case maybeName of

586 Nothing ->

608 Nothing ->

587 []

609 []

588

610

589 Just name ->

611 Just name ->

590− if Var.inHtml ["Html","App"] "program" == name then

612+ if Var.inHtml "Html" "program" == name then

591 [ "Does your program have flags? Maybe you want `programWithFlags` instead."

613 [ "Does your program have flags? Maybe you want `programWithFlags` instead."

592 ]

614 ]

593

615

@@ -599,20 +621,21 @@ functionHint maybeName =

599-- ARITY HINTS

621-- ARITY HINTS

600

622

601

623

602−arityHint :: Int -> Int -> [String]

624+arityHint :: Int -> Int -> [Text]

603arityHint typeArity argArity =

625arityHint typeArity argArity =

604 if typeArity == argArity then

626 if typeArity == argArity then

605 []

627 []

606

628

607 else

629 else

608− [ "The type annotation says there " ++ sayArgs typeArity

630+ [ "The type annotation says there " <> sayArgs typeArity <>

609− ++ ", but there " ++ sayArgs argArity ++ " named in the definition."

631+ ", but there " <> sayArgs argArity <>

610− ++ " It is best practice for each argument in the type to correspond"

632+ " named in the definition. It is best practice for each argument\

611− ++ " to a named argument in the definition, so try that first!"

633+ \ in the type to correspond to a named argument in the definition,\

634+ \ so try that first!"

612 ]

635 ]

613

636

614

637

615−sayArgs :: Int -> String

638+sayArgs :: Int -> Text

616sayArgs n =

639sayArgs n =

617 case n of

640 case n of

618 0 ->

641 0 ->

@@ -622,31 +645,31 @@ sayArgs n =

622 "is 1 argument"

645 "is 1 argument"

623

646

624 _ ->

647 _ ->

625− "are " ++ show n ++ " arguments"

648+ "are " <> i2t n <> " arguments"

626

649

627

650

628

651

629-- MISMATCH HELPERS

652-- MISMATCH HELPERS

630

653

631

654

632−ordinalPair :: Int -> String

655+ordinalPair :: Int -> Text

633ordinalPair number =

656ordinalPair number =

634− Help.ordinalize (number -1 ) ++ " and " ++ Help.ordinalize number

657+ ordinalize (number - 1) <> " and " <> ordinalize number

635

658

636

659

637−prettyName :: Var.Canonical -> String

660+varName :: Var.Canonical -> Text

638−prettyName (Var.Canonical _ opName) =

661+varName (Var.Canonical _ opName) =

639− Help.functionName opName

662+ functionName opName

640

663

641

664

642−funcName :: Maybe Var.Canonical -> String

665+maybeFuncName :: Maybe Var.Canonical -> Text

643−funcName maybeVar =

666+maybeFuncName maybeVar =

644 case maybeVar of

667 case maybeVar of

645 Nothing ->

668 Nothing ->

646 "this function"

669 "this function"

647

670

648 Just var ->

671 Just var ->

649− "function " ++ prettyName var

672+ "function " <> varName var

650

673

651

674

652

675

@@ -690,26 +713,26 @@ reasonToString reason =

690 Nothing

713 Nothing

691

714

692 [field] ->

715 [field] ->

693− Just $ "Problem in the `" ++ field ++ "` field. "

716+ Just $ "Problem in the `" <> field <> "` field. "

694

717

695 _ ->

718 _ ->

696− Just $ "Problem at `" ++ List.intercalate "." fields ++ "`. "

719+ Just $ "Problem at `" <> Text.intercalate "." fields <> "`. "

697 in

720 in

698 case (starter, maybeDocs) of

721 case (starter, maybeDocs) of

699 (Nothing, Nothing) ->

722 (Nothing, Nothing) ->

700 Nothing

723 Nothing

701

724

702 (Just msg, Nothing) ->

725 (Just msg, Nothing) ->

703− Just $ toHint (msg ++ badFieldElaboration)

726+ Just $ toHint (msg <> badFieldElaboration)

704

727

705 (_, Just (firstLine, docs)) ->

728 (_, Just (firstLine, docs)) ->

706 Just $ vcat $

729 Just $ vcat $

707− toHint (maybe firstLine (++firstLine) starter)

730+ toHint (maybe firstLine (<> firstLine) starter)

708 : map (indent 4) docs

731 : map (indent 4) docs

709

732

710

733

711

734

712−collectFields :: Reason -> ([String], Maybe Reason)

735+collectFields :: Reason -> ([Text], Maybe Reason)

713collectFields reason =

736collectFields reason =

714 case reason of

737 case reason of

715 BadFields [(field, Nothing)] ->

738 BadFields [(field, Nothing)] ->

@@ -722,7 +745,7 @@ collectFields reason =

722 ([], Just reason)

745 ([], Just reason)

723

746

724

747

725−reasonToStringHelp :: Reason -> Maybe (String, [Doc])

748+reasonToStringHelp :: Reason -> Maybe (Text, [Doc])

726reasonToStringHelp reason =

749reasonToStringHelp reason =

727 let

750 let

728 go msg =

751 go msg =

@@ -732,8 +755,8 @@ reasonToStringHelp reason =

732 BadFields fields ->

755 BadFields fields ->

733 go $

756 go $

734 "I am seeing issues with the "

757 "I am seeing issues with the "

735− ++ Help.commaSep (map fst fields) ++ " fields. "

758+ <> Help.commaSep (map fst fields) <> " fields. "

736− ++ badFieldElaboration

759+ <> badFieldElaboration

737

760

738 MessyFields both leftOnly rightOnly ->

761 MessyFields both leftOnly rightOnly ->

739 messyFieldsHelp both leftOnly rightOnly

762 messyFieldsHelp both leftOnly rightOnly

@@ -747,12 +770,11 @@ reasonToStringHelp reason =

747 TooLongComparableTuple len ->

770 TooLongComparableTuple len ->

748 go $

771 go $

749 "Although tuples are comparable, this is currently only supported\

772 "Although tuples are comparable, this is currently only supported\

750− \ for tuples with 6 or fewer entries, not " ++ show len ++ "."

773+ \ for tuples with 6 or fewer entries, not " <> i2t len <> "."

751

774

752 MissingArgs num ->

775 MissingArgs num ->

753 go $

776 go $

754− "It looks like a function needs " ++ show num ++ " more "

777+ "It looks like a function needs " <> i2t num <> " more" <> Help.args num <> "."

755− ++ (if num == 1 then "argument" else "arguments") ++ "."

756

778

757 BadVar (Just Comparable) _ ->

779 BadVar (Just Comparable) _ ->

758 go "Only ints, floats, chars, strings, lists, and tuples are comparable."

780 go "Only ints, floats, chars, strings, lists, and tuples are comparable."

@@ -776,48 +798,48 @@ reasonToStringHelp reason =

776 Nothing

798 Nothing

777

799

778

800

779−badFieldElaboration :: String

801+badFieldElaboration :: Text

780badFieldElaboration =

802badFieldElaboration =

781 "I always figure out field types in alphabetical order. If a field\

803 "I always figure out field types in alphabetical order. If a field\

782 \ seems fine, I assume it is \"correct\" in subsequent checks.\

804 \ seems fine, I assume it is \"correct\" in subsequent checks.\

783 \ So the problem may actually be a weird interaction with previous fields."

805 \ So the problem may actually be a weird interaction with previous fields."

784

806

785

807

786−weirdRigidError :: String

808+weirdRigidError :: Text

787weirdRigidError =

809weirdRigidError =

788 "You are having a problem with \"rigid\" type variables. That usually\

810 "You are having a problem with \"rigid\" type variables. That usually\

789 \ means you have a type annotation that says it accepts anything, but\

811 \ means you have a type annotation that says it accepts anything, but\

790 \ in fact, it accepts a much more specific type. More info at: "

812 \ in fact, it accepts a much more specific type. More info at: "

791− ++ Help.hintLink "type-annotations" ++

813+ <> Help.hintLink "type-annotations" <>

792 ". This case is weird though, so please turn it into an <http://sscce.org>\

814 ". This case is weird though, so please turn it into an <http://sscce.org>\

793 \ and report it to <https://github.com/elm-lang/error-message-catalog>."

815 \ and report it to <https://github.com/elm-lang/error-message-catalog>."

794

816

795

817

796−singleRigidError :: Maybe String -> String

818+singleRigidError :: Maybe Text -> Text

797singleRigidError maybeName =

819singleRigidError maybeName =

798 case maybeName of

820 case maybeName of

799 Just name ->

821 Just name ->

800− "Your type annotation uses type variable `" ++ name ++

822+ "Your type annotation uses type variable `" <> name <>

801 "` which means any type of value can flow through. Your code is saying\

823 "` which means any type of value can flow through. Your code is saying\

802 \ it CANNOT be anything though! Maybe change your type annotation to\

824 \ it CANNOT be anything though! Maybe change your type annotation to\

803 \ be more specific? Maybe the code has a problem? More at: "

825 \ be more specific? Maybe the code has a problem? More at: "

804− ++ Help.hintLink "type-annotations"

826+ <> Help.hintLink "type-annotations"

805

827

806 Nothing ->

828 Nothing ->

807 weirdRigidError

829 weirdRigidError

808

830

809

831

810−doubleRigidError :: Maybe String -> Maybe String -> String

832+doubleRigidError :: Maybe Text -> Maybe Text -> Text

811doubleRigidError maybeLeftName maybeRightName =

833doubleRigidError maybeLeftName maybeRightName =

812 case (maybeLeftName, maybeRightName) of

834 case (maybeLeftName, maybeRightName) of

813 (Just leftName, Just rightName) ->

835 (Just leftName, Just rightName) ->

814− "Your type annotation uses `" ++ leftName ++ "` and `" ++ rightName ++

836+ "Your type annotation uses `" <> leftName <> "` and `" <> rightName <>

815 "` as separate type variables. Each one can be any type of value,\

837 "` as separate type variables. Each one can be any type of value,\

816 \ but because they have separate names, there is no guarantee that they\

838 \ but because they have separate names, there is no guarantee that they\

817 \ are equal to each other. Your code seems to be saying they ARE the\

839 \ are equal to each other. Your code seems to be saying they ARE the\

818 \ same though! Maybe they should be the same in your type annotation?\

840 \ same though! Maybe they should be the same in your type annotation?\

819 \ Maybe your code uses them in a weird way? More at: "

841 \ Maybe your code uses them in a weird way? More at: "

820− ++ Help.hintLink "type-annotations"

842+ <> Help.hintLink "type-annotations"

821

843

822 _ ->

844 _ ->

823 weirdRigidError

845 weirdRigidError

@@ -828,12 +850,12 @@ hintDoc =

828 underline (text "Hint") <> colon

850 underline (text "Hint") <> colon

829

851

830

852

831−toHint :: String -> Doc

853+toHint :: Text -> Doc

832−toHint str =

854+toHint txt =

833− fillSep (hintDoc : map text (words str))

855+ fillSep (hintDoc : map text (Text.words txt))

834

856

835

857

836−messyFieldsHelp :: [String] -> [String] -> [String] -> Maybe (String, [Doc])

858+messyFieldsHelp :: [Text] -> [Text] -> [Text] -> Maybe (Text, [Doc])

837messyFieldsHelp both leftOnly rightOnly =

859messyFieldsHelp both leftOnly rightOnly =

838 case (leftOnly, rightOnly) of

860 case (leftOnly, rightOnly) of

839 ([], [missingField]) ->

861 ([], [missingField]) ->

@@ -861,8 +883,8 @@ messyFieldsHelp both leftOnly rightOnly =

861 if null typoPairs then

883 if null typoPairs then

862 Just

884 Just

863 ( "The record fields do not match up. One has "

885 ( "The record fields do not match up. One has "

864− ++ Help.commaSep leftOnly ++ ". The other has "

886+ <> Help.commaSep leftOnly <> ". The other has "

865− ++ Help.commaSep rightOnly ++ "."

887+ <> Help.commaSep rightOnly <> "."

866 , []

888 , []

867 )

889 )

868

890

@@ -873,61 +895,62 @@ messyFieldsHelp both leftOnly rightOnly =

873 )

895 )

874

896

875

897

876−oneMissingField :: [String] -> String -> Maybe (String, [Doc])

898+oneMissingField :: [Text] -> Text -> Maybe (Text, [Doc])

877oneMissingField knownFields missingField =

899oneMissingField knownFields missingField =

878 case Help.findPotentialTypos knownFields missingField of

900 case Help.findPotentialTypos knownFields missingField of

879 [] ->

901 [] ->

880 Just

902 Just

881− ( "Looks like a record is missing the `" ++ missingField ++ "` field."

903+ ( "Looks like a record is missing the `" <> missingField <> "` field."

882 , []

904 , []

883 )

905 )

884

906

885 [typo] ->

907 [typo] ->

886 Just

908 Just

887− ( "Looks like a record is missing the `" ++ missingField

909+ ( "Looks like a record is missing the `" <> missingField

888− ++ "` field. Maybe it is a typo?"

910+ <> "` field. Maybe it is a typo?"

889 , typoDocs "->" [(missingField, typo)]

911 , typoDocs "->" [(missingField, typo)]

890 )

912 )

891

913

892 typos ->

914 typos ->

893 Just

915 Just

894− ( "Looks like a record is missing the `" ++ missingField

916+ ( "Looks like a record is missing the `" <> missingField

895− ++ "` field. It is close to names like "

917+ <> "` field. It is close to names like "

896− ++ Help.commaSep typos ++ " so maybe it is a typo?"

918+ <> Help.commaSep typos <> " so maybe it is a typo?"

897 , []

919 , []

898 )

920 )

899

921

900

922

901−manyMissingFields :: [String] -> [String] -> Maybe (String, [Doc])

923+manyMissingFields :: [Text] -> [Text] -> Maybe (Text, [Doc])

902manyMissingFields knownFields missingFields =

924manyMissingFields knownFields missingFields =

903 case Help.findTypoPairs missingFields knownFields of

925 case Help.findTypoPairs missingFields knownFields of

904 [] ->

926 [] ->

905 Just

927 Just

906 ( "Looks like a record is missing these fields: "

928 ( "Looks like a record is missing these fields: "

907− ++ Help.commaSep missingFields

929+ <> Help.commaSep missingFields

908 , []

930 , []

909 )

931 )

910

932

911 typoPairs ->

933 typoPairs ->

912 Just

934 Just

913− ( "Looks like a record is missing these fields: " ++ Help.commaSep missingFields

935+ ( "Looks like a record is missing these fields: "

936+ <> Help.commaSep missingFields

914− ++ ". Potential typos include:"

937+ <> ". Potential typos include:"

915 , typoDocs "->" typoPairs

938 , typoDocs "->" typoPairs

916 )

939 )

917

940

918

941

919−typoDocs :: String -> [(String, String)] -> [Doc]

942+typoDocs :: Text -> [(Text, Text)] -> [Doc]

920typoDocs arrow typoPairs =

943typoDocs arrow typoPairs =

921 let

944 let

922 maxLen =

945 maxLen =

923− maximum (map (length . fst) typoPairs)

946+ maximum (map (Text.length . fst) typoPairs)

924 in

947 in

925 text "" : map (padTypo arrow maxLen) typoPairs

948 text "" : map (padTypo arrow maxLen) typoPairs

926

949

927

950

928−padTypo :: String -> Int -> (String, String) -> Doc

951+padTypo :: Text -> Int -> (Text, Text) -> Doc

929padTypo arrow maxLen (missingField, knownField) =

952padTypo arrow maxLen (missingField, knownField) =

930− text (replicate (maxLen - length missingField) ' ')

953+ text (Text.replicate (maxLen - Text.length missingField) " ")

931 <> dullyellow (text missingField)

954 <> dullyellow (text missingField)

932 <+> text arrow

955 <+> text arrow

933 <+> dullyellow (text knownField)

956 <+> dullyellow (text knownField)

@@ -939,24 +962,23 @@ padTypo arrow maxLen (missingField, knownField) =

939

962

940infiniteTypeToReport

963infiniteTypeToReport

941 :: RenderType.Localizer

964 :: RenderType.Localizer

942− -> String

965+ -> Text

943 -> Type.Canonical

966 -> Type.Canonical

944 -> Report.Report

967 -> Report.Report

945infiniteTypeToReport localizer name overallType =

968infiniteTypeToReport localizer name overallType =

946 Report.report

969 Report.report

947 "INFINITE TYPE"

970 "INFINITE TYPE"

948 Nothing

971 Nothing

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

972+ ( "I am inferring a weird self-referential type for " <> functionName name

950 )

973 )

951− ( Help.stack

974+ ( stack

952− [ Help.reflowParagraph $

975+ [ reflowParagraph $

953 "Here is my best effort at writing down the type. You will see ? and ∞ for\

976 "Here is my best effort at writing down the type. You will see ? and ∞ for\

954 \ parts of the type that repeat something already printed out infinitely."

977 \ parts of the type that repeat something already printed out infinitely."

955 , indent 4 (RenderType.toDoc localizer overallType)

978 , indent 4 (RenderType.toDoc localizer overallType)

956− , Help.reflowParagraph $

979+ , reflowParagraph $

957 "Usually staring at the type is not so helpful in these cases, so definitely\

980 "Usually staring at the type is not so helpful in these cases, so definitely\

958 \ read the debugging hints for ideas on how to figure this out: "

981 \ read the debugging hints for ideas on how to figure this out: "

959− ++ Help.hintLink "infinite-type"

982+ <> Help.hintLink "infinite-type"

960 ]

983 ]

961 )

984 )

962−

src/Reporting/Error/Helpers.hs → src/Reporting/Helpers.hsrenamed+68−42

@@ -1,6 +1,13 @@

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

2−module Reporting.Error.Helpers

3+module Reporting.Helpers

3 ( (|>)

4 ( (|>)

5+ -- re-exports

6+ , Doc, (<+>), (<>), cat, colon, comma, dullyellow, equals, fillSep, hang

7+ , hsep, indent, lbrace, lparen, parens, rbrace, rparen, sep, text, underline

8+ , vcat

9+ -- custom helpers

10+ , i2t

4 , functionName, args

11 , functionName, args

5 , hintLink, stack, reflowParagraph

12 , hintLink, stack, reflowParagraph

6 , commaSep, capitalize, ordinalize, drawCycle

13 , commaSep, capitalize, ordinalize, drawCycle

@@ -13,10 +20,13 @@ import Data.Function (on)

13import qualified Data.Char as Char

20import qualified Data.Char as Char

14import qualified Data.List as List

21import qualified Data.List as List

15import qualified Data.Map as Map

22import qualified Data.Map as Map

23+import Data.Monoid ((<>))

16import qualified Data.Set as Set

24import qualified Data.Set as Set

25+import qualified Data.Text as Text

26+import Data.Text (Text)

17import qualified Text.EditDistance as Dist

27import qualified Text.EditDistance as Dist

18−import Text.PrettyPrint.ANSI.Leijen

28+import qualified Text.PrettyPrint.ANSI.Leijen as P

19− ( Doc, (<>), dullyellow, fillSep, hardline, text, vcat )

29+import Text.PrettyPrint.ANSI.Leijen hiding ((<>), text)

21import qualified AST.Helpers as Help

31import qualified AST.Helpers as Help

22import qualified Elm.Compiler.Version as Compiler

32import qualified Elm.Compiler.Version as Compiler

@@ -39,30 +49,40 @@ infixl 0 |>

39-- DOC HELPERS

49-- DOC HELPERS

52+text :: Text -> Doc

53+text msg =

54+ P.text (Text.unpack msg)

55+

56+

57+i2t :: Int -> Text

58+i2t n =

59+ Text.pack (show n)

60+

61+

42−functionName :: String -> String

62+functionName :: Text -> Text

43functionName opName =

63functionName opName =

44 if Help.isOp opName then

64 if Help.isOp opName then

45− "(" ++ opName ++ ")"

65+ "(" <> opName <> ")"

47 else

67 else

48− "`" ++ opName ++ "`"

68+ "`" <> opName <> "`"

51−args :: Int -> String

71+args :: Int -> Text

52args n =

72args n =

53− show n ++ if n == 1 then " argument" else " arguments"

73+ i2t n <> if n == 1 then " argument" else " arguments"

56−hintLink :: String -> String

76+hintLink :: Text -> Text

57hintLink fileName =

77hintLink fileName =

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

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

59− ++ Pkg.versionToString Compiler.version

79+ <> Text.pack (Pkg.versionToString Compiler.version)

60− ++ "/hints/" ++ fileName ++ ".md>"

80+ <> "/hints/" <> fileName <> ".md>"

63stack :: [Doc] -> Doc

83stack :: [Doc] -> Doc

64−stack list =

84+stack chunks =

65− case list of

85+ case chunks of

66 [] ->

86 [] ->

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

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

@@ -70,33 +90,35 @@ stack list =

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

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

73−reflowParagraph :: String -> Doc

93+reflowParagraph :: Text -> Doc

74reflowParagraph paragraph =

94reflowParagraph paragraph =

75− fillSep (map text (words paragraph))

95+ fillSep (map text (Text.words paragraph))

78−commaSep :: [String] -> String

98+commaSep :: [Text] -> Text

79commaSep tokens =

99commaSep tokens =

80 case tokens of

100 case tokens of

81 [token] ->

101 [token] ->

82− " " ++ token

102+ " " <> token

103

84 [token1,token2] ->

104 [token1,token2] ->

85− " " ++ token1 ++ " and " ++ token2

105+ " " <> token1 <> " and " <> token2

106

87 _ ->

107 _ ->

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

108+ " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens

109+

110

111+capitalize :: Text -> Text

112+capitalize txt =

113+ case Text.uncons txt of

114+ Nothing ->

115+ txt

116

91−capitalize :: String -> String

117+ Just (c, rest) ->

92−capitalize string =

93− case string of

94− [] -> []

95− c : cs ->

96− Char.toUpper c : cs

118+ Text.cons (Char.toUpper c) rest

119

120

99−ordinalize :: Int -> String

121+ordinalize :: Int -> Text

100ordinalize number =

122ordinalize number =

101 let

123 let

102 remainder10 =

124 remainder10 =

@@ -112,18 +134,18 @@ ordinalize number =

112 | remainder10 == 3 = "rd"

134 | remainder10 == 3 = "rd"

113 | otherwise = "th"

135 | otherwise = "th"

114 in

136 in

115− show number ++ ending

137+ i2t number <> ending

116

138

117

139

118

140

119−drawCycle :: [String] -> Doc

141+drawCycle :: [Text] -> Doc

120−drawCycle strings =

142+drawCycle names =

121 let

143 let

122 topLine =

144 topLine =

123 text "┌─────┐"

145 text "┌─────┐"

124

146

125− line str =

147+ nameLine name =

126− text "│ " <> dullyellow (text str)

148+ text "│ " <> dullyellow (text name)

127

149

128 midLine =

150 midLine =

129 text "│ ↓"

151 text "│ ↓"

@@ -131,19 +153,19 @@ drawCycle strings =

131 bottomLine =

153 bottomLine =

132 text "└─────┘"

154 text "└─────┘"

133 in

155 in

134− vcat (topLine : List.intersperse midLine (map line strings) ++ [ bottomLine ])

156+ vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])

135

157

136

158

137

159

138-- FIND TYPOS

160-- FIND TYPOS

139

161

140

162

141−findPotentialTypos :: [String] -> String -> [String]

163+findPotentialTypos :: [Text] -> Text -> [Text]

142findPotentialTypos knownNames badName =

164findPotentialTypos knownNames badName =

143 filter ((==1) . distance badName) knownNames

165 filter ((==1) . distance badName) knownNames

144

166

145

167

146−findTypoPairs :: [String] -> [String] -> [(String, String)]

168+findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]

147findTypoPairs leftOnly rightOnly =

169findTypoPairs leftOnly rightOnly =

148 let

170 let

149 veryNear leftName =

171 veryNear leftName =

@@ -152,7 +174,7 @@ findTypoPairs leftOnly rightOnly =

152 concatMap veryNear leftOnly

174 concatMap veryNear leftOnly

153

175

154

176

155−vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)

177+vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)

156vetTypos potentialTypos =

178vetTypos potentialTypos =

157 let

179 let

158 tallyNames (ln, rn) (lc, rc) =

180 tallyNames (ln, rn) (lc, rc) =

@@ -163,7 +185,7 @@ vetTypos potentialTypos =

163 (leftCounts, rightCounts) =

185 (leftCounts, rightCounts) =

164 foldr tallyNames (Map.empty, Map.empty) potentialTypos

186 foldr tallyNames (Map.empty, Map.empty) potentialTypos

165

187

166− acceptable :: Map.Map String Int -> Bool

188+ acceptable :: Map.Map Text Int -> Bool

167 acceptable counts =

189 acceptable counts =

168 not (Map.null counts)

190 not (Map.null counts)

169 &&

191 &&

@@ -180,10 +202,10 @@ vetTypos potentialTypos =

180-- NEARBY NAMES

202-- NEARBY NAMES

181

203

182

204

183−nearbyNames :: (a -> String) -> a -> [a] -> [a]

205+nearbyNames :: (a -> Text) -> a -> [a] -> [a]

184nearbyNames format name names =

206nearbyNames format name names =

185 let editDistance =

207 let editDistance =

186− if length (format name) < 3 then 1 else 2

208+ if Text.length (format name) < 3 then 1 else 2

187 in

209 in

188 names

210 names

189 |> map (\x -> (distance (format name) (format x), x))

211 |> map (\x -> (distance (format name) (format x), x))

@@ -192,12 +214,15 @@ nearbyNames format name names =

192 |> map snd

214 |> map snd

193

215

194

216

195−distance :: String -> String -> Int

217+distance :: Text -> Text -> Int

196distance x y =

218distance x y =

197− Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y

219+ Dist.restrictedDamerauLevenshteinDistance

220+ Dist.defaultEditCosts

221+ (Text.unpack x)

222+ (Text.unpack y)

198

223

199

224

200−maybeYouWant :: [String] -> String

225+maybeYouWant :: [Text] -> Text

201maybeYouWant suggestions =

226maybeYouWant suggestions =

202 case suggestions of

227 case suggestions of

203 [] ->

228 [] ->

@@ -205,5 +230,6 @@ maybeYouWant suggestions =

205

230

206 _:_ ->

231 _:_ ->

207 "Maybe you want one of the following?\n"

232 "Maybe you want one of the following?\n"

233+ <>

208− ++ concatMap ("\n "++) (take 4 suggestions)

234+ Text.concat (map ("\n " <>) (take 4 suggestions))

209

235

src/Reporting/Region.hs+2−10

@@ -3,7 +3,6 @@ module Reporting.Region where

4import Data.Aeson ((.=))

5import qualified Data.Aeson as Json

6−import qualified Text.Parsec.Pos as Parsec

9data Region =

8data Region =

@@ -16,19 +15,12 @@ data Region =

17data Position =

16data Position =

18 Position

17 Position

19− { line :: {-# UNPACK #-} !Int

18+ { line :: !Int

20− , column :: {-# UNPACK #-} !Int

19+ , column :: !Int

21 }

20 }

22 deriving (Eq, Show)

21 deriving (Eq, Show)

25−fromSourcePos :: Parsec.SourcePos -> Position

26−fromSourcePos sourcePos =

27− Position

28− (Parsec.sourceLine sourcePos)

29− (Parsec.sourceColumn sourcePos)

30−

31−

32merge :: Region -> Region -> Region

24merge :: Region -> Region -> Region

33merge (Region start _) (Region _ end) =

25merge (Region start _) (Region _ end) =

34 Region start end

26 Region start end

src/Reporting/Render/Type.hs+25−22

@@ -1,3 +1,5 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

1module Reporting.Render.Type

3module Reporting.Render.Type

2 ( Localizer

4 ( Localizer

3 , decl

5 , decl

@@ -11,15 +13,16 @@ module Reporting.Render.Type

11import Control.Arrow ((***), first)

13import Control.Arrow ((***), first)

12import qualified Data.Map as Map

14import qualified Data.Map as Map

13import qualified Data.Set as Set

15import qualified Data.Set as Set

14−import Text.PrettyPrint.ANSI.Leijen

16+import Data.Text (Text)

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

16− , lbrace, lparen, parens, rbrace, rparen, sep, text, vcat

17− )

19import qualified AST.Helpers as Help

18import qualified AST.Helpers as Help

20import qualified AST.Type as Type

19import qualified AST.Type as Type

21import qualified AST.Variable as Var

20import qualified AST.Variable as Var

22−import qualified Reporting.Error.Helpers as Help

21+import qualified Reporting.Helpers as Help

22+import Reporting.Helpers

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

24+ , lbrace, lparen, parens, rbrace, rparen, sep, text, vcat

25+ )

@@ -41,21 +44,21 @@ diffToDocs localizer leftType rightType =

41 (leftDoc, rightDoc)

44 (leftDoc, rightDoc)

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

47+decl :: Localizer -> Text -> [Text] -> [(Text, [Type.Canonical])] -> Doc

45decl localizer name vars tags =

48decl localizer name vars tags =

46 let

49 let

47 docTag (tag, args) =

50 docTag (tag, args) =

48 hang 2 (sep (text tag : map (docType localizer App) args))

51 hang 2 (sep (text tag : map (docType localizer App) args))

49 in

52 in

50 hang 4 $ vcat $

53 hang 4 $ vcat $

51− (hsep (map text ("type" : name : vars)))

54+ (hsep (text "type" : map text (name : vars)))

52 :

55 :

53 zipWith (<+>)

56 zipWith (<+>)

54 (equals : repeat (text "|"))

57 (equals : repeat (text "|"))

55 (map docTag tags)

58 (map docTag tags)

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

61+annotation :: Localizer -> Text -> Type.Canonical -> Doc

59annotation localizer name tipe =

62annotation localizer name tipe =

60 let

63 let

61 docName =

64 docName =

@@ -81,20 +84,20 @@ annotation localizer name tipe =

83type Localizer =

86type Localizer =

84− Map.Map String String

87+ Map.Map Var.Canonical Text

87varToDoc :: Localizer -> Var.Canonical -> Doc

90varToDoc :: Localizer -> Var.Canonical -> Doc

88varToDoc localizer var =

91varToDoc localizer var =

89 let

92 let

90 name =

93 name =

91− Var.toString var

94+ Var.toText var

92 in

95 in

93 if name == "_Tuple0" then

96 if name == "_Tuple0" then

94 text "()"

97 text "()"

96 else

99 else

97− text (maybe name id (Map.lookup name localizer))

100+ text (maybe name id (Map.lookup var localizer))

101

102

100

103

@@ -120,8 +123,8 @@ instance Applicative Diff where

120 pure a =

123 pure a =

121 Same a

124 Same a

122

125

123− (<*>) func arg =

126+ (<*>) function argument =

124− case (func, arg) of

127+ case (function, argument) of

125 (Diff leftFunc rightFunc, Diff leftArg rightArg) ->

128 (Diff leftFunc rightFunc, Diff leftArg rightArg) ->

126 Diff (leftFunc leftArg) (rightFunc rightArg)

129 Diff (leftFunc leftArg) (rightFunc rightArg)

127

130

@@ -258,7 +261,7 @@ diffLambda localizer context leftType rightType =

258-- RECORD DIFFS

261-- RECORD DIFFS

259

262

260

263

261−diffRecord :: Localizer -> Fields -> Maybe String -> Fields -> Maybe String -> Diff Doc

264+diffRecord :: Localizer -> Fields -> Maybe Text -> Fields -> Maybe Text -> Diff Doc

262diffRecord localizer leftFields leftExt rightFields rightExt =

265diffRecord localizer leftFields leftExt rightFields rightExt =

263 let

266 let

264 (leftOnly, both, rightOnly) =

267 (leftOnly, both, rightOnly) =

@@ -305,7 +308,7 @@ diffRecord localizer leftFields leftExt rightFields rightExt =

305 (docRecord style rights (fmap text rightExt))

308 (docRecord style rights (fmap text rightExt))

306

309

307

310

308−unzipDiffs :: [(String, (Doc, Doc))] -> ( [(Doc, Doc)], [(Doc, Doc)] )

311+unzipDiffs :: [(Text, (Doc, Doc))] -> ( [(Doc, Doc)], [(Doc, Doc)] )

309unzipDiffs diffPairs =

312unzipDiffs diffPairs =

310 let

313 let

311 unzipHelp (name, (left, right)) =

314 unzipHelp (name, (left, right)) =

@@ -318,7 +321,7 @@ unzipDiffs diffPairs =

318-- RECORD DIFFS HELPERS

321-- RECORD DIFFS HELPERS

319

322

320

323

321−analyzeFields :: [String] -> [String] -> ( [(Doc, Doc)], [(Doc, Doc)] )

324+analyzeFields :: [Text] -> [Text] -> ( [(Doc, Doc)], [(Doc, Doc)] )

322analyzeFields leftOnly rightOnly =

325analyzeFields leftOnly rightOnly =

323 let

326 let

324 typoPairs =

327 typoPairs =

@@ -343,11 +346,11 @@ analyzeFields leftOnly rightOnly =

343

346

344

347

345type Fields =

348type Fields =

346− Map.Map String Type.Canonical

349+ Map.Map Text Type.Canonical

347

350

348

351

349type DoubleFields =

352type DoubleFields =

350− Map.Map String (Type.Canonical,Type.Canonical)

353+ Map.Map Text (Type.Canonical,Type.Canonical)

351

354

352

355

353vennDiagram :: Fields -> Fields -> (Fields, DoubleFields, Fields)

356vennDiagram :: Fields -> Fields -> (Fields, DoubleFields, Fields)

@@ -359,17 +362,17 @@ vennDiagram leftFields rightFields =

359

362

360

363

361flattenRecord

364flattenRecord

362− :: [(String, Type.Canonical)]

365+ :: [(Text, Type.Canonical)]

363 -> Maybe Type.Canonical

366 -> Maybe Type.Canonical

364− -> (Fields, Maybe String)

367+ -> (Fields, Maybe Text)

365flattenRecord fields ext =

368flattenRecord fields ext =

366 first Map.fromList (flattenRecordHelp fields ext)

369 first Map.fromList (flattenRecordHelp fields ext)

367

370

368

371

369flattenRecordHelp

372flattenRecordHelp

370− :: [(String, Type.Canonical)]

373+ :: [(Text, Type.Canonical)]

371 -> Maybe Type.Canonical

374 -> Maybe Type.Canonical

372− -> ([(String, Type.Canonical)], Maybe String)

375+ -> ([(Text, Type.Canonical)], Maybe Text)

373flattenRecordHelp fields ext =

376flattenRecordHelp fields ext =

374 case ext of

377 case ext of

375 Nothing ->

378 Nothing ->

src/Reporting/Report.hs+12−7

@@ -11,12 +11,15 @@ module Reporting.Report

12import Data.Aeson ((.=))

13import qualified Data.Aeson.Types as Json

14+import qualified Data.Text as Text

15+import Data.Text (Text)

14import System.IO (Handle)

16import System.IO (Handle)

15import Text.PrettyPrint.ANSI.Leijen

17import Text.PrettyPrint.ANSI.Leijen

16− ( Doc, (<>), displayS, displayIO, dullcyan, fillSep

18+ ( Doc, (<>), displayS, displayIO, dullcyan

17 , hardline, plain, renderPretty, text

19 , hardline, plain, renderPretty, text

18 )

20 )

22+import qualified Reporting.Helpers as Help

20import qualified Reporting.Region as R

23import qualified Reporting.Region as R

21import qualified Reporting.Render.Code as Code

24import qualified Reporting.Render.Code as Code

@@ -26,16 +29,16 @@ import qualified Reporting.Render.Code as Code

28data Report = Report

31data Report = Report

29− { _title :: String

32+ { _title :: Text

30 , _highlight :: Maybe R.Region

33 , _highlight :: Maybe R.Region

31 , _preHint :: Doc

34 , _preHint :: Doc

32 , _postHint :: Doc

35 , _postHint :: Doc

33 }

36 }

36−report :: String -> Maybe R.Region -> String -> Doc -> Report

39+report :: Text -> Maybe R.Region -> Text -> Doc -> Report

37report title highlight pre post =

40report title highlight pre post =

38− Report title highlight (fillSep (map text (words pre))) post

41+ Report title highlight (Help.reflowParagraph pre) post

@@ -70,14 +73,16 @@ toDoc location region (Report title highlight preHint postHint) source =

70 <> hardline <> hardline

73 <> hardline <> hardline

73−messageBar :: String -> String -> Doc

76+messageBar :: Text -> String -> Doc

74messageBar tag location =

77messageBar tag location =

75 let

78 let

76 usedSpace =

79 usedSpace =

77− 4 + length tag + 1 + length location

80+ 4 + Text.length tag + 1 + length location

78 in

81 in

79 dullcyan $ text $

82 dullcyan $ text $

83+ "-- " ++ Text.unpack tag

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

84+ ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'

85+ ++ " " ++ location

src/Reporting/Warning.hs+7−7

@@ -4,15 +4,15 @@ module Reporting.Warning where

5import Data.Aeson ((.=))

6import qualified Data.Aeson as Json

7−import qualified Data.Text as Text

7+import Data.Text (Text)

8−import Text.PrettyPrint.ANSI.Leijen (text)

10import qualified AST.Module.Name as ModuleName

9import qualified AST.Module.Name as ModuleName

11import qualified AST.Type as Type

10import qualified AST.Type as Type

12import qualified Reporting.Annotation as A

11import qualified Reporting.Annotation as A

13−import qualified Reporting.Error.Helpers as Help

14import qualified Reporting.Report as Report

12import qualified Reporting.Report as Report

15import qualified Reporting.Render.Type as RenderType

13import qualified Reporting.Render.Type as RenderType

14+import qualified Reporting.Helpers as Help

15+import Reporting.Helpers ((<>), text)

@@ -21,7 +21,7 @@ import qualified Reporting.Render.Type as RenderType

22data Warning

23 = UnusedImport ModuleName.Raw

24− | MissingTypeAnnotation String Type.Canonical

24+ | MissingTypeAnnotation Text Type.Canonical

@@ -35,14 +35,14 @@ toReport localizer warning =

35 Report.report

36 "unused import"

37 Nothing

38− ("Module `" ++ Text.unpack (ModuleName.toText moduleName) ++ "` is unused.")

38+ ("Module `" <> ModuleName.toText moduleName <> "` is unused.")

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

41 MissingTypeAnnotation name inferredType ->

42 Report.report

43 "missing type annotation"

44 Nothing

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

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

46 ( Help.stack

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

48 , RenderType.annotation localizer name inferredType

@@ -63,6 +63,6 @@ toJson localizer filePath (A.A region warning) =

63 Json.object $

64 [ "file" .= filePath

65 , "region" .= maybe region id maybeRegion

66− , "type" .= ("warning" :: String)

66+ , "type" .= ("warning" :: Text)

67 ]

68 ++ additionalFields

src/Type/Constrain/Expression.hs+1−1

@@ -598,7 +598,7 @@ constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =

598 let sharedArity = length args

599 let typeArity = sharedArity + length (ST.collectLambdas tipe) - 1

600 let argsArity = sharedArity + length (fst (C.collectLambdas expr))

601− let hint = Error.ReturnType (Text.unpack name) typeArity argsArity region

601+ let hint = Error.ReturnType name typeArity argsArity region

602 let resultCon =

603 CEqual hint defRegion rigidType resultType

604

src/Type/Unify.hs+2−3

@@ -6,7 +6,6 @@ import Control.Monad (zipWithM_)

6import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)

7import qualified Data.Map as Map

8import qualified Data.Maybe as Maybe

9−import qualified Data.Text as Text

10import Data.Text (Text)

9import Data.Text (Text)

11import qualified Data.UnionFind.IO as UF

10import qualified Data.UnionFind.IO as UF

@@ -682,7 +681,7 @@ unifySharedFieldsHelp context sharedFields =

682 mismatch context (Just (Error.BadFields (reverse badFields)))

681 mismatch context (Just (Error.BadFields (reverse badFields)))

683

682

684

683

685−unifyField :: Context -> (Text, (Variable, Variable)) -> Unify (Maybe (String, Maybe Error.Reason))

684+unifyField :: Context -> (Text, (Variable, Variable)) -> Unify (Maybe (Text, Maybe Error.Reason))

686unifyField context (field, (expected, actual)) =

685unifyField context (field, (expected, actual)) =

687 do result <- lift $ runExceptT $ subUnify context expected actual

686 do result <- lift $ runExceptT $ subUnify context expected actual

688 case result of

687 case result of

@@ -690,7 +689,7 @@ unifyField context (field, (expected, actual)) =

690 return $ Nothing

689 return $ Nothing

691

690

692 Left (Mismatch maybeReason) ->

691 Left (Mismatch maybeReason) ->

693− return $ Just (Text.unpack field, maybeReason)

692+ return $ Just (field, maybeReason)

694

693

695

694

696

695