gren-lang/compiler
1
1
Fork 0
mirror of https://github.com/gren-lang/compiler.git synced 2024-09-11 08:45:42 +03:00
Code Issues Actions 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.Docs as Docs
import qualified Elm.Package as Pkg import qualified Elm.Package as Pkg
import qualified Elm.Utils as Utils
import qualified Deps.Website as Website import qualified Deps.Website as Website
import qualified Elm.Project.Json as Project import qualified Elm.Project.Json as Project
import qualified File.IO as IO import qualified File.IO as IO
import qualified Reporting.Suggest as Suggest
import qualified Reporting.Exit as Exit import qualified Reporting.Exit as Exit
import qualified Reporting.Exit.Assets as E import qualified Reporting.Exit.Assets as E
import qualified Reporting.Progress as Progress import qualified Reporting.Progress as Progress
@ -122,7 +122,7 @@ nearbyNames (Pkg.Name author1 project1) possibleNames =
authorDistance :: String -> Text.Text -> Int authorDistance :: String -> Text.Text -> Int
authorDistance bad possibility = authorDistance bad possibility =
abs (Utils.distance bad (Text.unpack possibility)) abs (Suggest.distance bad (Text.unpack possibility))
projectDistance :: String -> Text.Text -> Int projectDistance :: String -> Text.Text -> Int
@ -130,7 +130,7 @@ projectDistance bad possibility =
if possibility == "elm-lang" || possibility == "elm-explorations" then if possibility == "elm-lang" || possibility == "elm-explorations" then
0 0
else 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.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Elm.Utils as Utils
import qualified Json.Encode as Encode import qualified Json.Encode as Encode
import qualified Reporting.Suggest as Suggest
@ -61,7 +61,7 @@ check rawName =
Text.unpack suggestion Text.unpack suggestion
in in
Left $ map snd $ 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 where
import qualified Data.ByteString.Builder as B
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import System.IO (stderr)
import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Elm.Compiler as Compiler import qualified Elm.Compiler as Compiler
import qualified Elm.Compiler.Module as Module import qualified Elm.Compiler.Module as Module
import qualified Elm.Package as Pkg import qualified Elm.Package as Pkg
import qualified Elm.Utils as Utils
import qualified Json.Encode as Encode import qualified Json.Encode as Encode
import qualified Reporting.Doc as D
import qualified Reporting.Exit.Assets as Asset import qualified Reporting.Exit.Assets as Asset
import qualified Reporting.Exit.Bump as Bump import qualified Reporting.Exit.Bump as Bump
import qualified Reporting.Exit.Compile as Compile import qualified Reporting.Exit.Compile as Compile
@ -65,9 +63,9 @@ toStderr exit =
Help.toStderr (Help.reportToDoc (toReport exit)) Help.toStderr (Help.reportToDoc (toReport exit))
toJson :: Exit -> IO () toJson :: Exit -> Encode.Value
toJson exit = toJson exit =
B.hPutBuilder stderr $ Encode.encodeUgly $ Help.reportToJson (toReport exit) Help.reportToJson (toReport exit)
toReport :: Exit -> Help.Report toReport :: Exit -> Help.Report
@ -106,7 +104,7 @@ toReport exit =
Cycle names -> Cycle names ->
Help.report "IMPORT CYCLE" Nothing Help.report "IMPORT CYCLE" Nothing
"Your module imports form a cycle:" "Your module imports form a cycle:"
[ P.indent 4 (Utils.drawCycle names) [ D.cycle 4 names
, Help.reflow $ , Help.reflow $
"Learn more about why this is disallowed and how to break cycles here:" "Learn more about why this is disallowed and how to break cycles here:"
++ Help.hintLink "import-cycles" ++ 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.ByteString as BS
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Text.PrettyPrint.ANSI.Leijen as P
import qualified Compile import qualified Compile
import qualified Elm.Compiler.Module as M import qualified Elm.Compiler.Module as M
import qualified Elm.Compiler.Version import qualified Elm.Compiler.Version
import qualified Elm.Package as Pkg import qualified Elm.Package as Pkg
import qualified Json.Encode as Encode import qualified Json.Encode as Encode
import qualified Reporting.Doc as D
import qualified Reporting.Error as Error import qualified Reporting.Error as Error
import qualified Reporting.Helpers as H
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Region as Region import qualified Reporting.Region as Region
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
@ -63,13 +62,13 @@ compile (Context pkg docsFlag importDict interfaces) source =
-- ERRORS TO DOC -- ERRORS TO DOC
errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> H.Doc errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> D.Doc
errorsToDoc filePath source errors = errorsToDoc filePath source errors =
let let
reports = reports =
concatMap (Error.toReports (Code.toSource source) Map.empty) errors concatMap (Error.toReports (Code.toSource source) Map.empty) errors
in 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 Encode.object
[ ("path", Encode.text (Text.pack filePath)) [ ("path", Encode.text (Text.pack filePath))
, ("name", Encode.name moduleName) , ("name", Encode.name moduleName)
, ("errors", Encode.array (map reportToJson reports)) , ("problems", Encode.array (map reportToJson reports))
] ]
reportToJson :: Report.Report -> Encode.Value reportToJson :: Report.Report -> Encode.Value
reportToJson (Report.Report title region _sgstns message) = reportToJson (Report.Report title region _sgstns message) =
let
messageString =
P.displayS (P.renderPretty 1 80 message) ""
in
Encode.object Encode.object
[ ("title", Encode.text (Text.pack title)) [ ("title", Encode.text (Text.pack title))
, ("region", Region.encode region) , ("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 as Text
import qualified Data.Text.Encoding 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 AST.Source as Src
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Parse.Primitives as Parse import qualified Parse.Primitives as Parse
import qualified Parse.Type as Type import qualified Parse.Type as Type
import qualified Reporting.Annotation as A import qualified Reporting.Annotation as A
import qualified Reporting.Doc as D
import Reporting.Doc ((<>), (<+>))
import qualified Json.Decode as Decode import qualified Json.Decode as Decode
import qualified Json.Encode as Encode import qualified Json.Encode as Encode
import Json.Encode ((==>)) import Json.Encode ((==>))
@ -61,7 +61,7 @@ data Union = Union N.Name [N.Name] [(N.Name, [Type])]
data Context = None | InType | InFunction data Context = None | InType | InFunction
toDoc :: Context -> Type -> P.Doc toDoc :: Context -> Type -> D.Doc
toDoc context tipe = toDoc context tipe =
case tipe of case tipe of
Lambda _ _ -> Lambda _ _ ->
@ -69,21 +69,21 @@ toDoc context tipe =
map (toDoc InFunction) (collectLambdas tipe) map (toDoc InFunction) (collectLambdas tipe)
lambda = lambda =
P.sep [ t, P.sep (map (P.text "->" <+>) ts) ] D.sep [ t, D.sep (map ("->" <+>) ts) ]
in in
case context of case context of
None -> lambda None -> lambda
_ -> P.parens lambda _ -> "(" <> lambda <> ")"
Var name -> Var name ->
P.text (N.toString name) D.fromName name
Unit -> Unit ->
"()" "()"
Tuple a b cs -> Tuple a b cs ->
P.sep D.sep
[ P.cat $ [ D.cat $
[ "(" <+> toDoc None a [ "(" <+> toDoc None a
, "," <+> toDoc None b , "," <+> toDoc None b
] ]
@ -94,19 +94,19 @@ toDoc context tipe =
Type name args -> Type name args ->
case args of case args of
[] -> [] ->
P.text (N.toString name) D.fromName name
_ -> _ ->
let let
docName = docName =
P.text (N.toString name) D.fromName name
application = application =
P.hang 2 $ P.sep (docName : map (toDoc InType) args) D.hang 2 $ D.sep (docName : map (toDoc InType) args)
in in
case context of case context of
InType -> InType ->
P.parens application "(" <> application <> ")"
_ -> _ ->
application application
@ -117,23 +117,24 @@ toDoc context tipe =
Record fields ext -> Record fields ext ->
case ext of case ext of
Nothing -> Nothing ->
P.sep D.sep
[ P.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields)) [ D.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields))
, "}" , "}"
] ]
Just x -> Just x ->
P.hang 4 $ D.sep
P.sep [ D.hang 4 $ D.sep $
[ "{" <+> P.text (N.toString x) <+> "|" [ "{" <+> D.fromName x
, P.sep (P.punctuate "," (map entryToDoc fields)) , D.cat (zipWith (<+>) ("|" : repeat ",") (map entryToDoc fields))
, "}" ]
] , "}"
]
entryToDoc :: (N.Name, Type) -> P.Doc entryToDoc :: (N.Name, Type) -> D.Doc
entryToDoc (field, fieldType) = entryToDoc (field, fieldType) =
P.text (N.toString field) <+> ":" <+> toDoc None fieldType D.fromName field <+> ":" <+> toDoc None fieldType
collectLambdas :: Type -> [Type] collectLambdas :: Type -> [Type]
@ -149,8 +150,7 @@ collectLambdas tipe =
encode :: Type -> Encode.Value encode :: Type -> Encode.Value
encode tipe = encode tipe =
Encode.text $ Text.pack $ Encode.text $ Text.pack $ D.toLine (toDoc None tipe)
P.displayS (P.renderPretty 1.0 (maxBound `div` 2) (toDoc None tipe)) ""
decoder :: Decode.Decoder () Type 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.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Encoding 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.Canonical as Can
import qualified AST.Optimized as Opt 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.Builder as JS
import qualified Generate.JavaScript.Expression as Expr import qualified Generate.JavaScript.Expression as Expr
import qualified Generate.JavaScript.Name as Name 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 let
value = Name.toBuilder (Name.fromGlobal home name) value = Name.toBuilder (Name.fromGlobal home name)
toString = Name.toBuilder (Name.fromKernel N.debug "toString") 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 in
"var _value = " <> toString <> "(" <> value <> ");\n" <> "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\ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\
\ console.log(_value + '\\n : ' + _type.split('\\n').join('\\n '));\n\ \ console.log(_value + '\\n : ' + _type.split('\\n').join('\\n '));\n\
\} else {\n\ \} else {\n\
@ -244,7 +243,7 @@ generateCycle mode (Opt.Global home _) cycle =
"The following top-level definitions are causing infinite recursion:\\n" "The following top-level definitions are causing infinite recursion:\\n"
<> drawCycle (map fst cycle) <> drawCycle (map fst cycle)
<> "\\n\\nThese errors are very tricky, so read " <> "\\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!" <> " 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.Keyword as Keyword
import qualified Parse.Primitives.Number as Number import qualified Parse.Primitives.Number as Number
import qualified Parse.Primitives.Symbol as Symbol import qualified Parse.Primitives.Symbol as Symbol
import qualified Reporting.Doc as D
import qualified Reporting.Error.Syntax as E import qualified Reporting.Error.Syntax as E
import qualified Reporting.Helpers as H
import qualified Reporting.Region as R import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
@ -43,7 +43,7 @@ import qualified Reporting.Render.Code as Code
-- PARSE -- 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 = parse rootName userErrorToDocs (Json.Decoder run) bytestring =
let let
source = 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.Decode.Internals as Json
import qualified Json.Encode as E import qualified Json.Encode as E
import qualified Reporting.Doc as D
import qualified Reporting.Error.Syntax as Syntax import qualified Reporting.Error.Syntax as Syntax
import qualified Reporting.Helpers as H
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
@ -35,7 +35,7 @@ data Error e
-- TO DOC -- 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 = toDoc rootName source userErrorToDocs err =
case err of case err of
BadJson syntaxError -> BadJson syntaxError ->
@ -46,7 +46,7 @@ toDoc rootName source userErrorToDocs err =
BadContent jsonError -> BadContent jsonError ->
case flatten jsonError of case flatten jsonError of
[] -> [] ->
H.reflow D.reflow
"I am not sure what is wrong with this JSON. Please create an <http://sscce.org>\ "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\ \ and share it at <https://github.com/elm-lang/elm-compiler/issues> so I can\
\ provide a helpful hint here!" \ provide a helpful hint here!"
@ -59,8 +59,8 @@ toDoc rootName source userErrorToDocs err =
toNumberedDoc index flatErr = toNumberedDoc index flatErr =
P.dullcyan ("(" <> P.int index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr P.dullcyan ("(" <> P.int index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr
in in
H.stack $ D.stack $
[ H.reflow $ [ D.reflow $
"I have " ++ show (length flatErrors) ++ " theories on what is going wrong:" "I have " ++ show (length flatErrors) ++ " theories on what is going wrong:"
] ]
++ zipWith toNumberedDoc [1..] flatErrors ++ zipWith toNumberedDoc [1..] flatErrors
@ -70,7 +70,7 @@ toDoc rootName source userErrorToDocs err =
-- FLAT ERROR TO DOC -- 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) = flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory theories) =
case theories of case theories of
[] -> [] ->
@ -85,12 +85,12 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory
in in
case accesses of case accesses of
[] -> [] ->
H.fillSep (starter ++ explanation) D.fillSep (starter ++ explanation)
_ -> _ ->
H.stack D.stack
[ H.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."] [ D.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."]
, H.fillSep explanation , D.fillSep explanation
] ]
_:_ -> _:_ ->
@ -107,31 +107,31 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory
++ actualThing json ++ actualThing json
++ ["at",accessToDoc rootName accesses,"because:"] ++ ["at",accessToDoc rootName accesses,"because:"]
in in
H.stack D.stack
[ H.fillSep (starter ++ introduction) [ D.fillSep (starter ++ introduction)
, H.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories) , D.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories)
, H.reflow "I accept any of these things." , D.reflow "I accept any of these things."
] ]
accessToDoc :: String -> [String] -> H.Doc accessToDoc :: String -> [String] -> D.Doc
accessToDoc rootName accesses = accessToDoc rootName accesses =
P.dullyellow (P.text (rootName ++ concat accesses)) P.dullyellow (P.text (rootName ++ concat accesses))
actualThing :: E.Value -> [H.Doc] actualThing :: E.Value -> [D.Doc]
actualThing json = actualThing json =
case json of case json of
E.Array _ -> [H.red "array"] E.Array _ -> [D.red "array"]
E.Object _ -> [H.red "object"] E.Object _ -> [D.red "object"]
E.String _ -> [H.red "string"] E.String _ -> [D.red "string"]
E.Boolean b -> [H.red (if b then "true" else "false"),"value"] E.Boolean b -> [D.red (if b then "true" else "false"),"value"]
E.Integer n -> ["number",H.red (H.text (show n))] E.Integer n -> ["number",D.red (D.fromString (show n))]
E.Number _ -> [H.red "number"] E.Number _ -> [D.red "number"]
E.Null -> [H.red "null","value"] E.Null -> [D.red "null","value"]
anExpectedThing :: Json.Type -> [H.Doc] anExpectedThing :: Json.Type -> [D.Doc]
anExpectedThing tipe = anExpectedThing tipe =
case tipe of case tipe of
Json.TObject -> ["an", P.green "OBJECT" <> "."] Json.TObject -> ["an", P.green "OBJECT" <> "."]
@ -141,15 +141,15 @@ anExpectedThing tipe =
Json.TInt -> ["an", P.green "INT" <> "."] Json.TInt -> ["an", P.green "INT" <> "."]
Json.TObjectWith field -> ["an",P.green "OBJECT","with","a",P.green ("\"" <> P.text (Text.unpack field) <> "\""),"field."] Json.TObjectWith field -> ["an",P.green "OBJECT","with","a",P.green ("\"" <> P.text (Text.unpack field) <> "\""),"field."]
Json.TArrayWith i len -> 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" ,"I","need","index",P.text (show i) <> ",","but","this","array"
,"only","has",P.text (show len),"elements." ,"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 = toBullet intro userErrorToDocs theory =
H.indent 4 $ H.fillSep $ (++) intro $ D.indent 4 $ D.fillSep $ (++) intro $
case theory of case theory of
Failure userError -> Failure userError ->
userErrorToDocs 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 Data.Index as Index
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Reporting.Annotation as A 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.Region as R
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT import qualified Reporting.Render.Type as RT
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
import qualified Reporting.Helpers as H import qualified Reporting.Suggest as Suggest
import Reporting.Helpers ( Doc, (<+>), (<>) )
@ -126,16 +127,16 @@ toKindInfo :: VarKind -> N.Name -> ( Doc, Doc, Doc )
toKindInfo kind name = toKindInfo kind name =
case kind of case kind of
BadOp -> BadOp ->
( "an", "operator", "(" <> H.nameToDoc name <> ")" ) ( "an", "operator", "(" <> D.fromName name <> ")" )
BadVar -> BadVar ->
( "a", "value", "`" <> H.nameToDoc name <> "`" ) ( "a", "value", "`" <> D.fromName name <> "`" )
BadPattern -> BadPattern ->
( "a", "pattern", "`" <> H.nameToDoc name <> "`" ) ( "a", "pattern", "`" <> D.fromName name <> "`" )
BadType -> 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.Report "BAD TYPE ANNOTATION" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The type annotation for `" <> N.toString name <> "` says it can accept " "The type annotation for `" <> N.toString name <> "` says it can accept "
<> H.args numTypeArgs <> ", but the definition says it has " <> D.args numTypeArgs <> ", but the definition says it has "
<> H.args numDefArgs <> ":" <> D.args numDefArgs <> ":"
, ,
H.reflow $ D.reflow $
"Is the type annotation missing something? Should some argument" "Is the type annotation missing something? Should some argument"
<> (if leftovers == 1 then "" else "s") <> (if leftovers == 1 then "" else "s")
<> " be deleted? Maybe some parentheses are missing?" <> " be deleted? Maybe some parentheses are missing?"
@ -187,20 +188,20 @@ toReport source err =
Report.Report "TOO FEW ARGS" region [] $ Report.Report "TOO FEW ARGS" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` " <> thing <> " was given " <> H.args actual <> ":" "The `" <> N.toString name <> "` " <> thing <> " was given " <> D.args actual <> ":"
, ,
H.reflow $ D.reflow $
"But it needs " <> H.args expected <> ". What is missing? Are some parentheses misplaced?" "But it needs " <> D.args expected <> ". What is missing? Are some parentheses misplaced?"
) )
else else
Report.Report "TOO MANY ARGS" region [] $ Report.Report "TOO MANY ARGS" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` " <> thing <> " needs " "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 if actual - expected == 1 then
"Which is the extra one? Maybe some parentheses are missing?" "Which is the extra one? Maybe some parentheses are missing?"
@ -212,10 +213,10 @@ toReport source err =
Report.Report "INFIX PROBLEM" region [] $ Report.Report "INFIX PROBLEM" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You cannot mix (" <> N.toString op1 <> ") and (" <> N.toString op2 <> ") without parentheses." "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!" "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.Report "EFFECT PROBLEM" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You have declared that `" ++ N.toString name ++ "` is an effect type:" "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!" "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.Report "EFFECT PROBLEM" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"This kind of effect module must define a `" ++ N.toString name ++ "` function." "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!" "But I cannot find `" ++ N.toString name ++ "` in this file!"
) )
@ -296,12 +297,12 @@ toReport source err =
Report.Report "REDUNDANT EXPORT" r2 [] $ Report.Report "REDUNDANT EXPORT" r2 [] $
Report.toCodePair source r1 r2 Report.toCodePair source r1 r2
( (
H.reflow messageThatEndsWithPunctuation D.reflow messageThatEndsWithPunctuation
, ,
"Remove one of them and you should be all set!" "Remove one of them and you should be all set!"
) )
( (
H.reflow (messageThatEndsWithPunctuation <> " Once here:") D.reflow (messageThatEndsWithPunctuation <> " Once here:")
, ,
"And again right here:" "And again right here:"
, ,
@ -312,27 +313,27 @@ toReport source err =
let let
suggestions = suggestions =
map N.toString $ take 4 $ map N.toString $ take 4 $
H.nearbyNames N.toString rawName possibleNames Suggest.nearbyNames N.toString rawName possibleNames
in in
Report.Report "UNKNOWN EXPORT" region suggestions $ Report.Report "UNKNOWN EXPORT" region suggestions $
let (a, thing, name) = toKindInfo kind rawName in let (a, thing, name) = toKindInfo kind rawName in
H.stack D.stack
[ H.fillSep [ D.fillSep
["You","are","trying","to","expose",a,thing,"named" ["You","are","trying","to","expose",a,thing,"named"
,name,"but","I","cannot","find","its","definition." ,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?" "I do not see any super similar names in this file. Is the definition missing?"
[alt] -> [alt] ->
H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"] D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"]
alts -> alts ->
H.stack D.stack
[ "These names seem close though:" [ "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.Report "BAD EXPORT" region [] $
Report.toCodeSnippet source region Nothing 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 `" "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"
++ N.toString name ++ "` though." ++ N.toString name ++ "` though."
, ,
H.reflow $ D.reflow $
"Remove the (..) and you should be fine!" "Remove the (..) and you should be fine!"
) )
@ -352,15 +353,15 @@ toReport source err =
Report.Report "BAD IMPORT" region [] $ Report.Report "BAD IMPORT" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You are trying to import the `" <> N.toString ctor "You are trying to import the `" <> N.toString ctor
<> "` type constructor by name:" <> "` type constructor by name:"
, ,
H.fillSep D.fillSep
["Try","importing",H.green (H.nameToDoc tipe <> "(..)"),"instead." ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead."
,"The","dots","mean","“expose","the",H.nameToDoc tipe,"type","and" ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and"
,"all","its","constructors”","so","it","gives","you","access","to" ,"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.Report "UNKNOWN IMPORT" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I could not find a `" <> N.toString name <> "` module to import!" "I could not find a `" <> N.toString name <> "` module to import!"
, ,
mempty mempty
@ -382,12 +383,12 @@ toReport source err =
Report.Report "BAD IMPORT" region [] $ Report.Report "BAD IMPORT" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` type alias cannot be followed by (..) like this:" "The `" <> N.toString name <> "` type alias cannot be followed by (..) like this:"
, ,
H.stack D.stack
[ "Remove the (..) and it should work." [ "Remove the (..) and it should work."
, H.link "Hint" , D.link "Hint"
"The distinction between `type` and `type alias` is important here. Read" "The distinction between `type` and `type alias` is important here. Read"
"types-vs-type-aliases" "types-vs-type-aliases"
"to learn more." "to learn more."
@ -398,27 +399,27 @@ toReport source err =
let let
suggestions = suggestions =
map N.toString $ take 4 $ map N.toString $ take 4 $
H.nearbyNames N.toString home possibleNames Suggest.nearbyNames N.toString home possibleNames
in in
Report.Report "BAD IMPORT" region suggestions $ Report.Report "BAD IMPORT" region suggestions $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString home "The `" <> N.toString home
<> "` module does not expose `" <> "` module does not expose `"
<> N.toString value <> "`:" <> 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?" "I cannot find any super similar exposed names. Maybe it is private?"
[alt] -> [alt] ->
H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"] D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"]
alts -> alts ->
H.stack D.stack
[ "These names seem close though:" [ "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.Report "UNKNOWN OPERATOR" region ["/="] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"Elm uses a different name for the “not equal” operator:" "Elm uses a different name for the “not equal” operator:"
, ,
H.stack D.stack
[ H.reflow "Switch to (/=) instead." [ D.reflow "Switch to (/=) instead."
, H.toSimpleNote $ , D.toSimpleNote $
"Our (/=) operator is supposed to look like a real “not equal” sign (≠). I hope that history will remember (" "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." ++ N.toString op ++ ") as a werid and temporary choice."
] ]
@ -460,10 +461,10 @@ toReport source err =
Report.Report "UNKNOWN OPERATOR" region ["^","*"] $ Report.Report "UNKNOWN OPERATOR" region ["^","*"] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I do not recognize the (**) operator:" "I do not recognize the (**) operator:"
, ,
H.reflow $ D.reflow $
"Switch to (^) for exponentiation. Or switch to (*) for multiplication." "Switch to (^) for exponentiation. Or switch to (*) for multiplication."
) )
@ -471,17 +472,17 @@ toReport source err =
Report.Report "UNKNOWN OPERATOR" region [] $ Report.Report "UNKNOWN OPERATOR" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"Elm does not use (%) as the remainder operator:" "Elm does not use (%) as the remainder operator:"
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"If you want the behavior of (%) like in JavaScript, switch to:\ "If you want the behavior of (%) like in JavaScript, switch to:\
\ <https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#remainderBy>" \ <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:\ "If you want modular arithmatic like in math, switch to:\
\ <https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#modBy>" \ <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." "The difference is how things work when negative numbers are involved."
] ]
) )
@ -490,37 +491,37 @@ toReport source err =
let let
suggestions = suggestions =
map N.toString $ take 2 $ map N.toString $ take 2 $
H.nearbyNames N.toString op (Set.toList locals) Suggest.nearbyNames N.toString op (Set.toList locals)
format altOp = format altOp =
H.green $ "(" <> altOp <> ")" D.green $ "(" <> altOp <> ")"
in in
Report.Report "UNKNOWN OPERATOR" region suggestions $ Report.Report "UNKNOWN OPERATOR" region suggestions $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I do not recognize the (" ++ N.toString op ++ ") operator." "I do not recognize the (" ++ N.toString op ++ ") operator."
, ,
H.fillSep $ D.fillSep $
["Is","there","an","`import`","and","`exposing`","entry","for","it?"] ["Is","there","an","`import`","and","`exposing`","entry","for","it?"]
++ ++
case map H.text suggestions of case map D.fromString suggestions of
[] -> [] ->
[] []
alts -> alts ->
["Maybe","you","want"] ++ H.commaSep "or" format alts ++ ["instead?"] ["Maybe","you","want"] ++ D.commaSep "or" format alts ++ ["instead?"]
) )
PatternHasRecordCtor region name -> PatternHasRecordCtor region name ->
Report.Report "BAD PATTERN" region [] $ Report.Report "BAD PATTERN" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You can construct records by using `" <> N.toString name "You can construct records by using `" <> N.toString name
<> "` as a function, but it is not available in pattern matching like this:" <> "` 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." "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.Report "PORT ERROR" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString portName <> "` port is trying to transmit " <> aBadKindOfThing <> ":" "The `" <> N.toString portName <> "` port is trying to transmit " <> aBadKindOfThing <> ":"
, ,
H.stack D.stack
[ elaboration [ elaboration
, H.link "Hint" , D.link "Hint"
"Ports are not a traditional FFI, so if you have tons of annoying ports, definitely read" "Ports are not a traditional FFI, so if you have tons of annoying ports, definitely read"
"ports" "ports"
"to learn how they are meant to work. They require a different mindset!" "to learn how they are meant to work. They require a different mindset!"
@ -548,7 +549,7 @@ toReport source err =
( (
"an extended record" "an extended record"
, ,
H.reflow $ D.reflow $
"But the exact shape of the record must be known at compile time. No type variables!" "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" "a function"
, ,
H.reflow $ D.reflow $
"But functions cannot be sent in and out ports. If we allowed functions in from JS\ "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\ \ 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." \ incorrect results because Elm optimizations assume there are no side-effects."
@ -567,7 +568,7 @@ toReport source err =
( (
"an unspecified type" "an unspecified type"
, ,
H.reflow $ D.reflow $
"But type variables like `" <> N.toString name <> "` cannot flow through ports.\ "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\ \ 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." \ unexpected data cannot sneak in and crash the Elm program."
@ -577,13 +578,13 @@ toReport source err =
( (
"a `" <> N.toString name <> "` value" "a `" <> N.toString name <> "` value"
, ,
H.stack D.stack
[ H.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:" [ D.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:"
, H.indent 4 $ , D.indent 4 $
H.reflow $ D.reflow $
"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
\ tuples, records, and JSON values." \ tuples, records, and JSON values."
, H.reflow $ , D.reflow $
"Since JSON values can flow through, you can use JSON encoders and decoders\ "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\ \ to allow other types through as well. More advanced users often just do\
\ everything with encoders and decoders for more control and better errors." \ everything with encoders and decoders for more control and better errors."
@ -596,11 +597,11 @@ toReport source err =
Report.Report "BAD PORT" region [] $ Report.Report "BAD PORT" region [] $
Report.toCodeSnippet source region Nothing $ Report.toCodeSnippet source region Nothing $
( (
H.reflow before D.reflow before
, ,
H.stack D.stack
[ after [ 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!" "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." "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\ "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." \ 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" | n == 3 = "these " ++ show n ++ " items into a tuple or record"
| True = "these " ++ show n ++ " items into a record" | True = "these " ++ show n ++ " items into a record"
in in
H.reflow $ D.reflow $
"You can put " ++ theseItemsInSomething ++ " to send them out though." "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." "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\ "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\ \ variable. The command will trigger some JS code, but it will not send\
\ anything particular back to Elm." \ anything particular back to Elm."
@ -643,12 +644,12 @@ toReport source err =
SubBad -> SubBad ->
( "There is something off about this `" <> N.toString name <> "` port declaration." ( "There is something off about this `" <> N.toString name <> "` port declaration."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"To receive messages from JavaScript, you need to define a port like this:" "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" "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`.\ "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`\ \ 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." \ 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." "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\ "Ports need to produce a command (Cmd) or a subscription (Sub) but\
\ this is neither. I do not know how to handle this." \ this is neither. I do not know how to handle this."
) )
@ -675,7 +676,7 @@ toReport source err =
Can.TypedDef name _ _ _ _ -> name Can.TypedDef name _ _ _ _ -> name
makeTheory question details = 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 in
case map toName cyclicValueDefs of case map toName cyclicValueDefs of
[] -> [] ->
@ -690,10 +691,10 @@ toReport source err =
case map A.toValue otherNames of 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." "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?" $ [ makeTheory "Are you are trying to mutate a variable?" $
"Elm does not have mutation, so when I see " ++ N.toString name "Elm does not have mutation, so when I see " ++ N.toString name
++ " defined in terms of " ++ 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 "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. Wait, but now we need to know what " ++ N.toString name
++ " is, so let’s expand it... This will keep going infinitely!" ++ " 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" "The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion" "bad-recursion"
"for more detailed advice, especially if you actually do need a recursive value." "for more detailed advice, especially if you actually do need a recursive value."
@ -711,15 +712,15 @@ toReport source err =
names -> names ->
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` definition is causing a very tricky infinite loop." "The `" <> N.toString name <> "` definition is causing a very tricky infinite loop."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"The `" <> N.toString name "The `" <> N.toString name
<> "` value depends on itself through the following chain of definitions:" <> "` value depends on itself through the following chain of definitions:"
, H.indent 4 $ H.drawCycle (name:names) , D.cycle 4 (name:names)
, H.link "Hint" , D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading" "The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion" "bad-recursion"
"for more detailed advice, especially if you actually do want mutually recursive values." "for more detailed advice, especially if you actually do want mutually recursive values."
@ -733,13 +734,13 @@ toReport source err =
[] -> [] ->
let let
makeTheory question details = 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 in
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` value is defined directly in terms of itself, causing an infinite loop." "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?" $ [ makeTheory "Are you are trying to mutate a variable?" $
"Elm does not have mutation, so when I see " ++ N.toString name "Elm does not have mutation, so when I see " ++ N.toString name
++ " defined in terms of " ++ 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 "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. Wait, but now we need to know what " ++ N.toString name
++ " is, so let’s expand it... This will keep going infinitely!" ++ " 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" "The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion" "bad-recursion"
"for more detailed advice, especially if you actually do need a recursive value." "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." "I do not allow cyclic values in `let` expressions."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"The `" <> N.toString name "The `" <> N.toString name
<> "` value depends on itself through the following chain of definitions:" <> "` value depends on itself through the following chain of definitions:"
, H.indent 4 $ H.drawCycle (name:names) , D.cycle 4 (name:names)
, H.link "Hint" , D.link "Hint"
"The root problem is often a typo in some variable name, but I recommend reading" "The root problem is often a typo in some variable name, but I recommend reading"
"bad-recursion" "bad-recursion"
"for more detailed advice, especially if you actually do want mutually recursive values." "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:" ( "These variables cannot have the same name:"
, advice , 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:" , "But then it is defined AGAIN over here:"
, advice , advice
) )
where where
advice = advice =
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Think of a more helpful name for one of them and you should be all set!" "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" "Linters advise against shadowing, so Elm makes “best practices” the default. Read"
"shadowing" "shadowing"
"for more details on this choice." "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:" "I only accept tuples with two or three items. This has too many:"
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"I recommend switching to records. Each item will be named, and you can use\ "I recommend switching to records. Each item will be named, and you can use\
\ the `point.x` syntax to access them." \ 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." "for more comprehensive advice on working with large chunks of data in Elm."
] ]
@ -818,7 +819,7 @@ toReport source err =
(unused:unuseds, []) -> (unused:unuseds, []) ->
let let
backQuote name = backQuote name =
"`" <> H.nameToDoc name <> "`" "`" <> D.fromName name <> "`"
allUnusedNames = allUnusedNames =
map fst unusedVars map fst unusedVars
@ -831,31 +832,31 @@ toReport source err =
, ["Type","alias",backQuote typeName,"does","not","use","the" , ["Type","alias",backQuote typeName,"does","not","use","the"
,backQuote (fst unused),"type","variable." ,backQuote (fst unused),"type","variable."
] ]
, [H.dullyellow (backQuote (fst unused))] , [D.dullyellow (backQuote (fst unused))]
) )
_:_ -> _:_ ->
( "UNUSED TYPE VARIABLES" ( "UNUSED TYPE VARIABLES"
, Nothing , Nothing
, ["Type","variables"] , ["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."] ++ ["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 in
Report.Report title aliasRegion [] $ Report.Report title aliasRegion [] $
Report.toCodeSnippet source aliasRegion subRegion Report.toCodeSnippet source aliasRegion subRegion
( (
H.fillSep overview D.fillSep overview
, ,
H.stack D.stack
[ H.fillSep $ [ D.fillSep $
["I","recommend","removing"] ++ stuff ++ ["from","the","declaration,","like","this:"] ["I","recommend","removing"] ++ stuff ++ ["from","the","declaration,","like","this:"]
, H.indent 4 $ H.hsep $ , D.indent 4 $ D.hsep $
["type","alias",H.green (H.nameToDoc typeName)] ["type","alias",D.green (D.fromName typeName)]
++ map H.nameToDoc (filter (`notElem` allUnusedNames) allVars) ++ 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\ "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`\ \ 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!" \ the same as `Height Int`? My solution is to not need to ask them!"
@ -873,43 +874,43 @@ toReport source err =
theseAreUsed = theseAreUsed =
case unbound of case unbound of
[x] -> [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." ,"in","the","definition,","but","I","do","not","see","it","declared."
] ]
_ -> _ ->
["Type","variables"] ["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."] ++ ["are","used","in","the","definition,","but","I","do","not","see","them","declared."]
butTheseAreUnused = butTheseAreUnused =
case unused of case unused of
[x] -> [x] ->
["Likewise,","type","variable" ["Likewise,","type","variable"
,H.dullyellow ("`" <> H.nameToDoc x <> "`") ,D.dullyellow ("`" <> D.fromName x <> "`")
,"is","delared,","but","not","used." ,"is","delared,","but","not","used."
] ]
_ -> _ ->
["Likewise,","type","variables"] ["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."] ++ ["are","delared,","but","not","used."]
in in
Report.Report "TYPE VARIABLE PROBLEMS" aliasRegion [] $ Report.Report "TYPE VARIABLE PROBLEMS" aliasRegion [] $
Report.toCodeSnippet source aliasRegion Nothing Report.toCodeSnippet source aliasRegion Nothing
( (
H.reflow $ D.reflow $
"Type alias `" <> N.toString typeName <> "` has some type variable problems." "Type alias `" <> N.toString typeName <> "` has some type variable problems."
, ,
H.stack D.stack
[ H.fillSep $ theseAreUsed ++ butTheseAreUnused [ D.fillSep $ theseAreUsed ++ butTheseAreUnused
, H.reflow $ , D.reflow $
"My guess is that a definition like this will work better:" "My guess is that a definition like this will work better:"
, H.indent 4 $ H.hsep $ , D.indent 4 $ D.hsep $
["type", "alias", H.nameToDoc typeName] ["type", "alias", D.fromName typeName]
++ map H.nameToDoc (filter (`notElem` unused) allVars) ++ map D.fromName (filter (`notElem` unused) allVars)
++ map (H.green . H.nameToDoc) unbound ++ map (D.green . D.fromName) unbound
++ ["=", "..."] ++ ["=", "..."]
] ]
) )
@ -919,11 +920,11 @@ toReport source err =
-- BAD TYPE VARIABLES -- 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 = unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion) unboundVars =
let let
backQuote name = backQuote name =
"`" <> H.nameToDoc name <> "`" "`" <> D.fromName name <> "`"
(title, subRegion, overview) = (title, subRegion, overview) =
case map fst unboundVars of case map fst unboundVars of
@ -932,32 +933,32 @@ unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion)
, Just varRegion , Just varRegion
, ["The",backQuote typeName] , ["The",backQuote typeName]
++ tipe ++ 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 -> vars ->
( "UNBOUND TYPE VARIABLES" ( "UNBOUND TYPE VARIABLES"
, Nothing , Nothing
, ["Type","variables"] , ["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:"] ++ ["are","unbound","in","the",backQuote typeName] ++ tipe ++ ["definition:"]
) )
in in
Report.Report title declRegion [] $ Report.Report title declRegion [] $
Report.toCodeSnippet source declRegion subRegion Report.toCodeSnippet source declRegion subRegion
( (
H.fillSep overview D.fillSep overview
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"You probably need to change the declaration to something like this:" "You probably need to change the declaration to something like this:"
, H.indent 4 $ H.hsep $ , D.indent 4 $ D.hsep $
tipe tipe
++ [H.nameToDoc typeName] ++ [D.fromName typeName]
++ map H.nameToDoc allVars ++ map D.fromName allVars
++ map (H.green . H.nameToDoc) (unboundVar : map fst unboundVars) ++ map (D.green . D.fromName) (unboundVar : map fst unboundVars)
++ ["=", "..."] ++ ["=", "..."]
, H.reflow $ , D.reflow $
"Why? Well, imagine one `" ++ N.toString typeName ++ "` where `" ++ N.toString unboundVar ++ "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\ "` 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." \ 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.Report "NAME CLASH" r2 [] $
Report.toCodePair source r1 r2 Report.toCodePair source r1 r2
( (
H.reflow messageThatEndsWithPunctuation D.reflow messageThatEndsWithPunctuation
, ,
"How can I know which one you want? Rename one of them!" "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:" "And another one here:"
, ,
@ -999,20 +1000,20 @@ ambiguousName source region maybePrefix name possibleHomes thing =
Nothing -> Nothing ->
let let
homeToYellowDoc (ModuleName.Canonical _ home) = homeToYellowDoc (ModuleName.Canonical _ home) =
H.dullyellow (H.nameToDoc home) D.dullyellow (D.fromName home)
bothOrAll = bothOrAll =
if length possibleHomes == 2 then "both" else "all" if length possibleHomes == 2 then "both" else "all"
in in
( (
H.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous." D.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Check your imports. The following modules " ++ bothOrAll "Check your imports. The following modules " ++ bothOrAll
++ " expose a `" ++ N.toString name ++ "` " ++ thing ++ ":" ++ " expose a `" ++ N.toString name ++ "` " ++ thing ++ ":"
, H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes
, H.reflowLink "Read" "imports" "to learn how to clarify which one you want." , 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 let
homeToYellowDoc (ModuleName.Canonical _ home) = homeToYellowDoc (ModuleName.Canonical _ home) =
if prefix == home then if prefix == home then
H.blue "import" <+> H.dullyellow (H.nameToDoc home) D.blue "import" <+> D.dullyellow (D.fromName home)
else 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 = eitherOrAny =
if length possibleHomes == 2 then "either" else "any" if length possibleHomes == 2 then "either" else "any"
in in
( (
H.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous." D.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"It could refer to a " ++ thing ++ " from " "It could refer to a " ++ thing ++ " from "
++ eitherOrAny ++ " of these imports:" ++ eitherOrAny ++ " of these imports:"
, H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes
, H.reflowLink "Read" "imports" "to learn how to clarify which one you want." , 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 Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals
nearbyNames = nearbyNames =
take 4 (H.nearbyNames id givenName possibleNames) take 4 (Suggest.nearbyNames id givenName possibleNames)
toDetails noSuggestionDetails yesSuggestionDetails = toDetails noSuggestionDetails yesSuggestionDetails =
case nearbyNames of case nearbyNames of
[] -> [] ->
H.stack D.stack
[ H.reflow noSuggestionDetails [ D.reflow noSuggestionDetails
, H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
] ]
suggestions -> suggestions ->
H.stack D.stack
[ H.reflow yesSuggestionDetails [ D.reflow yesSuggestionDetails
, H.indent 4 $ H.vcat $ map H.dullyellow $ map H.text suggestions , D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromString suggestions
, H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm."
] ]
in in
Report.Report "NAMING ERROR" region nearbyNames $ Report.Report "NAMING ERROR" region nearbyNames $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I cannot find a `" ++ givenName ++ "` " ++ thing ++ ":" "I cannot find a `" ++ givenName ++ "` " ++ thing ++ ":"
, ,
case maybePrefix of case maybePrefix of
@ -1115,20 +1116,20 @@ varErrorToReport :: VarError -> Report.Report
varErrorToReport (VarError kind name problem suggestions) = varErrorToReport (VarError kind name problem suggestions) =
let let
learnMore orMaybe = learnMore orMaybe =
H.reflow $ D.reflow $
orMaybe <> " `import` works different than you expect? Learn all about it here: " orMaybe <> " `import` works different than you expect? Learn all about it here: "
<> H.hintLink "imports" <> D.hintLink "imports"
namingError overview maybeStarter specializedSuggestions = namingError overview maybeStarter specializedSuggestions =
Report.reportDoc "NAMING ERROR" Nothing overview $ Report.reportDoc "NAMING ERROR" Nothing overview $
case H.maybeYouWant' maybeStarter specializedSuggestions of case D.maybeYouWant' maybeStarter specializedSuggestions of
Nothing -> Nothing ->
learnMore "Maybe" learnMore "Maybe"
Just doc -> Just doc ->
H.stack [ doc, learnMore "Or maybe" ] D.stack [ doc, learnMore "Or maybe" ]
specialNamingError specialHint = 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 in
case problem of case problem of
Ambiguous -> Ambiguous ->
@ -1158,35 +1159,35 @@ varErrorToReport (VarError kind name problem suggestions) =
cannotFind :: VarKind -> Text -> [Doc] cannotFind :: VarKind -> Text -> [Doc]
cannotFind kind rawName = cannotFind kind rawName =
let ( a, thing, name ) = toKindInfo kind rawName in 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 :: VarKind -> Text -> [Doc]
ambiguous kind rawName = ambiguous kind rawName =
let ( _a, thing, name ) = toKindInfo kind rawName in 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 :: Text -> [Doc]
notEqualsHint op = notEqualsHint op =
[ "Looking", "for", "the", "“not", "equal”", "operator?", "The", "traditional" [ "Looking", "for", "the", "“not", "equal”", "operator?", "The", "traditional"
, H.dullyellow $ text $ "(" <> op <> ")" , D.dullyellow $ text $ "(" <> op <> ")"
, "is", "replaced", "by", H.green "(/=)", "in", "Elm.", "It", "is", "meant" , "is", "replaced", "by", D.green "(/=)", "in", "Elm.", "It", "is", "meant"
, "to", "look", "like", "the", "“not", "equal”", "sign", "from", "math!", "(≠)" , "to", "look", "like", "the", "“not", "equal”", "sign", "from", "math!", "(≠)"
] ]
equalsHint :: [Doc] equalsHint :: [Doc]
equalsHint = equalsHint =
[ "A", "special", H.dullyellow "(===)", "operator", "is", "not", "needed" [ "A", "special", D.dullyellow "(===)", "operator", "is", "not", "needed"
, "in", "Elm.", "We", "use", H.green "(==)", "for", "everything!" , "in", "Elm.", "We", "use", D.green "(==)", "for", "everything!"
] ]
modHint :: [Doc] modHint :: [Doc]
modHint = modHint =
[ "Rather", "than", "a", H.dullyellow "(%)", "operator," [ "Rather", "than", "a", D.dullyellow "(%)", "operator,"
, "Elm", "has", "a", H.green "modBy", "function." , "Elm", "has", "a", D.green "modBy", "function."
, "Learn", "more", "here:" , "Learn", "more", "here:"
, "<https://package.elm-lang.org/packages/elm-lang/core/latest/Basics#modBy>" , "<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.Report (map Char.toUpper numArgs) region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
kind <> " " <> N.toString name <> " has " <> numArgs <> "." kind <> " " <> N.toString name <> " has " <> numArgs <> "."
, ,
H.reflow $ D.reflow $
"Expecting " <> show expected <> ", but got " <> show actual <> "." "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!" "This type alias is recursive, forming an infinite type!"
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"When I expand a recursive type alias, it just keeps getting bigger and bigger.\ "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:" \ So dealiasing results in an infinitely large type! Try this instead:"
, H.indent 4 $ , D.indent 4 $
aliasToUnionDoc name args tipe 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" "This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading"
"recursive-alias" "recursive-alias"
"for ideas on how to do better." "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." "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:" [ "It is part of this cycle of type aliases:"
, H.indent 4 (H.drawCycle (name:others)) , D.cycle 4 (name:others)
, H.reflow $ , D.reflow $
"You need to convert at least one of these type aliases into a `type`." "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!" "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 :: N.Name -> [N.Name] -> Src.Type -> Doc
aliasToUnionDoc name args tipe = aliasToUnionDoc name args tipe =
H.vcat D.vcat
[ H.dullyellow $ [ D.dullyellow $
"type" <+> H.nameToDoc name <+> (foldr (<+>) "=" (map H.nameToDoc args)) "type" <+> D.fromName name <+> (foldr (<+>) "=" (map D.fromName args))
, H.green $ , D.green $
H.indent 4 (H.nameToDoc name) D.indent 4 (D.fromName name)
, H.dullyellow $ , D.dullyellow $
H.indent 8 (RT.srcToDoc RT.App tipe) 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 qualified Elm.Name as N
import Reporting.Helpers ((<>)) import Reporting.Doc ((<>))
import qualified Reporting.Helpers as H import qualified Reporting.Doc as D
import qualified Reporting.Region as R import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
@ -35,24 +35,24 @@ toReport source err =
case err of case err of
NoDocs region -> NoDocs region ->
Report.Report "NO DOCS" region [] $ Report.Report "NO DOCS" region [] $
H.stack D.stack
[ [
H.reflow $ D.reflow $
"You must have a documentation comment between the module\ "You must have a documentation comment between the module\
\ declaration and the imports." \ declaration and the imports."
, ,
H.reflow D.reflow
"Learn more at <http://package.elm-lang.org/help/documentation-format>" "Learn more at <http://package.elm-lang.org/help/documentation-format>"
] ]
ImplicitExposing region -> ImplicitExposing region ->
Report.Report "IMPLICIT EXPOSING" 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:" "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\ "A great API usually hides some implementation details, so it is rare that\
\ everything in the file should be exposed. And requiring package authors\ \ 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\ \ 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.Report "DUPLICATE DOCS" r2 [] $
Report.toCodePair source r1 r2 Report.toCodePair source r1 r2
( (
H.reflow $ D.reflow $
"There can only be one `" <> N.toString name "There can only be one `" <> N.toString name
<> "` in your module documentation, but it is listed twice:" <> "` in your module documentation, but it is listed twice:"
, ,
"Remove one of them!" "Remove one of them!"
) )
( (
H.reflow $ D.reflow $
"There can only be one `" <> N.toString name "There can only be one `" <> N.toString name
<> "` in your module documentation, but I see two. One here:" <> "` in your module documentation, but I see two. One here:"
, ,
@ -84,11 +84,11 @@ toReport source err =
Report.Report "DOCS MISTAKE" region [] $ Report.Report "DOCS MISTAKE" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I do not see `" <> N.toString name "I do not see `" <> N.toString name
<> "` in the `exposing` list, but it is in your module documentation:" <> "` 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 `" "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?" <> N.toString name <> "` and forgot to delete it here?"
) )
@ -97,15 +97,15 @@ toReport source err =
Report.Report "DOCS MISTAKE" region [] $ Report.Report "DOCS MISTAKE" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I do not see `" <> N.toString name "I do not see `" <> N.toString name
<> "` in your module documentation, but it is in your `exposing` list:" <> "` in your module documentation, but it is in your `exposing` list:"
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Add a line like `@docs " <> N.toString name "Add a line like `@docs " <> N.toString name
<> "` to your module documentation!" <> "` 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.Report "NO DOCS" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` definition does not have a documentation comment." "The `" <> N.toString name <> "` definition does not have a documentation comment."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Add documentation with nice examples of how to use it!" "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.Report "NO TYPE ANNOTATION" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"The `" <> N.toString name <> "` definition does not have a type annotation." "The `" <> N.toString name <> "` definition does not have a type annotation."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"I use the type variable names from your annotations when generating docs. So if\ "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\ \ 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!" \ 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 AST.Canonical as Can
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Error.Canonicalize as E import qualified Reporting.Error.Canonicalize as E
import qualified Reporting.Helpers as H
import qualified Reporting.Region as R import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT import qualified Reporting.Render.Type as RT
@ -40,10 +40,10 @@ toReport source err =
( (
"I cannot handle this type of `main` value:" "I cannot handle this type of `main` value:"
, ,
H.stack D.stack
[ "The type of `main` value I am seeing is:" [ "The type of `main` value I am seeing is:"
, H.indent 4 $ H.dullyellow $ RT.canToDoc RT.None tipe , D.indent 4 $ D.dullyellow $ RT.canToDoc RT.None tipe
, H.reflow $ , D.reflow $
"I only know how to handle Html, Svg, and Programs\ "I only know how to handle Html, Svg, and Programs\
\ though. Modify `main` to be one of those types of values!" \ 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." "A `main` definition cannot be defined in terms of itself."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"It should be a boring value with no recursion. But\ "It should be a boring value with no recursion. But\
\ instead it is involved in this cycle of definitions:" \ 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.Report "BAD FLAGS" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"Your `main` program wants " ++ aBadKindOfThing ++ " from JavaScript." "Your `main` program wants " ++ aBadKindOfThing ++ " from JavaScript."
, ,
butThatIsNoGood butThatIsNoGood
@ -81,7 +81,7 @@ toReport source err =
( (
"an extended record" "an extended record"
, ,
H.reflow $ D.reflow $
"But the exact shape of the record must be known at compile time. No type variables!" "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" "a function"
, ,
H.reflow $ D.reflow $
"But if I allowed functions from JS, it would be possible to sneak\ "But if I allowed functions from JS, it would be possible to sneak\
\ side-effects and runtime exceptions into Elm!" \ side-effects and runtime exceptions into Elm!"
) )
@ -98,7 +98,7 @@ toReport source err =
( (
"an unspecified type" "an unspecified type"
, ,
H.reflow $ D.reflow $
"But type variables like `" ++ N.toString name ++ "` cannot be given as flags.\ "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\ \ 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." \ unexpected data cannot sneak in and crash the Elm program."
@ -108,13 +108,13 @@ toReport source err =
( (
"a `" ++ N.toString name ++ "` value" "a `" ++ N.toString name ++ "` value"
, ,
H.stack D.stack
[ H.reflow $ "I cannot handle that. The types that CAN be in flags include:" [ D.reflow $ "I cannot handle that. The types that CAN be in flags include:"
, H.indent 4 $ , D.indent 4 $
H.reflow $ D.reflow $
"Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\
\ tuples, records, and JSON values." \ tuples, records, and JSON values."
, H.reflow $ , D.reflow $
"Since JSON values can flow through, you can use JSON encoders and decoders\ "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\ \ to allow other types through as well. More advanced users often just do\
\ everything with encoders and decoders for more control and better errors." \ 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 Data.List as List
import qualified Nitpick.PatternMatches as P import qualified Nitpick.PatternMatches as P
import Reporting.Doc ((<>))
import qualified Reporting.Doc as D
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
import qualified Reporting.Render.Code as Code 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.Report "REDUNDANT PATTERN" patternRegion [] $
Report.toCodeSnippet source caseRegion (Just patternRegion) Report.toCodeSnippet source caseRegion (Just patternRegion)
( (
H.reflow $ D.reflow $
"The " <> H.ordinalize index <> " pattern is redundant:" "The " <> D.ordinalize index <> " pattern is redundant:"
, ,
H.reflow $ D.reflow $
"Any value with this shape will be handled by a previous\ "Any value with this shape will be handled by a previous\
\ pattern, so it should be removed." \ pattern, so it should be removed."
) )
@ -42,10 +42,10 @@ toReport source err =
( (
"This pattern does not cover all possiblities:" "This pattern does not cover all possiblities:"
, ,
H.stack D.stack
[ "Other possibilities include:" [ "Other possibilities include:"
, unhandledPatternsToDocBlock unhandled , unhandledPatternsToDocBlock unhandled
, H.reflow $ , D.reflow $
"I would have to crash if I saw one of those! So rather than\ "I would have to crash if I saw one of those! So rather than\
\ pattern matching in function arguments, put a `case` in\ \ pattern matching in function arguments, put a `case` in\
\ the function body to account for all possibilities." \ the function body to account for all possibilities."
@ -58,14 +58,14 @@ toReport source err =
( (
"This pattern does not cover all possible values:" "This pattern does not cover all possible values:"
, ,
H.stack D.stack
[ "Other possibilities include:" [ "Other possibilities include:"
, unhandledPatternsToDocBlock unhandled , unhandledPatternsToDocBlock unhandled
, H.reflow $ , D.reflow $
"I would have to crash if I saw one of those! You can use\ "I would have to crash if I saw one of those! You can use\
\ `let` to deconstruct values only if there is ONE possiblity.\ \ `let` to deconstruct values only if there is ONE possiblity.\
\ Switch to a `case` expression to account for all possibilities." \ Switch to a `case` expression to account for all possibilities."
, H.toSimpleHint $ , D.toSimpleHint $
"Are you calling a function that definitely returns values\ "Are you calling a function that definitely returns values\
\ with a very specific shape? Try making the return type of\ \ with a very specific shape? Try making the return type of\
\ that function more specific!" \ that function more specific!"
@ -78,12 +78,12 @@ toReport source err =
( (
"This `case` does not have branches for all possibilities:" "This `case` does not have branches for all possibilities:"
, ,
H.stack D.stack
[ "Missing possibilities include:" [ "Missing possibilities include:"
, unhandledPatternsToDocBlock unhandled , unhandledPatternsToDocBlock unhandled
, H.reflow $ , D.reflow $
"I would have to crash if I saw one of those. Add branches for them!" "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" "If you want to write the code for each branch later, use `Debug.todo` as a placeholder. Read"
"missing-patterns" "missing-patterns"
"for more guidance on this workflow." "for more guidance on this workflow."
@ -95,9 +95,9 @@ toReport source err =
-- PATTERN TO DOC -- PATTERN TO DOC
unhandledPatternsToDocBlock :: [P.Pattern] -> H.Doc unhandledPatternsToDocBlock :: [P.Pattern] -> D.Doc
unhandledPatternsToDocBlock unhandledPatterns = unhandledPatternsToDocBlock unhandledPatterns =
H.indent 4 $ H.dullyellow $ H.vcat $ D.indent 4 $ D.dullyellow $ D.vcat $
map (patternToDoc Unambiguous) unhandledPatterns map (patternToDoc Unambiguous) unhandledPatterns
@ -108,7 +108,7 @@ data Context
deriving (Eq) deriving (Eq)
patternToDoc :: Context -> P.Pattern -> H.Doc patternToDoc :: Context -> P.Pattern -> D.Doc
patternToDoc context pattern = patternToDoc context pattern =
case delist pattern [] of case delist pattern [] of
NonList P.Anything -> NonList P.Anything ->
@ -117,13 +117,13 @@ patternToDoc context pattern =
NonList (P.Literal literal) -> NonList (P.Literal literal) ->
case literal of case literal of
P.Chr chr -> P.Chr chr ->
H.textToDoc ("'" <> chr <> "'") D.fromText ("'" <> chr <> "'")
P.Str str -> P.Str str ->
H.textToDoc ("\"" <> str <> "\"") D.fromText ("\"" <> str <> "\"")
P.Int int -> P.Int int ->
H.text (show int) D.fromString (show int)
NonList (P.Ctor _ "#0" []) -> NonList (P.Ctor _ "#0" []) ->
"()" "()"
@ -142,7 +142,7 @@ patternToDoc context pattern =
NonList (P.Ctor _ name args) -> NonList (P.Ctor _ name args) ->
let let
ctorDoc = ctorDoc =
H.hsep (H.nameToDoc name : map (patternToDoc Arg) args) D.hsep (D.fromName name : map (patternToDoc Arg) args)
in in
if context == Arg && length args > 0 then if context == Arg && length args > 0 then
"(" <> ctorDoc <> ")" "(" <> ctorDoc <> ")"
@ -154,7 +154,7 @@ patternToDoc context pattern =
FiniteList entries -> FiniteList entries ->
let entryDocs = map (patternToDoc Unambiguous) entries in let entryDocs = map (patternToDoc Unambiguous) entries in
"[" <> H.hcat (List.intersperse "," entryDocs) <> "]" "[" <> D.hcat (List.intersperse "," entryDocs) <> "]"
Conses conses finalPattern -> Conses conses finalPattern ->
let 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 Data.Text as Text
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Region as R import qualified Reporting.Region as R
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Report as Report 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." "This documentation comment is not followed by anything."
, ,
H.reflow $ D.reflow $
"All documentation comments need to be right above the declaration they\ "All documentation comments need to be right above the declaration they\
\ describe. Maybe some code got deleted or commented out by accident? Or\ \ describe. Maybe some code got deleted or commented out by accident? Or\
\ maybe this comment is here by accident?" \ maybe this comment is here by accident?"
@ -154,12 +154,12 @@ toReport source err =
Report.Report "BAD PORT" region [] $ Report.Report "BAD PORT" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You are declaring port `" <> N.toString name <> "` in a normal module." "You are declaring port `" <> N.toString name <> "` in a normal module."
, ,
H.stack D.stack
[ "It needs to be in a `port` module." [ "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 are not a traditional FFI for calling JS functions directly. They need a different mindset! Read"
"ports" "ports"
"to learn how to use ports effectively." "to learn how to use ports effectively."
@ -170,17 +170,17 @@ toReport source err =
Report.Report "ANNOTATION MISMATCH" region [] $ Report.Report "ANNOTATION MISMATCH" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"I see a `" <> N.toString annName "I see a `" <> N.toString annName
<> "` annotation, but it is followed by a `" <> "` annotation, but it is followed by a `"
<> N.toString defName <> "` definition." <> N.toString defName <> "` definition."
, ,
H.fillSep D.fillSep
["The","annotation","and","definition","names","must","match!" ["The","annotation","and","definition","names","must","match!"
,"Is","there","a","typo","between" ,"Is","there","a","typo","between"
, H.dullyellow (H.nameToDoc annName) , D.dullyellow (D.fromName annName)
,"and" ,"and"
, H.dullyellow (H.nameToDoc defName) <> "?" , D.dullyellow (D.fromName defName) <> "?"
] ]
) )
@ -188,12 +188,12 @@ toReport source err =
Report.Report "MISSING DEFINITION" region [] $ Report.Report "MISSING DEFINITION" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"There is a type annotation for `" <> N.toString name "There is a type annotation for `" <> N.toString name
<> "` but there is no corresponding definition!" <> "` but there is no corresponding definition!"
, ,
"Directly below the type annotation, put a definition like:\n\n" "Directly below the type annotation, put a definition like:\n\n"
<> " " <> H.nameToDoc name <> " = 42" <> " " <> D.fromName name <> " = 42"
) )
Parse region subRegion problem -> Parse region subRegion problem ->
@ -206,7 +206,7 @@ toReport source err =
-- PARSE ERROR TO DOCS -- PARSE ERROR TO DOCS
problemToDocs :: Problem -> (H.Doc, H.Doc) problemToDocs :: Problem -> (D.Doc, D.Doc)
problemToDocs problem = problemToDocs problem =
case problem of case problem of
Tab -> Tab ->
@ -220,11 +220,11 @@ problemToDocs problem =
( (
"I got to the end of the file while parsing a multi-line comment." "I got to the end of the file while parsing a multi-line comment."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Multi-line comments look like {- comment -}, and it looks like\ "Multi-line comments look like {- comment -}, and it looks like\
\ you are missing the closing marker." \ you are missing the closing marker."
, H.toSimpleHint $ , D.toSimpleHint $
"Nested multi-line comments like {- this {- and this -} -} are allowed.\ "Nested multi-line comments like {- this {- and this -} -} are allowed.\
\ The opening and closing markers must be balanced though, just\ \ The opening and closing markers must be balanced though, just\
\ like parentheses in normal code. Maybe that is the problem?" \ 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." "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| ... |]" "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." "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.\ "Strings look like \"this\" with double quotes on each end.\
\ Is the closing double quote missing in your code?" \ 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." "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\ "Multi-line strings look like \"\"\"this\"\"\" with three double quotes on each\
\ end. Is the closing triple quote missing in your code?" \ 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." "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.\ "Characters look like 'c' with single quotes on each end.\
\ Is the closing single quote missing in your code?" \ Is the closing single quote missing in your code?"
) )
@ -270,10 +270,10 @@ problemToDocs problem =
( (
"This string is missing the closing quote." "This string is missing the closing quote."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Elm strings like \"this\" cannot contain newlines." "Elm strings like \"this\" cannot contain newlines."
, H.toSimpleHint $ , D.toSimpleHint $
"For strings that CAN contain newlines, say \"\"\"this\"\"\" for Elm’s\ "For strings that CAN contain newlines, say \"\"\"this\"\"\" for Elm’s\
\ multi-line string syntax. It allows unescaped newlines and double quotes." \ multi-line string syntax. It allows unescaped newlines and double quotes."
] ]
@ -292,10 +292,10 @@ problemToDocs problem =
UnknownEscape -> UnknownEscape ->
( (
"Backslashes always start escaped characters, but I do not recognize this one:" "Backslashes always start escaped characters, but I do not recognize this one:"
, H.stack , D.stack
[ "Maybe there is some typo?" [ "Maybe there is some typo?"
, H.toSimpleHint "Valid escape characters include:" , D.toSimpleHint "Valid escape characters include:"
, H.indent 4 $ H.vcat $ , D.indent 4 $ D.vcat $
[ "\\n" [ "\\n"
, "\\r" , "\\r"
, "\\t" , "\\t"
@ -304,7 +304,7 @@ problemToDocs problem =
, "\\\\" , "\\\\"
, "\\u{03BB}" , "\\u{03BB}"
] ]
, H.reflow $ , D.reflow $
"The last one lets encode ANY character by its Unicode code\ "The last one lets encode ANY character by its Unicode code\
\ point, so use that for anything outside the ordinary six." \ point, so use that for anything outside the ordinary six."
] ]
@ -314,15 +314,15 @@ problemToDocs problem =
( (
"I ran into an invalid Unicode escape character:" "I ran into an invalid Unicode escape character:"
, ,
H.stack D.stack
[ "Here are some examples of valid Unicode escape characters:" [ "Here are some examples of valid Unicode escape characters:"
, H.indent 4 $ H.vcat $ , D.indent 4 $ D.vcat $
[ "\\u{0041}" [ "\\u{0041}"
, "\\u{03BB}" , "\\u{03BB}"
, "\\u{6728}" , "\\u{6728}"
, "\\u{1F60A}" , "\\u{1F60A}"
] ]
, H.reflow $ , D.reflow $
"Notice that the code point is always surrounded by curly\ "Notice that the code point is always surrounded by curly\
\ braces. They are required!" \ braces. They are required!"
] ]
@ -342,18 +342,18 @@ problemToDocs problem =
, ,
let let
goodCode = replicate (4 - numDigits) '0' ++ badCode goodCode = replicate (4 - numDigits) '0' ++ badCode
escape = "\\u{" <> H.text goodCode <> "}" escape = "\\u{" <> D.fromString goodCode <> "}"
in in
H.hsep [ "Try", H.dullyellow escape, "instead?" ] D.hsep [ "Try", D.dullyellow escape, "instead?" ]
) )
else else
( (
"This Unicode code point has too many digits:" "This Unicode code point has too many digits:"
, ,
H.fillSep D.fillSep
["Valid","code","points","are","between" ["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." ,"so","it","must","have","between","four","and","six","digits."
] ]
) )
@ -362,12 +362,12 @@ problemToDocs problem =
( (
"Ran into a bad use of single quotes." "Ran into a bad use of single quotes."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"If you want to create a string, switch to double quotes:" "If you want to create a string, switch to double quotes:"
, H.indent 4 $ , D.indent 4 $
H.dullyellow "'this'" <> " => " <> H.green "\"this\"" D.dullyellow "'this'" <> " => " <> D.green "\"this\""
, H.toSimpleHint $ , D.toSimpleHint $
"Unlike JavaScript, Elm distinguishes between strings like \"hello\"\ "Unlike JavaScript, Elm distinguishes between strings like \"hello\"\
\ and individual characters like 'A' and '3'. If you really do want\ \ and individual characters like 'A' and '3'. If you really do want\
\ a character though, something went wrong and I did not find the\ \ a character though, something went wrong and I did not find the\
@ -381,16 +381,16 @@ problemToDocs problem =
, ,
let let
number = number =
H.text (show numberBeforeDot) D.fromString (show numberBeforeDot)
in 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 -> BadNumberEnd ->
( (
"Numbers cannot have letters or underscores in them." "Numbers cannot have letters or underscores in them."
, ,
H.reflow $ D.reflow $
"Maybe a space is missing between a number and a variable?" "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." "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.\ "If you want to say 1000, you can also say 1e3.\
\ You cannot just end it with an E though!" \ 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." "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\ "A hex number looks like 0x123ABC, where the 0x is followed by hexidecimal\
\ digits. Valid hexidecimal digits include: 0123456789abcdefABCDEF" \ digits. Valid hexidecimal digits include: 0123456789abcdefABCDEF"
) )
@ -416,7 +416,7 @@ problemToDocs problem =
( (
"Normal numbers cannot start with zeros. Take the zeros off the front." "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." "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:" "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\ "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." \ 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." "I ran into a problem while parsing this GLSL block."
, ,
H.reflow (Text.unpack msg) D.reflow (Text.unpack msg)
) )
BadUnderscore _ -> BadUnderscore _ ->
( (
"A variable name cannot start with an underscore:" "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\ "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!" \ a name that starts with a letter to access the value later. Pick one!"
) )
@ -454,7 +454,7 @@ problemToDocs problem =
Equals -> Equals ->
( (
H.reflow $ D.reflow $
"I was not expecting this equals sign" "I was not expecting this equals sign"
<> contextToString " here" " while parsing " stack <> "." <> contextToString " here" " while parsing " stack <> "."
, ,
@ -466,7 +466,7 @@ problemToDocs problem =
( (
"I ran into a stray arrow while parsing this `case` expression." "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\ "All branches in a `case` must be indented the exact\
\ same amount, so the patterns are vertically\ \ same amount, so the patterns are vertically\
\ aligned. Maybe this branch is indented too much?" \ aligned. Maybe this branch is indented too much?"
@ -486,7 +486,7 @@ problemToDocs problem =
( (
"I was not expecting this dot." "I was not expecting this dot."
, ,
H.reflow $ D.reflow $
"Dots are for record access and decimal points, so\ "Dots are for record access and decimal points, so\
\ they cannot float around on their own. Maybe\ \ they cannot float around on their own. Maybe\
\ there is some extra whitespace?" \ there is some extra whitespace?"
@ -494,27 +494,27 @@ problemToDocs problem =
Theories stack allTheories -> Theories stack allTheories ->
( (
H.reflow $ D.reflow $
"Something went wrong while parsing " <> contextToString "your code" "" stack <> "." "Something went wrong while parsing " <> contextToString "your code" "" stack <> "."
, ,
case Set.toList (Set.fromList allTheories) of case Set.toList (Set.fromList allTheories) of
[] -> [] ->
H.stack D.stack
[ H.reflow $ [ D.reflow $
"I do not have any suggestions though!" "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\ "Can you get it down to a <http://sscce.org> and share it at\
\ <https://github.com/elm-lang/error-message-catalog/issues>?\ \ <https://github.com/elm-lang/error-message-catalog/issues>?\
\ That way we can figure out how to give better advice!" \ That way we can figure out how to give better advice!"
] ]
[theory] -> [theory] ->
H.reflow $ D.reflow $
"I was expecting to see " "I was expecting to see "
<> addPeriod (theoryToString stack theory) <> addPeriod (theoryToString stack theory)
theories -> theories ->
H.vcat $ D.vcat $
[ "I was expecting:" [ "I was expecting:"
, "" , ""
] ]
@ -526,33 +526,33 @@ problemToDocs problem =
-- BAD OP HELPERS -- 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 = badOp stack article opName setting hint =
( (
H.reflow $ D.reflow $
"I was not expecting this " <> opName "I was not expecting this " <> opName
<> contextToString " here" " while parsing " stack <> "." <> contextToString " here" " while parsing " stack <> "."
, ,
H.reflow $ D.reflow $
article <> " " <> opName <> " should only appear in " article <> " " <> opName <> " should only appear in "
<> setting <> ". " <> hint <> setting <> ". " <> hint
) )
toBadEqualsHint :: ContextStack -> H.Doc toBadEqualsHint :: ContextStack -> D.Doc
toBadEqualsHint stack = toBadEqualsHint stack =
case stack of case stack of
[] -> [] ->
H.reflow $ D.reflow $
"Maybe you want == instead? Or maybe something is indented too much?" "Maybe you want == instead? Or maybe something is indented too much?"
(ExprRecord, _) : _ -> (ExprRecord, _) : _ ->
H.reflow $ D.reflow $
"Records look like { x = 3, y = 4 } with the equals sign right\ "Records look like { x = 3, y = 4 } with the equals sign right\
\ after the field name. Maybe you forgot a comma?" \ after the field name. Maybe you forgot a comma?"
(Definition _, _) : rest -> (Definition _, _) : rest ->
H.reflow $ D.reflow $
"Maybe this is supposed to be a separate definition? If so, it\ "Maybe this is supposed to be a separate definition? If so, it\
\ is indented too far. " \ is indented too far. "
<> <>
@ -634,9 +634,9 @@ getAnchor stack =
-- THEORY HELPERS -- THEORY HELPERS
bullet :: String -> H.Doc bullet :: String -> D.Doc
bullet point = 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 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.List as List
import qualified Data.Text as Text 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 import qualified Reporting.Region as R
@ -40,11 +41,6 @@ toSource source =
f a f a
(<==>) :: Doc -> Doc -> Doc
(<==>) a b =
a <> hardline <> b
render :: Source -> R.Region -> Maybe R.Region -> Doc render :: Source -> R.Region -> Maybe R.Region -> Doc
render (Source sourceLines) region@(R.Region start end) maybeSubRegion = render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
let let
@ -64,7 +60,7 @@ render (Source sourceLines) region@(R.Region start end) maybeSubRegion =
in in
case makeUnderline width endLine smallerRegion of case makeUnderline width endLine smallerRegion of
Nothing -> Nothing ->
drawLines True width smallerRegion relevantLines empty drawLines True width smallerRegion relevantLines D.empty
Just underline -> Just underline ->
drawLines False width smallerRegion relevantLines 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) ' ' spaces = replicate (c1 + width + 1) ' '
zigzag = replicate (max 1 (c2 - c1)) '^' zigzag = replicate (max 1 (c2 - c1)) '^'
in 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 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 startLine _) = start
(R.Position endLine _) = end (R.Position endLine _) = end
in in
foldr (<==>) finalLine $ D.vcat $
map (drawLine addZigZag width startLine endLine) sourceLines map (drawLine addZigZag width startLine endLine) sourceLines
++ [finalLine]
drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc
drawLine addZigZag width startLine endLine (n, line) = 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 addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc
@ -109,11 +106,11 @@ addLineNumber addZigZag width start end n line =
spacer = spacer =
if addZigZag && start <= n && n <= end then if addZigZag && start <= n && n <= end then
dullred ">" D.dullred ">"
else else
" " " "
in 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 (Just line) = List.lookup startRow1 sourceLines
in in
OneLine $ OneLine $
text lineNumber <> "| " <> text (Text.unpack line) D.vcat
<> hardline [ D.fromString lineNumber <> "| " <> D.fromText line
<> text spaces1 <> dullred (text zigzag1) , D.fromString spaces1 <> D.dullred (D.fromString zigzag1) <>
<> text spaces2 <> dullred (text zigzag2) D.fromString spaces2 <> D.dullred (D.fromString zigzag2)
]
else else
TwoChunks 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 AST.Module.Name as ModuleName
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Reporting.Annotation as A import qualified Reporting.Annotation as A
import qualified Reporting.Helpers as H import qualified Reporting.Doc as D
import Reporting.Helpers ( Doc, (<+>), (<>) ) import Reporting.Doc ( Doc, (<+>), (<>) )
@ -39,12 +39,12 @@ lambda :: Context -> Doc -> Doc -> [Doc] -> Doc
lambda context arg1 arg2 args = lambda context arg1 arg2 args =
let let
lambdaDoc = lambdaDoc =
H.sep (arg1 : map ("->" <+>) (arg2:args)) D.sep (arg1 : map ("->" <+>) (arg2:args))
in in
case context of case context of
None -> lambdaDoc None -> lambdaDoc
Func -> H.cat [ "(", lambdaDoc, ")" ] Func -> D.cat [ "(", lambdaDoc, ")" ]
App -> H.cat [ "(", lambdaDoc, ")" ] App -> D.cat [ "(", lambdaDoc, ")" ]
apply :: Context -> Doc -> [Doc] -> Doc apply :: Context -> Doc -> [Doc] -> Doc
@ -56,10 +56,10 @@ apply context name args =
_:_ -> _:_ ->
let let
applyDoc = applyDoc =
H.hang 4 (H.sep (name : args)) D.hang 4 (D.sep (name : args))
in in
case context of case context of
App -> H.cat [ "(", applyDoc, ")" ] App -> D.cat [ "(", applyDoc, ")" ]
Func -> applyDoc Func -> applyDoc
None -> applyDoc None -> applyDoc
@ -70,7 +70,7 @@ tuple a b cs =
entries = entries =
zipWith (<+>) ("(" : repeat ",") (a:b:cs) zipWith (<+>) ("(" : repeat ",") (a:b:cs)
in in
H.sep [ H.cat entries, ")" ] D.sep [ D.cat entries, ")" ]
record :: [(Doc, Doc)] -> Maybe Doc -> Doc record :: [(Doc, Doc)] -> Maybe Doc -> Doc
@ -80,16 +80,16 @@ record entries maybeExt =
"{}" "{}"
(fields, Nothing) -> (fields, Nothing) ->
H.sep D.sep
[ H.cat (zipWith (<+>) ("{" : repeat ",") fields) [ D.cat (zipWith (<+>) ("{" : repeat ",") fields)
, "}" , "}"
] ]
(fields, Just ext) -> (fields, Just ext) ->
H.sep D.sep
[ H.hang 4 $ H.sep $ [ D.hang 4 $ D.sep $
[ "{" <+> ext [ "{" <+> ext
, H.cat (zipWith (<+>) ("|" : repeat ",") fields) , D.cat (zipWith (<+>) ("|" : repeat ",") fields)
] ]
, "}" , "}"
] ]
@ -97,7 +97,7 @@ record entries maybeExt =
entryToDoc :: (Doc, Doc) -> Doc entryToDoc :: (Doc, Doc) -> Doc
entryToDoc (fieldName, fieldType) = entryToDoc (fieldName, fieldType) =
H.hang 4 (H.sep [ fieldName <+> ":", fieldType ]) D.hang 4 (D.sep [ fieldName <+> ":", fieldType ])
recordSnippet :: (Doc, Doc) -> [(Doc, Doc)] -> Doc recordSnippet :: (Doc, Doc) -> [(Doc, Doc)] -> Doc
@ -106,7 +106,7 @@ recordSnippet entry entries =
field = "{" <+> entryToDoc entry field = "{" <+> entryToDoc entry
fields = zipWith (<+>) (repeat ",") (map entryToDoc entries ++ ["..."]) fields = zipWith (<+>) (repeat ",") (map entryToDoc entries ++ ["..."])
in 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) (map (srcToDoc Func) rest)
Src.TVar name -> Src.TVar name ->
H.nameToDoc name D.fromName name
Src.TType _ name args -> Src.TType _ name args ->
apply context apply context
(H.nameToDoc name) (D.fromName name)
(map (srcToDoc App) args) (map (srcToDoc App) args)
Src.TTypeQual _ home name args -> Src.TTypeQual _ home name args ->
apply context apply context
(H.nameToDoc home <> "." <> H.nameToDoc name) (D.fromName home <> "." <> D.fromName name)
(map (srcToDoc App) args) (map (srcToDoc App) args)
Src.TRecord fields ext -> Src.TRecord fields ext ->
record record
(map fieldToDocs fields) (map fieldToDocs fields)
(fmap (H.nameToDoc . A.toValue) ext) (fmap (D.fromName . A.toValue) ext)
Src.TUnit -> Src.TUnit ->
"()" "()"
@ -155,7 +155,7 @@ srcToDoc context (A.At _ tipe) =
fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc) fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc)
fieldToDocs (A.At _ fieldName, fieldType) = fieldToDocs (A.At _ fieldName, fieldType) =
( H.nameToDoc fieldName ( D.fromName fieldName
, srcToDoc None fieldType , srcToDoc None fieldType
) )
@ -190,17 +190,17 @@ canToDoc context tipe =
(map (canToDoc Func) rest) (map (canToDoc Func) rest)
Can.TVar name -> Can.TVar name ->
H.nameToDoc name D.fromName name
Can.TType (ModuleName.Canonical _ home) name args -> Can.TType (ModuleName.Canonical _ home) name args ->
apply context apply context
(H.nameToDoc home <> "." <> H.nameToDoc name) (D.fromName home <> "." <> D.fromName name)
(map (canToDoc App) args) (map (canToDoc App) args)
Can.TRecord fields ext -> Can.TRecord fields ext ->
record record
(map entryToDocs (Map.toList fields)) (map entryToDocs (Map.toList fields))
(fmap H.nameToDoc ext) (fmap D.fromName ext)
Can.TUnit -> Can.TUnit ->
"()" "()"
@ -213,13 +213,13 @@ canToDoc context tipe =
Can.TAlias (ModuleName.Canonical _ home) name args _ -> Can.TAlias (ModuleName.Canonical _ home) name args _ ->
apply context apply context
(H.nameToDoc home <> "." <> H.nameToDoc name) (D.fromName home <> "." <> D.fromName name)
(map (canToDoc App . snd) args) (map (canToDoc App . snd) args)
entryToDocs :: (N.Name, Can.Type) -> (Doc, Doc) entryToDocs :: (N.Name, Can.Type) -> (Doc, Doc)
entryToDocs (name, tipe) = entryToDocs (name, tipe) =
(H.nameToDoc name, canToDoc None tipe) (D.fromName name, canToDoc None tipe)
collectArgs :: Can.Type -> (Can.Type, [Can.Type]) 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.Canonical as Can
import qualified AST.Utils.Type as Type import qualified AST.Utils.Type as Type
import qualified Elm.Name as N import qualified Elm.Name as N
import qualified Reporting.Doc as D
import qualified Reporting.Region as R import qualified Reporting.Region as R
import qualified Reporting.Report as Report import qualified Reporting.Report as Report
import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Code as Code
import qualified Reporting.Render.Type as RT 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.Report "unused import" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"Nothing from the `" <> N.toString moduleName <> "` module is used in this file." "Nothing from the `" <> N.toString moduleName <> "` module is used in this file."
, ,
"I recommend removing unused imports." "I recommend removing unused imports."
@ -55,14 +55,14 @@ toReport source warning =
Report.Report title region [] $ Report.Report title region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
"You are not using `" <> N.toString name <> "` anywhere." "You are not using `" <> N.toString name <> "` anywhere."
, ,
H.stack D.stack
[ H.reflow $ [ D.reflow $
"Is there a typo? Maybe you intended to use `" <> N.toString name "Is there a typo? Maybe you intended to use `" <> N.toString name
<> "` somewhere but typed another name instead?" <> "` somewhere but typed another name instead?"
, H.reflow $ , D.reflow $
defOrPat context defOrPat context
( "If you are sure there is no typo, remove the definition.\ ( "If you are sure there is no typo, remove the definition.\
\ This way future readers will not have to wonder why it is there!" \ 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.Report "missing type annotation" region [] $
Report.toCodeSnippet source region Nothing Report.toCodeSnippet source region Nothing
( (
H.reflow $ D.reflow $
case Type.deepDealias inferredType of case Type.deepDealias inferredType of
Can.TLambda _ _ -> Can.TLambda _ _ ->
"The `" <> N.toString name <> "` function has no type annotation." "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." "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:" [ "I inferred the type annotation myself though! You can copy it into your code:"
, H.green $ H.hang 4 $ H.sep $ , D.green $ D.hang 4 $ D.sep $
[ H.nameToDoc name <> " :" [ D.fromName name <> " :"
, RT.canToDoc RT.None inferredType , 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 AST.Module.Name as ModuleName
import qualified Data.Bag as Bag import qualified Data.Bag as Bag
import qualified Elm.Name as N 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 import qualified Reporting.Render.Type as RT
@ -78,17 +78,17 @@ iteratedDealias tipe =
type Localizer = Map.Map (ModuleName.Canonical, N.Name) String 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 = nameToDoc dict home@(ModuleName.Canonical _ moduleName) name =
case Map.lookup (home, name) dict of case Map.lookup (home, name) dict of
Nothing -> Nothing ->
H.nameToDoc moduleName <> "." <> H.nameToDoc name D.fromName moduleName <> "." <> D.fromName name
Just string -> 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 = toDoc dict ctx tipe =
case tipe of case tipe of
Lambda a b cs -> Lambda a b cs ->
@ -104,16 +104,16 @@ toDoc dict ctx tipe =
"?" "?"
FlexVar name -> FlexVar name ->
H.nameToDoc name D.fromName name
FlexSuper _ name -> FlexSuper _ name ->
H.nameToDoc name D.fromName name
RigidVar name -> RigidVar name ->
H.nameToDoc name D.fromName name
RigidSuper _ name -> RigidSuper _ name ->
H.nameToDoc name D.fromName name
Type home name args -> Type home name args ->
RT.apply ctx RT.apply ctx
@ -123,7 +123,7 @@ toDoc dict ctx tipe =
Record fields ext -> Record fields ext ->
let let
entryToDocs (fieldName, fieldType) = entryToDocs (fieldName, fieldType) =
( H.nameToDoc fieldName, toDoc dict RT.None fieldType ) ( D.fromName fieldName, toDoc dict RT.None fieldType )
fieldDocs = fieldDocs =
map entryToDocs (Map.toList fields) map entryToDocs (Map.toList fields)
@ -131,8 +131,8 @@ toDoc dict ctx tipe =
RT.record fieldDocs $ RT.record fieldDocs $
case ext of case ext of
Closed -> Nothing Closed -> Nothing
FlexOpen x -> Just (H.nameToDoc x) FlexOpen x -> Just (D.fromName x)
RigidOpen x -> Just (H.nameToDoc x) RigidOpen x -> Just (D.fromName x)
Unit -> Unit ->
"()" "()"
@ -153,7 +153,7 @@ toDoc dict ctx tipe =
-- DIFF -- DIFF
toDiffDocs :: Localizer -> Type -> Type -> (H.Doc, H.Doc, [Problem]) toDiffDocs :: Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
toDiffDocs dict a b = toDiffDocs dict a b =
case diff dict RT.None a b of case diff dict RT.None a b of
Similar aDoc bDoc -> Similar aDoc bDoc ->
@ -217,13 +217,13 @@ data Problem
-- COMPUTE DIFF -- 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 = diff dict ctx tipe1 tipe2 =
case (tipe1, tipe2) of case (tipe1, tipe2) of
(FlexVar x, FlexVar y) | x == y -> pure (H.nameToDoc x) (FlexVar x, FlexVar y) | x == y -> pure (D.fromName x)
(FlexSuper _ x, FlexSuper _ y) | x == y -> pure (H.nameToDoc x) (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x)
(RigidVar x, RigidVar y) | x == y -> pure (H.nameToDoc x) (RigidVar x, RigidVar y) | x == y -> pure (D.fromName x)
(RigidSuper _ x, RigidSuper _ y) | x == y -> pure (H.nameToDoc x) (RigidSuper _ x, RigidSuper _ y) | x == y -> pure (D.fromName x)
(Infinite, Infinite) -> pure "∞" (Infinite, Infinite) -> pure "∞"
(Error, Error) -> pure "?" (Error, Error) -> pure "?"
@ -236,8 +236,8 @@ diff dict ctx tipe1 tipe2 =
<*> <*>
case (maybeC, maybeZ) of case (maybeC, maybeZ) of
(Nothing, Nothing) -> pure [] (Nothing, Nothing) -> pure []
(Just c , Nothing) -> Different [H.dullyellow (toDoc dict RT.None c)] [] Bag.empty (Just c , Nothing) -> Different [D.dullyellow (toDoc dict RT.None c)] [] Bag.empty
(Nothing, Just z ) -> Different [] [H.dullyellow (toDoc dict RT.None z)] 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 (Just c , Just z ) -> (:[]) <$> diff dict RT.None c z
(Record fields1 ext1, Record fields2 ext2) -> diffRecord dict fields1 ext1 fields2 ext2 (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) (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) (FlexVar x, other) -> Similar (D.fromName x) (toDoc dict ctx other)
(other, FlexVar x) -> Similar (toDoc dict ctx other) (H.nameToDoc x) (other, FlexVar x) -> Similar (toDoc dict ctx other) (D.fromName x)
pair -> pair ->
case pair of case pair of
@ -268,8 +268,8 @@ diff dict ctx tipe1 tipe2 =
_ -> _ ->
let let
doc1 = H.dullyellow (toDoc dict ctx tipe1) doc1 = D.dullyellow (toDoc dict ctx tipe1)
doc2 = H.dullyellow (toDoc dict ctx tipe2) doc2 = D.dullyellow (toDoc dict ctx tipe2)
in in
Different doc1 doc2 $ Different doc1 doc2 $
case pair of case pair of
@ -334,10 +334,10 @@ isSimilar tipe1 tipe2 =
Different _ _ _ -> False 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 = yellowApply dict ctx home name tipe =
RT.apply ctx RT.apply ctx
(H.dullyellow (nameToDoc dict home name)) (D.dullyellow (nameToDoc dict home name))
[toDoc dict RT.App tipe] [toDoc dict RT.App tipe]
@ -348,7 +348,7 @@ yellowApply dict ctx home name tipe =
-- --
-- INVARIANT: length types1 >= 2 && length types2 >= 2 -- 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 = diffLambda dict ctx types1 types2 =
let let
(result1:revArgs1) = reverse types1 (result1:revArgs1) = reverse types1
@ -389,7 +389,7 @@ diffLambda dict ctx types1 types2 =
-- --
-- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2 -- 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 = diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
case toGreedyMatch dict shortRevArgs longRevArgs of case toGreedyMatch dict shortRevArgs longRevArgs of
Just (GreedyMatch shortRevArgDocs longRevArgDocs) -> Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->
@ -417,7 +417,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
Nothing -> Nothing ->
let let
toYellowDoc tipe = toYellowDoc tipe =
H.dullyellow (toDoc dict RT.Func tipe) D.dullyellow (toDoc dict RT.Func tipe)
(a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs) (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)
(x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs ) (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )
@ -433,7 +433,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
data GreedyMatch = 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) = toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
let let
toYellowDoc tipe = toYellowDoc tipe =
H.dullyellow (toDoc dict RT.Func tipe) D.dullyellow (toDoc dict RT.Func tipe)
in in
case (shorterArgs, longerArgs) of case (shorterArgs, longerArgs) of
(x:xs, y:ys) -> (x:xs, y:ys) ->
@ -475,7 +475,7 @@ toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs lon
-- RECORD DIFFS -- 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 = diffRecord dict fields1 ext1 fields2 ext2 =
let let
only1 = Map.keys (Map.difference fields1 fields2) only1 = Map.keys (Map.difference fields1 fields2)
@ -510,12 +510,12 @@ diffRecord dict fields1 ext1 fields2 ext2 =
(Bag.one (FieldMismatch only1 only2)) (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 _ _ _) = 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 = toOverlapRecord getDoc bad bads ext =
let go = toOverlapDoc getDoc in let go = toOverlapDoc getDoc in
case ext of case ext of
@ -524,7 +524,7 @@ toOverlapRecord getDoc bad bads ext =
RigidOpen _ -> RT.recordSnippet (go bad) (map go bads) 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 = toMissingDoc allFields uniqueFields ext =
case map emphasizeFieldName uniqueFields of case map emphasizeFieldName uniqueFields of
[] -> [] ->
@ -540,12 +540,12 @@ toMissingDoc allFields uniqueFields ext =
RigidOpen _ -> RT.recordSnippet doc docs RigidOpen _ -> RT.recordSnippet doc docs
emphasizeFieldName :: N.Name -> (H.Doc, H.Doc) emphasizeFieldName :: N.Name -> (D.Doc, D.Doc)
emphasizeFieldName field = 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 = toBoringRecord fields ext =
case ext of case ext of
Closed -> if Map.null fields then "{}" else "{ ... }" Closed -> if Map.null fields then "{}" else "{ ... }"
@ -557,11 +557,11 @@ toBoringRecord fields ext =
-- DIFF RECORD EXTENSION -- DIFF RECORD EXTENSION
diffExt :: Extension -> Extension -> Diff (Maybe H.Doc) diffExt :: Extension -> Extension -> Diff (Maybe D.Doc)
diffExt ext1 ext2 = diffExt ext1 ext2 =
let let
normal = Just . H.nameToDoc normal = Just . D.fromName
yellow = Just . H.dullyellow . H.nameToDoc yellow = Just . D.dullyellow . D.fromName
different x y = Different x y Bag.empty different x y = Different x y Bag.empty
in in
@ -596,8 +596,8 @@ diffExt ext1 ext2 =
data BadOverlap = data BadOverlap =
BadOverlap BadOverlap
{ _field :: N.Name { _field :: N.Name
, _doc1 :: H.Doc , _doc1 :: D.Doc
, _doc2 :: H.Doc , _doc2 :: D.Doc
, _problems :: Bag.Bag Problem , _problems :: Bag.Bag Problem
} }
@ -608,7 +608,7 @@ findBadOverlaps dict fields1 fields2 =
Map.intersectionWith (diff dict RT.None) 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 = findBadOverlapsHelp badOverlaps fieldPairs =
case fieldPairs of case fieldPairs of
[] -> [] ->

8
elm.cabal
View File

@ -134,7 +134,6 @@ Executable elm
Elm.Header, Elm.Header,
Elm.Name, Elm.Name,
Elm.Package, Elm.Package,
Elm.Utils,
Json.Decode, Json.Decode,
Json.Encode, Json.Encode,
@ -196,6 +195,7 @@ Executable elm
Parse.Shader, Parse.Shader,
Parse.Type, Parse.Type,
Reporting.Annotation, Reporting.Annotation,
Reporting.Doc,
Reporting.Error, Reporting.Error,
Reporting.Error.Canonicalize, Reporting.Error.Canonicalize,
Reporting.Error.Docs, Reporting.Error.Docs,
@ -203,12 +203,12 @@ Executable elm
Reporting.Error.Pattern, Reporting.Error.Pattern,
Reporting.Error.Syntax, Reporting.Error.Syntax,
Reporting.Error.Type, Reporting.Error.Type,
Reporting.Helpers,
Reporting.Region, Reporting.Region,
Reporting.Render.Code, Reporting.Render.Code,
Reporting.Render.Type, Reporting.Render.Type,
Reporting.Report, Reporting.Report,
Reporting.Result, Reporting.Result,
Reporting.Suggest,
Reporting.Warning, Reporting.Warning,
Type.Constrain.Expression, Type.Constrain.Expression,
Type.Constrain.Module, Type.Constrain.Module,
@ -224,8 +224,8 @@ Executable elm
Paths_elm Paths_elm
Build-depends: Build-depends:
ansi-terminal >= 0.7 && < 0.8, ansi-terminal >= 0.8 && < 0.9,
ansi-wl-pprint >= 0.6.7 && < 0.7, ansi-wl-pprint >= 0.6.8 && < 0.7,
base >=4.8 && <5, base >=4.8 && <5,
binary >= 0.8 && < 0.9, binary >= 0.8 && < 0.9,
bytestring >= 0.9 && < 0.11, 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.Project as Project
import qualified Elm.Package as Pkg import qualified Elm.Package as Pkg
import qualified Elm.PerUserCache as PerUserCache 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.Task as Task
import qualified Reporting.Progress.Repl as Repl 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 System.IO (hPutStrLn, stderr)
import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Text.PrettyPrint.ANSI.Leijen as P
import Elm.Utils (nearbyNames, distance) import Reporting.Suggest as Suggest
import Terminal.Args.Internal import Terminal.Args.Internal
@ -235,7 +235,7 @@ exitWithUnknown :: String -> [String] -> IO a
exitWithUnknown unknown knowns = exitWithUnknown unknown knowns =
let let
suggestions = 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 = getNearbyFlagsHelp unknown flag =
case flag of case flag of
OnOff flagName _ -> OnOff flagName _ ->
( distance unknown flagName, "--" ++ flagName ) ( Suggest.distance unknown flagName
, "--" ++ flagName
)
Flag flagName (Parser singular _ _ _ _) _ -> Flag flagName (Parser singular _ _ _ _) _ ->
( distance unknown flagName, "--" ++ flagName ++ "=" ++ toToken singular ) ( Suggest.distance unknown flagName
, "--" ++ flagName ++ "=" ++ toToken singular
)