2feb357 · elk · git.iko.soy

git.iko.soy/elk

Begin upgrade of Reporting code from String to Text

Still have to make the parse errors work. Also removes mention of Parsec from codebase, so I believe it would only be needed transitively by language-glsl. Maybe that can be avoided.

commit2feb35738da4d0afcbe8146948051f74507b3c70 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 7 Dec 2016, 15:00 (10 years ago) parentb09bb00

24 files changed+559−638

compare with master

unifiedsplit

elm-compiler.cabal+1−1

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

114114 Reporting.Error,

115115 Reporting.Error.Canonicalize,

116116 Reporting.Error.Docs,

117− Reporting.Error.Helpers,

118117 Reporting.Error.Pattern,

119118 Reporting.Error.Syntax,

120119 Reporting.Error.Type,

120+ Reporting.Helpers,

121121 Reporting.Region,

122122 Reporting.Render.Code,

123123 Reporting.Render.Type,

src/AST/Helpers.hs+10−4

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

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module AST.Helpers where

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

55import qualified Data.Char as Char

6+import qualified Data.Set as Set

67import qualified Data.Text as Text

78import Data.Text (Text)

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

2223-- INFIX OPERATORS

2324

2425

25−isOp :: String -> Bool

26+isOp :: Text -> Bool

2627isOp name =

27− all isSymbol name

28+ Text.all isSymbol name

2829

2930

3031isSymbol :: Char -> Bool

3132isSymbol 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 =

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

121121

122122

123+toText :: Canonical -> Text

124+toText var =

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

126+

127+

123128toBuilder :: Bool -> Canonical -> Builder

124129toBuilder needsParens (A.A _ pattern) =

125130 case pattern of

src/Canonicalize.hs+4−9

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

22module Canonicalize (module') where

44import Prelude hiding (last)

5+import qualified Data.Foldable as T

56import qualified Data.List as List

67import qualified Data.Map as Map

78import qualified Data.Maybe as Maybe

89import qualified Data.Set as Set

9−import qualified Data.Foldable as T

10−import qualified Data.Text as Text

1110import Data.Text (Text)

1211

1312import Elm.Utils ((|>))

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

3130import qualified Reporting.Annotation as A

3231import qualified Reporting.Error as Error

3332import qualified Reporting.Error.Canonicalize as CError

34−import qualified Reporting.Error.Helpers as ErrorHelp

33+import qualified Reporting.Helpers as Help

3534import qualified Reporting.Region as Region

3635import qualified Reporting.Render.Type as RenderType

3736import qualified Reporting.Result as Result

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

218217

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

220219notFound region possibilities badName =

221− let

222− badNameString =

223− Text.unpack badName

224− in

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

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

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

221+ Help.nearbyNames id badName possibilities

227222

228223

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

src/Canonicalize/Effects.hs+8−7

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

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

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

35import qualified Data.Foldable as F

4−import qualified Data.Text as Text

56import Data.Text (Text)

78import qualified AST.Effects as Effects

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

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

7879

7980

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

8182makeError region name tipe maybeMessage =

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

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

8384

8485

8586

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

8889

8990checkPortType

9091 :: (Monoid i)

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

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

9293 -> T.Canonical

9394 -> Result.Result i w e ()

94−checkPortType makeError tipe =

95+checkPortType mkError tipe =

9596 let

9697 check =

97− checkPortType makeError

98+ checkPortType mkError

9899

99100 throw maybeMsg =

100− Result.throwMany [makeError tipe maybeMsg]

101+ Result.throwMany [mkError tipe maybeMsg]

101102 in

102103 case tipe of

103104 T.Aliased _ args aliasedType ->

src/Canonicalize/Environment.hs+1−2

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

167167 add (key,value) dict =

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

169169 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

88import qualified Data.Map as Map

99import qualified Data.Maybe as Maybe

1010import Data.Monoid ((<>))

11−import qualified Data.Text as Text

1211import Data.Text (Text)

1312

1413import qualified AST.Declaration as D

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

2221import Elm.Utils ((|>))

2322import qualified Reporting.Annotation as A

2423import qualified Reporting.Error.Canonicalize as Error

25−import qualified Reporting.Error.Helpers as Error

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

2625import qualified Reporting.Region as R

2726import qualified Reporting.Result as Result

2827import qualified Canonicalize.Environment as Env

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

8786 allInterfaces

8887 |> Map.keys

8988 |> map ModuleName._module

90− |> Error.nearbyNames ModuleName.toString rawImportName

89+ |> Help.nearbyNames ModuleName.toText rawImportName

9190 |> Error.moduleNotFound rawImportName

9291 |> Result.throw region

9392

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

10099 listing

101100

102101 qualifier =

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

102+ maybe (ModuleName.toText rawImportName) id maybeAlias

104103

105104 infixPatches =

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

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

175174 notFound getNames x =

176175 Module.iExports interface

177176 |> getNames

178− |> Error.nearbyNames Text.unpack x

177+ |> Help.nearbyNames id x

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

180179 |> Result.throw region

181180 in

src/Canonicalize/Variable.hs+13−12

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

22{-# LANGUAGE OverloadedStrings #-}

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

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

56import qualified Data.Either as Either

67import qualified Data.Map as Map

78import qualified Data.Set as Set

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

1415import qualified AST.Variable as Var

1516import qualified Canonicalize.Environment as Env

1617import qualified Reporting.Error.Canonicalize as Error

17−import qualified Reporting.Error.Helpers as Error

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

1819import qualified Reporting.Region as R

1920import qualified Reporting.Result as Result

2021import qualified Reporting.Warning as Warning

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

151152 ambiguous possibleVars =

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

153154 where

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

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

155156

156157

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

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

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

196197

197198

198−noQualifier :: VarName -> String

199+noQualifier :: VarName -> Text

199200noQualifier name =

200201 case name of

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

202− Left x -> Text.unpack x

202+ Right (_, x) -> x

203+ Left x -> x

203204

204205

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

206−qualifiedToString (modul, name) =

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

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

207+qualifiedToText (modul, name) =

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

208209

209210

210211isOp :: VarName -> Bool

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

240241 let (exposed, qualified) =

241242 possibleNames

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

243− |> Error.nearbyNames noQualifier name

244+ |> Help.nearbyNames noQualifier name

244245 |> Either.partitionEithers

245246 in

246247 ( Error.ExposedUnknown

247− , exposed ++ map qualifiedToString qualified

248+ , exposed ++ map qualifiedToText qualified

248249 )

249250

250251

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

259260 , allQualified

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

261262 |> map snd

262− |> Error.nearbyNames Text.unpack name

263+ |> Help.nearbyNames id name

263264 )

264265

265266 False ->

266267 ( Error.UnknownQualifier moduleName name

267268 , Set.toList availableModules

268− |> Error.nearbyNames Text.unpack moduleName

269+ |> Help.nearbyNames id moduleName

269270 )

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

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

4343

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

4545define maybeHome name body =

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

46+ if not (Help.isOp name) then

4747 let

4848 jsName =

4949 maybe unqualified qualified maybeHome name

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

7474

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

7676canonical (Var.Canonical home name) =

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

77+ if Help.isOp name then

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

7979

8080 else

src/Nitpick/Pattern.hs+5−4

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

33module Nitpick.Pattern

44 ( Pattern(..)

55 , fromCanonicalPattern

6− , toString

6+ , toText

77 )

88 where

1010import qualified Data.List as List

1111import Data.Monoid ((<>))

12+import Data.Text (Text)

1213import qualified Data.Text.Lazy as LazyText

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

1415

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

6162-- TO STRING

6263

6364

64−toString :: Pattern -> String

65−toString pattern =

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

65+toText :: Pattern -> Text

66+toText pattern =

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

6768

6869

6970toBuilder :: Bool -> Pattern -> Builder

src/Nitpick/TopLevelTypes.hs+1−2

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

55import qualified Data.Foldable as F

66import Data.Map ((!))

77import qualified Data.Map as Map

8−import qualified Data.Text as Text

98import Data.Text (Text)

109

1110import qualified AST.Expression.Canonical as Can

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

6564 (P.Var name, Nothing) ->

6665 let

6766 warning =

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

67+ Warning.MissingTypeAnnotation name (typeEnv ! name)

6968 in

7069 Result.warn region warning ()

7170

src/Reporting/Annotation.hs+2−1

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

11module Reporting.Annotation where

33import Prelude hiding (map)

4+import Data.Text (Text)

45import qualified Reporting.Region as R

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

1718

1819

1920type Commented a =

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

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

2122

2223

2324

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

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

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Reporting.Error.Canonicalize where

45import Control.Arrow ((***))

56import 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)

