gren-lang/compiler
1
1
Fork 0
mirror of https://github.com/gren-lang/compiler.git synced 2024-08-16 12:00:22 +03:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Update a bunch of files based on Doc changes

Browse Source
This commit is contained in:
Evan Czaplicki 2018-04-07 19:55:49 +02:00
parent 31e51c1807
commit b1fd35f5f2
22 changed files with 761 additions and 780 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
builder/src/Deps/Get.hs
View File

@ -25,11 +25,11 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Elm.Docs as Docs
import qualified Elm.Package as Pkg
import qualified Elm.Utils as Utils
import qualified Deps.Website as Website
import qualified Elm.Project.Json as Project
import qualified File.IO as IO
import qualified Reporting.Suggest as Suggest
import qualified Reporting.Exit as Exit
import qualified Reporting.Exit.Assets as E
import qualified Reporting.Progress as Progress
@ -122,7 +122,7 @@ nearbyNames (Pkg.Name author1 project1) possibleNames =
authorDistance :: String -> Text.Text -> Int
authorDistance bad possibility =
abs (Utils.distance bad (Text.unpack possibility))
abs (Suggest.distance bad (Text.unpack possibility))
projectDistance :: String -> Text.Text -> Int
@ -130,7 +130,7 @@ projectDistance bad possibility =
if possibility == "elm-lang" || possibility == "elm-explorations" then
0
else
abs (Utils.distance bad (Text.unpack possibility))
abs (Suggest.distance bad (Text.unpack possibility))

4
builder/src/Elm/Project/Licenses.hs
View File

@ -13,8 +13,8 @@ import Data.Map ((!))
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Elm.Utils as Utils
import qualified Json.Encode as Encode
import qualified Reporting.Suggest as Suggest
@ -61,7 +61,7 @@ check rawName =
Text.unpack suggestion
in
Left $ map snd $
Utils.nearbyNames toSuggestion (rawName, rawName) pairs
Suggest.nearbyNames toSuggestion (rawName, rawName) pairs

10
builder/src/Reporting/Exit.hs
View File

