From b1fd35f5f22a002349ac14b6b8082aee98a6a9e5 Mon Sep 17 00:00:00 2001 From: Evan Czaplicki Date: Sat, 7 Apr 2018 19:55:49 +0200 Subject: [PATCH] Update a bunch of files based on Doc changes --- builder/src/Deps/Get.hs | 6 +- builder/src/Elm/Project/Licenses.hs | 4 +- builder/src/Reporting/Exit.hs | 10 +- compiler/src/Elm/Compiler.hs | 15 +- compiler/src/Elm/Compiler/Type.hs | 48 +- compiler/src/Elm/Utils.hs | 14 - compiler/src/Generate/JavaScript.hs | 9 +- compiler/src/Json/Decode.hs | 4 +- compiler/src/Json/Decode/Error.hs | 54 +- compiler/src/Reporting/Error/Canonicalize.hs | 409 +++++++-------- compiler/src/Reporting/Error/Docs.hs | 48 +- compiler/src/Reporting/Error/Main.hs | 32 +- compiler/src/Reporting/Error/Pattern.hs | 42 +- compiler/src/Reporting/Error/Syntax.hs | 130 ++--- compiler/src/Reporting/Error/Type.hs | 502 +++++++++---------- compiler/src/Reporting/Render/Code.hs | 32 +- compiler/src/Reporting/Render/Type.hs | 50 +- compiler/src/Reporting/Warning.hs | 20 +- compiler/src/Type/Error.hs | 90 ++-- elm.cabal | 8 +- ui/terminal/src/Repl.hs | 2 +- ui/terminal/src/Terminal/Args/Error.hs | 12 +- 22 files changed, 761 insertions(+), 780 deletions(-) delete mode 100644 compiler/src/Elm/Utils.hs diff --git a/builder/src/Deps/Get.hs b/builder/src/Deps/Get.hs index 231eaa1d..79489f29 100644 --- a/builder/src/Deps/Get.hs +++ b/builder/src/Deps/Get.hs @@ -25,11 +25,11 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Elm.Docs as Docs import qualified Elm.Package as Pkg -import qualified Elm.Utils as Utils import qualified Deps.Website as Website import qualified Elm.Project.Json as Project import qualified File.IO as IO +import qualified Reporting.Suggest as Suggest import qualified Reporting.Exit as Exit import qualified Reporting.Exit.Assets as E import qualified Reporting.Progress as Progress @@ -122,7 +122,7 @@ nearbyNames (Pkg.Name author1 project1) possibleNames = authorDistance :: String -> Text.Text -> Int authorDistance bad possibility = - abs (Utils.distance bad (Text.unpack possibility)) + abs (Suggest.distance bad (Text.unpack possibility)) projectDistance :: String -> Text.Text -> Int @@ -130,7 +130,7 @@ projectDistance bad possibility = if possibility == "elm-lang" || possibility == "elm-explorations" then 0 else - abs (Utils.distance bad (Text.unpack possibility)) + abs (Suggest.distance bad (Text.unpack possibility)) diff --git a/builder/src/Elm/Project/Licenses.hs b/builder/src/Elm/Project/Licenses.hs index 39751ba4..072ab45b 100644 --- a/builder/src/Elm/Project/Licenses.hs +++ b/builder/src/Elm/Project/Licenses.hs @@ -13,8 +13,8 @@ import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Text as Text -import qualified Elm.Utils as Utils import qualified Json.Encode as Encode +import qualified Reporting.Suggest as Suggest @@ -61,7 +61,7 @@ check rawName = Text.unpack suggestion in Left $ map snd $ - Utils.nearbyNames toSuggestion (rawName, rawName) pairs + Suggest.nearbyNames toSuggestion (rawName, rawName) pairs diff --git a/builder/src/Reporting/Exit.hs b/builder/src/Reporting/Exit.hs index 9be36ed4..4f1c8700 100644 --- a/builder/src/Reporting/Exit.hs +++ b/builder/src/Reporting/Exit.hs @@ -8,16 +8,14 @@ module Reporting.Exit where -import qualified Data.ByteString.Builder as B import Data.Monoid ((<>)) -import System.IO (stderr) import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Elm.Compiler as Compiler import qualified Elm.Compiler.Module as Module import qualified Elm.Package as Pkg -import qualified Elm.Utils as Utils import qualified Json.Encode as Encode +import qualified Reporting.Doc as D import qualified Reporting.Exit.Assets as Asset import qualified Reporting.Exit.Bump as Bump import qualified Reporting.Exit.Compile as Compile @@ -65,9 +63,9 @@ toStderr exit = Help.toStderr (Help.reportToDoc (toReport exit)) -toJson :: Exit -> IO () +toJson :: Exit -> Encode.Value toJson exit = - B.hPutBuilder stderr $ Encode.encodeUgly $ Help.reportToJson (toReport exit) + Help.reportToJson (toReport exit) toReport :: Exit -> Help.Report @@ -106,7 +104,7 @@ toReport exit = Cycle names -> Help.report "IMPORT CYCLE" Nothing "Your module imports form a cycle:" - [ P.indent 4 (Utils.drawCycle names) + [ D.cycle 4 names , Help.reflow $ "Learn more about why this is disallowed and how to break cycles here:" ++ Help.hintLink "import-cycles" diff --git a/compiler/src/Elm/Compiler.hs b/compiler/src/Elm/Compiler.hs index 81e7eda3..2424be27 100644 --- a/compiler/src/Elm/Compiler.hs +++ b/compiler/src/Elm/Compiler.hs @@ -16,15 +16,14 @@ module Elm.Compiler import qualified Data.ByteString as BS import qualified Data.Map as Map import qualified Data.Text as Text -import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Compile import qualified Elm.Compiler.Module as M import qualified Elm.Compiler.Version import qualified Elm.Package as Pkg import qualified Json.Encode as Encode +import qualified Reporting.Doc as D import qualified Reporting.Error as Error -import qualified Reporting.Helpers as H import qualified Reporting.Render.Code as Code import qualified Reporting.Region as Region import qualified Reporting.Report as Report @@ -63,13 +62,13 @@ compile (Context pkg docsFlag importDict interfaces) source = -- ERRORS TO DOC -errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> H.Doc +errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> D.Doc errorsToDoc filePath source errors = let reports = concatMap (Error.toReports (Code.toSource source) Map.empty) errors in - H.vcat $ map (Report.toDoc filePath) reports + D.vcat $ map (Report.toDoc filePath) reports @@ -85,18 +84,14 @@ errorsToJson moduleName filePath source errors = Encode.object [ ("path", Encode.text (Text.pack filePath)) , ("name", Encode.name moduleName) - , ("errors", Encode.array (map reportToJson reports)) + , ("problems", Encode.array (map reportToJson reports)) ] reportToJson :: Report.Report -> Encode.Value reportToJson (Report.Report title region _sgstns message) = - let - messageString = - P.displayS (P.renderPretty 1 80 message) "" - in Encode.object [ ("title", Encode.text (Text.pack title)) , ("region", Region.encode region) - , ("message", Encode.text (Text.pack messageString)) + , ("message", D.encode message) ] \ No newline at end of file diff --git a/compiler/src/Elm/Compiler/Type.hs b/compiler/src/Elm/Compiler/Type.hs index a24270c0..aded1e45 100644 --- a/compiler/src/Elm/Compiler/Type.hs +++ b/compiler/src/Elm/Compiler/Type.hs @@ -16,14 +16,14 @@ module Elm.Compiler.Type import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import qualified Text.PrettyPrint.ANSI.Leijen as P -import Text.PrettyPrint.ANSI.Leijen ((<+>)) import qualified AST.Source as Src import qualified Elm.Name as N import qualified Parse.Primitives as Parse import qualified Parse.Type as Type import qualified Reporting.Annotation as A +import qualified Reporting.Doc as D +import Reporting.Doc ((<>), (<+>)) import qualified Json.Decode as Decode import qualified Json.Encode as Encode import Json.Encode ((==>)) @@ -61,7 +61,7 @@ data Union = Union N.Name [N.Name] [(N.Name, [Type])] data Context = None | InType | InFunction -toDoc :: Context -> Type -> P.Doc +toDoc :: Context -> Type -> D.Doc toDoc context tipe = case tipe of Lambda _ _ -> @@ -69,21 +69,21 @@ toDoc context tipe = map (toDoc InFunction) (collectLambdas tipe) lambda = - P.sep [ t, P.sep (map (P.text "->" <+>) ts) ] + D.sep [ t, D.sep (map ("->" <+>) ts) ] in case context of None -> lambda - _ -> P.parens lambda + _ -> "(" <> lambda <> ")" Var name -> - P.text (N.toString name) + D.fromName name Unit -> "()" Tuple a b cs -> - P.sep - [ P.cat $ + D.sep + [ D.cat $ [ "(" <+> toDoc None a , "," <+> toDoc None b ] @@ -94,19 +94,19 @@ toDoc context tipe = Type name args -> case args of [] -> - P.text (N.toString name) + D.fromName name _ -> let docName = - P.text (N.toString name) + D.fromName name application = - P.hang 2 $ P.sep (docName : map (toDoc InType) args) + D.hang 2 $ D.sep (docName : map (toDoc InType) args) in case context of InType -> - P.parens application + "(" <> application <> ")" _ -> application @@ -117,23 +117,24 @@ toDoc context tipe = Record fields ext -> case ext of Nothing -> - P.sep - [ P.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields)) + D.sep + [ D.cat (zipWith (<+>) ("{" : repeat ",") (map entryToDoc fields)) , "}" ] Just x -> - P.hang 4 $ - P.sep - [ "{" <+> P.text (N.toString x) <+> "|" - , P.sep (P.punctuate "," (map entryToDoc fields)) - , "}" - ] + D.sep + [ D.hang 4 $ D.sep $ + [ "{" <+> D.fromName x + , D.cat (zipWith (<+>) ("|" : repeat ",") (map entryToDoc fields)) + ] + , "}" + ] -entryToDoc :: (N.Name, Type) -> P.Doc +entryToDoc :: (N.Name, Type) -> D.Doc entryToDoc (field, fieldType) = - P.text (N.toString field) <+> ":" <+> toDoc None fieldType + D.fromName field <+> ":" <+> toDoc None fieldType collectLambdas :: Type -> [Type] @@ -149,8 +150,7 @@ collectLambdas tipe = encode :: Type -> Encode.Value encode tipe = - Encode.text $ Text.pack $ - P.displayS (P.renderPretty 1.0 (maxBound `div` 2) (toDoc None tipe)) "" + Encode.text $ Text.pack $ D.toLine (toDoc None tipe) decoder :: Decode.Decoder () Type diff --git a/compiler/src/Elm/Utils.hs b/compiler/src/Elm/Utils.hs deleted file mode 100644 index a52a2ac2..00000000 --- a/compiler/src/Elm/Utils.hs +++ /dev/null @@ -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) - diff --git a/compiler/src/Generate/JavaScript.hs b/compiler/src/Generate/JavaScript.hs index 0dc387f2..5d0b0b43 100644 --- a/compiler/src/Generate/JavaScript.hs +++ b/compiler/src/Generate/JavaScript.hs @@ -17,7 +17,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified AST.Canonical as Can import qualified AST.Optimized as Opt @@ -30,7 +29,7 @@ import qualified Elm.Name as N import qualified Generate.JavaScript.Builder as JS import qualified Generate.JavaScript.Expression as Expr import qualified Generate.JavaScript.Name as Name -import qualified Reporting.Helpers as H +import qualified Reporting.Doc as D @@ -98,10 +97,10 @@ print home name annotation = let value = Name.toBuilder (Name.fromGlobal home name) toString = Name.toBuilder (Name.fromKernel N.debug "toString") - tipe = P.displayS (P.renderPretty 1.0 80 (Type.toDoc Type.None (Extract.fromAnnotation annotation))) "" + tipe = Type.toDoc Type.None (Extract.fromAnnotation annotation) in "var _value = " <> toString <> "(" <> value <> ");\n" <> - "var _type = " <> B.stringUtf8 (show tipe) <> ";\n\ + "var _type = " <> B.stringUtf8 (show (D.toString tipe)) <> ";\n\ \if (_value.length + 3 + _type.length >= 80 || _type.indexOf('\\n') >= 0) {\n\ \ console.log(_value + '\\n : ' + _type.split('\\n').join('\\n '));\n\ \} else {\n\ @@ -244,7 +243,7 @@ generateCycle mode (Opt.Global home _) cycle = "The following top-level definitions are causing infinite recursion:\\n" <> drawCycle (map fst cycle) <> "\\n\\nThese errors are very tricky, so read " - <> B.stringUtf8 (H.makeLink "halting-problem") + <> B.stringUtf8 (D.makeLink "halting-problem") <> " to learn how to fix it!" diff --git a/compiler/src/Json/Decode.hs b/compiler/src/Json/Decode.hs index c30937a4..bcd318e6 100644 --- a/compiler/src/Json/Decode.hs +++ b/compiler/src/Json/Decode.hs @@ -33,8 +33,8 @@ import Parse.Primitives.Internals (Parser(..), State(..), noError) import qualified Parse.Primitives.Keyword as Keyword import qualified Parse.Primitives.Number as Number import qualified Parse.Primitives.Symbol as Symbol +import qualified Reporting.Doc as D import qualified Reporting.Error.Syntax as E -import qualified Reporting.Helpers as H import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code @@ -43,7 +43,7 @@ import qualified Reporting.Render.Code as Code -- PARSE -parse :: String -> (e -> [H.Doc]) -> Json.Decoder e a -> B.ByteString -> Either H.Doc a +parse :: String -> (e -> [D.Doc]) -> Json.Decoder e a -> B.ByteString -> Either D.Doc a parse rootName userErrorToDocs (Json.Decoder run) bytestring = let source = diff --git a/compiler/src/Json/Decode/Error.hs b/compiler/src/Json/Decode/Error.hs index b6070fb0..bd8cc185 100644 --- a/compiler/src/Json/Decode/Error.hs +++ b/compiler/src/Json/Decode/Error.hs @@ -16,8 +16,8 @@ import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Json.Decode.Internals as Json import qualified Json.Encode as E +import qualified Reporting.Doc as D import qualified Reporting.Error.Syntax as Syntax -import qualified Reporting.Helpers as H import qualified Reporting.Render.Code as Code import qualified Reporting.Report as Report @@ -35,7 +35,7 @@ data Error e -- TO DOC -toDoc :: String -> Code.Source -> (e -> [H.Doc]) -> Error e -> H.Doc +toDoc :: String -> Code.Source -> (e -> [D.Doc]) -> Error e -> D.Doc toDoc rootName source userErrorToDocs err = case err of BadJson syntaxError -> @@ -46,7 +46,7 @@ toDoc rootName source userErrorToDocs err = BadContent jsonError -> case flatten jsonError of [] -> - H.reflow + D.reflow "I am not sure what is wrong with this JSON. Please create an \ \ and share it at so I can\ \ provide a helpful hint here!" @@ -59,8 +59,8 @@ toDoc rootName source userErrorToDocs err = toNumberedDoc index flatErr = P.dullcyan ("(" <> P.int index <> ")") <+> flatErrorToDoc rootName [] userErrorToDocs flatErr in - H.stack $ - [ H.reflow $ + D.stack $ + [ D.reflow $ "I have " ++ show (length flatErrors) ++ " theories on what is going wrong:" ] ++ zipWith toNumberedDoc [1..] flatErrors @@ -70,7 +70,7 @@ toDoc rootName source userErrorToDocs err = -- FLAT ERROR TO DOC -flatErrorToDoc :: String -> [H.Doc] -> (e -> [H.Doc]) -> FlatError e -> H.Doc +flatErrorToDoc :: String -> [D.Doc] -> (e -> [D.Doc]) -> FlatError e -> D.Doc flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory theories) = case theories of [] -> @@ -85,12 +85,12 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory in case accesses of [] -> - H.fillSep (starter ++ explanation) + D.fillSep (starter ++ explanation) _ -> - H.stack - [ H.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."] - , H.fillSep explanation + D.stack + [ D.fillSep $ starter ++ ["The"] ++ actualThing json ++ ["at",accessToDoc rootName accesses,"is","causing","issues."] + , D.fillSep explanation ] _:_ -> @@ -107,31 +107,31 @@ flatErrorToDoc rootName starter userErrorToDocs (FlatError accesses json theory ++ actualThing json ++ ["at",accessToDoc rootName accesses,"because:"] in - H.stack - [ H.fillSep (starter ++ introduction) - , H.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories) - , H.reflow "I accept any of these things." + D.stack + [ D.fillSep (starter ++ introduction) + , D.stack (toBullet [] userErrorToDocs theory : map (toBullet ["OR"] userErrorToDocs) theories) + , D.reflow "I accept any of these things." ] -accessToDoc :: String -> [String] -> H.Doc +accessToDoc :: String -> [String] -> D.Doc accessToDoc rootName accesses = P.dullyellow (P.text (rootName ++ concat accesses)) -actualThing :: E.Value -> [H.Doc] +actualThing :: E.Value -> [D.Doc] actualThing json = case json of - E.Array _ -> [H.red "array"] - E.Object _ -> [H.red "object"] - E.String _ -> [H.red "string"] - E.Boolean b -> [H.red (if b then "true" else "false"),"value"] - E.Integer n -> ["number",H.red (H.text (show n))] - E.Number _ -> [H.red "number"] - E.Null -> [H.red "null","value"] + E.Array _ -> [D.red "array"] + E.Object _ -> [D.red "object"] + E.String _ -> [D.red "string"] + E.Boolean b -> [D.red (if b then "true" else "false"),"value"] + E.Integer n -> ["number",D.red (D.fromString (show n))] + E.Number _ -> [D.red "number"] + E.Null -> [D.red "null","value"] -anExpectedThing :: Json.Type -> [H.Doc] +anExpectedThing :: Json.Type -> [D.Doc] anExpectedThing tipe = case tipe of Json.TObject -> ["an", P.green "OBJECT" <> "."] @@ -141,15 +141,15 @@ anExpectedThing tipe = Json.TInt -> ["an", P.green "INT" <> "."] Json.TObjectWith field -> ["an",P.green "OBJECT","with","a",P.green ("\"" <> P.text (Text.unpack field) <> "\""),"field."] Json.TArrayWith i len -> - ["a",H.green "longer",P.green "ARRAY" <> "." + ["a",D.green "longer",P.green "ARRAY" <> "." ,"I","need","index",P.text (show i) <> ",","but","this","array" ,"only","has",P.text (show len),"elements." ] -toBullet :: [H.Doc] -> (e -> [H.Doc]) -> Theory e -> H.Doc +toBullet :: [D.Doc] -> (e -> [D.Doc]) -> Theory e -> D.Doc toBullet intro userErrorToDocs theory = - H.indent 4 $ H.fillSep $ (++) intro $ + D.indent 4 $ D.fillSep $ (++) intro $ case theory of Failure userError -> userErrorToDocs userError diff --git a/compiler/src/Reporting/Error/Canonicalize.hs b/compiler/src/Reporting/Error/Canonicalize.hs index 5b35d74a..19e43b34 100644 --- a/compiler/src/Reporting/Error/Canonicalize.hs +++ b/compiler/src/Reporting/Error/Canonicalize.hs @@ -23,12 +23,13 @@ import qualified AST.Module.Name as ModuleName import qualified Data.Index as Index import qualified Elm.Name as N import qualified Reporting.Annotation as A +import qualified Reporting.Doc as D +import Reporting.Doc (Doc, (<+>), (<>)) import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Type as RT import qualified Reporting.Report as Report -import qualified Reporting.Helpers as H -import Reporting.Helpers ( Doc, (<+>), (<>) ) +import qualified Reporting.Suggest as Suggest @@ -126,16 +127,16 @@ toKindInfo :: VarKind -> N.Name -> ( Doc, Doc, Doc ) toKindInfo kind name = case kind of BadOp -> - ( "an", "operator", "(" <> H.nameToDoc name <> ")" ) + ( "an", "operator", "(" <> D.fromName name <> ")" ) BadVar -> - ( "a", "value", "`" <> H.nameToDoc name <> "`" ) + ( "a", "value", "`" <> D.fromName name <> "`" ) BadPattern -> - ( "a", "pattern", "`" <> H.nameToDoc name <> "`" ) + ( "a", "pattern", "`" <> D.fromName name <> "`" ) BadType -> - ( "a", "type", "`" <> H.nameToDoc name <> "`" ) + ( "a", "type", "`" <> D.fromName name <> "`" ) @@ -153,12 +154,12 @@ toReport source err = Report.Report "BAD TYPE ANNOTATION" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The type annotation for `" <> N.toString name <> "` says it can accept " - <> H.args numTypeArgs <> ", but the definition says it has " - <> H.args numDefArgs <> ":" + <> D.args numTypeArgs <> ", but the definition says it has " + <> D.args numDefArgs <> ":" , - H.reflow $ + D.reflow $ "Is the type annotation missing something? Should some argument" <> (if leftovers == 1 then "" else "s") <> " be deleted? Maybe some parentheses are missing?" @@ -187,20 +188,20 @@ toReport source err = Report.Report "TOO FEW ARGS" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ - "The `" <> N.toString name <> "` " <> thing <> " was given " <> H.args actual <> ":" + D.reflow $ + "The `" <> N.toString name <> "` " <> thing <> " was given " <> D.args actual <> ":" , - H.reflow $ - "But it needs " <> H.args expected <> ". What is missing? Are some parentheses misplaced?" + D.reflow $ + "But it needs " <> D.args expected <> ". What is missing? Are some parentheses misplaced?" ) else Report.Report "TOO MANY ARGS" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` " <> thing <> " needs " - <> H.args expected <> ", but I see " <> show actual <> " instead:" + <> D.args expected <> ", but I see " <> show actual <> " instead:" , if actual - expected == 1 then "Which is the extra one? Maybe some parentheses are missing?" @@ -212,10 +213,10 @@ toReport source err = Report.Report "INFIX PROBLEM" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You cannot mix (" <> N.toString op1 <> ") and (" <> N.toString op2 <> ") without parentheses." , - H.reflow + D.reflow "I do not know how to group these expressions. Add parentheses for me!" ) @@ -269,10 +270,10 @@ toReport source err = Report.Report "EFFECT PROBLEM" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You have declared that `" ++ N.toString name ++ "` is an effect type:" , - H.reflow $ + D.reflow $ "But I cannot find a union type named `" ++ N.toString name ++ "` in this file!" ) @@ -280,10 +281,10 @@ toReport source err = Report.Report "EFFECT PROBLEM" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "This kind of effect module must define a `" ++ N.toString name ++ "` function." , - H.reflow $ + D.reflow $ "But I cannot find `" ++ N.toString name ++ "` in this file!" ) @@ -296,12 +297,12 @@ toReport source err = Report.Report "REDUNDANT EXPORT" r2 [] $ Report.toCodePair source r1 r2 ( - H.reflow messageThatEndsWithPunctuation + D.reflow messageThatEndsWithPunctuation , "Remove one of them and you should be all set!" ) ( - H.reflow (messageThatEndsWithPunctuation <> " Once here:") + D.reflow (messageThatEndsWithPunctuation <> " Once here:") , "And again right here:" , @@ -312,27 +313,27 @@ toReport source err = let suggestions = map N.toString $ take 4 $ - H.nearbyNames N.toString rawName possibleNames + Suggest.nearbyNames N.toString rawName possibleNames in Report.Report "UNKNOWN EXPORT" region suggestions $ let (a, thing, name) = toKindInfo kind rawName in - H.stack - [ H.fillSep + D.stack + [ D.fillSep ["You","are","trying","to","expose",a,thing,"named" ,name,"but","I","cannot","find","its","definition." ] - , case map H.text suggestions of + , case map D.fromString suggestions of [] -> - H.reflow $ + D.reflow $ "I do not see any super similar names in this file. Is the definition missing?" [alt] -> - H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"] + D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"] alts -> - H.stack + D.stack [ "These names seem close though:" - , H.indent 4 $ H.vcat $ map H.dullyellow alts + , D.indent 4 $ D.vcat $ map D.dullyellow alts ] ] @@ -340,11 +341,11 @@ toReport source err = Report.Report "BAD EXPORT" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `" ++ N.toString name ++ "` though." , - H.reflow $ + D.reflow $ "Remove the (..) and you should be fine!" ) @@ -352,15 +353,15 @@ toReport source err = Report.Report "BAD IMPORT" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You are trying to import the `" <> N.toString ctor <> "` type constructor by name:" , - H.fillSep - ["Try","importing",H.green (H.nameToDoc tipe <> "(..)"),"instead." - ,"The","dots","mean","“expose","the",H.nameToDoc tipe,"type","and" + D.fillSep + ["Try","importing",D.green (D.fromName tipe <> "(..)"),"instead." + ,"The","dots","mean","“expose","the",D.fromName tipe,"type","and" ,"all","its","constructors”","so","it","gives","you","access","to" - , H.nameToDoc ctor <> "." + , D.fromName ctor <> "." ] ) @@ -372,7 +373,7 @@ toReport source err = Report.Report "UNKNOWN IMPORT" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I could not find a `" <> N.toString name <> "` module to import!" , mempty @@ -382,12 +383,12 @@ toReport source err = Report.Report "BAD IMPORT" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` type alias cannot be followed by (..) like this:" , - H.stack + D.stack [ "Remove the (..) and it should work." - , H.link "Hint" + , D.link "Hint" "The distinction between `type` and `type alias` is important here. Read" "types-vs-type-aliases" "to learn more." @@ -398,27 +399,27 @@ toReport source err = let suggestions = map N.toString $ take 4 $ - H.nearbyNames N.toString home possibleNames + Suggest.nearbyNames N.toString home possibleNames in Report.Report "BAD IMPORT" region suggestions $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString home <> "` module does not expose `" <> N.toString value <> "`:" , - case map H.text suggestions of + case map D.fromString suggestions of [] -> "I cannot find any super similar exposed names. Maybe it is private?" [alt] -> - H.fillSep ["Maybe","you","want",H.dullyellow alt,"instead?"] + D.fillSep ["Maybe","you","want",D.dullyellow alt,"instead?"] alts -> - H.stack + D.stack [ "These names seem close though:" - , H.indent 4 $ H.vcat $ map H.dullyellow alts + , D.indent 4 $ D.vcat $ map D.dullyellow alts ] ) @@ -445,12 +446,12 @@ toReport source err = Report.Report "UNKNOWN OPERATOR" region ["/="] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "Elm uses a different name for the “not equal” operator:" , - H.stack - [ H.reflow "Switch to (/=) instead." - , H.toSimpleNote $ + D.stack + [ D.reflow "Switch to (/=) instead." + , D.toSimpleNote $ "Our (/=) operator is supposed to look like a real “not equal” sign (≠). I hope that history will remember (" ++ N.toString op ++ ") as a werid and temporary choice." ] @@ -460,10 +461,10 @@ toReport source err = Report.Report "UNKNOWN OPERATOR" region ["^","*"] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I do not recognize the (**) operator:" , - H.reflow $ + D.reflow $ "Switch to (^) for exponentiation. Or switch to (*) for multiplication." ) @@ -471,17 +472,17 @@ toReport source err = Report.Report "UNKNOWN OPERATOR" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "Elm does not use (%) as the remainder operator:" , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "If you want the behavior of (%) like in JavaScript, switch to:\ \ " - , H.reflow $ + , D.reflow $ "If you want modular arithmatic like in math, switch to:\ \ " - , H.reflow $ + , D.reflow $ "The difference is how things work when negative numbers are involved." ] ) @@ -490,37 +491,37 @@ toReport source err = let suggestions = map N.toString $ take 2 $ - H.nearbyNames N.toString op (Set.toList locals) + Suggest.nearbyNames N.toString op (Set.toList locals) format altOp = - H.green $ "(" <> altOp <> ")" + D.green $ "(" <> altOp <> ")" in Report.Report "UNKNOWN OPERATOR" region suggestions $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I do not recognize the (" ++ N.toString op ++ ") operator." , - H.fillSep $ + D.fillSep $ ["Is","there","an","`import`","and","`exposing`","entry","for","it?"] ++ - case map H.text suggestions of + case map D.fromString suggestions of [] -> [] alts -> - ["Maybe","you","want"] ++ H.commaSep "or" format alts ++ ["instead?"] + ["Maybe","you","want"] ++ D.commaSep "or" format alts ++ ["instead?"] ) PatternHasRecordCtor region name -> Report.Report "BAD PATTERN" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You can construct records by using `" <> N.toString name <> "` as a function, but it is not available in pattern matching like this:" , - H.reflow $ + D.reflow $ "I recommend matching matching the record as a variable and unpacking it later." ) @@ -530,12 +531,12 @@ toReport source err = Report.Report "PORT ERROR" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString portName <> "` port is trying to transmit " <> aBadKindOfThing <> ":" , - H.stack + D.stack [ elaboration - , H.link "Hint" + , D.link "Hint" "Ports are not a traditional FFI, so if you have tons of annoying ports, definitely read" "ports" "to learn how they are meant to work. They require a different mindset!" @@ -548,7 +549,7 @@ toReport source err = ( "an extended record" , - H.reflow $ + D.reflow $ "But the exact shape of the record must be known at compile time. No type variables!" ) @@ -556,7 +557,7 @@ toReport source err = ( "a function" , - H.reflow $ + D.reflow $ "But functions cannot be sent in and out ports. If we allowed functions in from JS\ \ they may perform some side-effects. If we let functions out, they could produce\ \ incorrect results because Elm optimizations assume there are no side-effects." @@ -567,7 +568,7 @@ toReport source err = ( "an unspecified type" , - H.reflow $ + D.reflow $ "But type variables like `" <> N.toString name <> "` cannot flow through ports.\ \ I need to know exactly what type of data I am getting, so I can guarantee that\ \ unexpected data cannot sneak in and crash the Elm program." @@ -577,13 +578,13 @@ toReport source err = ( "a `" <> N.toString name <> "` value" , - H.stack - [ H.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:" - , H.indent 4 $ - H.reflow $ + D.stack + [ D.reflow $ "I cannot handle that. The types that CAN flow in and out of Elm include:" + , D.indent 4 $ + D.reflow $ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\ \ tuples, records, and JSON values." - , H.reflow $ + , D.reflow $ "Since JSON values can flow through, you can use JSON encoders and decoders\ \ to allow other types through as well. More advanced users often just do\ \ everything with encoders and decoders for more control and better errors." @@ -596,11 +597,11 @@ toReport source err = Report.Report "BAD PORT" region [] $ Report.toCodeSnippet source region Nothing $ ( - H.reflow before + D.reflow before , - H.stack + D.stack [ after - , H.link "Hint" "Read" "ports" + , D.link "Hint" "Read" "ports" "for more advice. For example, do not end up with one port per JS function!" ] ) @@ -611,7 +612,7 @@ toReport source err = ( "The `" <> N.toString name <> "` port cannot be just a command." , - H.reflow $ + D.reflow $ "It can be (() -> Cmd msg) if you just need to trigger a JavaScript\ \ function, but there is often a better way to set things up." ) @@ -626,7 +627,7 @@ toReport source err = | n == 3 = "these " ++ show n ++ " items into a tuple or record" | True = "these " ++ show n ++ " items into a record" in - H.reflow $ + D.reflow $ "You can put " ++ theseItemsInSomething ++ " to send them out though." ) @@ -634,7 +635,7 @@ toReport source err = ( "The `" <> N.toString name <> "` port cannot send any messages to the `update` function." , - H.reflow $ + D.reflow $ "It must produce a (Cmd msg) type. Notice the lower case `msg` type\ \ variable. The command will trigger some JS code, but it will not send\ \ anything particular back to Elm." @@ -643,12 +644,12 @@ toReport source err = SubBad -> ( "There is something off about this `" <> N.toString name <> "` port declaration." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "To receive messages from JavaScript, you need to define a port like this:" - , H.indent 4 $ H.dullyellow $ H.text $ + , D.indent 4 $ D.dullyellow $ D.fromString $ "port " <> N.toString name <> " : (Int -> msg) -> Sub msg" - , H.reflow $ + , D.reflow $ "Now every time JS sends an `Int` to this port, it is converted to a `msg`.\ \ And if you subscribe, those `msg` values will be piped into your `update`\ \ function. The only thing you can customize here is the `Int` type." @@ -659,7 +660,7 @@ toReport source err = ( "I am confused about the `" <> N.toString name <> "` port declaration." , - H.reflow $ + D.reflow $ "Ports need to produce a command (Cmd) or a subscription (Sub) but\ \ this is neither. I do not know how to handle this." ) @@ -675,7 +676,7 @@ toReport source err = Can.TypedDef name _ _ _ _ -> name makeTheory question details = - H.fillSep $ map (H.dullyellow . H.text) (words question) ++ map H.text (words details) + D.fillSep $ map (D.dullyellow . D.fromString) (words question) ++ map D.fromString (words details) in case map toName cyclicValueDefs of [] -> @@ -690,10 +691,10 @@ toReport source err = case map A.toValue otherNames of [] -> ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` value is defined directly in terms of itself, causing an infinite loop." , - H.stack + D.stack [ makeTheory "Are you are trying to mutate a variable?" $ "Elm does not have mutation, so when I see " ++ N.toString name ++ " defined in terms of " ++ N.toString name @@ -702,7 +703,7 @@ toReport source err = "To define " ++ N.toString name ++ " we need to know what " ++ N.toString name ++ " is, so let’s expand it. Wait, but now we need to know what " ++ N.toString name ++ " is, so let’s expand it... This will keep going infinitely!" - , H.link "Hint" + , D.link "Hint" "The root problem is often a typo in some variable name, but I recommend reading" "bad-recursion" "for more detailed advice, especially if you actually do need a recursive value." @@ -711,15 +712,15 @@ toReport source err = names -> ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` definition is causing a very tricky infinite loop." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "The `" <> N.toString name <> "` value depends on itself through the following chain of definitions:" - , H.indent 4 $ H.drawCycle (name:names) - , H.link "Hint" + , D.cycle 4 (name:names) + , D.link "Hint" "The root problem is often a typo in some variable name, but I recommend reading" "bad-recursion" "for more detailed advice, especially if you actually do want mutually recursive values." @@ -733,13 +734,13 @@ toReport source err = [] -> let makeTheory question details = - H.fillSep $ map (H.dullyellow . H.text) (words question) ++ map H.text (words details) + D.fillSep $ map (D.dullyellow . D.fromString) (words question) ++ map D.fromString (words details) in ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` value is defined directly in terms of itself, causing an infinite loop." , - H.stack + D.stack [ makeTheory "Are you are trying to mutate a variable?" $ "Elm does not have mutation, so when I see " ++ N.toString name ++ " defined in terms of " ++ N.toString name @@ -748,7 +749,7 @@ toReport source err = "To define " ++ N.toString name ++ " we need to know what " ++ N.toString name ++ " is, so let’s expand it. Wait, but now we need to know what " ++ N.toString name ++ " is, so let’s expand it... This will keep going infinitely!" - , H.link "Hint" + , D.link "Hint" "The root problem is often a typo in some variable name, but I recommend reading" "bad-recursion" "for more detailed advice, especially if you actually do need a recursive value." @@ -757,15 +758,15 @@ toReport source err = _ -> ( - H.reflow $ + D.reflow $ "I do not allow cyclic values in `let` expressions." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "The `" <> N.toString name <> "` value depends on itself through the following chain of definitions:" - , H.indent 4 $ H.drawCycle (name:names) - , H.link "Hint" + , D.cycle 4 (name:names) + , D.link "Hint" "The root problem is often a typo in some variable name, but I recommend reading" "bad-recursion" "for more detailed advice, especially if you actually do want mutually recursive values." @@ -778,16 +779,16 @@ toReport source err = ( "These variables cannot have the same name:" , advice ) - ( H.reflow $ "The name `" <> N.toString name <> "` is first defined here:" + ( D.reflow $ "The name `" <> N.toString name <> "` is first defined here:" , "But then it is defined AGAIN over here:" , advice ) where advice = - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Think of a more helpful name for one of them and you should be all set!" - , H.link "Note" + , D.link "Note" "Linters advise against shadowing, so Elm makes “best practices” the default. Read" "shadowing" "for more details on this choice." @@ -799,12 +800,12 @@ toReport source err = ( "I only accept tuples with two or three items. This has too many:" , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "I recommend switching to records. Each item will be named, and you can use\ \ the `point.x` syntax to access them." - , H.link "Note" "Read" "tuples" + , D.link "Note" "Read" "tuples" "for more comprehensive advice on working with large chunks of data in Elm." ] @@ -818,7 +819,7 @@ toReport source err = (unused:unuseds, []) -> let backQuote name = - "`" <> H.nameToDoc name <> "`" + "`" <> D.fromName name <> "`" allUnusedNames = map fst unusedVars @@ -831,31 +832,31 @@ toReport source err = , ["Type","alias",backQuote typeName,"does","not","use","the" ,backQuote (fst unused),"type","variable." ] - , [H.dullyellow (backQuote (fst unused))] + , [D.dullyellow (backQuote (fst unused))] ) _:_ -> ( "UNUSED TYPE VARIABLES" , Nothing , ["Type","variables"] - ++ H.commaSep "and" id (map H.nameToDoc allUnusedNames) + ++ D.commaSep "and" id (map D.fromName allUnusedNames) ++ ["are","unused","in","the",backQuote typeName,"definition."] - , H.commaSep "and" H.dullyellow (map H.nameToDoc allUnusedNames) + , D.commaSep "and" D.dullyellow (map D.fromName allUnusedNames) ) in Report.Report title aliasRegion [] $ Report.toCodeSnippet source aliasRegion subRegion ( - H.fillSep overview + D.fillSep overview , - H.stack - [ H.fillSep $ + D.stack + [ D.fillSep $ ["I","recommend","removing"] ++ stuff ++ ["from","the","declaration,","like","this:"] - , H.indent 4 $ H.hsep $ - ["type","alias",H.green (H.nameToDoc typeName)] - ++ map H.nameToDoc (filter (`notElem` allUnusedNames) allVars) + , D.indent 4 $ D.hsep $ + ["type","alias",D.green (D.fromName typeName)] + ++ map D.fromName (filter (`notElem` allUnusedNames) allVars) ++ ["=", "..."] - , H.reflow $ + , D.reflow $ "Why? Well, if I allowed `type alias Height a = Float` I would need to answer\ \ some weird questions. Is `Height Bool` the same as `Float`? Is `Height Bool`\ \ the same as `Height Int`? My solution is to not need to ask them!" @@ -873,43 +874,43 @@ toReport source err = theseAreUsed = case unbound of [x] -> - ["Type","variable",H.dullyellow ("`" <> H.nameToDoc x <> "`"),"appears" + ["Type","variable",D.dullyellow ("`" <> D.fromName x <> "`"),"appears" ,"in","the","definition,","but","I","do","not","see","it","declared." ] _ -> ["Type","variables"] - ++ H.commaSep "and" H.dullyellow (map H.nameToDoc unbound) + ++ D.commaSep "and" D.dullyellow (map D.fromName unbound) ++ ["are","used","in","the","definition,","but","I","do","not","see","them","declared."] butTheseAreUnused = case unused of [x] -> ["Likewise,","type","variable" - ,H.dullyellow ("`" <> H.nameToDoc x <> "`") + ,D.dullyellow ("`" <> D.fromName x <> "`") ,"is","delared,","but","not","used." ] _ -> ["Likewise,","type","variables"] - ++ H.commaSep "and" H.dullyellow (map H.nameToDoc unused) + ++ D.commaSep "and" D.dullyellow (map D.fromName unused) ++ ["are","delared,","but","not","used."] in Report.Report "TYPE VARIABLE PROBLEMS" aliasRegion [] $ Report.toCodeSnippet source aliasRegion Nothing ( - H.reflow $ + D.reflow $ "Type alias `" <> N.toString typeName <> "` has some type variable problems." , - H.stack - [ H.fillSep $ theseAreUsed ++ butTheseAreUnused - , H.reflow $ + D.stack + [ D.fillSep $ theseAreUsed ++ butTheseAreUnused + , D.reflow $ "My guess is that a definition like this will work better:" - , H.indent 4 $ H.hsep $ - ["type", "alias", H.nameToDoc typeName] - ++ map H.nameToDoc (filter (`notElem` unused) allVars) - ++ map (H.green . H.nameToDoc) unbound + , D.indent 4 $ D.hsep $ + ["type", "alias", D.fromName typeName] + ++ map D.fromName (filter (`notElem` unused) allVars) + ++ map (D.green . D.fromName) unbound ++ ["=", "..."] ] ) @@ -919,11 +920,11 @@ toReport source err = -- BAD TYPE VARIABLES -unboundTypeVars :: Code.Source -> R.Region -> [H.Doc] -> N.Name -> [N.Name] -> (N.Name, R.Region) -> [(N.Name, R.Region)] -> Report.Report +unboundTypeVars :: Code.Source -> R.Region -> [D.Doc] -> N.Name -> [N.Name] -> (N.Name, R.Region) -> [(N.Name, R.Region)] -> Report.Report unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion) unboundVars = let backQuote name = - "`" <> H.nameToDoc name <> "`" + "`" <> D.fromName name <> "`" (title, subRegion, overview) = case map fst unboundVars of @@ -932,32 +933,32 @@ unboundTypeVars source declRegion tipe typeName allVars (unboundVar, varRegion) , Just varRegion , ["The",backQuote typeName] ++ tipe - ++ ["uses","an","unbound","type","variable",H.dullyellow (backQuote unboundVar),"in","its","definition:"] + ++ ["uses","an","unbound","type","variable",D.dullyellow (backQuote unboundVar),"in","its","definition:"] ) vars -> ( "UNBOUND TYPE VARIABLES" , Nothing , ["Type","variables"] - ++ H.commaSep "and" H.dullyellow (H.nameToDoc unboundVar : map H.nameToDoc vars) + ++ D.commaSep "and" D.dullyellow (D.fromName unboundVar : map D.fromName vars) ++ ["are","unbound","in","the",backQuote typeName] ++ tipe ++ ["definition:"] ) in Report.Report title declRegion [] $ Report.toCodeSnippet source declRegion subRegion ( - H.fillSep overview + D.fillSep overview , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "You probably need to change the declaration to something like this:" - , H.indent 4 $ H.hsep $ + , D.indent 4 $ D.hsep $ tipe - ++ [H.nameToDoc typeName] - ++ map H.nameToDoc allVars - ++ map (H.green . H.nameToDoc) (unboundVar : map fst unboundVars) + ++ [D.fromName typeName] + ++ map D.fromName allVars + ++ map (D.green . D.fromName) (unboundVar : map fst unboundVars) ++ ["=", "..."] - , H.reflow $ + , D.reflow $ "Why? Well, imagine one `" ++ N.toString typeName ++ "` where `" ++ N.toString unboundVar ++ "` is an Int and another where it is a Bool. When we explicitly list the type\ \ variables, the type checker can see that they are actually different types." @@ -974,12 +975,12 @@ nameClash source r1 r2 messageThatEndsWithPunctuation = Report.Report "NAME CLASH" r2 [] $ Report.toCodePair source r1 r2 ( - H.reflow messageThatEndsWithPunctuation + D.reflow messageThatEndsWithPunctuation , "How can I know which one you want? Rename one of them!" ) ( - H.reflow (messageThatEndsWithPunctuation <> " One here:") + D.reflow (messageThatEndsWithPunctuation <> " One here:") , "And another one here:" , @@ -999,20 +1000,20 @@ ambiguousName source region maybePrefix name possibleHomes thing = Nothing -> let homeToYellowDoc (ModuleName.Canonical _ home) = - H.dullyellow (H.nameToDoc home) + D.dullyellow (D.fromName home) bothOrAll = if length possibleHomes == 2 then "both" else "all" in ( - H.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous." + D.reflow $ "This usage of `" ++ N.toString name ++ "` is ambiguous." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Check your imports. The following modules " ++ bothOrAll ++ " expose a `" ++ N.toString name ++ "` " ++ thing ++ ":" - , H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes - , H.reflowLink "Read" "imports" "to learn how to clarify which one you want." + , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes + , D.reflowLink "Read" "imports" "to learn how to clarify which one you want." ] ) @@ -1020,22 +1021,22 @@ ambiguousName source region maybePrefix name possibleHomes thing = let homeToYellowDoc (ModuleName.Canonical _ home) = if prefix == home then - H.blue "import" <+> H.dullyellow (H.nameToDoc home) + D.blue "import" <+> D.dullyellow (D.fromName home) else - H.blue "import" <+> H.dullyellow (H.nameToDoc home) <+> H.blue "as" <+> H.dullyellow (H.nameToDoc prefix) + D.blue "import" <+> D.dullyellow (D.fromName home) <+> D.blue "as" <+> D.dullyellow (D.fromName prefix) eitherOrAny = if length possibleHomes == 2 then "either" else "any" in ( - H.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous." + D.reflow $ "This usage of `" ++ toQualString prefix name ++ "` is ambiguous." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "It could refer to a " ++ thing ++ " from " ++ eitherOrAny ++ " of these imports:" - , H.indent 4 $ H.vcat $ map homeToYellowDoc possibleHomes - , H.reflowLink "Read" "imports" "to learn how to clarify which one you want." + , D.indent 4 $ D.vcat $ map homeToYellowDoc possibleHomes + , D.reflowLink "Read" "imports" "to learn how to clarify which one you want." ] ) @@ -1058,28 +1059,28 @@ notFound source region maybePrefix name thing (PossibleNames locals quals) = Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals nearbyNames = - take 4 (H.nearbyNames id givenName possibleNames) + take 4 (Suggest.nearbyNames id givenName possibleNames) toDetails noSuggestionDetails yesSuggestionDetails = case nearbyNames of [] -> - H.stack - [ H.reflow noSuggestionDetails - , H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." + D.stack + [ D.reflow noSuggestionDetails + , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." ] suggestions -> - H.stack - [ H.reflow yesSuggestionDetails - , H.indent 4 $ H.vcat $ map H.dullyellow $ map H.text suggestions - , H.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." + D.stack + [ D.reflow yesSuggestionDetails + , D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromString suggestions + , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." ] in Report.Report "NAMING ERROR" region nearbyNames $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I cannot find a `" ++ givenName ++ "` " ++ thing ++ ":" , case maybePrefix of @@ -1115,20 +1116,20 @@ varErrorToReport :: VarError -> Report.Report varErrorToReport (VarError kind name problem suggestions) = let learnMore orMaybe = - H.reflow $ + D.reflow $ orMaybe <> " `import` works different than you expect? Learn all about it here: " - <> H.hintLink "imports" + <> D.hintLink "imports" namingError overview maybeStarter specializedSuggestions = Report.reportDoc "NAMING ERROR" Nothing overview $ - case H.maybeYouWant' maybeStarter specializedSuggestions of + case D.maybeYouWant' maybeStarter specializedSuggestions of Nothing -> learnMore "Maybe" Just doc -> - H.stack [ doc, learnMore "Or maybe" ] + D.stack [ doc, learnMore "Or maybe" ] specialNamingError specialHint = - Report.reportDoc "NAMING ERROR" Nothing (cannotFind kind name) (H.hsep specialHint) + Report.reportDoc "NAMING ERROR" Nothing (cannotFind kind name) (D.hsep specialHint) in case problem of Ambiguous -> @@ -1158,35 +1159,35 @@ varErrorToReport (VarError kind name problem suggestions) = cannotFind :: VarKind -> Text -> [Doc] cannotFind kind rawName = let ( a, thing, name ) = toKindInfo kind rawName in - [ "Cannot", "find", a, thing, "named", H.dullyellow name <> ":" ] + [ "Cannot", "find", a, thing, "named", D.dullyellow name <> ":" ] ambiguous :: VarKind -> Text -> [Doc] ambiguous kind rawName = let ( _a, thing, name ) = toKindInfo kind rawName in - [ "This", "usage", "of", "the", H.dullyellow name, thing, "is", "ambiguous." ] + [ "This", "usage", "of", "the", D.dullyellow name, thing, "is", "ambiguous." ] notEqualsHint :: Text -> [Doc] notEqualsHint op = [ "Looking", "for", "the", "“not", "equal”", "operator?", "The", "traditional" - , H.dullyellow $ text $ "(" <> op <> ")" - , "is", "replaced", "by", H.green "(/=)", "in", "Elm.", "It", "is", "meant" + , D.dullyellow $ text $ "(" <> op <> ")" + , "is", "replaced", "by", D.green "(/=)", "in", "Elm.", "It", "is", "meant" , "to", "look", "like", "the", "“not", "equal”", "sign", "from", "math!", "(≠)" ] equalsHint :: [Doc] equalsHint = - [ "A", "special", H.dullyellow "(===)", "operator", "is", "not", "needed" - , "in", "Elm.", "We", "use", H.green "(==)", "for", "everything!" + [ "A", "special", D.dullyellow "(===)", "operator", "is", "not", "needed" + , "in", "Elm.", "We", "use", D.green "(==)", "for", "everything!" ] modHint :: [Doc] modHint = - [ "Rather", "than", "a", H.dullyellow "(%)", "operator," - , "Elm", "has", "a", H.green "modBy", "function." + [ "Rather", "than", "a", D.dullyellow "(%)", "operator," + , "Elm", "has", "a", D.green "modBy", "function." , "Learn", "more", "here:" , "" ] @@ -1209,10 +1210,10 @@ _argMismatchReport source region kind name expected actual = Report.Report (map Char.toUpper numArgs) region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ kind <> " " <> N.toString name <> " has " <> numArgs <> "." , - H.reflow $ + D.reflow $ "Expecting " <> show expected <> ", but got " <> show actual <> "." ) @@ -1230,13 +1231,13 @@ aliasRecursionReport source region name args tipe others = ( "This type alias is recursive, forming an infinite type!" , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "When I expand a recursive type alias, it just keeps getting bigger and bigger.\ \ So dealiasing results in an infinitely large type! Try this instead:" - , H.indent 4 $ + , D.indent 4 $ aliasToUnionDoc name args tipe - , H.link "Hint" + , D.link "Hint" "This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading" "recursive-alias" "for ideas on how to do better." @@ -1249,12 +1250,12 @@ aliasRecursionReport source region name args tipe others = ( "This type alias is part of a mutually recursive set of type aliases." , - H.stack + D.stack [ "It is part of this cycle of type aliases:" - , H.indent 4 (H.drawCycle (name:others)) - , H.reflow $ + , D.cycle 4 (name:others) + , D.reflow $ "You need to convert at least one of these type aliases into a `type`." - , H.link "Note" "Read" "recursive-alias" + , D.link "Note" "Read" "recursive-alias" "to learn why this `type` vs `type alias` distinction matters. It is subtle but important!" ] ) @@ -1262,11 +1263,11 @@ aliasRecursionReport source region name args tipe others = aliasToUnionDoc :: N.Name -> [N.Name] -> Src.Type -> Doc aliasToUnionDoc name args tipe = - H.vcat - [ H.dullyellow $ - "type" <+> H.nameToDoc name <+> (foldr (<+>) "=" (map H.nameToDoc args)) - , H.green $ - H.indent 4 (H.nameToDoc name) - , H.dullyellow $ - H.indent 8 (RT.srcToDoc RT.App tipe) + D.vcat + [ D.dullyellow $ + "type" <+> D.fromName name <+> (foldr (<+>) "=" (map D.fromName args)) + , D.green $ + D.indent 4 (D.fromName name) + , D.dullyellow $ + D.indent 8 (RT.srcToDoc RT.App tipe) ] diff --git a/compiler/src/Reporting/Error/Docs.hs b/compiler/src/Reporting/Error/Docs.hs index 0e68a7ec..924337c0 100644 --- a/compiler/src/Reporting/Error/Docs.hs +++ b/compiler/src/Reporting/Error/Docs.hs @@ -8,8 +8,8 @@ module Reporting.Error.Docs import qualified Elm.Name as N -import Reporting.Helpers ((<>)) -import qualified Reporting.Helpers as H +import Reporting.Doc ((<>)) +import qualified Reporting.Doc as D import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code import qualified Reporting.Report as Report @@ -35,24 +35,24 @@ toReport source err = case err of NoDocs region -> Report.Report "NO DOCS" region [] $ - H.stack + D.stack [ - H.reflow $ + D.reflow $ "You must have a documentation comment between the module\ \ declaration and the imports." , - H.reflow + D.reflow "Learn more at " ] ImplicitExposing region -> Report.Report "IMPLICIT EXPOSING" region [] $ - H.stack + D.stack [ - H.reflow $ + D.reflow $ "I need you to be explicit about what this module exposes:" , - H.reflow $ + D.reflow $ "A great API usually hides some implementation details, so it is rare that\ \ everything in the file should be exposed. And requiring package authors\ \ to be explicit about this is a way of adding another quality check before\ @@ -64,14 +64,14 @@ toReport source err = Report.Report "DUPLICATE DOCS" r2 [] $ Report.toCodePair source r1 r2 ( - H.reflow $ + D.reflow $ "There can only be one `" <> N.toString name <> "` in your module documentation, but it is listed twice:" , "Remove one of them!" ) ( - H.reflow $ + D.reflow $ "There can only be one `" <> N.toString name <> "` in your module documentation, but I see two. One here:" , @@ -84,11 +84,11 @@ toReport source err = Report.Report "DOCS MISTAKE" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I do not see `" <> N.toString name <> "` in the `exposing` list, but it is in your module documentation:" , - H.reflow $ + D.reflow $ "Does it need to be added to the `exposing` list as well? Or maybe you removed `" <> N.toString name <> "` and forgot to delete it here?" ) @@ -97,15 +97,15 @@ toReport source err = Report.Report "DOCS MISTAKE" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I do not see `" <> N.toString name <> "` in your module documentation, but it is in your `exposing` list:" , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Add a line like `@docs " <> N.toString name <> "` to your module documentation!" - , H.link "Note" "See" "docs" "for more guidance on writing high quality docs." + , D.link "Note" "See" "docs" "for more guidance on writing high quality docs." ] ) @@ -113,13 +113,13 @@ toReport source err = Report.Report "NO DOCS" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` definition does not have a documentation comment." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Add documentation with nice examples of how to use it!" - , H.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!" + , D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!" ] ) @@ -127,14 +127,14 @@ toReport source err = Report.Report "NO TYPE ANNOTATION" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "The `" <> N.toString name <> "` definition does not have a type annotation." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "I use the type variable names from your annotations when generating docs. So if\ \ you say `Html msg` in your type annotation, I can use `msg` in the docs and make\ \ them a bit clearer. So add an annotation and try to use nice type variables!" - , H.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!" + , D.link "Note" "Read" "docs" "for more advice on writing great docs. There are a couple important tricks!" ] ) diff --git a/compiler/src/Reporting/Error/Main.hs b/compiler/src/Reporting/Error/Main.hs index c4d562cd..04eb2567 100644 --- a/compiler/src/Reporting/Error/Main.hs +++ b/compiler/src/Reporting/Error/Main.hs @@ -9,8 +9,8 @@ module Reporting.Error.Main import qualified AST.Canonical as Can import qualified Elm.Name as N +import qualified Reporting.Doc as D import qualified Reporting.Error.Canonicalize as E -import qualified Reporting.Helpers as H import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Type as RT @@ -40,10 +40,10 @@ toReport source err = ( "I cannot handle this type of `main` value:" , - H.stack + D.stack [ "The type of `main` value I am seeing is:" - , H.indent 4 $ H.dullyellow $ RT.canToDoc RT.None tipe - , H.reflow $ + , D.indent 4 $ D.dullyellow $ RT.canToDoc RT.None tipe + , D.reflow $ "I only know how to handle Html, Svg, and Programs\ \ though. Modify `main` to be one of those types of values!" ] @@ -55,11 +55,11 @@ toReport source err = ( "A `main` definition cannot be defined in terms of itself." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "It should be a boring value with no recursion. But\ \ instead it is involved in this cycle of definitions:" - , H.indent 4 (H.drawCycle cycleNames) + , D.cycle 4 cycleNames ] ) @@ -69,7 +69,7 @@ toReport source err = Report.Report "BAD FLAGS" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "Your `main` program wants " ++ aBadKindOfThing ++ " from JavaScript." , butThatIsNoGood @@ -81,7 +81,7 @@ toReport source err = ( "an extended record" , - H.reflow $ + D.reflow $ "But the exact shape of the record must be known at compile time. No type variables!" ) @@ -89,7 +89,7 @@ toReport source err = ( "a function" , - H.reflow $ + D.reflow $ "But if I allowed functions from JS, it would be possible to sneak\ \ side-effects and runtime exceptions into Elm!" ) @@ -98,7 +98,7 @@ toReport source err = ( "an unspecified type" , - H.reflow $ + D.reflow $ "But type variables like `" ++ N.toString name ++ "` cannot be given as flags.\ \ I need to know exactly what type of data I am getting, so I can guarantee that\ \ unexpected data cannot sneak in and crash the Elm program." @@ -108,13 +108,13 @@ toReport source err = ( "a `" ++ N.toString name ++ "` value" , - H.stack - [ H.reflow $ "I cannot handle that. The types that CAN be in flags include:" - , H.indent 4 $ - H.reflow $ + D.stack + [ D.reflow $ "I cannot handle that. The types that CAN be in flags include:" + , D.indent 4 $ + D.reflow $ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays,\ \ tuples, records, and JSON values." - , H.reflow $ + , D.reflow $ "Since JSON values can flow through, you can use JSON encoders and decoders\ \ to allow other types through as well. More advanced users often just do\ \ everything with encoders and decoders for more control and better errors." diff --git a/compiler/src/Reporting/Error/Pattern.hs b/compiler/src/Reporting/Error/Pattern.hs index 21724327..3b0c7bfe 100644 --- a/compiler/src/Reporting/Error/Pattern.hs +++ b/compiler/src/Reporting/Error/Pattern.hs @@ -9,10 +9,10 @@ module Reporting.Error.Pattern import qualified Data.List as List import qualified Nitpick.PatternMatches as P +import Reporting.Doc ((<>)) +import qualified Reporting.Doc as D import qualified Reporting.Report as Report import qualified Reporting.Render.Code as Code -import qualified Reporting.Helpers as H -import Reporting.Helpers ((<>)) @@ -26,10 +26,10 @@ toReport source err = Report.Report "REDUNDANT PATTERN" patternRegion [] $ Report.toCodeSnippet source caseRegion (Just patternRegion) ( - H.reflow $ - "The " <> H.ordinalize index <> " pattern is redundant:" + D.reflow $ + "The " <> D.ordinalize index <> " pattern is redundant:" , - H.reflow $ + D.reflow $ "Any value with this shape will be handled by a previous\ \ pattern, so it should be removed." ) @@ -42,10 +42,10 @@ toReport source err = ( "This pattern does not cover all possiblities:" , - H.stack + D.stack [ "Other possibilities include:" , unhandledPatternsToDocBlock unhandled - , H.reflow $ + , D.reflow $ "I would have to crash if I saw one of those! So rather than\ \ pattern matching in function arguments, put a `case` in\ \ the function body to account for all possibilities." @@ -58,14 +58,14 @@ toReport source err = ( "This pattern does not cover all possible values:" , - H.stack + D.stack [ "Other possibilities include:" , unhandledPatternsToDocBlock unhandled - , H.reflow $ + , D.reflow $ "I would have to crash if I saw one of those! You can use\ \ `let` to deconstruct values only if there is ONE possiblity.\ \ Switch to a `case` expression to account for all possibilities." - , H.toSimpleHint $ + , D.toSimpleHint $ "Are you calling a function that definitely returns values\ \ with a very specific shape? Try making the return type of\ \ that function more specific!" @@ -78,12 +78,12 @@ toReport source err = ( "This `case` does not have branches for all possibilities:" , - H.stack + D.stack [ "Missing possibilities include:" , unhandledPatternsToDocBlock unhandled - , H.reflow $ + , D.reflow $ "I would have to crash if I saw one of those. Add branches for them!" - , H.link "Hint" + , D.link "Hint" "If you want to write the code for each branch later, use `Debug.todo` as a placeholder. Read" "missing-patterns" "for more guidance on this workflow." @@ -95,9 +95,9 @@ toReport source err = -- PATTERN TO DOC -unhandledPatternsToDocBlock :: [P.Pattern] -> H.Doc +unhandledPatternsToDocBlock :: [P.Pattern] -> D.Doc unhandledPatternsToDocBlock unhandledPatterns = - H.indent 4 $ H.dullyellow $ H.vcat $ + D.indent 4 $ D.dullyellow $ D.vcat $ map (patternToDoc Unambiguous) unhandledPatterns @@ -108,7 +108,7 @@ data Context deriving (Eq) -patternToDoc :: Context -> P.Pattern -> H.Doc +patternToDoc :: Context -> P.Pattern -> D.Doc patternToDoc context pattern = case delist pattern [] of NonList P.Anything -> @@ -117,13 +117,13 @@ patternToDoc context pattern = NonList (P.Literal literal) -> case literal of P.Chr chr -> - H.textToDoc ("'" <> chr <> "'") + D.fromText ("'" <> chr <> "'") P.Str str -> - H.textToDoc ("\"" <> str <> "\"") + D.fromText ("\"" <> str <> "\"") P.Int int -> - H.text (show int) + D.fromString (show int) NonList (P.Ctor _ "#0" []) -> "()" @@ -142,7 +142,7 @@ patternToDoc context pattern = NonList (P.Ctor _ name args) -> let ctorDoc = - H.hsep (H.nameToDoc name : map (patternToDoc Arg) args) + D.hsep (D.fromName name : map (patternToDoc Arg) args) in if context == Arg && length args > 0 then "(" <> ctorDoc <> ")" @@ -154,7 +154,7 @@ patternToDoc context pattern = FiniteList entries -> let entryDocs = map (patternToDoc Unambiguous) entries in - "[" <> H.hcat (List.intersperse "," entryDocs) <> "]" + "[" <> D.hcat (List.intersperse "," entryDocs) <> "]" Conses conses finalPattern -> let diff --git a/compiler/src/Reporting/Error/Syntax.hs b/compiler/src/Reporting/Error/Syntax.hs index c6032112..cd07e422 100644 --- a/compiler/src/Reporting/Error/Syntax.hs +++ b/compiler/src/Reporting/Error/Syntax.hs @@ -17,10 +17,10 @@ import qualified Data.Set as Set import qualified Data.Text as Text import qualified Elm.Name as N +import qualified Reporting.Doc as D import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code import qualified Reporting.Report as Report -import qualified Reporting.Helpers as H @@ -144,7 +144,7 @@ toReport source err = ( "This documentation comment is not followed by anything." , - H.reflow $ + D.reflow $ "All documentation comments need to be right above the declaration they\ \ describe. Maybe some code got deleted or commented out by accident? Or\ \ maybe this comment is here by accident?" @@ -154,12 +154,12 @@ toReport source err = Report.Report "BAD PORT" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You are declaring port `" <> N.toString name <> "` in a normal module." , - H.stack + D.stack [ "It needs to be in a `port` module." - , H.link "Hint" + , D.link "Hint" "Ports are not a traditional FFI for calling JS functions directly. They need a different mindset! Read" "ports" "to learn how to use ports effectively." @@ -170,17 +170,17 @@ toReport source err = Report.Report "ANNOTATION MISMATCH" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I see a `" <> N.toString annName <> "` annotation, but it is followed by a `" <> N.toString defName <> "` definition." , - H.fillSep + D.fillSep ["The","annotation","and","definition","names","must","match!" ,"Is","there","a","typo","between" - , H.dullyellow (H.nameToDoc annName) + , D.dullyellow (D.fromName annName) ,"and" - , H.dullyellow (H.nameToDoc defName) <> "?" + , D.dullyellow (D.fromName defName) <> "?" ] ) @@ -188,12 +188,12 @@ toReport source err = Report.Report "MISSING DEFINITION" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "There is a type annotation for `" <> N.toString name <> "` but there is no corresponding definition!" , "Directly below the type annotation, put a definition like:\n\n" - <> " " <> H.nameToDoc name <> " = 42" + <> " " <> D.fromName name <> " = 42" ) Parse region subRegion problem -> @@ -206,7 +206,7 @@ toReport source err = -- PARSE ERROR TO DOCS -problemToDocs :: Problem -> (H.Doc, H.Doc) +problemToDocs :: Problem -> (D.Doc, D.Doc) problemToDocs problem = case problem of Tab -> @@ -220,11 +220,11 @@ problemToDocs problem = ( "I got to the end of the file while parsing a multi-line comment." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Multi-line comments look like {- comment -}, and it looks like\ \ you are missing the closing marker." - , H.toSimpleHint $ + , D.toSimpleHint $ "Nested multi-line comments like {- this {- and this -} -} are allowed.\ \ The opening and closing markers must be balanced though, just\ \ like parentheses in normal code. Maybe that is the problem?" @@ -235,7 +235,7 @@ problemToDocs problem = ( "I got to the end of the file while parsing a GLSL block." , - H.reflow $ + D.reflow $ "A shader should be defined in a block like this: [glsl| ... |]" ) @@ -243,7 +243,7 @@ problemToDocs problem = ( "I got to the end of the file while parsing a string." , - H.reflow $ + D.reflow $ "Strings look like \"this\" with double quotes on each end.\ \ Is the closing double quote missing in your code?" ) @@ -252,7 +252,7 @@ problemToDocs problem = ( "I got to the end of the file while parsing a multi-line string." , - H.reflow $ + D.reflow $ "Multi-line strings look like \"\"\"this\"\"\" with three double quotes on each\ \ end. Is the closing triple quote missing in your code?" ) @@ -261,7 +261,7 @@ problemToDocs problem = ( "I got to the end of the file while parsing a character." , - H.reflow $ + D.reflow $ "Characters look like 'c' with single quotes on each end.\ \ Is the closing single quote missing in your code?" ) @@ -270,10 +270,10 @@ problemToDocs problem = ( "This string is missing the closing quote." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Elm strings like \"this\" cannot contain newlines." - , H.toSimpleHint $ + , D.toSimpleHint $ "For strings that CAN contain newlines, say \"\"\"this\"\"\" for Elm’s\ \ multi-line string syntax. It allows unescaped newlines and double quotes." ] @@ -292,10 +292,10 @@ problemToDocs problem = UnknownEscape -> ( "Backslashes always start escaped characters, but I do not recognize this one:" - , H.stack + , D.stack [ "Maybe there is some typo?" - , H.toSimpleHint "Valid escape characters include:" - , H.indent 4 $ H.vcat $ + , D.toSimpleHint "Valid escape characters include:" + , D.indent 4 $ D.vcat $ [ "\\n" , "\\r" , "\\t" @@ -304,7 +304,7 @@ problemToDocs problem = , "\\\\" , "\\u{03BB}" ] - , H.reflow $ + , D.reflow $ "The last one lets encode ANY character by its Unicode code\ \ point, so use that for anything outside the ordinary six." ] @@ -314,15 +314,15 @@ problemToDocs problem = ( "I ran into an invalid Unicode escape character:" , - H.stack + D.stack [ "Here are some examples of valid Unicode escape characters:" - , H.indent 4 $ H.vcat $ + , D.indent 4 $ D.vcat $ [ "\\u{0041}" , "\\u{03BB}" , "\\u{6728}" , "\\u{1F60A}" ] - , H.reflow $ + , D.reflow $ "Notice that the code point is always surrounded by curly\ \ braces. They are required!" ] @@ -342,18 +342,18 @@ problemToDocs problem = , let goodCode = replicate (4 - numDigits) '0' ++ badCode - escape = "\\u{" <> H.text goodCode <> "}" + escape = "\\u{" <> D.fromString goodCode <> "}" in - H.hsep [ "Try", H.dullyellow escape, "instead?" ] + D.hsep [ "Try", D.dullyellow escape, "instead?" ] ) else ( "This Unicode code point has too many digits:" , - H.fillSep + D.fillSep ["Valid","code","points","are","between" - , H.dullyellow "\\u{0000}", "and", H.dullyellow "\\u{10FFFF}" + , D.dullyellow "\\u{0000}", "and", D.dullyellow "\\u{10FFFF}" ,"so","it","must","have","between","four","and","six","digits." ] ) @@ -362,12 +362,12 @@ problemToDocs problem = ( "Ran into a bad use of single quotes." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "If you want to create a string, switch to double quotes:" - , H.indent 4 $ - H.dullyellow "'this'" <> " => " <> H.green "\"this\"" - , H.toSimpleHint $ + , D.indent 4 $ + D.dullyellow "'this'" <> " => " <> D.green "\"this\"" + , D.toSimpleHint $ "Unlike JavaScript, Elm distinguishes between strings like \"hello\"\ \ and individual characters like 'A' and '3'. If you really do want\ \ a character though, something went wrong and I did not find the\ @@ -381,16 +381,16 @@ problemToDocs problem = , let number = - H.text (show numberBeforeDot) + D.fromString (show numberBeforeDot) in - "Saying " <> H.green number <> " or " <> H.green (number <> ".0") <> " will work though!" + "Saying " <> D.green number <> " or " <> D.green (number <> ".0") <> " will work though!" ) BadNumberEnd -> ( "Numbers cannot have letters or underscores in them." , - H.reflow $ + D.reflow $ "Maybe a space is missing between a number and a variable?" ) @@ -398,7 +398,7 @@ problemToDocs problem = ( "If you put the letter E in a number, it should followed by more digits." , - H.reflow $ + D.reflow $ "If you want to say 1000, you can also say 1e3.\ \ You cannot just end it with an E though!" ) @@ -407,7 +407,7 @@ problemToDocs problem = ( "I see the start of a hex number, but not the end." , - H.reflow $ + D.reflow $ "A hex number looks like 0x123ABC, where the 0x is followed by hexidecimal\ \ digits. Valid hexidecimal digits include: 0123456789abcdefABCDEF" ) @@ -416,7 +416,7 @@ problemToDocs problem = ( "Normal numbers cannot start with zeros. Take the zeros off the front." , - H.reflow $ + D.reflow $ "Only numbers like 0x0040 or 0.25 can start with a zero." ) @@ -424,7 +424,7 @@ problemToDocs problem = ( "I cannot pattern match with floating point numbers:" , - H.reflow $ + D.reflow $ "Equality on floats can be unreliable, so you usually want to check that they\ \ are nearby with some sort of (abs (actual - expected) < 0.001) check." ) @@ -433,14 +433,14 @@ problemToDocs problem = ( "I ran into a problem while parsing this GLSL block." , - H.reflow (Text.unpack msg) + D.reflow (Text.unpack msg) ) BadUnderscore _ -> ( "A variable name cannot start with an underscore:" , - H.reflow $ + D.reflow $ "You can (1) use a wildcard like _ to ignore the value or you can (2) use\ \ a name that starts with a letter to access the value later. Pick one!" ) @@ -454,7 +454,7 @@ problemToDocs problem = Equals -> ( - H.reflow $ + D.reflow $ "I was not expecting this equals sign" <> contextToString " here" " while parsing " stack <> "." , @@ -466,7 +466,7 @@ problemToDocs problem = ( "I ran into a stray arrow while parsing this `case` expression." , - H.reflow $ + D.reflow $ "All branches in a `case` must be indented the exact\ \ same amount, so the patterns are vertically\ \ aligned. Maybe this branch is indented too much?" @@ -486,7 +486,7 @@ problemToDocs problem = ( "I was not expecting this dot." , - H.reflow $ + D.reflow $ "Dots are for record access and decimal points, so\ \ they cannot float around on their own. Maybe\ \ there is some extra whitespace?" @@ -494,27 +494,27 @@ problemToDocs problem = Theories stack allTheories -> ( - H.reflow $ + D.reflow $ "Something went wrong while parsing " <> contextToString "your code" "" stack <> "." , case Set.toList (Set.fromList allTheories) of [] -> - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "I do not have any suggestions though!" - , H.reflow $ + , D.reflow $ "Can you get it down to a and share it at\ \ ?\ \ That way we can figure out how to give better advice!" ] [theory] -> - H.reflow $ + D.reflow $ "I was expecting to see " <> addPeriod (theoryToString stack theory) theories -> - H.vcat $ + D.vcat $ [ "I was expecting:" , "" ] @@ -526,33 +526,33 @@ problemToDocs problem = -- BAD OP HELPERS -badOp :: ContextStack -> String -> String -> String -> String -> ( H.Doc, H.Doc ) +badOp :: ContextStack -> String -> String -> String -> String -> ( D.Doc, D.Doc ) badOp stack article opName setting hint = ( - H.reflow $ + D.reflow $ "I was not expecting this " <> opName <> contextToString " here" " while parsing " stack <> "." , - H.reflow $ + D.reflow $ article <> " " <> opName <> " should only appear in " <> setting <> ". " <> hint ) -toBadEqualsHint :: ContextStack -> H.Doc +toBadEqualsHint :: ContextStack -> D.Doc toBadEqualsHint stack = case stack of [] -> - H.reflow $ + D.reflow $ "Maybe you want == instead? Or maybe something is indented too much?" (ExprRecord, _) : _ -> - H.reflow $ + D.reflow $ "Records look like { x = 3, y = 4 } with the equals sign right\ \ after the field name. Maybe you forgot a comma?" (Definition _, _) : rest -> - H.reflow $ + D.reflow $ "Maybe this is supposed to be a separate definition? If so, it\ \ is indented too far. " <> @@ -634,9 +634,9 @@ getAnchor stack = -- THEORY HELPERS -bullet :: String -> H.Doc +bullet :: String -> D.Doc bullet point = - H.hang 4 (" - " <> H.fillSep (map H.text (words point))) + D.hang 4 (" - " <> D.fillSep (map D.fromString (words point))) addPeriod :: String -> String diff --git a/compiler/src/Reporting/Error/Type.hs b/compiler/src/Reporting/Error/Type.hs index e64965f4..117a6265 100644 --- a/compiler/src/Reporting/Error/Type.hs +++ b/compiler/src/Reporting/Error/Type.hs @@ -24,7 +24,7 @@ import Data.Monoid ((<>)) import qualified Data.Index as Index import qualified Elm.Name as N -import qualified Reporting.Helpers as H +import qualified Reporting.Doc as D import qualified Reporting.Region as R import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Type as RT @@ -202,15 +202,15 @@ toPatternReport source localizer patternRegion category tipe expected = case context of PTypedArg name index -> ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " argument to `" <> N.toString name <> "` is weird." + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " argument to `" <> N.toString name <> "` is weird." , patternTypeComparison localizer tipe expectedType ( toPatternDescription category $ "The argument is a pattern that matches" , - "But the type annotation on `" <> N.toString name <> "` says the " <> H.ordinalize (Index.toHuman index) <> " argument should be:" + "But the type annotation on `" <> N.toString name <> "` says the " <> D.ordinalize (Index.toHuman index) <> " argument should be:" , [] ) @@ -219,7 +219,7 @@ toPatternReport source localizer patternRegion category tipe expected = PCaseMatch index -> if index == Index.first then ( - H.reflow $ + D.reflow $ "The 1st pattern in this `case` causing a mismatch:" , patternTypeComparison localizer tipe expectedType @@ -228,20 +228,20 @@ toPatternReport source localizer patternRegion category tipe expected = , "But it is supposed to match an expression of type:" , - [ H.reflow $ + [ D.reflow $ "Is the pattern the problem? Or is it the expression you are trying to match on?" ] ) ) else ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " pattern in this `case` does not match the previous ones." + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " pattern in this `case` does not match the previous ones." , patternTypeComparison localizer tipe expectedType ( toPatternDescription category $ - "The " <> H.ordinalize (Index.toHuman index) <> " pattern is trying to match" + "The " <> D.ordinalize (Index.toHuman index) <> " pattern is trying to match" , "But all the previous patterns match values of type:" , @@ -251,14 +251,14 @@ toPatternReport source localizer patternRegion category tipe expected = PCtorArg name index -> ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " argument to `" <> N.toString name <> "` is weird." + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " argument to `" <> N.toString name <> "` is weird." , patternTypeComparison localizer tipe expectedType ( toPatternDescription category "It is trying to match" , - "But `" <> N.toString name <> "` needs its " <> H.ordinalize (Index.toHuman index) <> " argument to be:" + "But `" <> N.toString name <> "` needs its " <> D.ordinalize (Index.toHuman index) <> " argument to be:" , [] ) @@ -266,17 +266,17 @@ toPatternReport source localizer patternRegion category tipe expected = PListEntry index -> ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " pattern in this list does not match all the previous ones:" + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " pattern in this list does not match all the previous ones:" , patternTypeComparison localizer tipe expectedType ( toPatternDescription category $ - "The " <> H.ordinalize (Index.toHuman index) <> " pattern is trying to match" + "The " <> D.ordinalize (Index.toHuman index) <> " pattern is trying to match" , "But all the previous patterns in the list are:" , - [ H.toSimpleHint $ + [ D.toSimpleHint $ "Everything in the list needs to be the same type of value.\ \ This way you never run into unexpected values partway through.\ \ To mix different types in a single list, create a \"union type\" as\ @@ -287,7 +287,7 @@ toPatternReport source localizer patternRegion category tipe expected = PTail -> ( - H.reflow $ + D.reflow $ "The pattern after (::) is causing issues." , patternTypeComparison localizer tipe expectedType @@ -306,17 +306,17 @@ toPatternReport source localizer patternRegion category tipe expected = -- PATTERN HELPERS -patternTypeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc +patternTypeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) = let (actualDoc, expectedDoc, problems) = T.toDiffDocs localizer actual expected in - H.stack $ - [ H.reflow iAmSeeing - , H.indent 4 actualDoc - , H.reflow insteadOf - , H.indent 4 expectedDoc + D.stack $ + [ D.reflow iAmSeeing + , D.indent 4 actualDoc + , D.reflow insteadOf + , D.indent 4 expectedDoc ] ++ problemsToHint problems ++ contextHints @@ -340,31 +340,31 @@ toPatternDescription category iAmTryingToMatch = -- EXPR HELPERS -typeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [H.Doc] ) -> H.Doc +typeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc typeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) = let (actualDoc, expectedDoc, problems) = T.toDiffDocs localizer actual expected in - H.stack $ - [ H.reflow iAmSeeing - , H.indent 4 actualDoc - , H.reflow insteadOf - , H.indent 4 expectedDoc + D.stack $ + [ D.reflow iAmSeeing + , D.indent 4 actualDoc + , D.reflow insteadOf + , D.indent 4 expectedDoc ] ++ problemsToHint problems ++ contextHints -loneType :: T.Localizer -> T.Type -> T.Type -> ( H.Doc, [H.Doc] ) -> H.Doc +loneType :: T.Localizer -> T.Type -> T.Type -> ( D.Doc, [D.Doc] ) -> D.Doc loneType localizer actual expected ( iAmSeeing, furtherDetails ) = let (actualDoc, _, problems) = T.toDiffDocs localizer actual expected in - H.stack $ + D.stack $ [ iAmSeeing - , H.indent 4 actualDoc + , D.indent 4 actualDoc ] ++ furtherDetails ++ problemsToHint problems @@ -398,7 +398,7 @@ toDescription category thatThingIs = OpName _ -> thatThingIs <> ":" -problemsToHint :: [T.Problem] -> [H.Doc] +problemsToHint :: [T.Problem] -> [D.Doc] problemsToHint problems = case problems of [] -> @@ -408,63 +408,63 @@ problemsToHint problems = problemToHint problem -problemToHint :: T.Problem -> [H.Doc] +problemToHint :: T.Problem -> [D.Doc] problemToHint problem = case problem of T.FieldMismatch _ _ -> [] -- TODO do a better job? T.IntFloat -> - [ H.fancyLink "Note" ["Read"] "implicit-casts" + [ D.fancyLink "Note" ["Read"] "implicit-casts" ["to","learn","why","Elm","does","not","implicitly","convert" - ,"Ints","to","Floats.","Use",H.green "toFloat","and" - ,H.green "round","to","do","explicit","conversions." + ,"Ints","to","Floats.","Use",D.green "toFloat","and" + ,D.green "round","to","do","explicit","conversions." ] ] T.StringFromInt -> - [ H.toFancyHint + [ D.toFancyHint ["Want","to","convert","an","Int","into","a","String?" - ,"Use","the",H.green "String.fromInt","function!" + ,"Use","the",D.green "String.fromInt","function!" ] ] T.StringFromFloat -> - [ H.toFancyHint + [ D.toFancyHint ["Want","to","convert","a","Float","into","a","String?" - ,"Use","the",H.green "String.fromFloat","function!" + ,"Use","the",D.green "String.fromFloat","function!" ] ] T.StringToInt -> - [ H.toFancyHint + [ D.toFancyHint ["Want","to","convert","a","String","into","an","Int?" - ,"Use","the",H.green "String.toInt","function!" + ,"Use","the",D.green "String.toInt","function!" ] ] T.StringToFloat -> - [ H.toFancyHint + [ D.toFancyHint ["Want","to","convert","a","String","into","a","Float?" - ,"Use","the",H.green "String.toFloat","function!" + ,"Use","the",D.green "String.toFloat","function!" ] ] T.AnythingToBool -> - [ H.toSimpleHint $ + [ D.toSimpleHint $ "Elm does not have “truthiness” such that ints and strings and lists\ \ are automatically converted to booleans. Do that conversion explicitly!" ] T.AnythingFromMaybe -> - [ H.toFancyHint - ["Use",H.green "Maybe.withDefault","to","handle","possible","errors." + [ D.toFancyHint + ["Use",D.green "Maybe.withDefault","to","handle","possible","errors." ,"Longer","term,","it","is","usually","better","to","write","out","the" ,"full","`case`","though!" ] ] T.AnythingToList -> - [ H.toSimpleHint "Did you forget to add [] around it?" + [ D.toSimpleHint "Did you forget to add [] around it?" ] T.MissingArgs _ -> [] @@ -520,25 +520,25 @@ problemToHint problem = -- BAD RIGID HINTS -badRigidVar :: N.Name -> String -> [H.Doc] +badRigidVar :: N.Name -> String -> [D.Doc] badRigidVar name aThing = - [ H.toSimpleHint $ + [ D.toSimpleHint $ "Your type annotation uses type variable `" ++ N.toString name ++ "` which means ANY type of value can flow through, but your code is saying it specifically wants " ++ aThing ++ ". Maybe change your type annotation to\ \ be more specific? Maybe change the code to be more general?" - , H.reflowLink "Read" "type-annotations" "for more advice!" + , D.reflowLink "Read" "type-annotations" "for more advice!" ] -badDoubleRigid :: N.Name -> N.Name -> [H.Doc] +badDoubleRigid :: N.Name -> N.Name -> [D.Doc] badDoubleRigid x y = - [ H.toSimpleHint $ + [ D.toSimpleHint $ "Your type annotation uses `" ++ N.toString x ++ "` and `" ++ N.toString y ++ "` as separate type variables. Your code seems to be saying they are the\ \ same though! Maybe they should be the same in your type annotation?\ \ Maybe your code uses them in a weird way?" - , H.reflowLink "Read" "type-annotations" "for more advice!" + , D.reflowLink "Read" "type-annotations" "for more advice!" ] @@ -555,47 +555,47 @@ toASuperThing super = -- BAD SUPER HINTS -badFlexSuper :: T.Super -> T.Type -> [H.Doc] +badFlexSuper :: T.Super -> T.Type -> [D.Doc] badFlexSuper super tipe = case super of T.Comparable -> - [ H.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable." + [ D.toSimpleHint "Only ints, floats, chars, strings, lists, and tuples are comparable." ] T.Appendable -> case tipe of T.Type home name _ | T.isInt home name -> - [ H.toFancyHint ["Try","using",H.green"String.fromInt","to","convert","it","to","a","string?"] + [ D.toFancyHint ["Try","using",D.green"String.fromInt","to","convert","it","to","a","string?"] ] T.Type home name _ | T.isFloat home name -> - [ H.toFancyHint ["Try","using",H.green"String.fromFloat","to","convert","it","to","a","string?"] + [ D.toFancyHint ["Try","using",D.green"String.fromFloat","to","convert","it","to","a","string?"] ] T.FlexSuper T.Number _ -> - [ H.toFancyHint ["Try","using",H.green"String.fromInt","to","convert","it","to","a","string?"] + [ D.toFancyHint ["Try","using",D.green"String.fromInt","to","convert","it","to","a","string?"] ] _ -> - [ H.toFancyHint ["Only","strings","and","lists","are","appendable.","Put","it","in",H.green "[]","to","make","it","a","list?"] + [ D.toFancyHint ["Only","strings","and","lists","are","appendable.","Put","it","in",D.green "[]","to","make","it","a","list?"] ] T.CompAppend -> - [ H.toSimpleHint "Only strings and lists are both comparable and appendable." + [ D.toSimpleHint "Only strings and lists are both comparable and appendable." ] T.Number -> case tipe of T.Type home name _ | T.isString home name -> - [ H.toFancyHint ["Try","using",H.green"String.toInt","to","convert","it","to","a","number?"] + [ D.toFancyHint ["Try","using",D.green"String.toInt","to","convert","it","to","a","number?"] ] _ -> - [ H.toFancyHint ["Only",H.green "Int","and",H.green "Float","values","work","as","numbers."] + [ D.toFancyHint ["Only",D.green "Int","and",D.green "Float","values","work","as","numbers."] ] -badRigidSuper :: T.Super -> String -> [H.Doc] +badRigidSuper :: T.Super -> String -> [D.Doc] badRigidSuper super aThing = let (superType, manyThings) = @@ -605,16 +605,16 @@ badRigidSuper super aThing = T.Appendable -> ("appendable", "strings AND lists") T.CompAppend -> ("compappend", "strings AND lists") in - [ H.toSimpleHint $ + [ D.toSimpleHint $ "The `" ++ superType ++ "` in your type annotation is saying that " ++ manyThings ++ " can flow through, but your code is saying it specifically wants " ++ aThing ++ ". Maybe change your type annotation to\ \ be more specific? Maybe change the code to be more general?" - , H.reflowLink "Read" "type-annotations" "for more advice!" + , D.reflowLink "Read" "type-annotations" "for more advice!" ] -badFlexFlexSuper :: T.Super -> T.Super -> [H.Doc] +badFlexFlexSuper :: T.Super -> T.Super -> [D.Doc] badFlexFlexSuper s1 s2 = let likeThis super = @@ -624,7 +624,7 @@ badFlexFlexSuper s1 s2 = T.CompAppend -> "a compappend" T.Appendable -> "appendable" in - [ H.toSimpleHint $ + [ D.toSimpleHint $ "There are no values in Elm that are both" ++ likeThis s1 ++ " and " ++ likeThis s2 ++ "." ] @@ -656,13 +656,13 @@ toExprReport source localizer exprRegion category tipe expected = FromAnnotation name _arity subContext expectedType -> Report.toCodeSnippet source exprRegion Nothing ( - H.reflow $ + D.reflow $ case subContext of TypedIfBranch index -> - "Something is off with the " <> H.ordinalize (Index.toHuman index) <> " branch of this `if` expression:" + "Something is off with the " <> D.ordinalize (Index.toHuman index) <> " branch of this `if` expression:" TypedCaseBranch index -> - "Something is off with the " <> H.ordinalize (Index.toHuman index) <> " branch of this `case` expression:" + "Something is off with the " <> D.ordinalize (Index.toHuman index) <> " branch of this `case` expression:" TypedBody -> "Something is off with the body of the `" <> N.toString name <> "` definition:" @@ -672,10 +672,10 @@ toExprReport source localizer exprRegion category tipe expected = toDescription category $ case subContext of TypedIfBranch index -> - "The " <> H.ordinalize (Index.toHuman index) <> " branch is" + "The " <> D.ordinalize (Index.toHuman index) <> " branch is" TypedCaseBranch index -> - "The " <> H.ordinalize (Index.toHuman index) <> " branch is" + "The " <> D.ordinalize (Index.toHuman index) <> " branch is" TypedBody -> "The body is" @@ -691,17 +691,17 @@ toExprReport source localizer exprRegion category tipe expected = ListEntry index -> Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " element of this list does not match all the previous elements:" + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " element of this list does not match all the previous elements:" , typeComparison localizer tipe expectedType ( toDescription category $ - "The " <> H.ordinalize (Index.toHuman index) <> " element is" + "The " <> D.ordinalize (Index.toHuman index) <> " element is" , "But all the previous elements in the list are:" , - [ H.toSimpleHint $ + [ D.toSimpleHint $ "Everything in the list needs to be the same type of value.\ \ This way you never run into unexpected values partway through.\ \ To mix different types in a single list, create a \"union type\" as\ @@ -717,11 +717,11 @@ toExprReport source localizer exprRegion category tipe expected = , loneType localizer tipe expectedType ( - H.reflow $ toDescription category "It is" + D.reflow $ toDescription category "It is" , - [ H.fillSep + [ D.fillSep ["But","I","only","now","how","to","negate" - ,H.dullyellow "Int","and",H.dullyellow "Float","values." + ,D.dullyellow "Int","and",D.dullyellow "Float","values." ] ] ) @@ -746,9 +746,9 @@ toExprReport source localizer exprRegion category tipe expected = , loneType localizer tipe expectedType ( - H.reflow $ toDescription category "It is" + D.reflow $ toDescription category "It is" , - [ H.fillSep ["But","I","need","this","`if`","condition","to","be","a",H.dullyellow "Bool","value."] + [ D.fillSep ["But","I","need","this","`if`","condition","to","be","a",D.dullyellow "Bool","value."] ] ) ) @@ -756,17 +756,17 @@ toExprReport source localizer exprRegion category tipe expected = IfBranch index -> Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " branch of this `if` does not match all the previous branches:" + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " branch of this `if` does not match all the previous branches:" , typeComparison localizer tipe expectedType ( toDescription category $ - "The " <> H.ordinalize (Index.toHuman index) <> " branch is" + "The " <> D.ordinalize (Index.toHuman index) <> " branch is" , "But all the previous branches result in:" , - [ H.link "Hint" + [ D.link "Hint" "All branches in an `if` must produce the same type of values. This way, no\ \ matter which branch we take, the result is always a consistent shape. Read" "union-types" @@ -778,17 +778,17 @@ toExprReport source localizer exprRegion category tipe expected = CaseBranch index -> Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " branch of this `case` does not match all the previous branches:" + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " branch of this `case` does not match all the previous branches:" , typeComparison localizer tipe expectedType ( toDescription category $ - "The " <> H.ordinalize (Index.toHuman index) <> " branch is" + "The " <> D.ordinalize (Index.toHuman index) <> " branch is" , "But all the previous branches result in:" , - [ H.link "Hint" + [ D.link "Hint" "All branches in a `case` must produce the same type of values. This way, no\ \ matter which branch we take, the result is always a consistent shape. Read" "union-types" @@ -801,33 +801,33 @@ toExprReport source localizer exprRegion category tipe expected = case countArgs tipe of 0 -> Report.toCodeSnippet source region (Just exprRegion) - ( H.reflow $ + ( D.reflow $ case maybeFuncName of NoName -> "This is not a function:" FuncName name -> "The `" <> N.toString name <> "` value is not a function:" CtorName name -> "The `" <> N.toString name <> "` value is not a function:" OpName op -> "The (" <> N.toString op <> ") operator is not a function:" , - H.stack $ + D.stack $ [ "It has type:" - , H.indent 4 $ H.dullyellow $ T.toDoc localizer RT.None tipe - , H.reflow $ "So it cannot accept arguments, but it got " <> show numArgs <> " anyway." + , D.indent 4 $ D.dullyellow $ T.toDoc localizer RT.None tipe + , D.reflow $ "So it cannot accept arguments, but it got " <> show numArgs <> " anyway." ] ) n -> Report.toCodeSnippet source region (Just exprRegion) - ( H.reflow $ + ( D.reflow $ case maybeFuncName of NoName -> "This function was given too many arguments:" FuncName name -> "The `" <> N.toString name <> "` function was given too many arguments:" CtorName name -> "The `" <> N.toString name <> "` constructor was given too many arguments:" OpName op -> "The (" <> N.toString op <> ") operator was given too many arguments:" , - H.stack $ + D.stack $ [ "It has type:" - , H.indent 4 $ H.dullyellow $ T.toDoc localizer RT.None tipe - , H.reflow $ "So it expects " <> H.args n <> ", but it got " <> show numArgs <> " instead." + , D.indent 4 $ D.dullyellow $ T.toDoc localizer RT.None tipe + , D.reflow $ "So it expects " <> D.args n <> ", but it got " <> show numArgs <> " instead." ] ) @@ -842,20 +842,20 @@ toExprReport source localizer exprRegion category tipe expected = in Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ - "The " <> H.ordinalize (Index.toHuman index) <> " argument to " <> thisFunction <> " is not what I expect:" + D.reflow $ + "The " <> D.ordinalize (Index.toHuman index) <> " argument to " <> thisFunction <> " is not what I expect:" , typeComparison localizer tipe expectedType ( toDescription category "This argument is" , - "But " <> thisFunction <> " needs the " <> H.ordinalize (Index.toHuman index) + "But " <> thisFunction <> " needs the " <> D.ordinalize (Index.toHuman index) <> " argument to be:" , if Index.toHuman index == 1 then [] else - [ H.toSimpleHint $ + [ D.toSimpleHint $ "I always figure out the argument types from left to right. If an argument\ \ is acceptable, I assume it is “correct” and move on. So the problem may\ \ actually be in one of the previous arguments!" @@ -868,19 +868,19 @@ toExprReport source localizer exprRegion category tipe expected = 0 -> Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ + D.reflow $ case maybeName of NoName -> - "You are giving " <> H.args numGivenArgs <> " to something that is not a function!" + "You are giving " <> D.args numGivenArgs <> " to something that is not a function!" FuncName name -> - "`" <> N.toString name <> "` is not a function, but you are giving it " <> H.args numGivenArgs <> "!" + "`" <> N.toString name <> "` is not a function, but you are giving it " <> D.args numGivenArgs <> "!" CtorName name -> - "`" <> N.toString name <> "` is not a function, but you are giving it " <> H.args numGivenArgs <> "!" + "`" <> N.toString name <> "` is not a function, but you are giving it " <> D.args numGivenArgs <> "!" OpName op -> - "(" <> N.toString op <> ") is not a function, but you are giving it " <> H.args numGivenArgs <> "!" + "(" <> N.toString op <> ") is not a function, but you are giving it " <> D.args numGivenArgs <> "!" , typeComparison localizer tipe expectedType ( @@ -897,7 +897,7 @@ toExprReport source localizer exprRegion category tipe expected = OpName op -> "(" <> N.toString op <> ") is a value of type:" , - "But you are giving it " <> H.args numGivenArgs <> " as if its type was:" + "But you are giving it " <> D.args numGivenArgs <> " as if its type was:" , [ "Maybe you forgot some parentheses? Or a comma?" ] @@ -922,17 +922,17 @@ toExprReport source localizer exprRegion category tipe expected = in Report.toCodeSnippet source region (Just exprRegion) ( - H.reflow $ + D.reflow $ thisFunction <> " is getting too many arguments:" , typeComparison localizer tipe expectedType ( - thisFunction <> " is expecting to get " <> H.args numExpectedArgs <> " like this:" + thisFunction <> " is expecting to get " <> D.args numExpectedArgs <> " like this:" , - "But you are giving it " <> H.args numGivenArgs <> " as if its type was:" + "But you are giving it " <> D.args numGivenArgs <> " as if its type was:" , [ "Maybe you forgot some parentheses? Or a comma?" - , H.toSimpleNote $ + , D.toSimpleNote $ "I am not good at figuring out which arguments are extra myself. The\ \ problem may even be that the FUNCTION is defined funny, and the arguments are\ \ actually fine. Anyway, I hope I gave enough info to help you figure it out!" @@ -945,15 +945,15 @@ toExprReport source localizer exprRegion category tipe expected = case tipe of T.Record _ _ -> ( - H.reflow $ + D.reflow $ "This record does not have a `" <> N.toString field <> "` field:" , loneType localizer tipe expectedType ( - H.reflow $ "It is a record with this type:" + D.reflow $ "It is a record with this type:" , - [ H.fillSep - ["Is","the",H.dullyellow ("." <> H.nameToDoc field) + [ D.fillSep + ["Is","the",D.dullyellow ("." <> D.fromName field) ,"field","access","is","misspelled?" ] ] @@ -962,14 +962,14 @@ toExprReport source localizer exprRegion category tipe expected = _ -> ( - H.reflow $ + D.reflow $ "This is not a record, so it has no fields to access!" , loneType localizer tipe expectedType - ( H.reflow $ toDescription category "It is" - , [ H.fillSep + ( D.reflow $ toDescription category "It is" + , [ D.fillSep ["But","I","need","a","record","with","a" - ,H.dullyellow (H.nameToDoc field),"field!" + ,D.dullyellow (D.fromName field),"field!" ] ] ) @@ -980,7 +980,7 @@ toExprReport source localizer exprRegion category tipe expected = T.Record _ _ -> Report.toCodeSnippet source region Nothing $ ( - H.reflow $ + D.reflow $ "I think there is a typo in one of these field names:" , typeComparison localizer tipe expectedType @@ -989,7 +989,7 @@ toExprReport source localizer exprRegion category tipe expected = , "But you are saying it should have these fields:" , - [ H.reflow "Maybe there is some typo?" + [ D.reflow "Maybe there is some typo?" ] ) ) @@ -1000,8 +1000,8 @@ toExprReport source localizer exprRegion category tipe expected = "The record update syntax does not work with this value:" , loneType localizer tipe expectedType - ( H.reflow $ toDescription category "It is" - , [ H.reflow $ "But I need some kind of record here!" + ( D.reflow $ toDescription category "It is" + , [ D.reflow $ "But I need some kind of record here!" ] ) ) @@ -1009,7 +1009,7 @@ toExprReport source localizer exprRegion category tipe expected = Destructure -> Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I cannot destructure " , typeComparison localizer tipe expectedType @@ -1041,7 +1041,7 @@ countArgs tipe = -- OP LEFT -opLeftToDocs :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> (H.Doc, H.Doc) +opLeftToDocs :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> (D.Doc, D.Doc) opLeftToDocs localizer category op tipe expected = case op of "+" @@ -1070,15 +1070,15 @@ opLeftToDocs localizer category op tipe expected = ( "The left side of (<|) needs to be a function so I can pipe arguments to it!" , loneType localizer tipe expected - ( H.reflow $ toDescription category "I am seeing" - , [ H.reflow $ "This needs to be some kind of function though!" + ( D.reflow $ toDescription category "I am seeing" + , [ D.reflow $ "This needs to be some kind of function though!" ] ) ) _ -> ( - H.reflow $ + D.reflow $ "The left argument of (" <> N.toString op <> ") is causing problems:" , typeComparison localizer tipe expected @@ -1097,8 +1097,8 @@ opLeftToDocs localizer category op tipe expected = data RightDocs - = EmphBoth (H.Doc, H.Doc) - | EmphRight (H.Doc, H.Doc) + = EmphBoth (D.Doc, D.Doc) + | EmphRight (D.Doc, D.Doc) opRightToDocs :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> RightDocs @@ -1146,7 +1146,7 @@ opRightToDocs localizer category op tipe expected = "<|" -> EmphRight ( - H.reflow $ + D.reflow $ "I cannot send this through the (<|) pipe:" , typeComparison localizer tipe expected @@ -1182,7 +1182,7 @@ opRightToDocs localizer category op tipe expected = "The right side of (|>) needs to be a function so I can pipe arguments to it!" , loneType localizer tipe expected - ( H.reflow $ toDescription category $ + ( D.reflow $ toDescription category $ "But instead of a function, I am seeing " , [] ) @@ -1196,7 +1196,7 @@ badOpRightFallback :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> R badOpRightFallback localizer category op tipe expected = EmphRight ( - H.reflow $ + D.reflow $ "The right argument of (" <> N.toString op <> ") is causing problems." , typeComparison localizer tipe expected @@ -1205,7 +1205,7 @@ badOpRightFallback localizer category op tipe expected = , "But (" <> N.toString op <> ") needs the right argument to be:" , - [ H.toSimpleHint $ + [ D.toSimpleHint $ "With operators like (" ++ N.toString op ++ ") I always check the left\ \ side first. If it seems fine, I assume it is correct and check the right\ \ side. So the problem may be in how the left and right arguments interact!" @@ -1266,7 +1266,7 @@ badConsRight localizer category tipe expected = T.Type home2 name2 [expectedElement] | T.isList home2 name2 -> EmphBoth ( - H.reflow "I am having trouble with this (::) operator:" + D.reflow "I am having trouble with this (::) operator:" , typeComparison localizer expectedElement actualElement ( @@ -1276,14 +1276,14 @@ badConsRight localizer category tipe expected = , case expectedElement of T.Type home name [_] | T.isList home name -> - [ H.toSimpleHint + [ D.toSimpleHint "Are you trying to append two lists? The (++) operator\ \ appends lists, whereas the (::) operator is only for\ \ adding ONE element to a list." ] _ -> - [ H.reflow + [ D.reflow "Lists need ALL elements to be the same type though." ] ) @@ -1295,13 +1295,13 @@ badConsRight localizer category tipe expected = _ -> EmphRight ( - H.reflow "The (::) operator can only add elements onto lists." + D.reflow "The (::) operator can only add elements onto lists." , loneType localizer tipe expected ( - H.reflow $ toDescription category "The right side is" + D.reflow $ toDescription category "The right side is" , - [H.fillSep ["But","(::)","needs","a",H.dullyellow "List","on","the","right."] + [D.fillSep ["But","(::)","needs","a",D.dullyellow "List","on","the","right."] ] ) ) @@ -1312,7 +1312,7 @@ badConsRight localizer category tipe expected = data AppendType - = ANumber H.Doc H.Doc + = ANumber D.Doc D.Doc | AString | AList | AOther @@ -1332,18 +1332,18 @@ toAppendType tipe = _ -> AOther -badAppendLeft :: T.Localizer -> Category -> T.Type -> T.Type -> (H.Doc, H.Doc) +badAppendLeft :: T.Localizer -> Category -> T.Type -> T.Type -> (D.Doc, D.Doc) badAppendLeft localizer category tipe expected = case toAppendType tipe of ANumber thing stringFromThing -> ( - H.fillSep + D.fillSep ["The","(++)","operator","can","append","List","and","String" - ,"values,","but","not",H.dullyellow thing,"values","like","this:" + ,"values,","but","not",D.dullyellow thing,"values","like","this:" ] , - H.fillSep - ["Try","using",H.green stringFromThing,"to","turn","it","into","a","string?" + D.fillSep + ["Try","using",D.green stringFromThing,"to","turn","it","into","a","string?" ,"Or","put","it","in","[]","to","make","it","a","list?" ,"Or","switch","to","the","(::)","operator?" ] @@ -1351,15 +1351,15 @@ badAppendLeft localizer category tipe expected = _ -> ( - H.reflow $ + D.reflow $ "The (++) operator cannot append this type of value:" , loneType localizer tipe expected - ( H.reflow $ toDescription category "I am seeing" + ( D.reflow $ toDescription category "I am seeing" , - [ H.fillSep + [ D.fillSep ["But","the","(++)","operator","is","only","for","appending" - ,H.dullyellow "List","and",H.dullyellow "String","values." + ,D.dullyellow "List","and",D.dullyellow "String","values." ,"Maybe","put","this","value","in","[]","to","make","it","a","list?" ] ] @@ -1373,13 +1373,13 @@ badAppendRight localizer category tipe expected = (AString, ANumber thing stringFromThing) -> EmphRight ( - H.fillSep - ["I","thought","I","was","appending",H.dullyellow "String","values","here," - ,"not",H.dullyellow thing,"values","like","this:" + D.fillSep + ["I","thought","I","was","appending",D.dullyellow "String","values","here," + ,"not",D.dullyellow thing,"values","like","this:" ] , - H.fillSep - ["Try","using",H.green stringFromThing + D.fillSep + ["Try","using",D.green stringFromThing ,"to","turn","it","into","a","string?" ] ) @@ -1387,23 +1387,23 @@ badAppendRight localizer category tipe expected = (AList, ANumber thing _) -> EmphRight ( - H.fillSep - ["I","thought","I","was","appending",H.dullyellow "List","values","here," - ,"not",H.dullyellow thing,"values","like","this:" + D.fillSep + ["I","thought","I","was","appending",D.dullyellow "List","values","here," + ,"not",D.dullyellow thing,"values","like","this:" ] , - H.reflow "Try putting it in [] to make it a list?" + D.reflow "Try putting it in [] to make it a list?" ) (AString, AList) -> EmphBoth ( - H.reflow $ + D.reflow $ "The (++) operator needs the same type of value on both sides:" , - H.fillSep - ["I","see","a",H.dullyellow "String","on","the","left","and","a" - ,H.dullyellow "List","on","the","right.","Which","should","it","be?" + D.fillSep + ["I","see","a",D.dullyellow "String","on","the","left","and","a" + ,D.dullyellow "List","on","the","right.","Which","should","it","be?" ,"Does","the","string","need","[]","around","it","to","become","a","list?" ] ) @@ -1411,12 +1411,12 @@ badAppendRight localizer category tipe expected = (AList, AString) -> EmphBoth ( - H.reflow $ + D.reflow $ "The (++) operator needs the same type of value on both sides:" , - H.fillSep - ["I","see","a",H.dullyellow "List","on","the","left","and","a" - ,H.dullyellow "String","on","the","right.","Which","should","it","be?" + D.fillSep + ["I","see","a",D.dullyellow "List","on","the","left","and","a" + ,D.dullyellow "String","on","the","right.","Which","should","it","be?" ,"Does","the","string","need","[]","around","it","to","become","a","list?" ] ) @@ -1424,7 +1424,7 @@ badAppendRight localizer category tipe expected = (_,_) -> EmphBoth ( - H.reflow $ + D.reflow $ "The (++) operator cannot append these two values:" , typeComparison localizer expected tipe @@ -1450,14 +1450,14 @@ badCast :: N.Name -> ThisThenThat -> RightDocs badCast op thisThenThat = EmphBoth ( - H.text $ + D.reflow $ "I need both sides of (" <> N.toString op <> ") to be the exact same type. Both Int or both Float." , let - anInt = ["an", H.dullyellow "Int"] - aFloat = ["a", H.dullyellow "Float"] - toFloat = H.green "toFloat" - round = H.green "round" + anInt = ["an", D.dullyellow "Int"] + aFloat = ["a", D.dullyellow "Float"] + toFloat = D.green "toFloat" + round = D.green "round" in case thisThenThat of FloatInt -> @@ -1468,85 +1468,85 @@ badCast op thisThenThat = ) -badCastHelp :: [H.Doc] -> [H.Doc] -> H.Doc -> H.Doc -> H.Doc +badCastHelp :: [D.Doc] -> [D.Doc] -> D.Doc -> D.Doc -> D.Doc badCastHelp anInt aFloat toFloat round = - H.stack - [ H.fillSep $ + D.stack + [ D.fillSep $ ["But","I","see"] ++ anInt ++ ["on","the","left","and"] ++ aFloat ++ ["on","the","right."] - , H.fillSep + , D.fillSep ["Use",toFloat,"on","the","left","(or",round,"on" ,"the","right)","to","make","both","sides","match!" ] - , H.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." + , D.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." ] -badStringAdd :: (H.Doc, H.Doc) +badStringAdd :: (D.Doc, D.Doc) badStringAdd = ( - H.fillSep ["I","cannot","do","addition","with",H.dullyellow "String","values","like","this","one:"] + D.fillSep ["I","cannot","do","addition","with",D.dullyellow "String","values","like","this","one:"] , - H.stack - [ H.fillSep - ["The","(+)","operator","only","works","with",H.dullyellow "Int","and",H.dullyellow "Float","values." + D.stack + [ D.fillSep + ["The","(+)","operator","only","works","with",D.dullyellow "Int","and",D.dullyellow "Float","values." ] - , H.toFancyHint - ["Switch","to","the",H.green "(++)","operator","to","append","strings!" + , D.toFancyHint + ["Switch","to","the",D.green "(++)","operator","to","append","strings!" ] ] ) -badListAdd :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (H.Doc, H.Doc) +badListAdd :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc) badListAdd localizer category direction tipe expected = ( "I cannot do addition with lists:" , loneType localizer tipe expected ( - H.reflow $ toDescription category $ + D.reflow $ toDescription category $ "The " <> direction <> " side of (+) is" , - [ H.fillSep - ["But","(+)","only","works","with",H.dullyellow "Int","and",H.dullyellow "Float","values." + [ D.fillSep + ["But","(+)","only","works","with",D.dullyellow "Int","and",D.dullyellow "Float","values." ] - , H.toFancyHint - ["Switch","to","the",H.green "(++)","operator","to","append","lists!" + , D.toFancyHint + ["Switch","to","the",D.green "(++)","operator","to","append","lists!" ] ] ) ) -badListMul :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (H.Doc, H.Doc) +badListMul :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc) badListMul localizer category direction tipe expected = badMath localizer category "Multiplication" direction "*" tipe expected [ - H.toFancyHint + D.toFancyHint [ "Maybe", "you", "want" - , H.green "List.repeat" + , D.green "List.repeat" , "to", "build","a","list","of","repeated","values?" ] ] -badMath :: T.Localizer -> Category -> String -> String -> String -> T.Type -> T.Type -> [H.Doc] -> (H.Doc, H.Doc) +badMath :: T.Localizer -> Category -> String -> String -> String -> T.Type -> T.Type -> [D.Doc] -> (D.Doc, D.Doc) badMath localizer category operation direction op tipe expected otherHints = ( - H.reflow $ + D.reflow $ operation ++ " does not work with this value:" , loneType localizer tipe expected - ( H.reflow $ toDescription category $ + ( D.reflow $ toDescription category $ "The " <> direction <> " side of (" <> op <> ") is" , - [ H.fillSep - ["But","(" <> H.text op <> ")","only","works","with" - ,H.dullyellow "Int","and",H.dullyellow "Float","values." + [ D.fillSep + ["But","(" <> D.fromString op <> ")","only","works","with" + ,D.dullyellow "Int","and",D.dullyellow "Float","values." ] ] ++ otherHints @@ -1554,33 +1554,33 @@ badMath localizer category operation direction op tipe expected otherHints = ) -badFDiv :: T.Localizer -> H.Doc -> T.Type -> T.Type -> (H.Doc, H.Doc) +badFDiv :: T.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc) badFDiv localizer direction tipe expected = ( - H.reflow $ + D.reflow $ "The (/) operator is specifically for floating-point division:" , if isInt tipe then - H.stack - [ H.fillSep + D.stack + [ D.fillSep ["The",direction,"side","of","(/)","must","be","a" - ,H.dullyellow "Float" <> "," - ,"but","I","am","seeing","an",H.dullyellow "Int" <> "." + ,D.dullyellow "Float" <> "," + ,"but","I","am","seeing","an",D.dullyellow "Int" <> "." ,"I","recommend:" ] - , H.vcat - [ H.green "toFloat" <> " for explicit conversions " <> H.black "(toFloat 5 / 2) == 2.5" - , H.green "(//) " <> " for integer division " <> H.black "(5 // 2) == 2" + , D.vcat + [ D.green "toFloat" <> " for explicit conversions " <> D.black "(toFloat 5 / 2) == 2.5" + , D.green "(//) " <> " for integer division " <> D.black "(5 // 2) == 2" ] - , H.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." + , D.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." ] else loneType localizer tipe expected ( - H.fillSep + D.fillSep ["The",direction,"side","of","(/)","must","be","a" - ,H.dullyellow "Float" <> "," + ,D.dullyellow "Float" <> "," ,"but","instead","I","am","seeing:" ] , [] @@ -1588,35 +1588,35 @@ badFDiv localizer direction tipe expected = ) -badIDiv :: T.Localizer -> H.Doc -> T.Type -> T.Type -> (H.Doc, H.Doc) +badIDiv :: T.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc) badIDiv localizer direction tipe expected = ( - H.reflow $ + D.reflow $ "The (//) operator is specifically for integer division:" , if isFloat tipe then - H.stack - [ H.fillSep + D.stack + [ D.fillSep ["The",direction,"side","of","(//)","must","be","an" - ,H.dullyellow "Int" <> "," - ,"but","I","am","seeing","a",H.dullyellow "Float" <> "." + ,D.dullyellow "Int" <> "," + ,"but","I","am","seeing","a",D.dullyellow "Float" <> "." ,"I","recommend","doing","the","conversion","explicitly" ,"with","one","of","these","functions:" ] - , H.vcat - [ H.green "round" <> " 3.5 == 4" - , H.green "floor" <> " 3.5 == 3" - , H.green "ceiling" <> " 3.5 == 4" - , H.green "truncate" <> " 3.5 == 3" + , D.vcat + [ D.green "round" <> " 3.5 == 4" + , D.green "floor" <> " 3.5 == 3" + , D.green "ceiling" <> " 3.5 == 4" + , D.green "truncate" <> " 3.5 == 3" ] - , H.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." + , D.link "Note" "Read" "implicit-casts" "to learn why Elm does not implicitly convert Ints to Floats." ] else loneType localizer tipe expected ( - H.fillSep + D.fillSep ["The",direction,"side","of","(//)","must","be","an" - ,H.dullyellow "Int" <> "," + ,D.dullyellow "Int" <> "," ,"but","instead","I","am","seeing:" ] , [] @@ -1628,17 +1628,17 @@ badIDiv localizer direction tipe expected = -- BAD BOOLS -badBool :: T.Localizer -> H.Doc -> H.Doc -> T.Type -> T.Type -> (H.Doc, H.Doc) +badBool :: T.Localizer -> D.Doc -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc) badBool localizer op direction tipe expected = ( - H.reflow $ + D.reflow $ "I am struggling with this boolean operation:" , loneType localizer tipe expected ( - H.fillSep + D.fillSep ["Both","sides","of","(" <> op <> ")","must","be" - ,H.dullyellow "Bool","values,","but","the",direction,"side","is:" + ,D.dullyellow "Bool","values,","but","the",direction,"side","is:" ] , [] @@ -1650,24 +1650,24 @@ badBool localizer op direction tipe expected = -- BAD COMPARISON -badCompLeft :: T.Localizer -> Category -> String -> String -> T.Type -> T.Type -> (H.Doc, H.Doc) +badCompLeft :: T.Localizer -> Category -> String -> String -> T.Type -> T.Type -> (D.Doc, D.Doc) badCompLeft localizer category op direction tipe expected = ( - H.reflow $ + D.reflow $ "I cannot do a comparison with this value:" , loneType localizer tipe expected ( - H.reflow $ toDescription category $ + D.reflow $ toDescription category $ "The " <> direction <> " side of (" <> op <> ") is" , - [ H.fillSep - ["But","(" <> H.text op <> ")","only","works","on" - ,H.dullyellow "Int" <> "," - ,H.dullyellow "Float" <> "," - ,H.dullyellow "Char" <> "," + [ D.fillSep + ["But","(" <> D.fromString op <> ")","only","works","on" + ,D.dullyellow "Int" <> "," + ,D.dullyellow "Float" <> "," + ,D.dullyellow "Char" <> "," ,"and" - ,H.dullyellow "String" + ,D.dullyellow "String" ,"values.","It","can","work","on","lists","and","tuples" ,"of","comparable","values","as","well,","but","it","is" ,"usually","better","to","find","a","different","path." @@ -1681,7 +1681,7 @@ badCompRight :: T.Localizer -> String -> T.Type -> T.Type -> RightDocs badCompRight localizer op tipe expected = EmphBoth ( - H.reflow $ + D.reflow $ "I need both sides of (" <> op <> ") to be the same type:" , typeComparison localizer expected tipe @@ -1690,7 +1690,7 @@ badCompRight localizer op tipe expected = , "But the right side is:" , - [ H.reflow $ + [ D.reflow $ "I cannot compare different types though! Which side of (" <> op <> ") is the problem?" ] ) @@ -1705,7 +1705,7 @@ badEquality :: T.Localizer -> String -> T.Type -> T.Type -> RightDocs badEquality localizer op tipe expected = EmphBoth ( - H.reflow $ + D.reflow $ "I need both sides of (" <> op <> ") to be the same type:" , typeComparison localizer expected tipe @@ -1715,12 +1715,12 @@ badEquality localizer op tipe expected = "But the right side is:" , if isFloat tipe || isFloat expected then - [ H.toSimpleNote $ + [ D.toSimpleNote $ "Equality on floats is not 100% reliable due to the design of IEEE 754. I\ \ recommend a check like (abs (x - y) < 0.0001) instead." ] else - [ H.reflow $ + [ D.reflow $ "Different types can never be equal though! Which side is messed up?" ] ) @@ -1736,15 +1736,15 @@ toInfiniteReport source localizer region name overallType = Report.Report "INFINITE TYPE" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "I am inferring a weird self-referential type for " <> N.toString name <> ":" , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Here is my best effort at writing down the type. You will see ∞ for\ \ parts of the type that repeat something already printed out infinitely." - , H.indent 4 (H.dullyellow (T.toDoc localizer RT.None overallType)) - , H.reflowLink + , D.indent 4 (D.dullyellow (T.toDoc localizer RT.None overallType)) + , D.reflowLink "Staring at the type is usually not so helpful, so I recommend reading the hints at" "infinite-type" "to get unstuck." diff --git a/compiler/src/Reporting/Render/Code.hs b/compiler/src/Reporting/Render/Code.hs index 6b95b630..29cb2feb 100644 --- a/compiler/src/Reporting/Render/Code.hs +++ b/compiler/src/Reporting/Render/Code.hs @@ -12,8 +12,9 @@ module Reporting.Render.Code import qualified Data.List as List import qualified Data.Text as Text -import Text.PrettyPrint.ANSI.Leijen (Doc, (<>), hardline, dullred, empty, text) +import Reporting.Doc (Doc, (<>)) +import qualified Reporting.Doc as D import qualified Reporting.Region as R @@ -40,11 +41,6 @@ toSource source = f a -(<==>) :: Doc -> Doc -> Doc -(<==>) a b = - a <> hardline <> b - - render :: Source -> R.Region -> Maybe R.Region -> Doc render (Source sourceLines) region@(R.Region start end) maybeSubRegion = let @@ -64,7 +60,7 @@ render (Source sourceLines) region@(R.Region start end) maybeSubRegion = in case makeUnderline width endLine smallerRegion of Nothing -> - drawLines True width smallerRegion relevantLines empty + drawLines True width smallerRegion relevantLines D.empty Just underline -> drawLines False width smallerRegion relevantLines underline @@ -80,7 +76,7 @@ makeUnderline width realEndLine (R.Region (R.Position start c1) (R.Position end spaces = replicate (c1 + width + 1) ' ' zigzag = replicate (max 1 (c2 - c1)) '^' in - Just (text spaces <> dullred (text zigzag)) + Just (D.fromString spaces <> D.dullred (D.fromString zigzag)) drawLines :: Bool -> Int -> R.Region -> [(Int, Text.Text)] -> Doc -> Doc @@ -89,13 +85,14 @@ drawLines addZigZag width (R.Region start end) sourceLines finalLine = (R.Position startLine _) = start (R.Position endLine _) = end in - foldr (<==>) finalLine $ - map (drawLine addZigZag width startLine endLine) sourceLines + D.vcat $ + map (drawLine addZigZag width startLine endLine) sourceLines + ++ [finalLine] drawLine :: Bool -> Int -> Int -> Int -> (Int, Text.Text) -> Doc drawLine addZigZag width startLine endLine (n, line) = - addLineNumber addZigZag width startLine endLine n (text (Text.unpack line)) + addLineNumber addZigZag width startLine endLine n (D.fromText line) addLineNumber :: Bool -> Int -> Int -> Int -> Int -> Doc -> Doc @@ -109,11 +106,11 @@ addLineNumber addZigZag width start end n line = spacer = if addZigZag && start <= n && n <= end then - dullred ">" + D.dullred ">" else " " in - text lineNumber <> spacer <> line + D.fromString lineNumber <> spacer <> line @@ -142,10 +139,11 @@ renderPair source@(Source sourceLines) region1 region2 = (Just line) = List.lookup startRow1 sourceLines in OneLine $ - text lineNumber <> "| " <> text (Text.unpack line) - <> hardline - <> text spaces1 <> dullred (text zigzag1) - <> text spaces2 <> dullred (text zigzag2) + D.vcat + [ D.fromString lineNumber <> "| " <> D.fromText line + , D.fromString spaces1 <> D.dullred (D.fromString zigzag1) <> + D.fromString spaces2 <> D.dullred (D.fromString zigzag2) + ] else TwoChunks diff --git a/compiler/src/Reporting/Render/Type.hs b/compiler/src/Reporting/Render/Type.hs index 21e33e61..d4b8153a 100644 --- a/compiler/src/Reporting/Render/Type.hs +++ b/compiler/src/Reporting/Render/Type.hs @@ -21,8 +21,8 @@ import qualified AST.Canonical as Can import qualified AST.Module.Name as ModuleName import qualified Elm.Name as N import qualified Reporting.Annotation as A -import qualified Reporting.Helpers as H -import Reporting.Helpers ( Doc, (<+>), (<>) ) +import qualified Reporting.Doc as D +import Reporting.Doc ( Doc, (<+>), (<>) ) @@ -39,12 +39,12 @@ lambda :: Context -> Doc -> Doc -> [Doc] -> Doc lambda context arg1 arg2 args = let lambdaDoc = - H.sep (arg1 : map ("->" <+>) (arg2:args)) + D.sep (arg1 : map ("->" <+>) (arg2:args)) in case context of None -> lambdaDoc - Func -> H.cat [ "(", lambdaDoc, ")" ] - App -> H.cat [ "(", lambdaDoc, ")" ] + Func -> D.cat [ "(", lambdaDoc, ")" ] + App -> D.cat [ "(", lambdaDoc, ")" ] apply :: Context -> Doc -> [Doc] -> Doc @@ -56,10 +56,10 @@ apply context name args = _:_ -> let applyDoc = - H.hang 4 (H.sep (name : args)) + D.hang 4 (D.sep (name : args)) in case context of - App -> H.cat [ "(", applyDoc, ")" ] + App -> D.cat [ "(", applyDoc, ")" ] Func -> applyDoc None -> applyDoc @@ -70,7 +70,7 @@ tuple a b cs = entries = zipWith (<+>) ("(" : repeat ",") (a:b:cs) in - H.sep [ H.cat entries, ")" ] + D.sep [ D.cat entries, ")" ] record :: [(Doc, Doc)] -> Maybe Doc -> Doc @@ -80,16 +80,16 @@ record entries maybeExt = "{}" (fields, Nothing) -> - H.sep - [ H.cat (zipWith (<+>) ("{" : repeat ",") fields) + D.sep + [ D.cat (zipWith (<+>) ("{" : repeat ",") fields) , "}" ] (fields, Just ext) -> - H.sep - [ H.hang 4 $ H.sep $ + D.sep + [ D.hang 4 $ D.sep $ [ "{" <+> ext - , H.cat (zipWith (<+>) ("|" : repeat ",") fields) + , D.cat (zipWith (<+>) ("|" : repeat ",") fields) ] , "}" ] @@ -97,7 +97,7 @@ record entries maybeExt = entryToDoc :: (Doc, Doc) -> Doc entryToDoc (fieldName, fieldType) = - H.hang 4 (H.sep [ fieldName <+> ":", fieldType ]) + D.hang 4 (D.sep [ fieldName <+> ":", fieldType ]) recordSnippet :: (Doc, Doc) -> [(Doc, Doc)] -> Doc @@ -106,7 +106,7 @@ recordSnippet entry entries = field = "{" <+> entryToDoc entry fields = zipWith (<+>) (repeat ",") (map entryToDoc entries ++ ["..."]) in - H.sep [ H.cat (field:fields), "}" ] + D.sep [ D.cat (field:fields), "}" ] @@ -126,22 +126,22 @@ srcToDoc context (A.At _ tipe) = (map (srcToDoc Func) rest) Src.TVar name -> - H.nameToDoc name + D.fromName name Src.TType _ name args -> apply context - (H.nameToDoc name) + (D.fromName name) (map (srcToDoc App) args) Src.TTypeQual _ home name args -> apply context - (H.nameToDoc home <> "." <> H.nameToDoc name) + (D.fromName home <> "." <> D.fromName name) (map (srcToDoc App) args) Src.TRecord fields ext -> record (map fieldToDocs fields) - (fmap (H.nameToDoc . A.toValue) ext) + (fmap (D.fromName . A.toValue) ext) Src.TUnit -> "()" @@ -155,7 +155,7 @@ srcToDoc context (A.At _ tipe) = fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc) fieldToDocs (A.At _ fieldName, fieldType) = - ( H.nameToDoc fieldName + ( D.fromName fieldName , srcToDoc None fieldType ) @@ -190,17 +190,17 @@ canToDoc context tipe = (map (canToDoc Func) rest) Can.TVar name -> - H.nameToDoc name + D.fromName name Can.TType (ModuleName.Canonical _ home) name args -> apply context - (H.nameToDoc home <> "." <> H.nameToDoc name) + (D.fromName home <> "." <> D.fromName name) (map (canToDoc App) args) Can.TRecord fields ext -> record (map entryToDocs (Map.toList fields)) - (fmap H.nameToDoc ext) + (fmap D.fromName ext) Can.TUnit -> "()" @@ -213,13 +213,13 @@ canToDoc context tipe = Can.TAlias (ModuleName.Canonical _ home) name args _ -> apply context - (H.nameToDoc home <> "." <> H.nameToDoc name) + (D.fromName home <> "." <> D.fromName name) (map (canToDoc App . snd) args) entryToDocs :: (N.Name, Can.Type) -> (Doc, Doc) entryToDocs (name, tipe) = - (H.nameToDoc name, canToDoc None tipe) + (D.fromName name, canToDoc None tipe) collectArgs :: Can.Type -> (Can.Type, [Can.Type]) diff --git a/compiler/src/Reporting/Warning.hs b/compiler/src/Reporting/Warning.hs index 3350908e..bb00e815 100644 --- a/compiler/src/Reporting/Warning.hs +++ b/compiler/src/Reporting/Warning.hs @@ -13,11 +13,11 @@ import Data.Monoid ((<>)) import qualified AST.Canonical as Can import qualified AST.Utils.Type as Type import qualified Elm.Name as N +import qualified Reporting.Doc as D import qualified Reporting.Region as R import qualified Reporting.Report as Report import qualified Reporting.Render.Code as Code import qualified Reporting.Render.Type as RT -import qualified Reporting.Helpers as H @@ -44,7 +44,7 @@ toReport source warning = Report.Report "unused import" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "Nothing from the `" <> N.toString moduleName <> "` module is used in this file." , "I recommend removing unused imports." @@ -55,14 +55,14 @@ toReport source warning = Report.Report title region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ "You are not using `" <> N.toString name <> "` anywhere." , - H.stack - [ H.reflow $ + D.stack + [ D.reflow $ "Is there a typo? Maybe you intended to use `" <> N.toString name <> "` somewhere but typed another name instead?" - , H.reflow $ + , D.reflow $ defOrPat context ( "If you are sure there is no typo, remove the definition.\ \ This way future readers will not have to wonder why it is there!" @@ -77,7 +77,7 @@ toReport source warning = Report.Report "missing type annotation" region [] $ Report.toCodeSnippet source region Nothing ( - H.reflow $ + D.reflow $ case Type.deepDealias inferredType of Can.TLambda _ _ -> "The `" <> N.toString name <> "` function has no type annotation." @@ -85,10 +85,10 @@ toReport source warning = _ -> "The `" <> N.toString name <> "` definition has no type annotation." , - H.stack + D.stack [ "I inferred the type annotation myself though! You can copy it into your code:" - , H.green $ H.hang 4 $ H.sep $ - [ H.nameToDoc name <> " :" + , D.green $ D.hang 4 $ D.sep $ + [ D.fromName name <> " :" , RT.canToDoc RT.None inferredType ] ] diff --git a/compiler/src/Type/Error.hs b/compiler/src/Type/Error.hs index 0bcdb120..add14cdc 100644 --- a/compiler/src/Type/Error.hs +++ b/compiler/src/Type/Error.hs @@ -25,7 +25,7 @@ import Data.Monoid ((<>)) import qualified AST.Module.Name as ModuleName import qualified Data.Bag as Bag import qualified Elm.Name as N -import qualified Reporting.Helpers as H +import qualified Reporting.Doc as D import qualified Reporting.Render.Type as RT @@ -78,17 +78,17 @@ iteratedDealias tipe = type Localizer = Map.Map (ModuleName.Canonical, N.Name) String -nameToDoc :: Localizer -> ModuleName.Canonical -> N.Name -> H.Doc +nameToDoc :: Localizer -> ModuleName.Canonical -> N.Name -> D.Doc nameToDoc dict home@(ModuleName.Canonical _ moduleName) name = case Map.lookup (home, name) dict of Nothing -> - H.nameToDoc moduleName <> "." <> H.nameToDoc name + D.fromName moduleName <> "." <> D.fromName name Just string -> - H.text string + D.fromString string -toDoc :: Localizer -> RT.Context -> Type -> H.Doc +toDoc :: Localizer -> RT.Context -> Type -> D.Doc toDoc dict ctx tipe = case tipe of Lambda a b cs -> @@ -104,16 +104,16 @@ toDoc dict ctx tipe = "?" FlexVar name -> - H.nameToDoc name + D.fromName name FlexSuper _ name -> - H.nameToDoc name + D.fromName name RigidVar name -> - H.nameToDoc name + D.fromName name RigidSuper _ name -> - H.nameToDoc name + D.fromName name Type home name args -> RT.apply ctx @@ -123,7 +123,7 @@ toDoc dict ctx tipe = Record fields ext -> let entryToDocs (fieldName, fieldType) = - ( H.nameToDoc fieldName, toDoc dict RT.None fieldType ) + ( D.fromName fieldName, toDoc dict RT.None fieldType ) fieldDocs = map entryToDocs (Map.toList fields) @@ -131,8 +131,8 @@ toDoc dict ctx tipe = RT.record fieldDocs $ case ext of Closed -> Nothing - FlexOpen x -> Just (H.nameToDoc x) - RigidOpen x -> Just (H.nameToDoc x) + FlexOpen x -> Just (D.fromName x) + RigidOpen x -> Just (D.fromName x) Unit -> "()" @@ -153,7 +153,7 @@ toDoc dict ctx tipe = -- DIFF -toDiffDocs :: Localizer -> Type -> Type -> (H.Doc, H.Doc, [Problem]) +toDiffDocs :: Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem]) toDiffDocs dict a b = case diff dict RT.None a b of Similar aDoc bDoc -> @@ -217,13 +217,13 @@ data Problem -- COMPUTE DIFF -diff :: Localizer -> RT.Context -> Type -> Type -> Diff H.Doc +diff :: Localizer -> RT.Context -> Type -> Type -> Diff D.Doc diff dict ctx tipe1 tipe2 = case (tipe1, tipe2) of - (FlexVar x, FlexVar y) | x == y -> pure (H.nameToDoc x) - (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (H.nameToDoc x) - (RigidVar x, RigidVar y) | x == y -> pure (H.nameToDoc x) - (RigidSuper _ x, RigidSuper _ y) | x == y -> pure (H.nameToDoc x) + (FlexVar x, FlexVar y) | x == y -> pure (D.fromName x) + (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x) + (RigidVar x, RigidVar y) | x == y -> pure (D.fromName x) + (RigidSuper _ x, RigidSuper _ y) | x == y -> pure (D.fromName x) (Infinite, Infinite) -> pure "∞" (Error, Error) -> pure "?" @@ -236,8 +236,8 @@ diff dict ctx tipe1 tipe2 = <*> case (maybeC, maybeZ) of (Nothing, Nothing) -> pure [] - (Just c , Nothing) -> Different [H.dullyellow (toDoc dict RT.None c)] [] Bag.empty - (Nothing, Just z ) -> Different [] [H.dullyellow (toDoc dict RT.None z)] Bag.empty + (Just c , Nothing) -> Different [D.dullyellow (toDoc dict RT.None c)] [] Bag.empty + (Nothing, Just z ) -> Different [] [D.dullyellow (toDoc dict RT.None z)] Bag.empty (Just c , Just z ) -> (:[]) <$> diff dict RT.None c z (Record fields1 ext1, Record fields2 ext2) -> diffRecord dict fields1 ext1 fields2 ext2 @@ -255,8 +255,8 @@ diff dict ctx tipe1 tipe2 = (Lambda a b cs, Lambda x y zs) -> diffLambda dict ctx (a:b:cs) (x:y:zs) - (FlexVar x, other) -> Similar (H.nameToDoc x) (toDoc dict ctx other) - (other, FlexVar x) -> Similar (toDoc dict ctx other) (H.nameToDoc x) + (FlexVar x, other) -> Similar (D.fromName x) (toDoc dict ctx other) + (other, FlexVar x) -> Similar (toDoc dict ctx other) (D.fromName x) pair -> case pair of @@ -268,8 +268,8 @@ diff dict ctx tipe1 tipe2 = _ -> let - doc1 = H.dullyellow (toDoc dict ctx tipe1) - doc2 = H.dullyellow (toDoc dict ctx tipe2) + doc1 = D.dullyellow (toDoc dict ctx tipe1) + doc2 = D.dullyellow (toDoc dict ctx tipe2) in Different doc1 doc2 $ case pair of @@ -334,10 +334,10 @@ isSimilar tipe1 tipe2 = Different _ _ _ -> False -yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> H.Doc +yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc yellowApply dict ctx home name tipe = RT.apply ctx - (H.dullyellow (nameToDoc dict home name)) + (D.dullyellow (nameToDoc dict home name)) [toDoc dict RT.App tipe] @@ -348,7 +348,7 @@ yellowApply dict ctx home name tipe = -- -- INVARIANT: length types1 >= 2 && length types2 >= 2 -- -diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff H.Doc +diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc diffLambda dict ctx types1 types2 = let (result1:revArgs1) = reverse types1 @@ -389,7 +389,7 @@ diffLambda dict ctx types1 types2 = -- -- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2 -- -diffArgMismatch :: Localizer -> RT.Context -> [Type] -> H.Doc -> [Type] -> H.Doc -> Diff H.Doc +diffArgMismatch :: Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult = case toGreedyMatch dict shortRevArgs longRevArgs of Just (GreedyMatch shortRevArgDocs longRevArgDocs) -> @@ -417,7 +417,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult = Nothing -> let toYellowDoc tipe = - H.dullyellow (toDoc dict RT.Func tipe) + D.dullyellow (toDoc dict RT.Func tipe) (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs) (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs ) @@ -433,7 +433,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult = data GreedyMatch = - GreedyMatch [H.Doc] [H.Doc] + GreedyMatch [D.Doc] [D.Doc] -- @@ -448,7 +448,7 @@ toGreedyMatchHelp :: Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe Greed toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) = let toYellowDoc tipe = - H.dullyellow (toDoc dict RT.Func tipe) + D.dullyellow (toDoc dict RT.Func tipe) in case (shorterArgs, longerArgs) of (x:xs, y:ys) -> @@ -475,7 +475,7 @@ toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs lon -- RECORD DIFFS -diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff H.Doc +diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc diffRecord dict fields1 ext1 fields2 ext2 = let only1 = Map.keys (Map.difference fields1 fields2) @@ -510,12 +510,12 @@ diffRecord dict fields1 ext1 fields2 ext2 = (Bag.one (FieldMismatch only1 only2)) -toOverlapDoc :: (BadOverlap -> H.Doc) -> BadOverlap -> (H.Doc, H.Doc) +toOverlapDoc :: (BadOverlap -> D.Doc) -> BadOverlap -> (D.Doc, D.Doc) toOverlapDoc getDoc overlap@(BadOverlap field _ _ _) = - (H.nameToDoc field, getDoc overlap) + (D.fromName field, getDoc overlap) -toOverlapRecord :: (BadOverlap -> H.Doc) -> BadOverlap -> [BadOverlap] -> Extension -> H.Doc +toOverlapRecord :: (BadOverlap -> D.Doc) -> BadOverlap -> [BadOverlap] -> Extension -> D.Doc toOverlapRecord getDoc bad bads ext = let go = toOverlapDoc getDoc in case ext of @@ -524,7 +524,7 @@ toOverlapRecord getDoc bad bads ext = RigidOpen _ -> RT.recordSnippet (go bad) (map go bads) -toMissingDoc :: Map.Map N.Name t -> [N.Name] -> Extension -> H.Doc +toMissingDoc :: Map.Map N.Name t -> [N.Name] -> Extension -> D.Doc toMissingDoc allFields uniqueFields ext = case map emphasizeFieldName uniqueFields of [] -> @@ -540,12 +540,12 @@ toMissingDoc allFields uniqueFields ext = RigidOpen _ -> RT.recordSnippet doc docs -emphasizeFieldName :: N.Name -> (H.Doc, H.Doc) +emphasizeFieldName :: N.Name -> (D.Doc, D.Doc) emphasizeFieldName field = - ( H.dullyellow (H.nameToDoc field), "..." ) + ( D.dullyellow (D.fromName field), "..." ) -toBoringRecord :: Map.Map N.Name t -> Extension -> H.Doc +toBoringRecord :: Map.Map N.Name t -> Extension -> D.Doc toBoringRecord fields ext = case ext of Closed -> if Map.null fields then "{}" else "{ ... }" @@ -557,11 +557,11 @@ toBoringRecord fields ext = -- DIFF RECORD EXTENSION -diffExt :: Extension -> Extension -> Diff (Maybe H.Doc) +diffExt :: Extension -> Extension -> Diff (Maybe D.Doc) diffExt ext1 ext2 = let - normal = Just . H.nameToDoc - yellow = Just . H.dullyellow . H.nameToDoc + normal = Just . D.fromName + yellow = Just . D.dullyellow . D.fromName different x y = Different x y Bag.empty in @@ -596,8 +596,8 @@ diffExt ext1 ext2 = data BadOverlap = BadOverlap { _field :: N.Name - , _doc1 :: H.Doc - , _doc2 :: H.Doc + , _doc1 :: D.Doc + , _doc2 :: D.Doc , _problems :: Bag.Bag Problem } @@ -608,7 +608,7 @@ findBadOverlaps dict fields1 fields2 = Map.intersectionWith (diff dict RT.None) fields1 fields2 -findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff H.Doc)] -> [BadOverlap] +findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff D.Doc)] -> [BadOverlap] findBadOverlapsHelp badOverlaps fieldPairs = case fieldPairs of [] -> diff --git a/elm.cabal b/elm.cabal index 16e10bfa..c7fdcf3f 100644 --- a/elm.cabal +++ b/elm.cabal @@ -134,7 +134,6 @@ Executable elm Elm.Header, Elm.Name, Elm.Package, - Elm.Utils, Json.Decode, Json.Encode, @@ -196,6 +195,7 @@ Executable elm Parse.Shader, Parse.Type, Reporting.Annotation, + Reporting.Doc, Reporting.Error, Reporting.Error.Canonicalize, Reporting.Error.Docs, @@ -203,12 +203,12 @@ Executable elm Reporting.Error.Pattern, Reporting.Error.Syntax, Reporting.Error.Type, - Reporting.Helpers, Reporting.Region, Reporting.Render.Code, Reporting.Render.Type, Reporting.Report, Reporting.Result, + Reporting.Suggest, Reporting.Warning, Type.Constrain.Expression, Type.Constrain.Module, @@ -224,8 +224,8 @@ Executable elm Paths_elm Build-depends: - ansi-terminal >= 0.7 && < 0.8, - ansi-wl-pprint >= 0.6.7 && < 0.7, + ansi-terminal >= 0.8 && < 0.9, + ansi-wl-pprint >= 0.6.8 && < 0.7, base >=4.8 && <5, binary >= 0.8 && < 0.9, bytestring >= 0.9 && < 0.11, diff --git a/ui/terminal/src/Repl.hs b/ui/terminal/src/Repl.hs index e20cfa9b..866a2481 100644 --- a/ui/terminal/src/Repl.hs +++ b/ui/terminal/src/Repl.hs @@ -29,7 +29,7 @@ import qualified Elm.Name as N import qualified Elm.Project as Project import qualified Elm.Package as Pkg import qualified Elm.PerUserCache as PerUserCache -import qualified Elm.Utils as Elm +import qualified Parse.Repl as Elm import qualified Reporting.Task as Task import qualified Reporting.Progress.Repl as Repl diff --git a/ui/terminal/src/Terminal/Args/Error.hs b/ui/terminal/src/Terminal/Args/Error.hs index 1ec5b5f6..2c1c8d5e 100644 --- a/ui/terminal/src/Terminal/Args/Error.hs +++ b/ui/terminal/src/Terminal/Args/Error.hs @@ -23,7 +23,7 @@ import qualified System.FilePath as FP import System.IO (hPutStrLn, stderr) import qualified Text.PrettyPrint.ANSI.Leijen as P -import Elm.Utils (nearbyNames, distance) +import Reporting.Suggest as Suggest import Terminal.Args.Internal @@ -235,7 +235,7 @@ exitWithUnknown :: String -> [String] -> IO a exitWithUnknown unknown knowns = let suggestions = - case map toGreen (nearbyNames id unknown knowns) of + case map toGreen (Suggest.nearbyNames id unknown knowns) of [] -> [] @@ -434,7 +434,11 @@ getNearbyFlagsHelp :: String -> Flag a -> (Int, String) getNearbyFlagsHelp unknown flag = case flag of OnOff flagName _ -> - ( distance unknown flagName, "--" ++ flagName ) + ( Suggest.distance unknown flagName + , "--" ++ flagName + ) Flag flagName (Parser singular _ _ _ _) _ -> - ( distance unknown flagName, "--" ++ flagName ++ "=" ++ toToken singular ) + ( Suggest.distance unknown flagName + , "--" ++ flagName ++ "=" ++ toToken singular + )