810import qualified AST.Declaration as Decl

911import qualified AST.Expression.Canonical as Canonical

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

1214import qualified AST.Type as Type

1315import qualified AST.Variable as Var

1416import qualified Reporting.Annotation as A

15−import qualified Reporting.Error.Helpers as Help

1617import qualified Reporting.Region as Region

1718import qualified Reporting.Render.Type as RenderType

1819import 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

1928

2029

2130data Error

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

2534 | Pattern PatternError

2635 | Alias AliasError

2736 | Import ModuleName.Raw ImportError

28− | Export String [String]

29− | DuplicateExport String

37+ | Export Text [Text]

38+ | DuplicateExport Text

3039 | Port PortError

31− | BadPort String Type.Canonical

40+ | BadPort Text Type.Canonical

3241

3342

3443

3544-- VARIABLES

3645

3746

38−data VarError = VarError

39− { varKind :: String

40− , varName :: String

47+data VarError =

48+ VarError

49+ { varKind :: Text

50+ , varName :: Text

4151 , varProblem :: VarProblem

42− , varSuggestions :: [String]

52+ , varSuggestions :: [Text]

4353 }

4454

4555

4656data VarProblem

4757 = Ambiguous

48− | UnknownQualifier String String

49− | QualifiedUnknown String String

58+ | UnknownQualifier Text Text

59+ | QualifiedUnknown Text Text

5060 | ExposedUnknown

5161

5262

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

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

5464variable kind name problem suggestions =

5565 Var (VarError kind name problem suggestions)

5666

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

7484

7585data ImportError

7686 = ModuleNotFound [ModuleName.Raw]

77− | ValueNotFound String [String]

87+ | ValueNotFound Text [Text]

7888

7989

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

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

8292 Import name (ModuleNotFound possibilities)

8393

8494

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

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

8696valueNotFound name value possibilities =

8797 Import name (ValueNotFound value possibilities)

8898

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

93103

94104data AliasError

95105 = ArgMismatch Var.Canonical Int Int

96− | SelfRecursive String [String] Type.Raw

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

106+ | SelfRecursive Text [Text] Type.Raw

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

98108

99109

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

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

108118

109119data PortError =

110120 PortError

111− { portName :: String

121+ { portName :: Text

112122 , portType :: Type.Canonical

113− , portMessage :: Maybe String

123+ , portMessage :: Maybe Text

114124 }

115125

116126

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

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

118128port name tipe maybeMessage =

119129 Port (PortError name tipe maybeMessage)

120130

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

123133-- TO REPORT

124134

125135

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

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

127137namingError pre post =

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

129139

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

132142toReport localizer err =

133143 case err of

134144 Var (VarError kind name problem suggestions) ->

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

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

136146 in

137147 case problem of

138148 Ambiguous ->

139149 namingError

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

141− (Help.maybeYouWant suggestions)

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

151+ (maybeYouWant suggestions)

142152

143153 UnknownQualifier qualifier localName ->

144154 namingError

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

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

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

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

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

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

148158 )

149159

150160 QualifiedUnknown qualifier localName ->

151161 namingError

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

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

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

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

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

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

155165 )

156166

157167 ExposedUnknown ->

158168 namingError

159− ("Cannot find " ++ var)

160− (Help.maybeYouWant suggestions)

169+ ("Cannot find " <> var)

170+ (maybeYouWant suggestions)

161171

162172 BadRecursion region def defs ->

163173 case defs of

164174 [] ->

165− badSelfRecursion region (defToString def)

175+ badSelfRecursion region (defToText def)

166176

167177 _ ->

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

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

169179

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

171181 Report.report

172182 "INFIX PROBLEM"

173183 (Just region)

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

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

175185 (

176186 Help.stack

177− [ Help.reflowParagraph $

187+ [ reflowParagraph $

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

179189 ]

180190 )

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

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

197207 (

198208 Help.stack

199− [ Help.reflowParagraph $

209+ [ reflowParagraph $

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

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

202212 , indent 4 $

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

204214 , text $

205215 "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"

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

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

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

208218 ]

209219 )

210220

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

216226 ( Help.stack

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

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

219− , Help.reflowParagraph $

229+ , reflowParagraph $

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

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

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

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

223233 ]

224234 )

225235

226236 Import name importError ->

227− let moduleName = ModuleName.toString name

237+ let moduleName = ModuleName.toText name

228238 in

229239 case importError of

230240 ModuleNotFound suggestions ->

231241 namingError

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

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

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

243+ (maybeYouWant suggestions)

234244

235245 ValueNotFound value suggestions ->

236246 namingError

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

238− (Help.maybeYouWant suggestions)

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

248+ (maybeYouWant suggestions)

239249

240250 Export name suggestions ->

241251 namingError

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

243− (Help.maybeYouWant suggestions)

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

253+ (maybeYouWant suggestions)

244254

245255 DuplicateExport name ->

246256 namingError

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

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

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

249259

250260 Port (PortError name tipe maybeMessage) ->

251261 let

252262 context =

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

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

254264 in

255265 Report.report

256266 "PORT ERROR"

257267 Nothing

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

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

259269 )

260270 ( Help.stack

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

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

262272 , indent 4 (RenderType.toDoc localizer tipe)

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

264− , indent 4 $ Help.reflowParagraph $

274+ , indent 4 $ reflowParagraph $

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

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

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

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

272282 Report.report

273283 "PORT ERROR"

274284 Nothing

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

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

276286 )

277287 ( Help.stack

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

279289 , indent 4 (RenderType.toDoc localizer tipe)

280− , Help.reflowParagraph $

290+ , reflowParagraph $

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

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

283293 ]

284294 )

285295

286296

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

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

288298argMismatchReport kind var expected actual =

289299 let

290300 numArgs =

291301 "too "

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

293− ++ " arguments"

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

303+ <> " arguments"

294304 in

295305 Report.report

296− (map Char.toUpper numArgs)

306+ (Text.map Char.toUpper numArgs)

297307 Nothing

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

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

299309 )

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

310+ ( text $

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

312+ )

313+

301314

302315

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

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

304317extractSuggestions err =

305318 case err of

306319 Var (VarError _ _ _ suggestions) ->

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

321334 Import _ importError ->

322335 case importError of

323336 ModuleNotFound suggestions ->

324− Just (map ModuleName.toString suggestions)

337+ Just (map ModuleName.toText suggestions)

325338

326339 ValueNotFound _ suggestions ->

327340 Just suggestions

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

362375-- BAD RECURSION

363376

364377

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

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

366379badSelfRecursion region name =

367380 let

368381 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."

370383 in

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

372385 Help.stack

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

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

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

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

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

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

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

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

378− "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

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

391+ "To define " <> Help.functionName name <> " 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

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

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

382395 Help.hintLink "bad-recursion"

383396 ]

384397

385398

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

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

387400badSelfRecursionHelp intro body =

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

401+ fillSep $

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

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

389404

390405

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

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