@ -8,16 +8,14 @@ module Reporting.Exit
where
import qualified Data.ByteString.Builder as B
import Data.Monoid ((<>))
import System.IO (stderr)
import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module
import qualified Elm.Package as Pkg
import qualified Elm.Utils as Utils
import qualified Json.Encode as Encode
import qualified Reporting.Doc as D
import qualified Reporting.Exit.Assets as Asset
import qualified Reporting.Exit.Bump as Bump
import qualified Reporting.Exit.Compile as Compile
@ -65,9 +63,9 @@ toStderr exit =
Help.toStderr (Help.reportToDoc (toReport exit))
toJson :: Exit -> IO ()
toJson :: Exit -> Encode.Value
toJson exit =
B.hPutBuilder stderr $ Encode.encodeUgly $ Help.reportToJson (toReport exit)
Help.reportToJson (toReport exit)
toReport :: Exit -> Help.Report
@ -106,7 +104,7 @@ toReport exit =
Cycle names ->
Help.report "IMPORT CYCLE" Nothing
"Your module imports form a cycle:"
[ P.indent 4 (Utils.drawCycle names)
[ D.cycle 4 names
, Help.reflow $
"Learn more about why this is disallowed and how to break cycles here:"
++ Help.hintLink "import-cycles"

15
compiler/src/Elm/Compiler.hs
View File

@ -16,15 +16,14 @@ module Elm.Compiler
import qualified Data.ByteString as BS
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Compile
import qualified Elm.Compiler.Module as M
import qualified Elm.Compiler.Version
import qualified Elm.Package as Pkg
import qualified Json.Encode as Encode
import qualified Reporting.Doc as D
import qualified Reporting.Error as Error
import qualified Reporting.Helpers as H
import qualified Reporting.Render.Code as Code
import qualified Reporting.Region as Region
import qualified Reporting.Report as Report
@ -63,13 +62,13 @@ compile (Context pkg docsFlag importDict interfaces) source =
-- ERRORS TO DOC
errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> H.Doc
errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> D.Doc
errorsToDoc filePath source errors =
let
reports =
concatMap (Error.toReports (Code.toSource source) Map.empty) errors
in
H.vcat $ map (Report.toDoc filePath) reports
D.vcat $ map (Report.toDoc filePath) reports
@ -85,18 +84,14 @@ errorsToJson moduleName filePath source errors =
Encode.object
[ ("path", Encode.text (Text.pack filePath))
, ("name", Encode.name moduleName)
, ("errors", Encode.array (map reportToJson reports))
, ("problems", Encode.array (map reportToJson reports))
]
reportToJson :: Report.Report -> Encode.Value
reportToJson (Report.Report title region _sgstns message) =
let
messageString =
P.displayS (P.renderPretty 1 80 message) ""
in
Encode.object
[ ("title", Encode.text (Text.pack title))
, ("region", Region.encode region)
, ("message", Encode.text (Text.pack messageString))
, ("message", D.encode message)
]

48
compiler/src/Elm/Compiler/Type.hs
View File

@ -16,14 +16,14 @@ module Elm.Compiler.Type
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Text.PrettyPrint.ANSI.Leijen as P
import Text.PrettyPrint.ANSI.Leijen ((<+>))
import qualified AST.Source as Src
import qualified Elm.Name as N
import qualified Parse.Primitives as Parse
import qualified Parse.Type as Type
import qualified Reporting.Annotation as A
import qualified Reporting.Doc as D
import Reporting.Doc ((<>), (<+>))
import qualified Json.Decode as Decode
import qualified Json.Encode as Encode
import Json.Encode ((==>))
@ -61,7 +61,7 @@ data Union = Union N.Name [N.Name] [(N.Name, [Type])]
data Context = None | InType | InFunction
toDoc :: Context -> Type -> P.Doc
toDoc :: Context -> Type -> D.Doc
toDoc context tipe =
case tipe of
Lambda _ _ ->
@ -69,21 +69,21 @@ toDoc context tipe =
map (toDoc InFunction) (collectLambdas tipe)
lambda =
P.sep [ t, P.sep (map (P.text "->" <+>) ts) ]
D.sep [ t, D.sep (map ("->" <+>) ts) ]
in
case context of
None -> lambda
_ -> P.parens lambda
_ -> "(" <> lambda <> ")"
Var name ->
P.text (N.toString name)
D.fromName name
Unit ->
"()"
Tuple a b cs ->
P.sep
[ P.cat $
D.sep
[ D.cat $
[ "(" <+> toDoc None a
, "," <+> toDoc None b
]
@ -94,19 +94,19 @@ toDoc context tipe =
Type name args ->
case args of
[] ->
P.text (N.toString name)
D.fromName name
_ ->
let
docName =
P.text (N.toString name)
D.fromName name
application =
P.hang 2 $ P.sep (docName : map (toDoc InType) args)
D.hang 2 $ D.sep (docName : map (toDoc InType) args)
in
case context of
InType ->
P.parens application
"(" <> application <> ")"
_ ->
application
@ -117,23 +117,24 @@ toDoc context tipe =
Record fields ext ->
case ext of
Nothing ->
P.sep
[ P.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields))
D.sep
[ D.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields))
, "}"
]
Just x ->
P.hang 4 $
P.sep
[ "{" <+> P.text (N.toString x) <+> "|"
, P.sep (P.punctuate "," (map entryToDoc fields))
, "}"
]
D.sep
[ D.hang 4 $ D.sep $
[ "{" <+> D.fromName x
, D.cat (zipWith (<+>) ("|" : repeat ",") (map entryToDoc fields))
]
, "}"
]
entryToDoc :: (N.Name, Type) -> P.Doc
entryToDoc :: (N.Name, Type) -> D.Doc
entryToDoc (field, fieldType) =
P.text (N.toString field) <+> ":" <+> toDoc None fieldType
D.fromName field <+> ":" <+> toDoc None fieldType
collectLambdas :: Type -> [Type]
@ -149,8 +150,7 @@ collectLambdas tipe =
encode :: Type -> Encode.Value
encode tipe =
Encode.text $ Text.pack $
P.displayS (P.renderPretty 1.0 (maxBound `div` 2) (toDoc None tipe)) ""
Encode.text $ Text.pack $ D.toLine (toDoc None tipe)
decoder :: Decode.Decoder () Type

14
compiler/src/Elm/Utils.hs
View File

@ -1,14 +0,0 @@
{-# OPTIONS_GHC -Wall #-}
module Elm.Utils
( drawCycle
, nearbyNames
, distance
, Entry(..)
, parseEntry
)
where
import Parse.Repl (Entry(..), parseEntry)
import Reporting.Helpers (drawCycle, nearbyNames, distance)

9
compiler/src/Generate/JavaScript.hs
View File

@ -17,7 +17,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified AST.Canonical as Can
import qualified AST.Optimized as Opt
@ -30,7 +29,7 @@ import qualified Elm.Name as N
import qualified Generate.JavaScript.Builder as JS
import qualified Generate.JavaScript.Expression as Expr
import qualified Generate.JavaScript.Name as Name
import qualified Reporting.Helpers as H
import qualified Reporting.Doc as D
@ -98,10 +97,10 @@ print home name annotation =
let
value = Name.toBuilder (Name.fromGlobal home name)
toString = Name.toBuilder (Name.fromKernel N.debug "toString")
tipe = P.displayS (P.renderPretty 1.0 80 (Type.toDoc Type.None (Extract.fromAnnotation annotation))) ""
tipe = Type.toDoc Type.None (Extract.fromAnnotation annotation)
in
"var _value = " <> toString <> "(" <> value <> ");\n" <>
"var _type = " <> B.stringUtf8 (show tipe) <> ";\n\
"var _type = " <> B.stringUtf8 (show (D.toString tipe)) <> ";\n\
\if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
\ console.log(_value + '\\n : ' + _type.split('\\n').join('\\n '));\n\
\} else {\n\
@ -244,7 +243,7 @@ generateCycle mode (Opt.Global home _) cycle =
"The following top-level definitions are causing infinite recursion:\\n"
<> drawCycle (map fst cycle)
<> "\\n\\nThese errors are very tricky, so read "
<> B.stringUtf8 (H.makeLink "halting-problem")
<> B.stringUtf8 (D.makeLink "halting-problem")
<> " to learn how to fix it!"

4
compiler/src/Json/Decode.hs
View File

@ -33,8 +33,8 @@ import Parse.Primitives.Internals (Parser(..), State(..), noError)
import qualified Parse.Primitives.Keyword as Keyword
import qualified Parse.Primitives.Number as Number
import qualified Parse.Primitives.Symbol as Symbol
import qualified Reporting.Doc as D
import qualified Reporting.Error.Syntax as E
import qualified Reporting.Helpers as H
import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code
@ -43,7 +43,7 @@ import qualified Reporting.Render.Code as Code
-- PARSE
parse :: String -> (e -> [H.Doc]) -> Json.Decoder e a -> B.ByteString -> Either H.Doc a
parse :: String -> (e -> [D.Doc]) -> Json.Decoder e a -> B.ByteString -> Either D.Doc a
parse rootName userErrorToDocs (Json.Decoder run) bytestring =
let
source =

54
compiler/src/Json/Decode/Error.hs
View File

@ -16,8 +16,8 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Json.Decode.Internals as Json
import qualified Json.Encode as E
import qualified Reporting.Doc as D
import qualified Reporting.Error.Syntax as Syntax
import qualified Reporting.Helpers as H
import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report
@ -35,7 +35,7 @@ data Error e
-- TO DOC
toDoc :: String -> Code.Source -> (e -> [H.Doc]) -> Error e -> H.Doc
toDoc :: String -> Code.Source -> (e -> [D.Doc]) -> Error e -> D.Doc
toDoc rootName source userErrorToDocs err =
case err of
BadJson syntaxError ->
@ -46,7 +46,7 @@ toDoc rootName source userErrorToDocs err =
BadContent jsonError ->
case flatten jsonError of
[] ->
H.reflow
D.reflow
"I am not sure what is wrong with this JSON. Please create an <http://sscce.org>\
\ and share it at <https://github.com/elm-lang/elm-compiler/issues> so I can\
\ provide a helpful hint here!"
@ -59,8 +59,8 @@ toDoc rootName source userErrorToDocs err =
toNumberedDoc index flatErr =
P.dullcyan ("(" <> P.int index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr
in
H.stack $
[ H.reflow $
D.stack $
[ D.reflow $
"I have " ++ show (length flatErrors) ++ " theories on what is going wrong:"
]
++ zipWith toNumberedDoc [1..] flatErrors
@ -70,7 +70,7 @@ toDoc rootName source userErrorToDocs err =
-- FLAT ERROR TO DOC
flatErrorToDoc :: String -> [H.Doc] -> (e -> [H.Doc]) -> FlatError e -> H.Doc
flatErrorToDoc :: String -> [D.Doc] -> (e -> [D.Doc]) -> FlatError e -> D.Doc
flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory theories) =
case theories of
[] ->
@ -85,12 +85,12 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory
in
case accesses of
[] ->
H.fillSep (starter ++ explanation)
D.fillSep (starter ++ explanation)
_ ->
H.stack
[ H.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."]
, H.fillSep explanation
D.stack
[ D.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."]
, D.fillSep explanation
]
_:_ ->
@ -107,31 +107,31 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory
++ actualThing json
++ ["at",accessToDoc rootName accesses,"because:"]
in
H.stack
[ H.fillSep (starter ++ introduction)
, H.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories)
, H.reflow "I accept any of these things."
D.stack
[ D.fillSep (starter ++ introduction)
, D.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories)
, D.reflow "I accept any of these things."
]
accessToDoc :: String -> [String] -> H.Doc
accessToDoc :: String -> [String] -> D.Doc
accessToDoc rootName accesses =
P.dullyellow (P.text (rootName ++ concat accesses))
actualThing :: E.Value -> [H.Doc]
actualThing :: E.Value -> [D.Doc]
actualThing json =
case json of
E.Array _ -> [H.red "array"]
E.Object _ -> [H.red "object"]
E.String _ -> [H.red "string"]
E.Boolean b -> [H.red (if b then "true" else "false"),"value"]
E.Integer n -> ["number",H.red (H.text (show n))]
E.Number _ -> [H.red "number"]
E.Null -> [H.red "null","value"]
E.Array _ -> [D.red "array"]
E.Object _ -> [D.red "object"]
E.String _ -> [D.red "string"]
E.Boolean b -> [D.red (if b then "true" else "false"),"value"]
E.Integer n -> ["number",D.red (D.fromString (show n))]
E.Number _ -> [D.red "number"]
E.Null -> [D.red "null","value"]
anExpectedThing :: Json.Type -> [H.Doc]
anExpectedThing :: Json.Type -> [D.Doc]
anExpectedThing tipe =
case tipe of
Json.TObject -> ["an", P.green "OBJECT" <> "."]
@ -141,15 +141,15 @@ anExpectedThing tipe =
Json.TInt -> ["an", P.green "INT" <> "."]
Json.TObjectWith field -> ["an",P.green "OBJECT","with","a",P.green ("\"" <> P.text (Text.unpack field) <> "\""),"field."]
Json.TArrayWith i len ->
["a",H.green "longer",P.green "ARRAY" <> "."
["a",D.green "longer",P.green "ARRAY" <> "."
,"I","need","index",P.text (show i) <> ",","but","this","array"
,"only","has",P.text (show len),"elements."
]
toBullet :: [H.Doc] -> (e -> [H.Doc]) -> Theory e -> H.Doc
toBullet :: [D.Doc] -> (e -> [D.Doc]) -> Theory e -> D.Doc
toBullet intro userErrorToDocs theory =
H.indent 4 $ H.fillSep $ (++) intro $
D.indent 4 $ D.fillSep $ (++) intro $
case theory of
Failure userError ->
userErrorToDocs userError

409
compiler/src/Reporting/Error/Canonicalize.hs
View File

@ -23,12 +23,13 @@ import qualified AST.Module.Name as ModuleName
import qualified Data.Index as Index
import qualified Elm.Name as N
import qualified Reporting.Annotation as A
import qualified Reporting.Doc as D
import Reporting.Doc (Doc, (<+>), (<>))
import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT
import qualified Reporting.Report as Report
import qualified Reporting.Helpers as H
import Reporting.Helpers ( Doc, (<+>), (<>) )
import qualified Reporting.Suggest as Suggest
@ -126,16 +127,16 @@ toKindInfo :: VarKind -> N.Name -> ( Doc, Doc, Doc )
toKindInfo kind name =
case kind of
BadOp ->
( "an", "operator", "(" <> H.nameToDoc name <> ")" )
( "an", "operator", "(" <> D.fromName name <> ")" )
BadVar ->
( "a", "value", "`" <> H.nameToDoc name <> "`" )
( "a", "value", "`" <> D.fromName name <> "`" )
BadPattern ->
( "a", "pattern", "`" <> H.nameToDoc name <> "`" )
( "a", "pattern", "`" <> D.fromName name <> "`" )
BadType ->
( "a", "type", "`" <> H.nameToDoc name <> "`" )
( "a", "type", "`" <> D.fromName name <> "`" )
@ -153,12 +154,12 @@ toReport source err =
Report.Report "BAD TYPE ANNOTATION" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The type annotation for `" <> N.toString name <> "` says it can accept "
<> H.args numTypeArgs <> ", but the definition says it has "
<> H.args numDefArgs <> ":"
<> D.args numTypeArgs <> ", but the definition says it has "
<> D.args numDefArgs <> ":"
,
H.reflow $
D.reflow $
"Is the type annotation missing something? Should some argument"
<> (if leftovers == 1 then "" else "s")
<> " be deleted? Maybe some parentheses are missing?"
@ -187,20 +188,20 @@ toReport source err =
Report.Report "TOO FEW ARGS" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
"The `" <> N.toString name <> "` " <> thing <> " was given " <> H.args actual <> ":"
D.reflow $
"The `" <> N.toString name <> "` " <> thing <> " was given " <> D.args actual <> ":"
,
H.reflow $
"But it needs " <> H.args expected <> ". What is missing? Are some parentheses misplaced?"
D.reflow $
"But it needs " <> D.args expected <> ". What is missing? Are some parentheses misplaced?"
)
else
Report.Report "TOO MANY ARGS" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` " <> thing <> " needs "
<> H.args expected <> ", but I see " <> show actual <> " instead:"
<> D.args expected <> ", but I see " <> show actual <> " instead:"
,
if actual - expected == 1 then
"Which is the extra one? Maybe some parentheses are missing?"
@ -212,10 +213,10 @@ toReport source err =
Report.Report "INFIX PROBLEM" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You cannot mix (" <> N.toString op1 <> ") and (" <> N.toString op2 <> ") without parentheses."
,
H.reflow
D.reflow
"I do not know how to group these expressions. Add parentheses for me!"
)
@ -269,10 +270,10 @@ toReport source err =
Report.Report "EFFECT PROBLEM" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You have declared that `" ++ N.toString name ++ "` is an effect type:"
,
H.reflow $
D.reflow $
"But I cannot find a union type named `" ++ N.toString name ++ "` in this file!"
)
@ -280,10 +281,10 @@ toReport source err =
Report.Report "EFFECT PROBLEM" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"This kind of effect module must define a `" ++ N.toString name ++ "` function."
,
H.reflow $
D.reflow $
"But I cannot find `" ++ N.toString name ++ "` in this file!"
)
@ -296,12 +297,12 @@ toReport source err =
Report.Report "REDUNDANT EXPORT" r2 [] $
Report.toCodePair source r1 r2
(
H.reflow messageThatEndsWithPunctuation
D.reflow messageThatEndsWithPunctuation
,
"Remove one of them and you should be all set!"
)
(
H.reflow (messageThatEndsWithPunctuation <> " Once here:")
D.reflow (messageThatEndsWithPunctuation <> " Once here:")
,
"And again right here:"
,
@ -312,27 +313,27 @@ toReport source err =
let
suggestions =
map N.toString $ take 4 $
H.nearbyNames N.toString rawName possibleNames
Suggest.nearbyNames N.toString rawName possibleNames
in
Report.Report "UNKNOWN EXPORT" region suggestions $
let (a, thing, name) = toKindInfo kind rawName in
H.stack
[ H.fillSep
D.stack
[ D.fillSep
["You","are","trying","to","expose",a,thing,"named"
,name,"but","I","cannot","find","its","definition."
]
, case map H.text suggestions of
, case map D.fromString suggestions of
[] ->
H.reflow $
D.reflow $
"I do not see any super similar names in this file. Is the definition missing?"
[alt] ->
H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"]
D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"]
alts ->
H.stack
D.stack
[ "These names seem close though:"
, H.indent 4 $ H.vcat $ map H.dullyellow alts
, D.indent 4 $ D.vcat $ map D.dullyellow alts
]
]
@ -340,11 +341,11 @@ toReport source err =
Report.Report "BAD EXPORT" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"
++ N.toString name ++ "` though."
,
H.reflow $
D.reflow $
"Remove the (..) and you should be fine!"
)
@ -352,15 +353,15 @@ toReport source err =
Report.Report "BAD IMPORT" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You are trying to import the `" <> N.toString ctor
<> "` type constructor by name:"
,
H.fillSep
["Try","importing",H.green (H.nameToDoc tipe <> "(..)"),"instead."
,"The","dots","mean","“expose","the",H.nameToDoc tipe,"type","and"
D.fillSep
["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."
,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"
,"all","its","constructors”","so","it","gives","you","access","to"
, H.nameToDoc ctor <> "."
, D.fromName ctor <> "."
]
)
@ -372,7 +373,7 @@ toReport source err =
Report.Report "UNKNOWN IMPORT" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I could not find a `" <> N.toString name <> "` module to import!"
,
mempty
@ -382,12 +383,12 @@ toReport source err =
Report.Report "BAD IMPORT" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` type alias cannot be followed by (..) like this:"
,
H.stack
D.stack
[ "Remove the (..) and it should work."
, H.link "Hint"
, D.link "Hint"
"The distinction between `type` and `type alias` is important here. Read"
"types-vs-type-aliases"
"to learn more."
@ -398,27 +399,27 @@ toReport source err =
let
suggestions =
map N.toString $ take 4 $
H.nearbyNames N.toString home possibleNames
Suggest.nearbyNames N.toString home possibleNames
in
Report.Report "BAD IMPORT" region suggestions $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString home
<> "` module does not expose `"
<> N.toString value <> "`:"
,
case map H.text suggestions of
case map D.fromString suggestions of
[] ->
"I cannot find any super similar exposed names. Maybe it is private?"
[alt] ->
H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"]
D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"]
alts ->
H.stack
D.stack
[ "These names seem close though:"
, H.indent 4 $ H.vcat $ map H.dullyellow alts
, D.indent 4 $ D.vcat $ map D.dullyellow alts
]
)
@ -445,12 +446,12 @@ toReport source err =
Report.Report "UNKNOWN OPERATOR" region ["/="] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"Elm uses a different name for the “not equal” operator:"
,
H.stack
[ H.reflow "Switch to (/=) instead."
, H.toSimpleNote $
D.stack
[ D.reflow "Switch to (/=) instead."
, D.toSimpleNote $
"Our (/=) operator is supposed to look like a real “not equal” sign (≠). I hope that history will remember ("
++ N.toString op ++ ") as a werid and temporary choice."
]
@ -460,10 +461,10 @@ toReport source err =
Report.Report "UNKNOWN OPERATOR" region ["^","*"] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I do not recognize the (**) operator:"
,
H.reflow $
D.reflow $
"Switch to (^) for exponentiation. Or switch to (*) for multiplication."
)
@ -471,17 +472,17 @@ toReport source err =
Report.Report "UNKNOWN OPERATOR" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"Elm does not use (%) as the remainder operator:"
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"If you want the behavior of (%) like in JavaScript, switch to:\
\ <https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#remainderBy>"
, H.reflow $
, D.reflow $
"If you want modular arithmatic like in math, switch to:\
\ <https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#modBy>"
, H.reflow $
, D.reflow $
"The difference is how things work when negative numbers are involved."
]
)
@ -490,37 +491,37 @@ toReport source err =
let
suggestions =
map N.toString $ take 2 $
H.nearbyNames N.toString op (Set.toList locals)
Suggest.nearbyNames N.toString op (Set.toList locals)
format altOp =
H.green $ "(" <> altOp <> ")"
D.green $ "(" <> altOp <> ")"
in
Report.Report "UNKNOWN OPERATOR" region suggestions $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I do not recognize the (" ++ N.toString op ++ ") operator."
,
H.fillSep $
D.fillSep $
["Is","there","an","`import`","and","`exposing`","entry","for","it?"]
++
case map H.text suggestions of
case map D.fromString suggestions of
[] ->
[]
alts ->
["Maybe","you","want"] ++ H.commaSep "or" format alts ++ ["instead?"]
["Maybe","you","want"] ++ D.commaSep "or" format alts ++ ["instead?"]
)
PatternHasRecordCtor region name ->
Report.Report "BAD PATTERN" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You can construct records by using `" <> N.toString name
<> "` as a function, but it is not available in pattern matching like this:"
,
H.reflow $
D.reflow $
"I recommend matching matching the record as a variable and unpacking it later."
)
@ -530,12 +531,12 @@ toReport source err =
Report.Report "PORT ERROR" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString portName <> "` port is trying to transmit " <> aBadKindOfThing <> ":"
,
H.stack
D.stack
[ elaboration
, H.link "Hint"
, D.link "Hint"
"Ports are not a traditional FFI, so if you have tons of annoying ports, definitely read"
"ports"
"to learn how they are meant to work. They require a different mindset!"
@ -548,7 +549,7 @@ toReport source err =
(
"an extended record"
,
H.reflow $
D.reflow $
"But the exact shape of the record must be known at compile time. No type variables!"
)
@ -556,7 +557,7 @@ toReport source err =
(
"a function"
,
H.reflow $
D.reflow $
"But functions cannot be sent in and out ports. If we allowed functions in from JS\
\ they may perform some side-effects. If we let functions out, they could produce\
\ incorrect results because Elm optimizations assume there are no side-effects."
@ -567,7 +568,7 @@ toReport source err =
(
"an unspecified type"
,
H.reflow $
D.reflow $
"But type variables like `" <> N.toString name <> "` cannot flow through ports.\
\ I need to know exactly what type of data I am getting, so I can guarantee that\
\ unexpected data cannot sneak in and crash the Elm program."
@ -577,13 +578,13 @@ toReport source err =
(
"a `" <> N.toString name <> "` value"
,
H.stack
[ H.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:"
, H.indent 4 $
H.reflow $
D.stack
[ D.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:"
, D.indent 4 $
D.reflow $
"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
\ tuples, records, and JSON values."
, H.reflow $
, D.reflow $
"Since JSON values can flow through, you can use JSON encoders and decoders\
\ to allow other types through as well. More advanced users often just do\
\ everything with encoders and decoders for more control and better errors."
@ -596,11 +597,11 @@ toReport source err =
Report.Report "BAD PORT" region [] $
Report.toCodeSnippet source region Nothing $
(
H.reflow before
D.reflow before
,
H.stack
D.stack
[ after
, H.link "Hint" "Read" "ports"
, D.link "Hint" "Read" "ports"
"for more advice. For example, do not end up with one port per JS function!"
]
)
@ -611,7 +612,7 @@ toReport source err =
(
"The `" <> N.toString name <> "` port cannot be just a command."
,
H.reflow $
D.reflow $
"It can be (() -> Cmd msg) if you just need to trigger a JavaScript\
\ function, but there is often a better way to set things up."
)
@ -626,7 +627,7 @@ toReport source err =
| n == 3 = "these " ++ show n ++ " items into a tuple or record"
| True = "these " ++ show n ++ " items into a record"
in
H.reflow $
D.reflow $
"You can put " ++ theseItemsInSomething ++ " to send them out though."
)
@ -634,7 +635,7 @@ toReport source err =
(
"The `" <> N.toString name <> "` port cannot send any messages to the `update` function."
,
H.reflow $
D.reflow $
"It must produce a (Cmd msg) type. Notice the lower case `msg` type\
\ variable. The command will trigger some JS code, but it will not send\
\ anything particular back to Elm."
@ -643,12 +644,12 @@ toReport source err =
SubBad ->
( "There is something off about this `" <> N.toString name <> "` port declaration."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"To receive messages from JavaScript, you need to define a port like this:"
, H.indent 4 $ H.dullyellow $ H.text $
, D.indent 4 $ D.dullyellow $ D.fromString $
"port " <> N.toString name <> " : (Int -> msg) -> Sub msg"
, H.reflow $
, D.reflow $
"Now every time JS sends an `Int` to this port, it is converted to a `msg`.\
\ And if you subscribe, those `msg` values will be piped into your `update`\
\ function. The only thing you can customize here is the `Int` type."
@ -659,7 +660,7 @@ toReport source err =
(
"I am confused about the `" <> N.toString name <> "` port declaration."
,
H.reflow $
D.reflow $
"Ports need to produce a command (Cmd) or a subscription (Sub) but\
\ this is neither. I do not know how to handle this."
)
@ -675,7 +676,7 @@ toReport source err =
Can.TypedDef name _ _ _ _ -> name
makeTheory question details =
H.fillSep $ map (H.dullyellow . H.text) (words question) ++ map H.text (words details)
D.fillSep $ map (D.dullyellow . D.fromString) (words question) ++ map D.fromString (words details)
in
case map toName cyclicValueDefs of
[] ->
@ -690,10 +691,10 @@ toReport source err =
case map A.toValue otherNames of
[] ->
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` value is defined directly in terms of itself, causing an infinite loop."
,
H.stack
D.stack
[ makeTheory "Are you are trying to mutate a variable?" $
"Elm does not have mutation, so when I see " ++ N.toString name
++ " defined in terms of " ++ N.toString name
@ -702,7 +703,7 @@ toReport source err =
"To define " ++ N.toString name ++ " we need to know what " ++ N.toString name
++ " is, so let’s expand it. Wait, but now we need to know what " ++ N.toString name
++ " is, so let’s expand it... This will keep going infinitely!"
, H.link "Hint"
, D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion"
"for more detailed advice, especially if you actually do need a recursive value."
@ -711,15 +712,15 @@ toReport source err =
names ->
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` definition is causing a very tricky infinite loop."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"The `" <> N.toString name
<> "` value depends on itself through the following chain of definitions:"
, H.indent 4 $ H.drawCycle (name:names)
, H.link "Hint"
, D.cycle 4 (name:names)
, D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion"
"for more detailed advice, especially if you actually do want mutually recursive values."
@ -733,13 +734,13 @@ toReport source err =
[] ->
let
makeTheory question details =
H.fillSep $ map (H.dullyellow . H.text) (words question) ++ map H.text (words details)
D.fillSep $ map (D.dullyellow . D.fromString) (words question) ++ map D.fromString (words details)
in
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` value is defined directly in terms of itself, causing an infinite loop."
,
H.stack
D.stack
[ makeTheory "Are you are trying to mutate a variable?" $
"Elm does not have mutation, so when I see " ++ N.toString name
++ " defined in terms of " ++ N.toString name
@ -748,7 +749,7 @@ toReport source err =
"To define " ++ N.toString name ++ " we need to know what " ++ N.toString name
++ " is, so let’s expand it. Wait, but now we need to know what " ++ N.toString name
++ " is, so let’s expand it... This will keep going infinitely!"
, H.link "Hint"
, D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion"
"for more detailed advice, especially if you actually do need a recursive value."
@ -757,15 +758,15 @@ toReport source err =
_ ->
(
H.reflow $
D.reflow $
"I do not allow cyclic values in `let` expressions."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"The `" <> N.toString name
<> "` value depends on itself through the following chain of definitions:"
, H.indent 4 $ H.drawCycle (name:names)
, H.link "Hint"
, D.cycle 4 (name:names)
, D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion"
"for more detailed advice, especially if you actually do want mutually recursive values."
@ -778,16 +779,16 @@ toReport source err =
( "These variables cannot have the same name:"
, advice
)
( H.reflow $ "The name `" <> N.toString name <> "` is first defined here:"
( D.reflow $ "The name `" <> N.toString name <> "` is first defined here:"
, "But then it is defined AGAIN over here:"
, advice
)
where
advice =
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Think of a more helpful name for one of them and you should be all set!"
, H.link "Note"
, D.link "Note"
"Linters advise against shadowing, so Elm makes “best practices” the default. Read"
"shadowing"
"for more details on this choice."
@ -799,12 +800,12 @@ toReport source err =
(
"I only accept tuples with two or three items. This has too many:"
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"I recommend switching to records. Each item will be named, and you can use\
\ the `point.x` syntax to access them."
, H.link "Note" "Read" "tuples"
, D.link "Note" "Read" "tuples"
"for more comprehensive advice on working with large chunks of data in Elm."
]
@ -818,7 +819,7 @@ toReport source err =
(unused:unuseds, []) ->
let
backQuote name =
"`" <> H.nameToDoc name <> "`"
"`" <> D.fromName name <> "`"
allUnusedNames =
map fst unusedVars
@ -831,31 +832,31 @@ toReport source err =
, ["Type","alias",backQuote typeName,"does","not","use","the"
,backQuote (fst unused),"type","variable."
]
, [H.dullyellow (backQuote (fst unused))]
, [D.dullyellow (backQuote (fst unused))]
)
_:_ ->
( "UNUSED TYPE VARIABLES"
, Nothing
, ["Type","variables"]
++ H.commaSep "and" id (map H.nameToDoc allUnusedNames)
++ D.commaSep "and" id (map D.fromName allUnusedNames)
++ ["are","unused","in","the",backQuote typeName,"definition."]
, H.commaSep "and" H.dullyellow (map H.nameToDoc allUnusedNames)
, D.commaSep "and" D.dullyellow (map D.fromName allUnusedNames)
)
in
Report.Report title aliasRegion [] $
Report.toCodeSnippet source aliasRegion subRegion
(
H.fillSep overview
D.fillSep overview
,
H.stack
[ H.fillSep $
D.stack
[ D.fillSep $
["I","recommend","removing"] ++ stuff ++ ["from","the","declaration,","like","this:"]
, H.indent 4 $ H.hsep $
["type","alias",H.green (H.nameToDoc typeName)]
++ map H.nameToDoc (filter (`notElem` allUnusedNames) allVars)
, D.indent 4 $ D.hsep $
["type","alias",D.green (D.fromName typeName)]
++ map D.fromName (filter (`notElem` allUnusedNames) allVars)
++ ["=", "..."]
, H.reflow $
, D.reflow $
"Why? Well, if I allowed `type alias Height a = Float` I would need to answer\
\ some weird questions. Is `Height Bool` the same as `Float`? Is `Height Bool`\
\ the same as `Height Int`? My solution is to not need to ask them!"
@ -873,43 +874,43 @@ toReport source err =
theseAreUsed =
case unbound of
[x] ->
["Type","variable",H.dullyellow ("`" <> H.nameToDoc x <> "`"),"appears"
["Type","variable",D.dullyellow ("`" <> D.fromName x <> "`"),"appears"
,"in","the","definition,","but","I","do","not","see","it","declared."
]
_ ->
["Type","variables"]
++ H.commaSep "and" H.dullyellow (map H.nameToDoc unbound)
++ D.commaSep "and" D.dullyellow (map D.fromName unbound)
++ ["are","used","in","the","definition,","but","I","do","not","see","them","declared."]
butTheseAreUnused =
case unused of
[x] ->
["Likewise,","type","variable"
,H.dullyellow ("`" <> H.nameToDoc x <> "`")
,D.dullyellow ("`" <> D.fromName x <> "`")
,"is","delared,","but","not","used."
]
_ ->
["Likewise,","type","variables"]
++ H.commaSep "and" H.dullyellow (map H.nameToDoc unused)
++ D.commaSep "and" D.dullyellow (map D.fromName unused)
++ ["are","delared,","but","not","used."]
in
Report.Report "TYPE VARIABLE PROBLEMS" aliasRegion [] $
Report.toCodeSnippet source aliasRegion Nothing
(
H.reflow $
D.reflow $
"Type alias `" <> N.toString typeName <> "` has some type variable problems."
,
H.stack
[ H.fillSep $ theseAreUsed ++ butTheseAreUnused
, H.reflow $
D.stack
[ D.fillSep $ theseAreUsed ++ butTheseAreUnused
, D.reflow $
"My guess is that a definition like this will work better:"
, H.indent 4 $ H.hsep $
["type", "alias", H.nameToDoc typeName]
++ map H.nameToDoc (filter (`notElem` unused) allVars)
++ map (H.green . H.nameToDoc) unbound
, D.indent 4 $ D.hsep $
["type", "alias", D.fromName typeName]
++ map D.fromName (filter (`notElem` unused) allVars)
++ map (D.green . D.fromName) unbound
++ ["=", "..."]
]
)
@ -919,11 +920,11 @@ toReport source err =
-- BAD TYPE VARIABLES
unboundTypeVars :: Code.Source -> R.Region -> [H.Doc] -> N.Name -> [N.Name] -> (N.Name, R.Region) -> [(N.Name, R.Region)] -> Report.Report
unboundTypeVars :: Code.Source -> R.Region -> [D.Doc] -> N.Name -> [N.Name] -> (N.Name, R.Region) -> [(N.Name, R.Region)] -> Report.Report
unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion) unboundVars =
let
backQuote name =
"`" <> H.nameToDoc name <> "`"
"`" <> D.fromName name <> "`"
(title, subRegion, overview) =
case map fst unboundVars of
@ -932,32 +933,32 @@ unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion)
, Just varRegion
, ["The",backQuote typeName]
++ tipe
++ ["uses","an","unbound","type","variable",H.dullyellow (backQuote unboundVar),"in","its","definition:"]
++ ["uses","an","unbound","type","variable",D.dullyellow (backQuote unboundVar),"in","its","definition:"]
)
vars ->
( "UNBOUND TYPE VARIABLES"
, Nothing
, ["Type","variables"]
++ H.commaSep "and" H.dullyellow (H.nameToDoc unboundVar : map H.nameToDoc vars)
++ D.commaSep "and" D.dullyellow (D.fromName unboundVar : map D.fromName vars)
++ ["are","unbound","in","the",backQuote typeName] ++ tipe ++ ["definition:"]
)
in
Report.Report title declRegion [] $
Report.toCodeSnippet source declRegion subRegion
(
H.fillSep overview
D.fillSep overview
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"You probably need to change the declaration to something like this:"
, H.indent 4 $ H.hsep $
, D.indent 4 $ D.hsep $
tipe
++ [H.nameToDoc typeName]
++ map H.nameToDoc allVars
++ map (H.green . H.nameToDoc) (unboundVar : map fst unboundVars)
++ [D.fromName typeName]
++ map D.fromName allVars
++ map (D.green . D.fromName) (unboundVar : map fst unboundVars)
++ ["=", "..."]
, H.reflow $
, D.reflow $
"Why? Well, imagine one `" ++ N.toString typeName ++ "` where `" ++ N.toString unboundVar ++
"` is an Int and another where it is a Bool. When we explicitly list the type\
\ variables, the type checker can see that they are actually different types."
@ -974,12 +975,12 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
Report.Report "NAME CLASH" r2 [] $
Report.toCodePair source r1 r2
(
H.reflow messageThatEndsWithPunctuation
D.reflow messageThatEndsWithPunctuation
,
"How can I know which one you want? Rename one of them!"
)
(
H.reflow (messageThatEndsWithPunctuation <> " One here:")
D.reflow (messageThatEndsWithPunctuation <> " One here:")
,
"And another one here:"
,
@ -999,20 +1000,20 @@ ambiguousName source region maybePrefix name possibleHomes thing =
Nothing ->
let
homeToYellowDoc (ModuleName.Canonical _ home) =
H.dullyellow (H.nameToDoc home)
D.dullyellow (D.fromName home)
bothOrAll =
if length possibleHomes == 2 then "both" else "all"
in
(
H.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous."
D.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Check your imports. The following modules " ++ bothOrAll
++ " expose a `" ++ N.toString name ++ "` " ++ thing ++ ":"
, H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes
, H.reflowLink "Read" "imports" "to learn how to clarify which one you want."
, D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes
, D.reflowLink "Read" "imports" "to learn how to clarify which one you want."
]
)
@ -1020,22 +1021,22 @@ ambiguousName source region maybePrefix name possibleHomes thing =
let
homeToYellowDoc (ModuleName.Canonical _ home) =
if prefix == home then
H.blue "import" <+> H.dullyellow (H.nameToDoc home)
D.blue "import" <+> D.dullyellow (D.fromName home)
else
H.blue "import" <+> H.dullyellow (H.nameToDoc home) <+> H.blue "as" <+> H.dullyellow (H.nameToDoc prefix)
D.blue "import" <+> D.dullyellow (D.fromName home) <+> D.blue "as" <+> D.dullyellow (D.fromName prefix)
eitherOrAny =
if length possibleHomes == 2 then "either" else "any"
in
(
H.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous."
D.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"It could refer to a " ++ thing ++ " from "
++ eitherOrAny ++ " of these imports:"
, H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes
, H.reflowLink "Read" "imports" "to learn how to clarify which one you want."
, D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes
, D.reflowLink "Read" "imports" "to learn how to clarify which one you want."
]
)
@ -1058,28 +1059,28 @@ notFound source region maybePrefix name thing (PossibleNames locals quals) =
Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals
nearbyNames =
take 4 (H.nearbyNames id givenName possibleNames)
take 4 (Suggest.nearbyNames id givenName possibleNames)
toDetails noSuggestionDetails yesSuggestionDetails =
case nearbyNames of
[] ->
H.stack
[ H.reflow noSuggestionDetails
, H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
D.stack
[ D.reflow noSuggestionDetails
, D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
]
suggestions ->
H.stack
[ H.reflow yesSuggestionDetails
, H.indent 4 $ H.vcat $ map H.dullyellow $ map H.text suggestions
, H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
D.stack
[ D.reflow yesSuggestionDetails
, D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromString suggestions
, D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
]
in
Report.Report "NAMING ERROR" region nearbyNames $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I cannot find a `" ++ givenName ++ "` " ++ thing ++ ":"
,
case maybePrefix of
@ -1115,20 +1116,20 @@ varErrorToReport :: VarError -> Report.Report
varErrorToReport (VarError kind name problem suggestions) =
let
learnMore orMaybe =
H.reflow $
D.reflow $
orMaybe <> " `import` works different than you expect? Learn all about it here: "
<> H.hintLink "imports"
<> D.hintLink "imports"
namingError overview maybeStarter specializedSuggestions =
Report.reportDoc "NAMING ERROR" Nothing overview $
case H.maybeYouWant' maybeStarter specializedSuggestions of
case D.maybeYouWant' maybeStarter specializedSuggestions of
Nothing ->
learnMore "Maybe"
Just doc ->
H.stack [ doc, learnMore "Or maybe" ]
D.stack [ doc, learnMore "Or maybe" ]
specialNamingError specialHint =
Report.reportDoc "NAMING ERROR" Nothing (cannotFind kind name) (H.hsep specialHint)
Report.reportDoc "NAMING ERROR" Nothing (cannotFind kind name) (D.hsep specialHint)
in
case problem of
Ambiguous ->
@ -1158,35 +1159,35 @@ varErrorToReport (VarError kind name problem suggestions) =
cannotFind :: VarKind -> Text -> [Doc]
cannotFind kind rawName =
let ( a, thing, name ) = toKindInfo kind rawName in
[ "Cannot", "find", a, thing, "named", H.dullyellow name <> ":" ]
[ "Cannot", "find", a, thing, "named", D.dullyellow name <> ":" ]
ambiguous :: VarKind -> Text -> [Doc]
ambiguous kind rawName =
let ( _a, thing, name ) = toKindInfo kind rawName in
[ "This", "usage", "of", "the", H.dullyellow name, thing, "is", "ambiguous." ]
[ "This", "usage", "of", "the", D.dullyellow name, thing, "is", "ambiguous." ]
notEqualsHint :: Text -> [Doc]
notEqualsHint op =
[ "Looking", "for", "the", "“not", "equal”", "operator?", "The", "traditional"
, H.dullyellow $ text $ "(" <> op <> ")"
, "is", "replaced", "by", H.green "(/=)", "in", "Elm.", "It", "is", "meant"
, D.dullyellow $ text $ "(" <> op <> ")"
, "is", "replaced", "by", D.green "(/=)", "in", "Elm.", "It", "is", "meant"
, "to", "look", "like", "the", "“not", "equal”", "sign", "from", "math!", "(≠)"
]
equalsHint :: [Doc]
equalsHint =
[ "A", "special", H.dullyellow "(===)", "operator", "is", "not", "needed"
, "in", "Elm.", "We", "use", H.green "(==)", "for", "everything!"
[ "A", "special", D.dullyellow "(===)", "operator", "is", "not", "needed"
, "in", "Elm.", "We", "use", D.green "(==)", "for", "everything!"
]
modHint :: [Doc]
modHint =
[ "Rather", "than", "a", H.dullyellow "(%)", "operator,"
, "Elm", "has", "a", H.green "modBy", "function."
[ "Rather", "than", "a", D.dullyellow "(%)", "operator,"
, "Elm", "has", "a", D.green "modBy", "function."
, "Learn", "more", "here:"
, "<https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#modBy>"
]
@ -1209,10 +1210,10 @@ _argMismatchReport source region kind name expected actual =
Report.Report (map Char.toUpper numArgs) region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
kind <> " " <> N.toString name <> " has " <> numArgs <> "."
,
H.reflow $
D.reflow $
"Expecting " <> show expected <> ", but got " <> show actual <> "."
)
@ -1230,13 +1231,13 @@ aliasRecursionReport source region name args tipe others =
(
"This type alias is recursive, forming an infinite type!"
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"When I expand a recursive type alias, it just keeps getting bigger and bigger.\
\ So dealiasing results in an infinitely large type! Try this instead:"
, H.indent 4 $
, D.indent 4 $
aliasToUnionDoc name args tipe
, H.link "Hint"
, D.link "Hint"
"This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading"
"recursive-alias"
"for ideas on how to do better."
@ -1249,12 +1250,12 @@ aliasRecursionReport source region name args tipe others =
(
"This type alias is part of a mutually recursive set of type aliases."
,
H.stack
D.stack
[ "It is part of this cycle of type aliases:"
, H.indent 4 (H.drawCycle (name:others))
, H.reflow $
, D.cycle 4 (name:others)
, D.reflow $
"You need to convert at least one of these type aliases into a `type`."
, H.link "Note" "Read" "recursive-alias"
, D.link "Note" "Read" "recursive-alias"
"to learn why this `type` vs `type alias` distinction matters. It is subtle but important!"
]
)
@ -1262,11 +1263,11 @@ aliasRecursionReport source region name args tipe others =
aliasToUnionDoc :: N.Name -> [N.Name] -> Src.Type -> Doc
aliasToUnionDoc name args tipe =
H.vcat
[ H.dullyellow $
"type" <+> H.nameToDoc name <+> (foldr (<+>) "=" (map H.nameToDoc args))
, H.green $
H.indent 4 (H.nameToDoc name)
, H.dullyellow $
H.indent 8 (RT.srcToDoc RT.App tipe)
D.vcat
[ D.dullyellow $
"type" <+> D.fromName name <+> (foldr (<+>) "=" (map D.fromName args))
, D.green $
D.indent 4 (D.fromName name)
, D.dullyellow $
D.indent 8 (RT.srcToDoc RT.App tipe)
]

48
compiler/src/Reporting/Error/Docs.hs
View File

@ -8,8 +8,8 @@ module Reporting.Error.Docs
import qualified Elm.Name as N
import Reporting.Helpers ((<>))
import qualified Reporting.Helpers as H
import Reporting.Doc ((<>))
import qualified Reporting.Doc as D
import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report
@ -35,24 +35,24 @@ toReport source err =
case err of
NoDocs region ->
Report.Report "NO DOCS" region [] $
H.stack
D.stack
[
H.reflow $
D.reflow $
"You must have a documentation comment between the module\
\ declaration and the imports."
,
H.reflow
D.reflow
"Learn more at <http://package.elm-lang.org/help/documentation-format>"
]
ImplicitExposing region ->
Report.Report "IMPLICIT EXPOSING" region [] $
H.stack
D.stack
[
H.reflow $
D.reflow $
"I need you to be explicit about what this module exposes:"
,
H.reflow $
D.reflow $
"A great API usually hides some implementation details, so it is rare that\
\ everything in the file should be exposed. And requiring package authors\
\ to be explicit about this is a way of adding another quality check before\
@ -64,14 +64,14 @@ toReport source err =
Report.Report "DUPLICATE DOCS" r2 [] $
Report.toCodePair source r1 r2
(
H.reflow $
D.reflow $
"There can only be one `" <> N.toString name
<> "` in your module documentation, but it is listed twice:"
,
"Remove one of them!"
)
(
H.reflow $
D.reflow $
"There can only be one `" <> N.toString name
<> "` in your module documentation, but I see two. One here:"
,
@ -84,11 +84,11 @@ toReport source err =
Report.Report "DOCS MISTAKE" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I do not see `" <> N.toString name
<> "` in the `exposing` list, but it is in your module documentation:"
,
H.reflow $
D.reflow $
"Does it need to be added to the `exposing` list as well? Or maybe you removed `"
<> N.toString name <> "` and forgot to delete it here?"
)
@ -97,15 +97,15 @@ toReport source err =
Report.Report "DOCS MISTAKE" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I do not see `" <> N.toString name
<> "` in your module documentation, but it is in your `exposing` list:"
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Add a line like `@docs " <> N.toString name
<> "` to your module documentation!"
, H.link "Note" "See" "docs" "for more guidance on writing high quality docs."
, D.link "Note" "See" "docs" "for more guidance on writing high quality docs."
]
)
@ -113,13 +113,13 @@ toReport source err =
Report.Report "NO DOCS" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` definition does not have a documentation comment."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Add documentation with nice examples of how to use it!"
, H.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
, D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
]
)
@ -127,14 +127,14 @@ toReport source err =
Report.Report "NO TYPE ANNOTATION" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"The `" <> N.toString name <> "` definition does not have a type annotation."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"I use the type variable names from your annotations when generating docs. So if\
\ you say `Html msg` in your type annotation, I can use `msg` in the docs and make\
\ them a bit clearer. So add an annotation and try to use nice type variables!"
, H.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
, D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!"
]
)

32
compiler/src/Reporting/Error/Main.hs
View File

@ -9,8 +9,8 @@ module Reporting.Error.Main
import qualified AST.Canonical as Can
import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Error.Canonicalize as E
import qualified Reporting.Helpers as H
import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT
@ -40,10 +40,10 @@ toReport source err =
(
"I cannot handle this type of `main` value:"
,
H.stack
D.stack
[ "The type of `main` value I am seeing is:"
, H.indent 4 $ H.dullyellow $ RT.canToDoc RT.None tipe
, H.reflow $
, D.indent 4 $ D.dullyellow $ RT.canToDoc RT.None tipe
, D.reflow $
"I only know how to handle Html, Svg, and Programs\
\ though. Modify `main` to be one of those types of values!"
]
@ -55,11 +55,11 @@ toReport source err =
(
"A `main` definition cannot be defined in terms of itself."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"It should be a boring value with no recursion. But\
\ instead it is involved in this cycle of definitions:"
, H.indent 4 (H.drawCycle cycleNames)
, D.cycle 4 cycleNames
]
)
@ -69,7 +69,7 @@ toReport source err =
Report.Report "BAD FLAGS" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"Your `main` program wants " ++ aBadKindOfThing ++ " from JavaScript."
,
butThatIsNoGood
@ -81,7 +81,7 @@ toReport source err =
(
"an extended record"
,
H.reflow $
D.reflow $
"But the exact shape of the record must be known at compile time. No type variables!"
)
@ -89,7 +89,7 @@ toReport source err =
(
"a function"
,
H.reflow $
D.reflow $
"But if I allowed functions from JS, it would be possible to sneak\
\ side-effects and runtime exceptions into Elm!"
)
@ -98,7 +98,7 @@ toReport source err =
(
"an unspecified type"
,
H.reflow $
D.reflow $
"But type variables like `" ++ N.toString name ++ "` cannot be given as flags.\
\ I need to know exactly what type of data I am getting, so I can guarantee that\
\ unexpected data cannot sneak in and crash the Elm program."
@ -108,13 +108,13 @@ toReport source err =
(
"a `" ++ N.toString name ++ "` value"
,
H.stack
[ H.reflow $ "I cannot handle that. The types that CAN be in flags include:"
, H.indent 4 $
H.reflow $
D.stack
[ D.reflow $ "I cannot handle that. The types that CAN be in flags include:"
, D.indent 4 $
D.reflow $
"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
\ tuples, records, and JSON values."
, H.reflow $
, D.reflow $
"Since JSON values can flow through, you can use JSON encoders and decoders\
\ to allow other types through as well. More advanced users often just do\
\ everything with encoders and decoders for more control and better errors."

42
compiler/src/Reporting/Error/Pattern.hs
View File

@ -9,10 +9,10 @@ module Reporting.Error.Pattern
import qualified Data.List as List
import qualified Nitpick.PatternMatches as P
import Reporting.Doc ((<>))
import qualified Reporting.Doc as D
import qualified Reporting.Report as Report
import qualified Reporting.Render.Code as Code
import qualified Reporting.Helpers as H
import Reporting.Helpers ((<>))
@ -26,10 +26,10 @@ toReport source err =
Report.Report "REDUNDANT PATTERN" patternRegion [] $
Report.toCodeSnippet source caseRegion (Just patternRegion)
(
H.reflow $
"The " <> H.ordinalize index <> " pattern is redundant:"
D.reflow $
"The " <> D.ordinalize index <> " pattern is redundant:"
,
H.reflow $
D.reflow $
"Any value with this shape will be handled by a previous\
\ pattern, so it should be removed."
)
@ -42,10 +42,10 @@ toReport source err =
(
"This pattern does not cover all possiblities:"
,
H.stack
D.stack
[ "Other possibilities include:"
, unhandledPatternsToDocBlock unhandled
, H.reflow $
, D.reflow $
"I would have to crash if I saw one of those! So rather than\
\ pattern matching in function arguments, put a `case` in\
\ the function body to account for all possibilities."
@ -58,14 +58,14 @@ toReport source err =
(
"This pattern does not cover all possible values:"
,
H.stack
D.stack
[ "Other possibilities include:"
, unhandledPatternsToDocBlock unhandled
, H.reflow $
, D.reflow $
"I would have to crash if I saw one of those! You can use\
\ `let` to deconstruct values only if there is ONE possiblity.\
\ Switch to a `case` expression to account for all possibilities."
, H.toSimpleHint $
, D.toSimpleHint $
"Are you calling a function that definitely returns values\
\ with a very specific shape? Try making the return type of\
\ that function more specific!"
@ -78,12 +78,12 @@ toReport source err =
(
"This `case` does not have branches for all possibilities:"
,
H.stack
D.stack
[ "Missing possibilities include:"
, unhandledPatternsToDocBlock unhandled
, H.reflow $
, D.reflow $
"I would have to crash if I saw one of those. Add branches for them!"
, H.link "Hint"
, D.link "Hint"
"If you want to write the code for each branch later, use `Debug.todo` as a placeholder. Read"
"missing-patterns"
"for more guidance on this workflow."
@ -95,9 +95,9 @@ toReport source err =
-- PATTERN TO DOC
unhandledPatternsToDocBlock :: [P.Pattern] -> H.Doc
unhandledPatternsToDocBlock :: [P.Pattern] -> D.Doc
unhandledPatternsToDocBlock unhandledPatterns =
H.indent 4 $ H.dullyellow $ H.vcat $
D.indent 4 $ D.dullyellow $ D.vcat $
map (patternToDoc Unambiguous) unhandledPatterns
@ -108,7 +108,7 @@ data Context
deriving (Eq)
patternToDoc :: Context -> P.Pattern -> H.Doc
patternToDoc :: Context -> P.Pattern -> D.Doc
patternToDoc context pattern =
case delist pattern [] of
NonList P.Anything ->
@ -117,13 +117,13 @@ patternToDoc context pattern =
NonList (P.Literal literal) ->
case literal of
P.Chr chr ->
H.textToDoc ("'" <> chr <> "'")
D.fromText ("'" <> chr <> "'")
P.Str str ->
H.textToDoc ("\"" <> str <> "\"")
D.fromText ("\"" <> str <> "\"")
P.Int int ->
H.text (show int)
D.fromString (show int)
NonList (P.Ctor _ "#0" []) ->
"()"
@ -142,7 +142,7 @@ patternToDoc context pattern =
NonList (P.Ctor _ name args) ->
let
ctorDoc =
H.hsep (H.nameToDoc name : map (patternToDoc Arg) args)
D.hsep (D.fromName name : map (patternToDoc Arg) args)
in
if context == Arg && length args > 0 then
"(" <> ctorDoc <> ")"
@ -154,7 +154,7 @@ patternToDoc context pattern =
FiniteList entries ->
let entryDocs = map (patternToDoc Unambiguous) entries in
"[" <> H.hcat (List.intersperse "," entryDocs) <> "]"
"[" <> D.hcat (List.intersperse "," entryDocs) <> "]"
Conses conses finalPattern ->
let

130
compiler/src/Reporting/Error/Syntax.hs
View File

@ -17,10 +17,10 @@ import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report
import qualified Reporting.Helpers as H
@ -144,7 +144,7 @@ toReport source err =
(
"This documentation comment is not followed by anything."
,
H.reflow $
D.reflow $
"All documentation comments need to be right above the declaration they\
\ describe. Maybe some code got deleted or commented out by accident? Or\
\ maybe this comment is here by accident?"
@ -154,12 +154,12 @@ toReport source err =
Report.Report "BAD PORT" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You are declaring port `" <> N.toString name <> "` in a normal module."
,
H.stack
D.stack
[ "It needs to be in a `port` module."
, H.link "Hint"
, D.link "Hint"
"Ports are not a traditional FFI for calling JS functions directly. They need a different mindset! Read"
"ports"
"to learn how to use ports effectively."
@ -170,17 +170,17 @@ toReport source err =
Report.Report "ANNOTATION MISMATCH" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"I see a `" <> N.toString annName
<> "` annotation, but it is followed by a `"
<> N.toString defName <> "` definition."
,
H.fillSep
D.fillSep
["The","annotation","and","definition","names","must","match!"
,"Is","there","a","typo","between"
, H.dullyellow (H.nameToDoc annName)
, D.dullyellow (D.fromName annName)
,"and"
, H.dullyellow (H.nameToDoc defName) <> "?"
, D.dullyellow (D.fromName defName) <> "?"
]
)
@ -188,12 +188,12 @@ toReport source err =
Report.Report "MISSING DEFINITION" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"There is a type annotation for `" <> N.toString name
<> "` but there is no corresponding definition!"
,
"Directly below the type annotation, put a definition like:\n\n"
<> " " <> H.nameToDoc name <> " = 42"
<> " " <> D.fromName name <> " = 42"
)
Parse region subRegion problem ->
@ -206,7 +206,7 @@ toReport source err =
-- PARSE ERROR TO DOCS
problemToDocs :: Problem -> (H.Doc, H.Doc)
problemToDocs :: Problem -> (D.Doc, D.Doc)
problemToDocs problem =
case problem of
Tab ->
@ -220,11 +220,11 @@ problemToDocs problem =
(
"I got to the end of the file while parsing a multi-line comment."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Multi-line comments look like {- comment -}, and it looks like\
\ you are missing the closing marker."
, H.toSimpleHint $
, D.toSimpleHint $
"Nested multi-line comments like {- this {- and this -} -} are allowed.\
\ The opening and closing markers must be balanced though, just\
\ like parentheses in normal code. Maybe that is the problem?"
@ -235,7 +235,7 @@ problemToDocs problem =
(
"I got to the end of the file while parsing a GLSL block."
,
H.reflow $
D.reflow $
"A shader should be defined in a block like this: [glsl| ... |]"
)
@ -243,7 +243,7 @@ problemToDocs problem =
(
"I got to the end of the file while parsing a string."
,
H.reflow $
D.reflow $
"Strings look like \"this\" with double quotes on each end.\
\ Is the closing double quote missing in your code?"
)
@ -252,7 +252,7 @@ problemToDocs problem =
(
"I got to the end of the file while parsing a multi-line string."
,
H.reflow $
D.reflow $
"Multi-line strings look like \"\"\"this\"\"\" with three double quotes on each\
\ end. Is the closing triple quote missing in your code?"
)
@ -261,7 +261,7 @@ problemToDocs problem =
(
"I got to the end of the file while parsing a character."
,
H.reflow $
D.reflow $
"Characters look like 'c' with single quotes on each end.\
\ Is the closing single quote missing in your code?"
)
@ -270,10 +270,10 @@ problemToDocs problem =
(
"This string is missing the closing quote."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Elm strings like \"this\" cannot contain newlines."
, H.toSimpleHint $
, D.toSimpleHint $
"For strings that CAN contain newlines, say \"\"\"this\"\"\" for Elm’s\
\ multi-line string syntax. It allows unescaped newlines and double quotes."
]
@ -292,10 +292,10 @@ problemToDocs problem =
UnknownEscape ->
(
"Backslashes always start escaped characters, but I do not recognize this one:"
, H.stack
, D.stack
[ "Maybe there is some typo?"
, H.toSimpleHint "Valid escape characters include:"
, H.indent 4 $ H.vcat $
, D.toSimpleHint "Valid escape characters include:"
, D.indent 4 $ D.vcat $
[ "\\n"
, "\\r"
, "\\t"
@ -304,7 +304,7 @@ problemToDocs problem =
, "\\\\"
, "\\u{03BB}"
]
, H.reflow $
, D.reflow $
"The last one lets encode ANY character by its Unicode code\
\ point, so use that for anything outside the ordinary six."
]
@ -314,15 +314,15 @@ problemToDocs problem =
(
"I ran into an invalid Unicode escape character:"
,
H.stack
D.stack
[ "Here are some examples of valid Unicode escape characters:"
, H.indent 4 $ H.vcat $
, D.indent 4 $ D.vcat $
[ "\\u{0041}"
, "\\u{03BB}"
, "\\u{6728}"
, "\\u{1F60A}"
]
, H.reflow $
, D.reflow $
"Notice that the code point is always surrounded by curly\
\ braces. They are required!"
]
@ -342,18 +342,18 @@ problemToDocs problem =
,
let
goodCode = replicate (4 - numDigits) '0' ++ badCode
escape = "\\u{" <> H.text goodCode <> "}"
escape = "\\u{" <> D.fromString goodCode <> "}"
in
H.hsep [ "Try", H.dullyellow escape, "instead?" ]
D.hsep [ "Try", D.dullyellow escape, "instead?" ]
)
else
(
"This Unicode code point has too many digits:"
,
H.fillSep
D.fillSep
["Valid","code","points","are","between"
, H.dullyellow "\\u{0000}", "and", H.dullyellow "\\u{10FFFF}"
, D.dullyellow "\\u{0000}", "and", D.dullyellow "\\u{10FFFF}"
,"so","it","must","have","between","four","and","six","digits."
]
)
@ -362,12 +362,12 @@ problemToDocs problem =
(
"Ran into a bad use of single quotes."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"If you want to create a string, switch to double quotes:"
, H.indent 4 $
H.dullyellow "'this'" <> " => " <> H.green "\"this\""
, H.toSimpleHint $
, D.indent 4 $
D.dullyellow "'this'" <> " => " <> D.green "\"this\""
, D.toSimpleHint $
"Unlike JavaScript, Elm distinguishes between strings like \"hello\"\
\ and individual characters like 'A' and '3'. If you really do want\
\ a character though, something went wrong and I did not find the\
@ -381,16 +381,16 @@ problemToDocs problem =
,
let
number =
H.text (show numberBeforeDot)
D.fromString (show numberBeforeDot)
in
"Saying " <> H.green number <> " or " <> H.green (number <> ".0") <> " will work though!"
"Saying " <> D.green number <> " or " <> D.green (number <> ".0") <> " will work though!"
)
BadNumberEnd ->
(
"Numbers cannot have letters or underscores in them."
,
H.reflow $
D.reflow $
"Maybe a space is missing between a number and a variable?"
)
@ -398,7 +398,7 @@ problemToDocs problem =
(
"If you put the letter E in a number, it should followed by more digits."
,
H.reflow $
D.reflow $
"If you want to say 1000, you can also say 1e3.\
\ You cannot just end it with an E though!"
)
@ -407,7 +407,7 @@ problemToDocs problem =
(
"I see the start of a hex number, but not the end."
,
H.reflow $
D.reflow $
"A hex number looks like 0x123ABC, where the 0x is followed by hexidecimal\
\ digits. Valid hexidecimal digits include: 0123456789abcdefABCDEF"
)
@ -416,7 +416,7 @@ problemToDocs problem =
(
"Normal numbers cannot start with zeros. Take the zeros off the front."
,
H.reflow $
D.reflow $
"Only numbers like 0x0040 or 0.25 can start with a zero."
)
@ -424,7 +424,7 @@ problemToDocs problem =
(
"I cannot pattern match with floating point numbers:"
,
H.reflow $
D.reflow $
"Equality on floats can be unreliable, so you usually want to check that they\
\ are nearby with some sort of (abs (actual - expected) < 0.001) check."
)
@ -433,14 +433,14 @@ problemToDocs problem =
(
"I ran into a problem while parsing this GLSL block."
,
H.reflow (Text.unpack msg)
D.reflow (Text.unpack msg)
)
BadUnderscore _ ->
(
"A variable name cannot start with an underscore:"
,
H.reflow $
D.reflow $
"You can (1) use a wildcard like _ to ignore the value or you can (2) use\
\ a name that starts with a letter to access the value later. Pick one!"
)
@ -454,7 +454,7 @@ problemToDocs problem =
Equals ->
(
H.reflow $
D.reflow $
"I was not expecting this equals sign"
<> contextToString " here" " while parsing " stack <> "."
,
@ -466,7 +466,7 @@ problemToDocs problem =
(
"I ran into a stray arrow while parsing this `case` expression."
,
H.reflow $
D.reflow $
"All branches in a `case` must be indented the exact\
\ same amount, so the patterns are vertically\
\ aligned. Maybe this branch is indented too much?"
@ -486,7 +486,7 @@ problemToDocs problem =
(
"I was not expecting this dot."
,
H.reflow $
D.reflow $
"Dots are for record access and decimal points, so\
\ they cannot float around on their own. Maybe\
\ there is some extra whitespace?"
@ -494,27 +494,27 @@ problemToDocs problem =
Theories stack allTheories ->
(
H.reflow $
D.reflow $
"Something went wrong while parsing " <> contextToString "your code" "" stack <> "."
,
case Set.toList (Set.fromList allTheories) of
[] ->
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"I do not have any suggestions though!"
, H.reflow $
, D.reflow $
"Can you get it down to a <http://sscce.org> and share it at\
\ <https://github.com/elm-lang/error-message-catalog/issues>?\
\ That way we can figure out how to give better advice!"
]
[theory] ->
H.reflow $
D.reflow $
"I was expecting to see "
<> addPeriod (theoryToString stack theory)
theories ->
H.vcat $
D.vcat $
[ "I was expecting:"
, ""
]
@ -526,33 +526,33 @@ problemToDocs problem =
-- BAD OP HELPERS
badOp :: ContextStack -> String -> String -> String -> String -> ( H.Doc, H.Doc )
badOp :: ContextStack -> String -> String -> String -> String -> ( D.Doc, D.Doc )
badOp stack article opName setting hint =
(
H.reflow $
D.reflow $
"I was not expecting this " <> opName
<> contextToString " here" " while parsing " stack <> "."
,
H.reflow $
D.reflow $
article <> " " <> opName <> " should only appear in "
<> setting <> ". " <> hint
)
toBadEqualsHint :: ContextStack -> H.Doc
toBadEqualsHint :: ContextStack -> D.Doc
toBadEqualsHint stack =
case stack of
[] ->
H.reflow $
D.reflow $
"Maybe you want == instead? Or maybe something is indented too much?"
(ExprRecord, _) : _ ->
H.reflow $
D.reflow $
"Records look like { x = 3, y = 4 } with the equals sign right\
\ after the field name. Maybe you forgot a comma?"
(Definition _, _) : rest ->
H.reflow $
D.reflow $
"Maybe this is supposed to be a separate definition? If so, it\
\ is indented too far. "
<>
@ -634,9 +634,9 @@ getAnchor stack =
-- THEORY HELPERS
bullet :: String -> H.Doc
bullet :: String -> D.Doc
bullet point =
H.hang 4 (" - " <> H.fillSep (map H.text (words point)))
D.hang 4 (" - " <> D.fillSep (map D.fromString (words point)))
addPeriod :: String -> String

502
compiler/src/Reporting/Error/Type.hs
View File

File diff suppressed because it is too large Load Diff

32
compiler/src/Reporting/Render/Code.hs
View File

@ -12,8 +12,9 @@ module Reporting.Render.Code
import qualified Data.List as List
import qualified Data.Text as Text
import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullred, empty, text)
import Reporting.Doc (Doc, (<>))
import qualified Reporting.Doc as D
import qualified Reporting.Region as R
@ -40,11 +41,6 @@ toSource source =
f a
(<==>) :: Doc -> Doc -> Doc
(<==>) a b =
a <> hardline <> b
render :: Source -> R.Region -> Maybe R.Region -> Doc
render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
let
@ -64,7 +60,7 @@ render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
in
case makeUnderline width endLine smallerRegion of
Nothing ->
drawLines True width smallerRegion relevantLines empty
drawLines True width smallerRegion relevantLines D.empty
Just underline ->
drawLines False width smallerRegion relevantLines underline
@ -80,7 +76,7 @@ makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end
spaces = replicate (c1 + width + 1) ' '
zigzag = replicate (max 1 (c2 - c1)) '^'
in
Just (text spaces <> dullred (text zigzag))
Just (D.fromString spaces <> D.dullred (D.fromString zigzag))
drawLines :: Bool -> Int -> R.Region -> [(Int, Text.Text)] -> Doc -> Doc
@ -89,13 +85,14 @@ drawLines addZigZag width (R.Region start end) sourceLines finalLine =
(R.Position startLine _) = start
(R.Position endLine _) = end
in
foldr (<==>) finalLine $
map (drawLine addZigZag width startLine endLine) sourceLines
D.vcat $
map (drawLine addZigZag width startLine endLine) sourceLines
++ [finalLine]
drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc
drawLine addZigZag width startLine endLine (n, line) =
addLineNumber addZigZag width startLine endLine n (text (Text.unpack line))
addLineNumber addZigZag width startLine endLine n (D.fromText line)
addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
@ -109,11 +106,11 @@ addLineNumber addZigZag width start end n line =
spacer =
if addZigZag && start <= n && n <= end then
dullred ">"
D.dullred ">"
else
" "
in
text lineNumber <> spacer <> line
D.fromString lineNumber <> spacer <> line
@ -142,10 +139,11 @@ renderPair source@(Source sourceLines) region1 region2 =
(Just line) = List.lookup startRow1 sourceLines
in
OneLine $
text lineNumber <> "| " <> text (Text.unpack line)
<> hardline
<> text spaces1 <> dullred (text zigzag1)
<> text spaces2 <> dullred (text zigzag2)
D.vcat
[ D.fromString lineNumber <> "| " <> D.fromText line
, D.fromString spaces1 <> D.dullred (D.fromString zigzag1) <>
D.fromString spaces2 <> D.dullred (D.fromString zigzag2)
]
else
TwoChunks

50
compiler/src/Reporting/Render/Type.hs
View File

@ -21,8 +21,8 @@ import qualified AST.Canonical as Can
import qualified AST.Module.Name as ModuleName
import qualified Elm.Name as N
import qualified Reporting.Annotation as A
import qualified Reporting.Helpers as H
import Reporting.Helpers ( Doc, (<+>), (<>) )
import qualified Reporting.Doc as D
import Reporting.Doc ( Doc, (<+>), (<>) )
@ -39,12 +39,12 @@ lambda :: Context -> Doc -> Doc -> [Doc] -> Doc
lambda context arg1 arg2 args =
let
lambdaDoc =
H.sep (arg1 : map ("->" <+>) (arg2:args))
D.sep (arg1 : map ("->" <+>) (arg2:args))
in
case context of
None -> lambdaDoc
Func -> H.cat [ "(", lambdaDoc, ")" ]
App -> H.cat [ "(", lambdaDoc, ")" ]
Func -> D.cat [ "(", lambdaDoc, ")" ]
App -> D.cat [ "(", lambdaDoc, ")" ]
apply :: Context -> Doc -> [Doc] -> Doc
@ -56,10 +56,10 @@ apply context name args =
_:_ ->
let
applyDoc =
H.hang 4 (H.sep (name : args))
D.hang 4 (D.sep (name : args))
in
case context of
App -> H.cat [ "(", applyDoc, ")" ]
App -> D.cat [ "(", applyDoc, ")" ]
Func -> applyDoc
None -> applyDoc
@ -70,7 +70,7 @@ tuple a b cs =
entries =
zipWith (<+>) ("(" : repeat ",") (a:b:cs)
in
H.sep [ H.cat entries, ")" ]
D.sep [ D.cat entries, ")" ]
record :: [(Doc, Doc)] -> Maybe Doc -> Doc
@ -80,16 +80,16 @@ record entries maybeExt =
"{}"
(fields, Nothing) ->
H.sep
[ H.cat (zipWith (<+>) ("{" : repeat ",") fields)
D.sep
[ D.cat (zipWith (<+>) ("{" : repeat ",") fields)
, "}"
]
(fields, Just ext) ->
H.sep
[ H.hang 4 $ H.sep $
D.sep
[ D.hang 4 $ D.sep $
[ "{" <+> ext
, H.cat (zipWith (<+>) ("|" : repeat ",") fields)
, D.cat (zipWith (<+>) ("|" : repeat ",") fields)
]
, "}"
]
@ -97,7 +97,7 @@ record entries maybeExt =
entryToDoc :: (Doc, Doc) -> Doc
entryToDoc (fieldName, fieldType) =
H.hang 4 (H.sep [ fieldName <+> ":", fieldType ])
D.hang 4 (D.sep [ fieldName <+> ":", fieldType ])
recordSnippet :: (Doc, Doc) -> [(Doc, Doc)] -> Doc
@ -106,7 +106,7 @@ recordSnippet entry entries =
field = "{" <+> entryToDoc entry
fields = zipWith (<+>) (repeat ",") (map entryToDoc entries ++ ["..."])
in
H.sep [ H.cat (field:fields), "}" ]
D.sep [ D.cat (field:fields), "}" ]
@ -126,22 +126,22 @@ srcToDoc context (A.At _ tipe) =
(map (srcToDoc Func) rest)
Src.TVar name ->
H.nameToDoc name
D.fromName name
Src.TType _ name args ->
apply context
(H.nameToDoc name)
(D.fromName name)
(map (srcToDoc App) args)
Src.TTypeQual _ home name args ->
apply context
(H.nameToDoc home <> "." <> H.nameToDoc name)
(D.fromName home <> "." <> D.fromName name)
(map (srcToDoc App) args)
Src.TRecord fields ext ->
record
(map fieldToDocs fields)
(fmap (H.nameToDoc . A.toValue) ext)
(fmap (D.fromName . A.toValue) ext)
Src.TUnit ->
"()"
@ -155,7 +155,7 @@ srcToDoc context (A.At _ tipe) =
fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc)
fieldToDocs (A.At _ fieldName, fieldType) =
( H.nameToDoc fieldName
( D.fromName fieldName
, srcToDoc None fieldType
)
@ -190,17 +190,17 @@ canToDoc context tipe =
(map (canToDoc Func) rest)
Can.TVar name ->
H.nameToDoc name
D.fromName name
Can.TType (ModuleName.Canonical _ home) name args ->
apply context
(H.nameToDoc home <> "." <> H.nameToDoc name)
(D.fromName home <> "." <> D.fromName name)
(map (canToDoc App) args)
Can.TRecord fields ext ->
record
(map entryToDocs (Map.toList fields))
(fmap H.nameToDoc ext)
(fmap D.fromName ext)
Can.TUnit ->
"()"
@ -213,13 +213,13 @@ canToDoc context tipe =
Can.TAlias (ModuleName.Canonical _ home) name args _ ->
apply context
(H.nameToDoc home <> "." <> H.nameToDoc name)
(D.fromName home <> "." <> D.fromName name)
(map (canToDoc App . snd) args)
entryToDocs :: (N.Name, Can.Type) -> (Doc, Doc)
entryToDocs (name, tipe) =
(H.nameToDoc name, canToDoc None tipe)
(D.fromName name, canToDoc None tipe)
collectArgs :: Can.Type -> (Can.Type, [Can.Type])

20
compiler/src/Reporting/Warning.hs
View File

@ -13,11 +13,11 @@ import Data.Monoid ((<>))
import qualified AST.Canonical as Can
import qualified AST.Utils.Type as Type
import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Region as R
import qualified Reporting.Report as Report
import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT
import qualified Reporting.Helpers as H
@ -44,7 +44,7 @@ toReport source warning =
Report.Report "unused import" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"Nothing from the `" <> N.toString moduleName <> "` module is used in this file."
,
"I recommend removing unused imports."
@ -55,14 +55,14 @@ toReport source warning =
Report.Report title region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
"You are not using `" <> N.toString name <> "` anywhere."
,
H.stack
[ H.reflow $
D.stack
[ D.reflow $
"Is there a typo? Maybe you intended to use `" <> N.toString name
<> "` somewhere but typed another name instead?"
, H.reflow $
, D.reflow $
defOrPat context
( "If you are sure there is no typo, remove the definition.\
\ This way future readers will not have to wonder why it is there!"
@ -77,7 +77,7 @@ toReport source warning =
Report.Report "missing type annotation" region [] $
Report.toCodeSnippet source region Nothing
(
H.reflow $
D.reflow $
case Type.deepDealias inferredType of
Can.TLambda _ _ ->
"The `" <> N.toString name <> "` function has no type annotation."
@ -85,10 +85,10 @@ toReport source warning =
_ ->
"The `" <> N.toString name <> "` definition has no type annotation."
,
H.stack
D.stack
[ "I inferred the type annotation myself though! You can copy it into your code:"
, H.green $ H.hang 4 $ H.sep $
[ H.nameToDoc name <> " :"
, D.green $ D.hang 4 $ D.sep $
[ D.fromName name <> " :"
, RT.canToDoc RT.None inferredType
]
]

90
compiler/src/Type/Error.hs
View File

@ -25,7 +25,7 @@ import Data.Monoid ((<>))
import qualified AST.Module.Name as ModuleName
import qualified Data.Bag as Bag
import qualified Elm.Name as N
import qualified Reporting.Helpers as H
import qualified Reporting.Doc as D
import qualified Reporting.Render.Type as RT
@ -78,17 +78,17 @@ iteratedDealias tipe =
type Localizer = Map.Map (ModuleName.Canonical, N.Name) String
nameToDoc :: Localizer -> ModuleName.Canonical -> N.Name -> H.Doc
nameToDoc :: Localizer -> ModuleName.Canonical -> N.Name -> D.Doc
nameToDoc dict home@(ModuleName.Canonical _ moduleName) name =
case Map.lookup (home, name) dict of
Nothing ->
H.nameToDoc moduleName <> "." <> H.nameToDoc name
D.fromName moduleName <> "." <> D.fromName name
Just string ->
H.text string
D.fromString string
toDoc :: Localizer -> RT.Context -> Type -> H.Doc
toDoc :: Localizer -> RT.Context -> Type -> D.Doc
toDoc dict ctx tipe =
case tipe of
Lambda a b cs ->
@ -104,16 +104,16 @@ toDoc dict ctx tipe =
"?"
FlexVar name ->
H.nameToDoc name
D.fromName name
FlexSuper _ name ->
H.nameToDoc name
D.fromName name
RigidVar name ->
H.nameToDoc name
D.fromName name
RigidSuper _ name ->
H.nameToDoc name
D.fromName name
Type home name args ->
RT.apply ctx
@ -123,7 +123,7 @@ toDoc dict ctx tipe =
Record fields ext ->
let
entryToDocs (fieldName, fieldType) =
( H.nameToDoc fieldName, toDoc dict RT.None fieldType )
( D.fromName fieldName, toDoc dict RT.None fieldType )
fieldDocs =
map entryToDocs (Map.toList fields)
@ -131,8 +131,8 @@ toDoc dict ctx tipe =
RT.record fieldDocs $
case ext of
Closed -> Nothing
FlexOpen x -> Just (H.nameToDoc x)
RigidOpen x -> Just (H.nameToDoc x)
FlexOpen x -> Just (D.fromName x)
RigidOpen x -> Just (D.fromName x)
Unit ->
"()"
@ -153,7 +153,7 @@ toDoc dict ctx tipe =
-- DIFF
toDiffDocs :: Localizer -> Type -> Type -> (H.Doc, H.Doc, [Problem])
toDiffDocs :: Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
toDiffDocs dict a b =
case diff dict RT.None a b of
Similar aDoc bDoc ->
@ -217,13 +217,13 @@ data Problem
-- COMPUTE DIFF
diff :: Localizer -> RT.Context -> Type -> Type -> Diff H.Doc
diff :: Localizer -> RT.Context -> Type -> Type -> Diff D.Doc
diff dict ctx tipe1 tipe2 =
case (tipe1, tipe2) of
(FlexVar x, FlexVar y) | x == y -> pure (H.nameToDoc x)
(FlexSuper _ x, FlexSuper _ y) | x == y -> pure (H.nameToDoc x)
(RigidVar x, RigidVar y) | x == y -> pure (H.nameToDoc x)
(RigidSuper _ x, RigidSuper _ y) | x == y -> pure (H.nameToDoc x)
(FlexVar x, FlexVar y) | x == y -> pure (D.fromName x)
(FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x)
(RigidVar x, RigidVar y) | x == y -> pure (D.fromName x)
(RigidSuper _ x, RigidSuper _ y) | x == y -> pure (D.fromName x)
(Infinite, Infinite) -> pure "∞"
(Error, Error) -> pure "?"
@ -236,8 +236,8 @@ diff dict ctx tipe1 tipe2 =
<*>
case (maybeC, maybeZ) of
(Nothing, Nothing) -> pure []
(Just c , Nothing) -> Different [H.dullyellow (toDoc dict RT.None c)] [] Bag.empty
(Nothing, Just z ) -> Different [] [H.dullyellow (toDoc dict RT.None z)] Bag.empty
(Just c , Nothing) -> Different [D.dullyellow (toDoc dict RT.None c)] [] Bag.empty
(Nothing, Just z ) -> Different [] [D.dullyellow (toDoc dict RT.None z)] Bag.empty
(Just c , Just z ) -> (:[]) <$> diff dict RT.None c z
(Record fields1 ext1, Record fields2 ext2) -> diffRecord dict fields1 ext1 fields2 ext2
@ -255,8 +255,8 @@ diff dict ctx tipe1 tipe2 =
(Lambda a b cs, Lambda x y zs) -> diffLambda dict ctx (a:b:cs) (x:y:zs)
(FlexVar x, other) -> Similar (H.nameToDoc x) (toDoc dict ctx other)
(other, FlexVar x) -> Similar (toDoc dict ctx other) (H.nameToDoc x)
(FlexVar x, other) -> Similar (D.fromName x) (toDoc dict ctx other)
(other, FlexVar x) -> Similar (toDoc dict ctx other) (D.fromName x)
pair ->
case pair of
@ -268,8 +268,8 @@ diff dict ctx tipe1 tipe2 =
_ ->
let
doc1 = H.dullyellow (toDoc dict ctx tipe1)
doc2 = H.dullyellow (toDoc dict ctx tipe2)
doc1 = D.dullyellow (toDoc dict ctx tipe1)
doc2 = D.dullyellow (toDoc dict ctx tipe2)
in
Different doc1 doc2 $
case pair of
@ -334,10 +334,10 @@ isSimilar tipe1 tipe2 =
Different _ _ _ -> False
yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> H.Doc
yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc
yellowApply dict ctx home name tipe =
RT.apply ctx
(H.dullyellow (nameToDoc dict home name))
(D.dullyellow (nameToDoc dict home name))
[toDoc dict RT.App tipe]
@ -348,7 +348,7 @@ yellowApply dict ctx home name tipe =
--
-- INVARIANT: length types1 >= 2 && length types2 >= 2
--
diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff H.Doc
diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc
diffLambda dict ctx types1 types2 =
let
(result1:revArgs1) = reverse types1
@ -389,7 +389,7 @@ diffLambda dict ctx types1 types2 =
--
-- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2
--
diffArgMismatch :: Localizer -> RT.Context -> [Type] -> H.Doc -> [Type] -> H.Doc -> Diff H.Doc
diffArgMismatch :: Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc
diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
case toGreedyMatch dict shortRevArgs longRevArgs of
Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->
@ -417,7 +417,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
Nothing ->
let
toYellowDoc tipe =
H.dullyellow (toDoc dict RT.Func tipe)
D.dullyellow (toDoc dict RT.Func tipe)
(a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)
(x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )
@ -433,7 +433,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
data GreedyMatch =
GreedyMatch [H.Doc] [H.Doc]
GreedyMatch [D.Doc] [D.Doc]
--
@ -448,7 +448,7 @@ toGreedyMatchHelp :: Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe Greed
toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
let
toYellowDoc tipe =
H.dullyellow (toDoc dict RT.Func tipe)
D.dullyellow (toDoc dict RT.Func tipe)
in
case (shorterArgs, longerArgs) of
(x:xs, y:ys) ->
@ -475,7 +475,7 @@ toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs lon
-- RECORD DIFFS
diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff H.Doc
diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc
diffRecord dict fields1 ext1 fields2 ext2 =
let
only1 = Map.keys (Map.difference fields1 fields2)
@ -510,12 +510,12 @@ diffRecord dict fields1 ext1 fields2 ext2 =
(Bag.one (FieldMismatch only1 only2))
toOverlapDoc :: (BadOverlap -> H.Doc) -> BadOverlap -> (H.Doc, H.Doc)
toOverlapDoc :: (BadOverlap -> D.Doc) -> BadOverlap -> (D.Doc, D.Doc)
toOverlapDoc getDoc overlap@(BadOverlap field _ _ _) =
(H.nameToDoc field, getDoc overlap)
(D.fromName field, getDoc overlap)
toOverlapRecord :: (BadOverlap -> H.Doc) -> BadOverlap -> [BadOverlap] -> Extension -> H.Doc
toOverlapRecord :: (BadOverlap -> D.Doc) -> BadOverlap -> [BadOverlap] -> Extension -> D.Doc
toOverlapRecord getDoc bad bads ext =
let go = toOverlapDoc getDoc in
case ext of
@ -524,7 +524,7 @@ toOverlapRecord getDoc bad bads ext =
RigidOpen _ -> RT.recordSnippet (go bad) (map go bads)
toMissingDoc :: Map.Map N.Name t -> [N.Name] -> Extension -> H.Doc
toMissingDoc :: Map.Map N.Name t -> [N.Name] -> Extension -> D.Doc
toMissingDoc allFields uniqueFields ext =
case map emphasizeFieldName uniqueFields of
[] ->
@ -540,12 +540,12 @@ toMissingDoc allFields uniqueFields ext =
RigidOpen _ -> RT.recordSnippet doc docs
emphasizeFieldName :: N.Name -> (H.Doc, H.Doc)
emphasizeFieldName :: N.Name -> (D.Doc, D.Doc)
emphasizeFieldName field =
( H.dullyellow (H.nameToDoc field), "..." )
( D.dullyellow (D.fromName field), "..." )
toBoringRecord :: Map.Map N.Name t -> Extension -> H.Doc
toBoringRecord :: Map.Map N.Name t -> Extension -> D.Doc
toBoringRecord fields ext =
case ext of
Closed -> if Map.null fields then "{}" else "{ ... }"
@ -557,11 +557,11 @@ toBoringRecord fields ext =
-- DIFF RECORD EXTENSION
diffExt :: Extension -> Extension -> Diff (Maybe H.Doc)
diffExt :: Extension -> Extension -> Diff (Maybe D.Doc)
diffExt ext1 ext2 =
let
normal = Just . H.nameToDoc
yellow = Just . H.dullyellow . H.nameToDoc
normal = Just . D.fromName
yellow = Just . D.dullyellow . D.fromName
different x y = Different x y Bag.empty
in
@ -596,8 +596,8 @@ diffExt ext1 ext2 =
data BadOverlap =
BadOverlap
{ _field :: N.Name
, _doc1 :: H.Doc
, _doc2 :: H.Doc
, _doc1 :: D.Doc
, _doc2 :: D.Doc
, _problems :: Bag.Bag Problem
}
@ -608,7 +608,7 @@ findBadOverlaps dict fields1 fields2 =
Map.intersectionWith (diff dict RT.None) fields1 fields2
findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff H.Doc)] -> [BadOverlap]
findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff D.Doc)] -> [BadOverlap]
findBadOverlapsHelp badOverlaps fieldPairs =
case fieldPairs of
[] ->

8
elm.cabal
View File

@ -134,7 +134,6 @@ Executable elm
Elm.Header,
Elm.Name,
Elm.Package,
Elm.Utils,
Json.Decode,
Json.Encode,
@ -196,6 +195,7 @@ Executable elm
Parse.Shader,
Parse.Type,
Reporting.Annotation,
Reporting.Doc,
Reporting.Error,
Reporting.Error.Canonicalize,
Reporting.Error.Docs,
@ -203,12 +203,12 @@ Executable elm
Reporting.Error.Pattern,
Reporting.Error.Syntax,
Reporting.Error.Type,
Reporting.Helpers,
Reporting.Region,
Reporting.Render.Code,
Reporting.Render.Type,
Reporting.Report,
Reporting.Result,
Reporting.Suggest,
Reporting.Warning,
Type.Constrain.Expression,
Type.Constrain.Module,
@ -224,8 +224,8 @@ Executable elm
Paths_elm
Build-depends:
ansi-terminal >= 0.7 && < 0.8,
ansi-wl-pprint >= 0.6.7 && < 0.7,
ansi-terminal >= 0.8 && < 0.9,
ansi-wl-pprint >= 0.6.8 && < 0.7,
base >=4.8 && <5,
binary >= 0.8 && < 0.9,
bytestring >= 0.9 && < 0.11,

2
ui/terminal/src/Repl.hs
View File

@ -29,7 +29,7 @@ import qualified Elm.Name as N
import qualified Elm.Project as Project
import qualified Elm.Package as Pkg
import qualified Elm.PerUserCache as PerUserCache
import qualified Elm.Utils as Elm
import qualified Parse.Repl as Elm
import qualified Reporting.Task as Task
import qualified Reporting.Progress.Repl as Repl

12
ui/terminal/src/Terminal/Args/Error.hs
View File

@ -23,7 +23,7 @@ import qualified System.FilePath as FP
import System.IO (hPutStrLn, stderr)
import qualified Text.PrettyPrint.ANSI.Leijen as P
import Elm.Utils (nearbyNames, distance)
import Reporting.Suggest as Suggest
import Terminal.Args.Internal
@ -235,7 +235,7 @@ exitWithUnknown :: String -> [String] -> IO a
exitWithUnknown unknown knowns =
let
suggestions =
case map toGreen (nearbyNames id unknown knowns) of
case map toGreen (Suggest.nearbyNames id unknown knowns) of
[] ->
[]
@ -434,7 +434,11 @@ getNearbyFlagsHelp :: String -> Flag a -> (Int, String)
getNearbyFlagsHelp unknown flag =
case flag of
OnOff flagName _ ->
( distance unknown flagName, "--" ++ flagName )
( Suggest.distance unknown flagName
, "--" ++ flagName
)
Flag flagName (Parser singular _ _ _ _) _ ->
( distance unknown flagName, "--" ++ flagName ++ "=" ++ toToken singular )
( Suggest.distance unknown flagName
, "--" ++ flagName ++ "=" ++ toToken singular
)