|
| 1 | +{-# LANGUAGE OverloadedStrings #-} |
| 2 | +module Lamdera.Reporting.Evergreen where |
| 3 | + |
| 4 | +import qualified Reporting.Doc as D |
| 5 | + |
| 6 | + |
| 7 | +import Lamdera |
| 8 | + |
| 9 | + |
| 10 | +exposureHint givenName = |
| 11 | + D.reflow $ |
| 12 | + "Note: Evergreen migrations need access to all custom type variants. Make sure both `" ++ |
| 13 | + givenName ++ "` and `Evergreen.VX." ++ givenName ++ "` are exposed." |
| 14 | + |
| 15 | + |
| 16 | +exposureHintToDetails nearbyNames givenName noSuggestionDetails yesSuggestionDetails = |
| 17 | + case nearbyNames of |
| 18 | + [] -> |
| 19 | + D.stack |
| 20 | + [ D.reflow noSuggestionDetails |
| 21 | + , exposureHint givenName |
| 22 | + , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." |
| 23 | + ] |
| 24 | + |
| 25 | + suggestions -> |
| 26 | + D.stack |
| 27 | + [ D.reflow yesSuggestionDetails |
| 28 | + , D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromChars suggestions |
| 29 | + , exposureHint givenName |
| 30 | + , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." |
| 31 | + ] |
| 32 | + |
| 33 | + |
| 34 | + |
| 35 | +-- Maybe in future if we figure out a way to get the filename context we can do a much more fine-grained error message |
| 36 | + |
| 37 | + |
| 38 | +-- import qualified Data.Char as Char |
| 39 | +-- import qualified Data.List as List |
| 40 | +-- import qualified Data.Map as Map |
| 41 | +-- import qualified Data.Name as Name |
| 42 | +-- import qualified Data.OneOrMore as OneOrMore |
| 43 | +-- import qualified Data.Set as Set |
| 44 | + |
| 45 | +-- import qualified AST.Canonical as Can |
| 46 | +-- import qualified AST.Source as Src |
| 47 | +-- import qualified Data.Index as Index |
| 48 | +-- import qualified Elm.ModuleName as ModuleName |
| 49 | +-- import qualified Reporting.Annotation as A |
| 50 | +-- import Reporting.Doc (Doc, (<+>), (<>)) |
| 51 | +-- import qualified Reporting.Render.Code as Code |
| 52 | +-- import qualified Reporting.Render.Type as RT |
| 53 | +-- import qualified Reporting.Report as Report |
| 54 | +-- import qualified Reporting.Suggest as Suggest |
| 55 | + |
| 56 | +-- import qualified Lamdera.Reporting.Suggestions |
| 57 | + |
| 58 | + |
| 59 | +-- explainExposureErrors :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> String -> Locals -> Quals -> Report.Report |
| 60 | +-- explainExposureErrors source region maybePrefix name thing locals quals = |
| 61 | +-- notFound source region maybePrefix name thing locals quals |
| 62 | + |
| 63 | + |
| 64 | +-- type Locals = Set.Set Name.Name |
| 65 | +-- type Quals = Map.Map Name.Name (Set.Set Name.Name) |
| 66 | + |
| 67 | + |
| 68 | +-- -- Clone of Reporting.Error.Canonicalize.notFound |
| 69 | +-- notFound :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> String -> Locals -> Quals -> Report.Report |
| 70 | +-- notFound source region maybePrefix name thing locals quals = |
| 71 | +-- let |
| 72 | +-- evergreenExposureHint = |
| 73 | +-- D.reflow $ "Note: Evergreen migrations need access to all custom type constructors, make sure the `" ++ givenName ++ "` constructor is exposed and not just the `Evergreen.VX." ++ givenName ++ "` one." |
| 74 | + |
| 75 | +-- givenName = |
| 76 | +-- maybe Name.toChars toQualString maybePrefix name |
| 77 | + |
| 78 | +-- possibleNames = |
| 79 | +-- let |
| 80 | +-- addQuals prefix localSet allNames = |
| 81 | +-- Set.foldr (\x xs -> toQualString prefix x : xs) allNames localSet |
| 82 | +-- in |
| 83 | +-- Map.foldrWithKey addQuals (map Name.toChars (Set.toList locals)) quals |
| 84 | +-- & Lamdera.Reporting.Suggestions.hideWireSuggestions |
| 85 | + |
| 86 | +-- nearbyNames = |
| 87 | +-- take 4 (Suggest.sort givenName id possibleNames) |
| 88 | + |
| 89 | +-- toDetails noSuggestionDetails yesSuggestionDetails = |
| 90 | +-- case nearbyNames of |
| 91 | +-- [] -> |
| 92 | +-- D.stack |
| 93 | +-- [ D.reflow noSuggestionDetails |
| 94 | +-- , evergreenExposureHint |
| 95 | +-- , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." |
| 96 | +-- ] |
| 97 | + |
| 98 | +-- suggestions -> |
| 99 | +-- D.stack |
| 100 | +-- [ D.reflow yesSuggestionDetails |
| 101 | +-- , D.indent 4 $ D.vcat $ map D.dullyellow $ map D.fromChars suggestions |
| 102 | +-- , evergreenExposureHint |
| 103 | +-- , D.link "Hint" "Read" "imports" "to see how `import` declarations work in Elm." |
| 104 | +-- ] |
| 105 | + |
| 106 | +-- in |
| 107 | +-- Report.Report "NAMING ERROR" region nearbyNames $ |
| 108 | +-- Code.toSnippet source region Nothing |
| 109 | +-- ( |
| 110 | +-- D.reflow $ |
| 111 | +-- "I cannot find a `" ++ givenName ++ "` " ++ thing ++ ":" |
| 112 | +-- , |
| 113 | +-- case maybePrefix of |
| 114 | +-- Nothing -> |
| 115 | +-- toDetails |
| 116 | +-- "Is there an `import` or `exposing` missing up top?" |
| 117 | +-- "These names seem close though:" |
| 118 | + |
| 119 | +-- Just prefix -> |
| 120 | +-- case Map.lookup prefix quals of |
| 121 | +-- Nothing -> |
| 122 | +-- toDetails |
| 123 | +-- ("I cannot find a `" ++ Name.toChars prefix ++ "` module. Is there an `import` for it?") |
| 124 | +-- ("I cannot find a `" ++ Name.toChars prefix ++ "` import. These names seem close though:") |
| 125 | + |
| 126 | +-- Just _ -> |
| 127 | +-- toDetails |
| 128 | +-- ("The `" ++ Name.toChars prefix ++ "` module does not expose a `" ++ Name.toChars name ++ "` " ++ thing ++ ".") |
| 129 | +-- ("The `" ++ Name.toChars prefix ++ "` module does not expose a `" ++ Name.toChars name ++ "` " ++ thing ++ ". These names seem close though:") |
| 130 | +-- ) |
| 131 | + |
| 132 | + |
| 133 | +-- toQualString :: Name.Name -> Name.Name -> String |
| 134 | +-- toQualString prefix name = |
| 135 | +-- Name.toChars prefix ++ "." ++ Name.toChars name |
0 commit comments