392407badMutualRecursion region name names =

393408 let

394409 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."

396411 in

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

398413 Help.stack

399− [ Help.reflowParagraph $

414+ [ reflowParagraph $

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

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

402− , Help.reflowParagraph $

417+ , reflowParagraph $

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

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

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

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

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

406421 ]

407422

408423

409−defToString :: Canonical.Def -> String

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

411− P.toString False pattern

424+defToText :: Canonical.Def -> Text

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

426+ P.toText pattern

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

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

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Reporting.Error.Docs where

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

5+import Data.Text (Text)

6−import qualified Reporting.Error.Helpers as Help

77import qualified Reporting.Report as Report

8+import qualified Reporting.Helpers as Help

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

810

911

1012

1113data Error

1214 = NoDocs

13− | OnlyInDocs String [String]

14− | OnlyInExports [String]

15− | NoComment String

16− | NoType String

15+ | OnlyInDocs Text [Text]

16+ | OnlyInExports [Text]

17+ | NoComment Text

18+ | NoType Text

1719

1820

1921

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

2729 Report.report

2830 "DOCUMENTATION ERROR"

2931 Nothing

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

31− ++ "imports."

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

33+ \ declaration and the imports."

3234 )

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

3436 )

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

3739 Report.report

3840 "DOCUMENTATION ERROR"

3941 Nothing

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

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

43+ )

4144 ( text $

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

43− ++ Help.maybeYouWant suggestions

46+ <> Help.maybeYouWant suggestions

4447 )

4548

4649 OnlyInExports names ->

4750 Report.report

4851 "DOCUMENTATION ERROR"

4952 Nothing

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

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

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

54+ <> Help.commaSep names

5255 )

5356 ( text $

5457 "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>"

5659 )

5760

5861 NoComment name ->

5962 Report.report

6063 "DOCUMENTATION ERROR"

6164 Nothing

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

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

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

6467 )

6568

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

6770 Report.report

6871 "MISSING ANNOTATION"

6972 Nothing

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

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

7174 ( text $

7275 "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!"

7477 )

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

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

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Reporting.Error.Pattern where

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

5+import Data.Text (Text)

6+import qualified Data.Text as Text

68import qualified Nitpick.Pattern as Pattern

7−import qualified Reporting.Error.Helpers as Help

89import qualified Reporting.Render.Type as RenderType

910import qualified Reporting.Region as Region

1011import qualified Reporting.Report as Report

12+import qualified Reporting.Helpers as Help

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

1114

1215

1316

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

5457 Report.report

5558 "REDUNDANT PATTERN"

5659 (Just region)

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

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

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

5962

6063

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

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

6265unhandledError unhandledPatterns relevantMessage =

6366 let

6467 (visiblePatterns, rest) =

6568 splitAt 4 unhandledPatterns

6669

6770 patternList =

68− map Pattern.toString visiblePatterns

71+ map Pattern.toText visiblePatterns

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

7073

7174 noun =

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

7376 in

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

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

76− ++ "\n"

77− ++ relevantMessage ++ "\n"

78− ++ "\n"

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

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

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

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

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

79+ <> "\n"

80+ <> relevantMessage <> "\n"

81+ <> "\n"

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

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

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

8285

8386

84−toCaseMessage :: String

87+toCaseMessage :: Text

8588toCaseMessage =

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

8790

8891

89−missingBranchesMessage :: Int -> String

92+missingBranchesMessage :: Int -> Text

9093missingBranchesMessage numUnhandled =

9194 if numUnhandled == 1 then

9295 "Add a branch to cover this pattern!"

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

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

11{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

23module Reporting.Error.Syntax where

4−import qualified Data.List as List

5−import qualified Data.Set as Set

6−import qualified Text.Parsec.Error as Parsec

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

5+import Data.Text (Text)

9−import qualified Reporting.Error.Helpers as Help

107import qualified Reporting.Render.Type as RenderType

118import qualified Reporting.Region as Region

129import qualified Reporting.Report as Report

10+import qualified Reporting.Helpers as Help

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

1312

1413

1514data Error

16− = Parse [Parsec.Message]

15+ = Parse

1716 | BadFunctionName Int

18− | BadPattern String

17+ | BadPattern Text

1918

2019 | CommentOnNothing

2120

2221 | SettingsOnNormalModule

2322 | SettingsOnPortModule

24− | DuplicateSettingOnEffectModule String

25− | BadSettingOnEffectModule String

23+ | DuplicateSettingOnEffectModule Text

24+ | BadSettingOnEffectModule Text

2625 | NoSettingsOnEffectModule

27− | MissingManagerOnEffectModule String

28− | UnexpectedPort String

29−

30− | TypeWithoutDefinition String

26+ | MissingManagerOnEffectModule Text

27+ | UnexpectedPort Text

28+

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)

3141

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]

4142

4243

4344-- TO REPORT

4445

46+

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

4648toReport _localizer err =

4749 case err of

48− Parse messages ->

49− parseErrorReport messages

50+ Parse ->

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

5052

5153 BadFunctionName arity ->

5254 Report.report

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

5456 Nothing

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

5658 ( Help.reflowParagraph $

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

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

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

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

6062 \ be changed to a normal name."

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

6466 Report.report

6567 "BAD PATTERN"

6668 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.")

6870 ( Help.stack

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

7072 , Help.reflowParagraph $

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

7274 \ 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\

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

7577 ]

7678 )

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

113115 Report.report

114116 "EFFECT MODULE PROBLEM"

115117 Nothing

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

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

117119 ( Help.reflowParagraph $

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

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

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

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

120122 )

121123

122124 BadSettingOnEffectModule name ->

123125 Report.report

124126 "EFFECT MODULE PROBLEM"

125127 Nothing

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

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

127129 ( Help.reflowParagraph $

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

129131 )

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

144146 Report.report

145147 "EFFECT MODULE PROBLEM"

146148 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.")

148150 ( Help.reflowParagraph $

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

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

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

156158 Report.report

157159 "BAD PORT"

158160 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.")

160162 ( Help.reflowParagraph $

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

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

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

167169 Report.report

168170 "MISSING DEFINITION"

169171 Nothing

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

171− ++ " is no corresponding definition!"

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

173+ <> " is no corresponding definition!"

172174 )

173175 ( text $

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

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

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

176178 )

177179

178180 DuplicateArgument funcName argName ->

179181 Report.report

180182 "DUPLICATE ARGUMENT"

181183 Nothing

182− ( "The name `" ++ argName

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

184− ++ funcName ++ "`."

184+ ( "The name `" <> argName

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

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

185187 )

186188 ( Help.reflowParagraph $

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

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

188190 \ 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?"

190192 )

191193

192194 DuplicateFieldName region name ->

193195 Report.report

194196 "DUPLICATE FIELD"

195197 (Just region)

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

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

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

198200

199201 DuplicateValueDeclaration name ->

200202 Report.report

201203 "DUPLICATE DEFINITION"

202204 Nothing

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

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

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

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

205207 )

206208 ( Help.reflowParagraph $

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

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

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

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

209211 )

210212

211213 DuplicateTypeDeclaration name ->

212214 Report.report

213215 "DUPLICATE DEFINITION"

214216 Nothing

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

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

216218 )

217219 ( Help.reflowParagraph $

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

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

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

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

220222 )

221223

222224 DuplicateDefinition name ->

223225 Report.report

224226 "DUPLICATE DEFINITION"

225227 Nothing

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

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

227229 )

228230 ( Help.reflowParagraph $

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

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

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

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

231233 )

232234

233235 UnboundTypeVarsInUnion typeName givenVars unbound ->

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

240242 Report.report

241243 "UNUSED TYPE VARIABLES"

242244 Nothing

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

244− ++ Help.commaSep unused

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

246+ <> Help.commaSep unused

245247 )

