git.iko.soy/elk
on 9b0c310 help sign in
elk/src/Reporting/Error/Canonicalize.hs
248 lines 7.1 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Reporting.Error.Canonicalize where
5--import Data.Aeson ((.=))
6import qualified Data.Aeson as Json
7--import qualified Data.Aeson.Types as Json
8import Data.Function (on)
9import qualified Data.List as List
10import qualified Text.EditDistance as Dist
11import qualified Text.PrettyPrint as P
13import qualified AST.Module as Module
14import qualified AST.Type as Type
15import qualified AST.Variable as Var
16import Elm.Utils ((|>))
17import qualified Reporting.PrettyPrint as P
18import qualified Reporting.Region as R
21data Error
22 = Var VarError
23 | Pattern PatternError
24 | Alias AliasError
25 | Import Module.Name ImportError
26 | Export String [String]
27 | Port PortError
30-- VARIABLES
32data VarError = VarError
33 { varKind :: String
34 , varName :: String
35 , varProblem :: VarProblem
36 , varSuggestions :: [String]
37 }
40data VarProblem
41 = Ambiguous
42 | UnknownQualifier String
43 | QualifiedUnknown String
44 | ExposedUnknown
47variable :: String -> String -> VarProblem -> [String] -> Error
48variable kind name problem suggestions =
49 Var (VarError kind name problem suggestions)
52-- PATTERN
54data PatternError
55 = PatternArgMismatch Var.Canonical Int Int
58argMismatch :: Var.Canonical -> Int -> Int -> Error
59argMismatch name expected actual =
60 Pattern (PatternArgMismatch name expected actual)
63-- IMPORTS
65data ImportError
66 = ModuleNotFound [Module.Name]
67 | ValueNotFound String [String]
70moduleNotFound :: Module.Name -> [Module.Name] -> Error
71moduleNotFound name possibilities =
72 Import name (ModuleNotFound possibilities)
75valueNotFound :: Module.Name -> String -> [String] -> Error
76valueNotFound name value possibilities =
77 Import name (ValueNotFound value possibilities)
80-- ALIASES
82data AliasError
83 = ArgMismatch Var.Canonical Int Int
84 | SelfRecursive String [String] Type.Raw
85 | MutuallyRecursive [(R.Region, String, [String], Type.Raw)]
88alias :: Var.Canonical -> Int -> Int -> Error
89alias name expected actual =
90 Alias (ArgMismatch name expected actual)
93-- PORTS
95data PortError = PortError
96 { portName :: String
97 , portIsInbound :: Bool
98 , portRootType :: Type.Canonical
99 , portLocalType :: Type.Canonical
100 , portMessage :: Maybe String
101 }
104port
105 :: String
106 -> Bool
107 -> Type.Canonical
108 -> Type.Canonical
109 -> Maybe String
110 -> Error
111port name isInbound rootType localType maybeMessage =
112 Port (PortError name isInbound rootType localType maybeMessage)
115-- NEARBY NAMES
117nearbyNames :: (a -> String) -> a -> [a] -> [a]
118nearbyNames format name names =
119 let editDistance =
120 if length (format name) < 3 then 1 else 2
121 in
122 names
123 |> map (\x -> (distance (format name) (format x), x))
124 |> List.sortBy (compare `on` fst)
125 |> filter ( (<= editDistance) . abs . fst )
126 |> map snd
129distance :: String -> String -> Int
130distance x y =
131 Dist.restrictedDamerauLevenshteinDistance Dist.defaultEditCosts x y
134-- TO STRING
136toString :: R.Region -> Error -> String
137toString region err =
138 case err of
139 _ -> error "Canonicalize.toString" region
142-- TO JSON
144toJson :: Error -> Json.Value
145toJson err =
146 case err of
147 _ -> error "Canonicalize.toJson"
150-- HINTS
152toHint :: Error -> String
153toHint err =
154 case err of
155 Var (VarError kind name problem suggestions) ->
156 let var = kind ++ "'" ++ name ++ "'"
157 in
158 case problem of
159 Ambiguous ->
160 "This usage of " ++ var ++ " is ambiguous"
161 ++ maybeYouWant "\n\n" suggestions
163 UnknownQualifier qualifier ->
164 "Cannot find " ++ var ++ "\n\n"
165 ++ "The qualifier " ++ qualifier ++ " is not in scope."
166 ++ maybeYouWant "\n" suggestions
168 QualifiedUnknown qualifier ->
169 "Cannot find " ++ var ++ "\n\n"
170 ++ "The module called " ++ qualifier ++ " does not expose that value."
171 ++ maybeYouWant "\n" suggestions
173 ExposedUnknown ->
174 "Cannot find " ++ var
175 ++ maybeYouWant "\n\n" suggestions
177 Pattern patternError ->
178 case patternError of
179 PatternArgMismatch var expected actual ->
180 argMismatchHint "pattern" var expected actual
182 Alias aliasError ->
183 case aliasError of
184 ArgMismatch var expected actual ->
185 argMismatchHint "type" var expected actual
187 SelfRecursive name tvars tipe ->
188 "This type alias is recursive, forming an infinite type!\n\n"
189 ++ "Type aliases are just names for more fundamental types, so I go through\n"
190 ++ "and expand them all to know the real underlying type. The problem is that\n"
191 ++ "when I expand a recursive type alias, it keeps getting bigger and bigger.\n"
192 ++ "Dealiasing results in an infinitely large type! Try this instead:\n\n"
193 ++ " type " ++ name ++ concatMap (' ':) tvars ++ " ="
194 ++ P.render (P.nest 8 (P.hang (P.text name) 2 (P.pretty True tipe)))
195 ++ "\n\nThis creates a brand new type that cannot be expanded. It is similar types\n"
196 ++ "like List which are recursive, but do not get expanded into infinite types."
198 MutuallyRecursive aliases ->
199 error "TODO" aliases
201 Import name importError ->
202 case importError of
203 ModuleNotFound suggestions ->
204 "Could not find a module named '" ++ Module.nameToString name ++ "'"
205 ++ maybeYouWant "\n\n" (map Module.nameToString suggestions)
207 ValueNotFound value suggestions ->
208 "Module '" ++ Module.nameToString name ++ "' does not expose '" ++ value ++ "'"
209 ++ maybeYouWant "\n\n" suggestions
211 Export name suggestions ->
212 "Could not export '" ++ name ++ "'\n\n"
213 ++ "It is not defined in this module."
214 ++ maybeYouWant " " suggestions
216 Port (PortError name isInbound _rootType localType maybeMessage) ->
217 "Cannot pass " ++ message ++ " through " ++ boundPort ++ " '" ++ name ++ "':\n\n"
218 ++ P.render (P.nest 4 (P.pretty False localType)) ++ "\n\n"
219 ++ "The kinds of values that can flow through " ++ boundPort ++ "s include:\n"
220 ++ "Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples,\n"
221 ++ "Json.Values, and concrete records."
222 where
223 boundPort =
224 if isInbound then "inbound port" else "outbound port"
226 message =
227 maybe "the following type" id maybeMessage
230argMismatchHint :: String -> Var.Canonical -> Int -> Int -> String
231argMismatchHint kind var expected actual =
232 "The " ++ kind ++ " " ++ Var.toString var ++ " has too "
233 ++ (if actual < expected then "few" else "many")
234 ++ "arguments.\n\n"
235 ++ "Expecting " ++ show expected ++ ", but got " ++ show actual
238maybeYouWant :: String -> [String] -> String
239maybeYouWant prefix suggestions =
240 case suggestions of
241 [] ->
242 ""
244 _:_ ->
245 prefix
246 ++ "Maybe you want one of the following?\n"
247 ++ concatMap ("\n "++) suggestions