246248 ( Help.stack

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

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

254256 Report.report

255257 "TYPE VARIABLE PROBLEMS"

256258 Nothing

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

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

258260 )

259261 ( Help.stack

260262 [ Help.reflowParagraph $

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

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

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

264− ++ Help.commaSep unbound

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

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

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

266+ <> Help.commaSep unbound

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

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

267269 , dullyellow $ hsep $

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

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

270272 )

271273

272274

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

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

274276unboundTypeVars declKind typeName givenVars unboundVars =

275277 Report.report

276278 "UNBOUND TYPE VARIABLES"

277279 Nothing

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

279− ++ Help.commaSep unboundVars

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

281+ <> Help.commaSep unboundVars

280282 )

281283 ( Help.stack

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

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

285287 ++ map (dullyellow . text) unboundVars

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

287289 , Help.reflowParagraph $

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

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

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

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

291293 ]

292294 )

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 @@

11{-# OPTIONS_GHC -Wall #-}

2−module Reporting.Error.Type where

2+{-# LANGUAGE OverloadedStrings #-}

3+module Reporting.Error.Type

4+ ( Error(..)

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

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

7+ , Pattern(..)

8+ , toReport

9+ , flipReason

10+ )

11+ where

312

413import Control.Arrow (first, second)

5−import qualified Data.List as List

614import qualified Data.Map as Map

715import qualified Data.Maybe as Maybe

8−import Text.PrettyPrint.ANSI.Leijen

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

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

11− )

16+import qualified Data.Text as Text

17+import Data.Text (Text)

1218

1319import qualified AST.Helpers as Help

1420import qualified AST.Type as Type

1521import qualified AST.Variable as Var

16−import qualified Reporting.Error.Helpers as Help

1722import qualified Reporting.Region as Region

1823import qualified Reporting.Render.Type as RenderType

1924import 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+ )

2030

2131

2232

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

2636data Error

2737 = Mismatch Mismatch

2838 | BadMain Type.Canonical

29− | BadFlags Type.Canonical (Maybe String)

30− | InfiniteType String Type.Canonical

39+ | BadFlags Type.Canonical (Maybe Text)

40+ | InfiniteType Text Type.Canonical

3141

3242

3343data Mismatch = MismatchInfo

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

3949

4050

4151data Reason

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

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

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

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

4454 | IntFloat

4555 | TooLongComparableTuple Int

4656 | MissingArgs Int

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

5262 | Comparable

5363 | Appendable

5464 | CompAppend

55− | Rigid (Maybe String)

65+ | Rigid (Maybe Text)

5666

5767

5868data Hint

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

7080 | Function (Maybe Var.Canonical)

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

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

73− | ReturnType String Int Int Region.Region

74− | Instance String

75− | Literal String

83+ | ReturnType Text Int Int Region.Region

84+ | Instance Text

85+ | Literal Text

7686 | Pattern Pattern

7787 | Shader

7888 | Lambda

79− | Access (Maybe String) String

89+ | Access (Maybe Text) Text

8090 | Record

8191 -- effect manager problems

82− | Manager String

83− | State String

92+ | Manager Text

93+ | State Text

8494 | SelfMsg

8595

8696

8797data Pattern

88− = PVar String

89− | PAlias String

90− | PData String

98+ = PVar Text

99+ | PAlias Text

100+ | PCtor Var.Canonical

91101 | PRecord

92102

93103

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

109119 "BAD MAIN TYPE"

110120 Nothing

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

112− ( Help.stack

113− [ Help.reflowParagraph $

122+ ( stack

123+ [ reflowParagraph $

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

115125 \ screen, but you gave me:"

116126 , indent 4 (RenderType.toDoc localizer tipe)

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

120130 BadFlags tipe maybeMessage ->

121131 let

122132 context =

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

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

124134 in

125135 Report.report

126136 "BAD FLAGS"

127137 Nothing

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

129139 )

130− ( Help.stack

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

140+ ( stack

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

132142 , indent 4 (RenderType.toDoc localizer tipe)

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

134− , indent 4 $ Help.reflowParagraph $

144+ , indent 4 $ reflowParagraph $

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

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

137147 ]

138148 )

139149

140150

151+

141152-- TYPE MISMATCHES

142153

143154

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

152163

153164 cmpHint leftWords rightWords extraHints =

154165 comparisonHint localizer leftType rightType leftWords rightWords

155− (typicalHints ++ map toHint extraHints)

166+ (typicalHints <> map toHint extraHints)

156167 in

157168 case hint of

158169 CaseBranch branchNumber region ->

159170 report

160171 (Just region)

161− ( "The " ++ ordinalPair branchNumber

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

172+ ( "The " <> ordinalPair branchNumber

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

163174 )

164175 ( cmpHint

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

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

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

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

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

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

169180 ]

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

173184 report

174185 Nothing

175186 ( "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."

177188 )

178189 ( cmpHint

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

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

208219 MultiIfBranch branchNumber region ->

209220 report

210221 (Just region)

211− ( "The " ++ ordinalPair branchNumber

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

222+ ( "The " <> ordinalPair branchNumber

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

213224 )

214225 ( cmpHint

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

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

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

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

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

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

219230 ]

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

233244 ListElement elementNumber region ->

234245 report

235246 (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.")

237248 ( cmpHint

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

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

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

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

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

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

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

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

247258 List ->

248259 report

249260 Nothing

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

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

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

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

252263 )

253264 ( cmpHint

254265 "The list has type:"

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

259270 BinopLeft op region ->

260271 report

261272 (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.")

263274 ( cmpHint

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

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

265276 "But the left argument is:"

266277 (binopHint op leftType rightType)

267278 )

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

269280 BinopRight op region ->

270281 report

271282 (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.")

273284 ( cmpHint

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

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

275286 "But the right side is:"

276287 ( binopHint op leftType rightType

277288 ++

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

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

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

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

281292 ]

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

285296 Binop op ->

286297 report

287298 Nothing

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

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

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

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

291302 )

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

298309 Function maybeName ->

299310 report

300311 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."

302313 )

303314 ( cmpHint

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

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

309320 UnexpectedArg maybeName 1 1 region ->

310321 report

311322 (Just region)

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

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

313324 ( cmpHint

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

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

315326 "But it is:"

316327 (functionHint maybeName)

317328 )

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

319330 UnexpectedArg maybeName index _totalArgs region ->

320331 report

321332 (Just region)

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

323− ++ " is causing a mismatch."

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

334+ <> " is causing a mismatch."

324335 )

325336 ( cmpHint

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

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

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

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

328339 )

329340 "But it is:"

330341 ( functionHint maybeName

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

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

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

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

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

349+ <> ordinalize index <> "."

339350 ]

340351 )

341352 )

342353

343354 FunctionArity maybeName 0 actual region ->

344355 let

345− arg =

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

356+ args =

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

347358

348359 preHint =

349360 case maybeName of

350361 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!"

352363

353364 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 <> "!"

355366 in

356367 report

357368 (Just region)

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

361372 FunctionArity maybeName expected actual region ->

362373 report

363374 (Just region)

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

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

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

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

366377 )

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

368379

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

370381 if typeArity == 0 || argArity == 0 then

371382 report

372383 (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.")

374385 ( cmpHint

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

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

376387 )

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

378389 (arityHint typeArity argArity)

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

381392 else

382393 report

383394 (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.")

385396 ( cmpHint

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

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

387398 )

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

389400 (arityHint typeArity argArity)

390401 )

391402

392− Instance name ->

403+ Instance var ->

404+ let

405+ name =

406+ functionName var

407+ in

393408 report

394409 Nothing

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

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

396411 ( cmpHint

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

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

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

399414 []

400415 )

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

402417 Literal name ->

403418 report

404419 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."

406421 )

407422 ( cmpHint

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

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

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

410425 []

411426 )

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

414429 let

415430 thing =

416431 case patErr of

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

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

419− PRecord -> "this record"

420− PData name ->

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

432+ PVar name ->

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

434+

435+ PAlias name ->

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

437+

438+ PRecord ->

439+ "this record"

440+

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

442+ "this tuple"

443+

444+ PCtor name ->

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

422446 in

423447 report

424448 Nothing

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

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

426450 )

427451 ( cmpHint

428452 "The pattern matches things of type:"

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

452476

453477 Access (Just body) field ->

454478 let

455− header =

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

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

457480 in

458− report Nothing header $ Help.stack $

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

481+ report Nothing header $ stack $

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

460483 , 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 <> "`."

462485 ]

463486 ++ typicalHints

464487

465488 Access Nothing field ->

466489 let

467− header =

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

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

469491 in

470− report Nothing header $ Help.stack $

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

492+ report Nothing header $ stack $

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

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

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

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

474496 ]

475497 ++ typicalHints

476498

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

487509 Manager name ->

488510 report

489511 Nothing

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

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

491513 ( cmpHint

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

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

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

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

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

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

500522 report

501523 Nothing

502524 ( "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."

504526 )

505527 ( cmpHint

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

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

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

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

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

510532 ]

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

529551 :: RenderType.Localizer

530552 -> Type.Canonical

531553 -> Type.Canonical

532− -> String

533− -> String

554+ -> Text

555+ -> Text

534556 -> [Doc]

535557 -> Doc

536558comparisonHint localizer leftType rightType leftWords rightWords finalHints =

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

538560 (leftDoc, rightDoc) =

539561 RenderType.diffToDocs localizer leftType rightType

540562 in

541− Help.stack $

542− [ Help.reflowParagraph leftWords

563+ stack $

564+ [ reflowParagraph leftWords

543565 , indent 4 leftDoc

544− , Help.reflowParagraph rightWords

566+ , reflowParagraph rightWords

545567 , indent 4 rightDoc

546568 ]

547569 ++

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

552574-- BINOP HINTS

553575

554576

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

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

556578binopHint op leftType rightType =

557579 let

558580 leftString =

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

561583 rightString =

562584 show (RenderType.toDoc Map.empty rightType)

563585 in

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

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

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

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

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

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

567589 ]

568590

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

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

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

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

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

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

580602-- FUNCTION HINTS

581603

582604

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

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

584606functionHint maybeName =

585607 case maybeName of

586608 Nothing ->

587609 []

588610

589611 Just name ->

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

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

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

592614 ]

593615

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

599621-- ARITY HINTS

600622

601623

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

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

603625arityHint typeArity argArity =

604626 if typeArity == argArity then

605627 []

606628

607629 else

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

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

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

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

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

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

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

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

634+ \ so try that first!"

612635 ]

613636

614637

615−sayArgs :: Int -> String

638+sayArgs :: Int -> Text

616639sayArgs n =

617640 case n of

618641 0 ->

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

622645 "is 1 argument"

623646

624647 _ ->

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

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

626649

627650

628651

629652-- MISMATCH HELPERS

630653

631654

632−ordinalPair :: Int -> String

655+ordinalPair :: Int -> Text

633656ordinalPair number =

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

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

635658

636659

637−prettyName :: Var.Canonical -> String

638−prettyName (Var.Canonical _ opName) =

639− Help.functionName opName

660+varName :: Var.Canonical -> Text

661+varName (Var.Canonical _ opName) =

662+ functionName opName

640663

641664

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

643−funcName maybeVar =

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

666+maybeFuncName maybeVar =

644667 case maybeVar of

645668 Nothing ->

646669 "this function"

647670

648671 Just var ->

649− "function " ++ prettyName var

672+ "function " <> varName var

650673

651674

652675

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

690713 Nothing

691714

692715 [field] ->

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

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

694717

695718 _ ->

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

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

697720 in

698721 case (starter, maybeDocs) of

699722 (Nothing, Nothing) ->

700723 Nothing

701724

702725 (Just msg, Nothing) ->

703− Just $ toHint (msg ++ badFieldElaboration)

726+ Just $ toHint (msg <> badFieldElaboration)

704727

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

706729 Just $ vcat $

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

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

708731 : map (indent 4) docs

709732

710733

711734

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

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

713736collectFields reason =

714737 case reason of

715738 BadFields [(field, Nothing)] ->

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

722745 ([], Just reason)

723746

724747

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

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

726749reasonToStringHelp reason =

727750 let

728751 go msg =

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

732755 BadFields fields ->

733756 go $

734757 "I am seeing issues with the "

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

736− ++ badFieldElaboration

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

759+ <> badFieldElaboration

737760

738761 MessyFields both leftOnly rightOnly ->

739762 messyFieldsHelp both leftOnly rightOnly

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

747770 TooLongComparableTuple len ->

748771 go $

749772 "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 <> "."

751774

752775 MissingArgs num ->

753776 go $

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

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

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

756778

757779 BadVar (Just Comparable) _ ->

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

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

776798 Nothing

777799

778800

779−badFieldElaboration :: String

801+badFieldElaboration :: Text

780802badFieldElaboration =

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

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

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

784806

785807

786−weirdRigidError :: String

808+weirdRigidError :: Text

787809weirdRigidError =

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

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

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

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

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

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

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

794816

795817

796−singleRigidError :: Maybe String -> String

818+singleRigidError :: Maybe Text -> Text

797819singleRigidError maybeName =

798820 case maybeName of

799821 Just name ->

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

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

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

802824 \ it CANNOT be anything though! Maybe change your type annotation to\

803825 \ be more specific? Maybe the code has a problem? More at: "

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

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

805827

806828 Nothing ->

807829 weirdRigidError

808830

809831

810−doubleRigidError :: Maybe String -> Maybe String -> String

832+doubleRigidError :: Maybe Text -> Maybe Text -> Text

811833doubleRigidError maybeLeftName maybeRightName =

812834 case (maybeLeftName, maybeRightName) of

813835 (Just leftName, Just rightName) ->

814− "Your type annotation uses `" ++ leftName ++ "` and `" ++ rightName ++

836+ "Your type annotation uses `" <> leftName <> "` and `" <> rightName <>

815837 "` as separate type variables. Each one can be any type of value,\

816838 \ but because they have separate names, there is no guarantee that they\

817839 \ are equal to each other. Your code seems to be saying they ARE the\

818840 \ same though! Maybe they should be the same in your type annotation?\

819841 \ Maybe your code uses them in a weird way? More at: "

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

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

821843

822844 _ ->

823845 weirdRigidError

@@ -828,12 +850,12 @@ hintDoc =

828850 underline (text "Hint") <> colon

829851

830852

831−toHint :: String -> Doc

832−toHint str =

833− fillSep (hintDoc : map text (words str))

853+toHint :: Text -> Doc

854+toHint txt =

855+ fillSep (hintDoc : map text (Text.words txt))

834856

835857

836−messyFieldsHelp :: [String] -> [String] -> [String] -> Maybe (String, [Doc])

858+messyFieldsHelp :: [Text] -> [Text] -> [Text] -> Maybe (Text, [Doc])

837859messyFieldsHelp both leftOnly rightOnly =

838860 case (leftOnly, rightOnly) of

839861 ([], [missingField]) ->

@@ -861,8 +883,8 @@ messyFieldsHelp both leftOnly rightOnly =

861883 if null typoPairs then

862884 Just

863885 ( "The record fields do not match up. One has "

864− ++ Help.commaSep leftOnly ++ ". The other has "

865− ++ Help.commaSep rightOnly ++ "."

886+ <> Help.commaSep leftOnly <> ". The other has "

887+ <> Help.commaSep rightOnly <> "."

866888 , []

867889 )

868890

@@ -873,61 +895,62 @@ messyFieldsHelp both leftOnly rightOnly =

873895 )

874896

875897

876−oneMissingField :: [String] -> String -> Maybe (String, [Doc])

898+oneMissingField :: [Text] -> Text -> Maybe (Text, [Doc])

877899oneMissingField knownFields missingField =

878900 case Help.findPotentialTypos knownFields missingField of

879901 [] ->

880902 Just

881− ( "Looks like a record is missing the `" ++ missingField ++ "` field."

903+ ( "Looks like a record is missing the `" <> missingField <> "` field."

882904 , []

883905 )

884906

885907 [typo] ->

886908 Just

887− ( "Looks like a record is missing the `" ++ missingField

888− ++ "` field. Maybe it is a typo?"

909+ ( "Looks like a record is missing the `" <> missingField

910+ <> "` field. Maybe it is a typo?"

889911 , typoDocs "->" [(missingField, typo)]

890912 )

891913

892914 typos ->

893915 Just

894− ( "Looks like a record is missing the `" ++ missingField

895− ++ "` field. It is close to names like "

896− ++ Help.commaSep typos ++ " so maybe it is a typo?"

916+ ( "Looks like a record is missing the `" <> missingField

917+ <> "` field. It is close to names like "

918+ <> Help.commaSep typos <> " so maybe it is a typo?"

897919 , []

898920 )

899921

900922

901−manyMissingFields :: [String] -> [String] -> Maybe (String, [Doc])

923+manyMissingFields :: [Text] -> [Text] -> Maybe (Text, [Doc])

902924manyMissingFields knownFields missingFields =

903925 case Help.findTypoPairs missingFields knownFields of

904926 [] ->

905927 Just

906928 ( "Looks like a record is missing these fields: "

907− ++ Help.commaSep missingFields

929+ <> Help.commaSep missingFields

908930 , []

909931 )

910932

911933 typoPairs ->

912934 Just

913− ( "Looks like a record is missing these fields: " ++ Help.commaSep missingFields

914− ++ ". Potential typos include:"

935+ ( "Looks like a record is missing these fields: "

936+ <> Help.commaSep missingFields

937+ <> ". Potential typos include:"

915938 , typoDocs "->" typoPairs

916939 )

917940

918941

919−typoDocs :: String -> [(String, String)] -> [Doc]

942+typoDocs :: Text -> [(Text, Text)] -> [Doc]

920943typoDocs arrow typoPairs =

921944 let

922945 maxLen =

923− maximum (map (length . fst) typoPairs)

946+ maximum (map (Text.length . fst) typoPairs)

924947 in

925948 text "" : map (padTypo arrow maxLen) typoPairs

926949

927950

928−padTypo :: String -> Int -> (String, String) -> Doc

951+padTypo :: Text -> Int -> (Text, Text) -> Doc

929952padTypo arrow maxLen (missingField, knownField) =

930− text (replicate (maxLen - length missingField) ' ')

953+ text (Text.replicate (maxLen - Text.length missingField) " ")

931954 <> dullyellow (text missingField)

932955 <+> text arrow

933956 <+> dullyellow (text knownField)

@@ -939,24 +962,23 @@ padTypo arrow maxLen (missingField, knownField) =

939962

940963infiniteTypeToReport

941964 :: RenderType.Localizer

942− -> String

965+ -> Text

943966 -> Type.Canonical

944967 -> Report.Report

945968infiniteTypeToReport localizer name overallType =

946969 Report.report

947970 "INFINITE TYPE"

948971 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

950973 )

951− ( Help.stack

952− [ Help.reflowParagraph $

974+ ( stack

975+ [ reflowParagraph $

953976 "Here is my best effort at writing down the type. You will see ? and ∞ for\

954977 \ parts of the type that repeat something already printed out infinitely."

955978 , indent 4 (RenderType.toDoc localizer overallType)

956− , Help.reflowParagraph $

979+ , reflowParagraph $

957980 "Usually staring at the type is not so helpful in these cases, so definitely\

958981 \ read the debugging hints for ideas on how to figure this out: "

959− ++ Help.hintLink "infinite-type"

982+ <> Help.hintLink "infinite-type"

960983 ]

961984 )

962−

src/Reporting/Error/Helpers.hs → src/Reporting/Helpers.hsrenamed+68−42

@@ -1,6 +1,13 @@

11{-# OPTIONS_GHC -Wall #-}

2−module Reporting.Error.Helpers

2+{-# LANGUAGE OverloadedStrings #-}

3+module Reporting.Helpers

34 ( (|>)

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

411 , functionName, args

512 , hintLink, stack, reflowParagraph

613 , commaSep, capitalize, ordinalize, drawCycle

@@ -13,10 +20,13 @@ import Data.Function (on)

1320import qualified Data.Char as Char

1421import qualified Data.List as List

1522import qualified Data.Map as Map

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

1624import qualified Data.Set as Set

25+import qualified Data.Text as Text

26+import Data.Text (Text)

1727import qualified Text.EditDistance as Dist

18−import Text.PrettyPrint.ANSI.Leijen

19− ( Doc, (<>), dullyellow, fillSep, hardline, text, vcat )

28+import qualified Text.PrettyPrint.ANSI.Leijen as P

29+import Text.PrettyPrint.ANSI.Leijen hiding ((<>), text)

2030

2131import qualified AST.Helpers as Help

2232import qualified Elm.Compiler.Version as Compiler

@@ -39,30 +49,40 @@ infixl 0 |>

3949-- DOC HELPERS

4050

4151

42−functionName :: String -> String

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+

62+functionName :: Text -> Text

4363functionName opName =

4464 if Help.isOp opName then

45− "(" ++ opName ++ ")"

65+ "(" <> opName <> ")"

4666

4767 else

48− "`" ++ opName ++ "`"

68+ "`" <> opName <> "`"

4969

5070

51−args :: Int -> String

71+args :: Int -> Text

5272args n =

53− show n ++ if n == 1 then " argument" else " arguments"

73+ i2t n <> if n == 1 then " argument" else " arguments"

5474

5575

56−hintLink :: String -> String

76+hintLink :: Text -> Text

5777hintLink fileName =

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

59− ++ Pkg.versionToString Compiler.version

60− ++ "/hints/" ++ fileName ++ ".md>"

79+ <> Text.pack (Pkg.versionToString Compiler.version)

80+ <> "/hints/" <> fileName <> ".md>"

6181

6282

6383stack :: [Doc] -> Doc

64−stack list =

65− case list of

84+stack chunks =

85+ case chunks of

6686 [] ->

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

6888

@@ -70,33 +90,35 @@ stack list =

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

7191

7292

73−reflowParagraph :: String -> Doc

93+reflowParagraph :: Text -> Doc

7494reflowParagraph paragraph =

75− fillSep (map text (words paragraph))

95+ fillSep (map text (Text.words paragraph))

7696

7797

78−commaSep :: [String] -> String

98+commaSep :: [Text] -> Text

7999commaSep tokens =

80100 case tokens of

81101 [token] ->

82− " " ++ token

102+ " " <> token

83103

84104 [token1,token2] ->

85− " " ++ token1 ++ " and " ++ token2

105+ " " <> token1 <> " and " <> token2

86106

87107 _ ->

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

108+ " " <> Text.intercalate ", " (init tokens) <> ", and " <> last tokens

109+

89110

111+capitalize :: Text -> Text

112+capitalize txt =

113+ case Text.uncons txt of

114+ Nothing ->

115+ txt

90116

91−capitalize :: String -> String

92−capitalize string =

93− case string of

94− [] -> []

95− c : cs ->

96− Char.toUpper c : cs

117+ Just (c, rest) ->

118+ Text.cons (Char.toUpper c) rest

97119

98120

99−ordinalize :: Int -> String

121+ordinalize :: Int -> Text

100122ordinalize number =

101123 let

102124 remainder10 =

@@ -112,18 +134,18 @@ ordinalize number =

112134 | remainder10 == 3 = "rd"

113135 | otherwise = "th"

114136 in

115− show number ++ ending

137+ i2t number <> ending

116138

117139

118140

119−drawCycle :: [String] -> Doc

120−drawCycle strings =

141+drawCycle :: [Text] -> Doc

142+drawCycle names =

121143 let

122144 topLine =

123145 text "┌─────┐"

124146

125− line str =

126− text "│ " <> dullyellow (text str)

147+ nameLine name =

148+ text "│ " <> dullyellow (text name)

127149

128150 midLine =

129151 text "│ ↓"

@@ -131,19 +153,19 @@ drawCycle strings =

131153 bottomLine =

132154 text "└─────┘"

133155 in

134− vcat (topLine : List.intersperse midLine (map line strings) ++ [ bottomLine ])

156+ vcat (topLine : List.intersperse midLine (map nameLine names) ++ [ bottomLine ])

135157

136158

137159

138160-- FIND TYPOS

139161

140162

141−findPotentialTypos :: [String] -> String -> [String]

163+findPotentialTypos :: [Text] -> Text -> [Text]

142164findPotentialTypos knownNames badName =

143165 filter ((==1) . distance badName) knownNames

144166

145167

146−findTypoPairs :: [String] -> [String] -> [(String, String)]

168+findTypoPairs :: [Text] -> [Text] -> [(Text, Text)]

147169findTypoPairs leftOnly rightOnly =

148170 let

149171 veryNear leftName =

@@ -152,7 +174,7 @@ findTypoPairs leftOnly rightOnly =

152174 concatMap veryNear leftOnly

153175

154176

155−vetTypos :: [(String, String)] -> Maybe (Set.Set String, Set.Set String)

177+vetTypos :: [(Text, Text)] -> Maybe (Set.Set Text, Set.Set Text)

156178vetTypos potentialTypos =

157179 let

158180 tallyNames (ln, rn) (lc, rc) =

@@ -163,7 +185,7 @@ vetTypos potentialTypos =

163185 (leftCounts, rightCounts) =

164186 foldr tallyNames (Map.empty, Map.empty) potentialTypos

165187

166− acceptable :: Map.Map String Int -> Bool

188+ acceptable :: Map.Map Text Int -> Bool

167189 acceptable counts =

168190 not (Map.null counts)

169191 &&

@@ -180,10 +202,10 @@ vetTypos potentialTypos =

180202-- NEARBY NAMES

181203

182204

183−nearbyNames :: (a -> String) -> a -> [a] -> [a]

205+nearbyNames :: (a -> Text) -> a -> [a] -> [a]

184206nearbyNames format name names =

185207 let editDistance =

186− if length (format name) < 3 then 1 else 2

208+ if Text.length (format name) < 3 then 1 else 2

187209 in

188210 names

189211 |> map (\x -> (distance (format name) (format x), x))

@@ -192,12 +214,15 @@ nearbyNames format name names =

192214 |> map snd

193215

194216

195−distance :: String -> String -> Int

217+distance :: Text -> Text -> Int

196218distance x y =

197− Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y

219+ Dist.restrictedDamerauLevenshteinDistance

220+ Dist.defaultEditCosts

221+ (Text.unpack x)

222+ (Text.unpack y)

198223

199224

200−maybeYouWant :: [String] -> String

225+maybeYouWant :: [Text] -> Text

201226maybeYouWant suggestions =

202227 case suggestions of

203228 [] ->

@@ -205,5 +230,6 @@ maybeYouWant suggestions =

205230

206231 _:_ ->

207232 "Maybe you want one of the following?\n"

208− ++ concatMap ("\n "++) (take 4 suggestions)

233+ <>

234+ Text.concat (map ("\n " <>) (take 4 suggestions))

209235

src/Reporting/Region.hs+2−10

@@ -3,7 +3,6 @@ module Reporting.Region where

44import Data.Aeson ((.=))

55import qualified Data.Aeson as Json

6−import qualified Text.Parsec.Pos as Parsec

98data Region =

@@ -16,19 +15,12 @@ data Region =

1615

1716data Position =

1817 Position

19− { line :: {-# UNPACK #-} !Int

20− , column :: {-# UNPACK #-} !Int

18+ { line :: !Int

19+ , column :: !Int

2120 }

2221 deriving (Eq, Show)

2322

2423

25−fromSourcePos :: Parsec.SourcePos -> Position

26−fromSourcePos sourcePos =

27− Position

28− (Parsec.sourceLine sourcePos)

29− (Parsec.sourceColumn sourcePos)

30−

31−

3224merge :: Region -> Region -> Region

3325merge (Region start _) (Region _ end) =

3426 Region start end

src/Reporting/Render/Type.hs+25−22

@@ -1,3 +1,5 @@

1+{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE OverloadedStrings #-}

13module Reporting.Render.Type

24 ( Localizer

35 , decl

@@ -11,15 +13,16 @@ module Reporting.Render.Type

1113import Control.Arrow ((***), first)

1214import qualified Data.Map as Map

1315import qualified Data.Set as Set

14−import Text.PrettyPrint.ANSI.Leijen

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

16− , lbrace, lparen, parens, rbrace, rparen, sep, text, vcat

17− )

16+import Data.Text (Text)

1817

1918import qualified AST.Helpers as Help

2019import qualified AST.Type as Type

2120import 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+ )

2326

2427

2528

@@ -41,21 +44,21 @@ diffToDocs localizer leftType rightType =

4144 (leftDoc, rightDoc)

4245

4346

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

47+decl :: Localizer -> Text -> [Text] -> [(Text, [Type.Canonical])] -> Doc

4548decl localizer name vars tags =

4649 let

4750 docTag (tag, args) =

4851 hang 2 (sep (text tag : map (docType localizer App) args))

4952 in

5053 hang 4 $ vcat $

51− (hsep (map text ("type" : name : vars)))

54+ (hsep (text "type" : map text (name : vars)))

5255 :

5356 zipWith (<+>)

5457 (equals : repeat (text "|"))

5558 (map docTag tags)

5659

5760

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

61+annotation :: Localizer -> Text -> Type.Canonical -> Doc

5962annotation localizer name tipe =

6063 let

6164 docName =

@@ -81,20 +84,20 @@ annotation localizer name tipe =

8184

8285

8386type Localizer =

84− Map.Map String String

87+ Map.Map Var.Canonical Text

8588

8689

8790varToDoc :: Localizer -> Var.Canonical -> Doc

8891varToDoc localizer var =

8992 let

9093 name =

91− Var.toString var

94+ Var.toText var

9295 in

9396 if name == "_Tuple0" then

9497 text "()"

9598

9699 else

97− text (maybe name id (Map.lookup name localizer))

100+ text (maybe name id (Map.lookup var localizer))

98101

99102

100103

@@ -120,8 +123,8 @@ instance Applicative Diff where

120123 pure a =

121124 Same a

122125

123− (<*>) func arg =

124− case (func, arg) of

126+ (<*>) function argument =

127+ case (function, argument) of

125128 (Diff leftFunc rightFunc, Diff leftArg rightArg) ->

126129 Diff (leftFunc leftArg) (rightFunc rightArg)

127130

@@ -258,7 +261,7 @@ diffLambda localizer context leftType rightType =

258261-- RECORD DIFFS

259262

260263

261−diffRecord :: Localizer -> Fields -> Maybe String -> Fields -> Maybe String -> Diff Doc

264+diffRecord :: Localizer -> Fields -> Maybe Text -> Fields -> Maybe Text -> Diff Doc

262265diffRecord localizer leftFields leftExt rightFields rightExt =

263266 let

264267 (leftOnly, both, rightOnly) =

@@ -305,7 +308,7 @@ diffRecord localizer leftFields leftExt rightFields rightExt =

305308 (docRecord style rights (fmap text rightExt))

306309

307310

308−unzipDiffs :: [(String, (Doc, Doc))] -> ( [(Doc, Doc)], [(Doc, Doc)] )

311+unzipDiffs :: [(Text, (Doc, Doc))] -> ( [(Doc, Doc)], [(Doc, Doc)] )

309312unzipDiffs diffPairs =

310313 let

311314 unzipHelp (name, (left, right)) =

@@ -318,7 +321,7 @@ unzipDiffs diffPairs =

318321-- RECORD DIFFS HELPERS

319322

320323

321−analyzeFields :: [String] -> [String] -> ( [(Doc, Doc)], [(Doc, Doc)] )

324+analyzeFields :: [Text] -> [Text] -> ( [(Doc, Doc)], [(Doc, Doc)] )

322325analyzeFields leftOnly rightOnly =

323326 let

324327 typoPairs =

@@ -343,11 +346,11 @@ analyzeFields leftOnly rightOnly =

343346

344347

345348type Fields =

346− Map.Map String Type.Canonical

349+ Map.Map Text Type.Canonical

347350

348351

349352type DoubleFields =

350− Map.Map String (Type.Canonical,Type.Canonical)

353+ Map.Map Text (Type.Canonical,Type.Canonical)

351354

352355

353356vennDiagram :: Fields -> Fields -> (Fields, DoubleFields, Fields)

@@ -359,17 +362,17 @@ vennDiagram leftFields rightFields =

359362

360363

361364flattenRecord

362− :: [(String, Type.Canonical)]

365+ :: [(Text, Type.Canonical)]

363366 -> Maybe Type.Canonical

364− -> (Fields, Maybe String)

367+ -> (Fields, Maybe Text)

365368flattenRecord fields ext =

366369 first Map.fromList (flattenRecordHelp fields ext)

367370

368371

369372flattenRecordHelp

370− :: [(String, Type.Canonical)]

373+ :: [(Text, Type.Canonical)]

371374 -> Maybe Type.Canonical

372− -> ([(String, Type.Canonical)], Maybe String)

375+ -> ([(Text, Type.Canonical)], Maybe Text)

373376flattenRecordHelp fields ext =

374377 case ext of

375378 Nothing ->

src/Reporting/Report.hs+12−7

@@ -11,12 +11,15 @@ module Reporting.Report

1111

1212import Data.Aeson ((.=))

1313import qualified Data.Aeson.Types as Json

14+import qualified Data.Text as Text

15+import Data.Text (Text)

1416import System.IO (Handle)

1517import Text.PrettyPrint.ANSI.Leijen

16− ( Doc, (<>), displayS, displayIO, dullcyan, fillSep

18+ ( Doc, (<>), displayS, displayIO, dullcyan

1719 , hardline, plain, renderPretty, text

1820 )

1921

22+import qualified Reporting.Helpers as Help

2023import qualified Reporting.Region as R

2124import qualified Reporting.Render.Code as Code

2225

@@ -26,16 +29,16 @@ import qualified Reporting.Render.Code as Code

2629

2730

2831data Report = Report

29− { _title :: String

32+ { _title :: Text

3033 , _highlight :: Maybe R.Region

3134 , _preHint :: Doc

3235 , _postHint :: Doc

3336 }

3437

3538

36−report :: String -> Maybe R.Region -> String -> Doc -> Report

39+report :: Text -> Maybe R.Region -> Text -> Doc -> Report

3740report title highlight pre post =

38− Report title highlight (fillSep (map text (words pre))) post

41+ Report title highlight (Help.reflowParagraph pre) post

3942

4043

4144

@@ -70,14 +73,16 @@ toDoc location region (Report title highlight preHint postHint) source =

7073 <> hardline <> hardline

7174

7275

73−messageBar :: String -> String -> Doc

76+messageBar :: Text -> String -> Doc

7477messageBar tag location =

7578 let

7679 usedSpace =

77− 4 + length tag + 1 + length location

80+ 4 + Text.length tag + 1 + length location

7881 in

7982 dullcyan $ text $

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

83+ "-- " ++ Text.unpack tag

84+ ++ " " ++ replicate (max 1 (80 - usedSpace)) '-'

85+ ++ " " ++ location

8186

8287

8388

src/Reporting/Warning.hs+7−7

@@ -4,15 +4,15 @@ module Reporting.Warning where

55import Data.Aeson ((.=))

66import qualified Data.Aeson as Json

7−import qualified Data.Text as Text

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

7+import Data.Text (Text)

109import qualified AST.Module.Name as ModuleName

1110import qualified AST.Type as Type

1211import qualified Reporting.Annotation as A

13−import qualified Reporting.Error.Helpers as Help

1412import qualified Reporting.Report as Report

1513import qualified Reporting.Render.Type as RenderType

14+import qualified Reporting.Helpers as Help

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

1616

1717

1818

@@ -21,7 +21,7 @@ import qualified Reporting.Render.Type as RenderType

2121

2222data Warning

2323 = UnusedImport ModuleName.Raw

24− | MissingTypeAnnotation String Type.Canonical

24+ | MissingTypeAnnotation Text Type.Canonical

2525

2626

2727

@@ -35,14 +35,14 @@ toReport localizer warning =

3535 Report.report

3636 "unused import"

3737 Nothing

38− ("Module `" ++ Text.unpack (ModuleName.toText moduleName) ++ "` is unused.")

38+ ("Module `" <> ModuleName.toText moduleName <> "` is unused.")

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

4040

4141 MissingTypeAnnotation name inferredType ->

4242 Report.report

4343 "missing type annotation"

4444 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.")

4646 ( Help.stack

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

4848 , RenderType.annotation localizer name inferredType

@@ -63,6 +63,6 @@ toJson localizer filePath (A.A region warning) =

6363 Json.object $

6464 [ "file" .= filePath

6565 , "region" .= maybe region id maybeRegion

66− , "type" .= ("warning" :: String)

66+ , "type" .= ("warning" :: Text)

6767 ]

6868 ++ additionalFields

src/Type/Constrain/Expression.hs+1−1

@@ -598,7 +598,7 @@ constrainAnnDefHelp expr tipe (ArgInfo name defRegion env args vars) =

598598 let sharedArity = length args

599599 let typeArity = sharedArity + length (ST.collectLambdas tipe) - 1

600600 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

602602 let resultCon =

603603 CEqual hint defRegion rigidType resultType

604604

src/Type/Unify.hs+2−3

@@ -6,7 +6,6 @@ import Control.Monad (zipWithM_)

66import Control.Monad.Except (ExceptT, lift, liftIO, throwError, runExceptT)

77import qualified Data.Map as Map

88import qualified Data.Maybe as Maybe

9−import qualified Data.Text as Text

109import Data.Text (Text)

1110import qualified Data.UnionFind.IO as UF

1211

@@ -682,7 +681,7 @@ unifySharedFieldsHelp context sharedFields =

682681 mismatch context (Just (Error.BadFields (reverse badFields)))

683682

684683

685−unifyField :: Context -> (Text, (Variable, Variable)) -> Unify (Maybe (String, Maybe Error.Reason))

684+unifyField :: Context -> (Text, (Variable, Variable)) -> Unify (Maybe (Text, Maybe Error.Reason))

686685unifyField context (field, (expected, actual)) =

687686 do result <- lift $ runExceptT $ subUnify context expected actual

688687 case result of

@@ -690,7 +689,7 @@ unifyField context (field, (expected, actual)) =

690689 return $ Nothing

691690

692691 Left (Mismatch maybeReason) ->

693− return $ Just (Text.unpack field, maybeReason)

692+ return $ Just (field, maybeReason)

694693

695694

696695