@@ -5,7 +5,6 @@ module Type.Error
55 , Super(..)
66 , Extension(..)
77 , iteratedDealias
8− , Localizer
98 , toDoc
109 , toDiffDocs
1110 , Problem(..)
@@ -20,13 +19,13 @@ module Type.Error
2019
2120import qualified Data.Map as Map
2221import qualified Data.Maybe as Maybe
23−import Data.Monoid ((<>))
2422
2523import qualified AST.Module.Name as ModuleName
2624import qualified Data.Bag as Bag
2725import qualified Elm.Name as N
2826import qualified Reporting.Doc as D
2927import qualified Reporting.Render.Type as RT
28+import qualified Reporting.Render.Type.Localizer as L
3029
3130
3231
@@ -75,27 +74,19 @@ iteratedDealias tipe =
7574-- TO DOC
7675
7776
78−type Localizer = Map.Map (ModuleName.Canonical, N.Name) String
77+nameToDoc :: L.Localizer -> ModuleName.Canonical -> N.Name -> D.Doc
78+nameToDoc localizer (ModuleName.Canonical _ home) name =
79+ L.toDoc localizer home name
7980
8081
81−nameToDoc :: Localizer -> ModuleName.Canonical -> N.Name -> D.Doc
82−nameToDoc dict home@(ModuleName.Canonical _ moduleName) name =
83− case Map.lookup (home, name) dict of
84− Nothing ->
85− D.fromName moduleName <> "." <> D.fromName name
86−
87− Just string ->
88− D.fromString string
89−
90−
91−toDoc :: Localizer -> RT.Context -> Type -> D.Doc
92−toDoc dict ctx tipe =
82+toDoc :: L.Localizer -> RT.Context -> Type -> D.Doc
83+toDoc localizer ctx tipe =
9384 case tipe of
9485 Lambda a b cs ->
9586 RT.lambda ctx
96− (toDoc dict RT.Func a)
97− (toDoc dict RT.Func b)
98− (map (toDoc dict RT.Func) cs)
87+ (toDoc localizer RT.Func a)
88+ (toDoc localizer RT.Func b)
89+ (map (toDoc localizer RT.Func) cs)
9990
10091 Infinite ->
10192 "∞"
@@ -117,13 +108,13 @@ toDoc dict ctx tipe =
117108
118109 Type home name args ->
119110 RT.apply ctx
120− (nameToDoc dict home name)
121− (map (toDoc dict RT.App) args)
111+ (nameToDoc localizer home name)
112+ (map (toDoc localizer RT.App) args)
122113
123114 Record fields ext ->
124115 let
125116 entryToDocs (fieldName, fieldType) =
126− ( D.fromName fieldName, toDoc dict RT.None fieldType )
117+ ( D.fromName fieldName, toDoc localizer RT.None fieldType )
127118
128119 fieldDocs =
129120 map entryToDocs (Map.toList fields)
@@ -139,23 +130,23 @@ toDoc dict ctx tipe =
139130
140131 Tuple a b maybeC ->
141132 RT.tuple
142− (toDoc dict RT.None a)
143− (toDoc dict RT.None b)
144− (map (toDoc dict RT.None) (Maybe.maybeToList maybeC))
133+ (toDoc localizer RT.None a)
134+ (toDoc localizer RT.None b)
135+ (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))
145136
146137 Alias home name args _ ->
147138 RT.apply ctx
148− (nameToDoc dict home name)
149− (map (toDoc dict RT.App . snd) args)
139+ (nameToDoc localizer home name)
140+ (map (toDoc localizer RT.App . snd) args)
150141
151142
152143
153144-- DIFF
154145
155146
156−toDiffDocs :: Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
157−toDiffDocs dict a b =
158− case diff dict RT.None a b of
147+toDiffDocs :: L.Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
148+toDiffDocs localizer a b =
149+ case diff localizer RT.None a b of
159150 Similar aDoc bDoc ->
160151 (aDoc, bDoc, [])
161152
@@ -217,8 +208,8 @@ data Problem
217208-- COMPUTE DIFF
218209
219210
220−diff :: Localizer -> RT.Context -> Type -> Type -> Diff D.Doc
221−diff dict ctx tipe1 tipe2 =
211+diff :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc
212+diff localizer ctx tipe1 tipe2 =
222213 case (tipe1, tipe2) of
223214 (FlexVar x, FlexVar y) | x == y -> pure (D.fromName x)
224215 (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x)
@@ -231,45 +222,45 @@ diff dict ctx tipe1 tipe2 =
231222
232223 (Tuple a b maybeC, Tuple x y maybeZ) ->
233224 RT.tuple
234− <$> diff dict RT.None a x
235− <*> diff dict RT.None b y
225+ <$> diff localizer RT.None a x
226+ <*> diff localizer RT.None b y
236227 <*>
237228 case (maybeC, maybeZ) of
238229 (Nothing, Nothing) -> pure []
239− (Just c , Nothing) -> Different [D.dullyellow (toDoc dict RT.None c)] [] Bag.empty
240− (Nothing, Just z ) -> Different [] [D.dullyellow (toDoc dict RT.None z)] Bag.empty
241− (Just c , Just z ) -> (:[]) <$> diff dict RT.None c z
230+ (Just c , Nothing) -> Different [D.dullyellow (toDoc localizer RT.None c)] [] Bag.empty
231+ (Nothing, Just z ) -> Different [] [D.dullyellow (toDoc localizer RT.None z)] Bag.empty
232+ (Just c , Just z ) -> (:[]) <$> diff localizer RT.None c z
242233
243− (Record fields1 ext1, Record fields2 ext2) -> diffRecord dict fields1 ext1 fields2 ext2
234+ (Record fields1 ext1, Record fields2 ext2) -> diffRecord localizer fields1 ext1 fields2 ext2
244235
245236 (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->
246− RT.apply ctx (nameToDoc dict home1 name1) <$>
247− sequenceA (zipWith (diff dict RT.App) args1 args2)
237+ RT.apply ctx (nameToDoc localizer home1 name1) <$>
238+ sequenceA (zipWith (diff localizer RT.App) args1 args2)
248239
249240 (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->
250− RT.apply ctx (nameToDoc dict home1 name1) <$>
251− sequenceA (zipWith (diff dict RT.App) (map snd args1) (map snd args2))
241+ RT.apply ctx (nameToDoc localizer home1 name1) <$>
242+ sequenceA (zipWith (diff localizer RT.App) (map snd args1) (map snd args2))
252243
253− (Alias _ _ _ alias1, other) -> diff dict ctx alias1 other
254− (other, Alias _ _ _ alias2) -> diff dict ctx other alias2
244+ (Alias _ _ _ alias1, other) -> diff localizer ctx alias1 other
245+ (other, Alias _ _ _ alias2) -> diff localizer ctx other alias2
255246
256− (Lambda a b cs, Lambda x y zs) -> diffLambda dict ctx (a:b:cs) (x:y:zs)
247+ (Lambda a b cs, Lambda x y zs) -> diffLambda localizer ctx (a:b:cs) (x:y:zs)
257248
258− (FlexVar x, other) -> Similar (D.fromName x) (toDoc dict ctx other)
259− (other, FlexVar x) -> Similar (toDoc dict ctx other) (D.fromName x)
249+ (FlexVar x, other) -> Similar (D.fromName x) (toDoc localizer ctx other)
250+ (other, FlexVar x) -> Similar (toDoc localizer ctx other) (D.fromName x)
260251
261252 pair ->
262253 case pair of
263254 (Type home name [t1], t2) | isMaybe home name && isSimilar t1 t2 ->
264− Different (yellowApply dict ctx home name t1) (toDoc dict ctx t2) (Bag.one AnythingFromMaybe)
255+ Different (yellowApply localizer ctx home name t1) (toDoc localizer ctx t2) (Bag.one AnythingFromMaybe)
265256
266257 (t1, Type home name [t2]) | isList home name && isSimilar t1 t2 ->
267− Different (toDoc dict ctx t1) (yellowApply dict ctx home name t2) (Bag.one AnythingToList)
258+ Different (toDoc localizer ctx t1) (yellowApply localizer ctx home name t2) (Bag.one AnythingToList)
268259
269260 _ ->
270261 let
271− doc1 = D.dullyellow (toDoc dict ctx tipe1)
272− doc2 = D.dullyellow (toDoc dict ctx tipe2)
262+ doc1 = D.dullyellow (toDoc localizer ctx tipe1)
263+ doc2 = D.dullyellow (toDoc localizer ctx tipe2)
273264 in
274265 Different doc1 doc2 $
275266 case pair of
@@ -329,16 +320,16 @@ isList home name =
329320
330321isSimilar :: Type -> Type -> Bool
331322isSimilar tipe1 tipe2 =
332− case diff Map.empty RT.None tipe1 tipe2 of
323+ case diff L.empty RT.None tipe1 tipe2 of
333324 Similar _ _ -> True
334325 Different _ _ _ -> False
335326
336327
337−yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc
338−yellowApply dict ctx home name tipe =
328+yellowApply :: L.Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc
329+yellowApply localizer ctx home name tipe =
339330 RT.apply ctx
340− (D.dullyellow (nameToDoc dict home name))
341− [toDoc dict RT.App tipe]
331+ (D.dullyellow (nameToDoc localizer home name))
332+ [toDoc localizer RT.App tipe]
342333
343334
344335
@@ -348,8 +339,8 @@ yellowApply dict ctx home name tipe =
348339--
349340-- INVARIANT: length types1 >= 2 && length types2 >= 2
350341--
351−diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc
352−diffLambda dict ctx types1 types2 =
342+diffLambda :: L.Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc
343+diffLambda localizer ctx types1 types2 =
353344 let
354345 (result1:revArgs1) = reverse types1
355346 (result2:revArgs2) = reverse types2
@@ -357,7 +348,7 @@ diffLambda dict ctx types1 types2 =
357348 numArgs1 = length revArgs1
358349 numArgs2 = length revArgs2
359350
360− resultDiff = diff dict RT.Func result1 result2
351+ resultDiff = diff localizer RT.Func result1 result2
361352 in
362353 case resultDiff of
363354 Similar resultDoc1 resultDoc2 ->
@@ -367,18 +358,18 @@ diffLambda dict ctx types1 types2 =
367358 RT.lambda ctx x y zs
368359 )
369360 <$> resultDiff
370− <*> sequenceA (zipWith (diff dict RT.Func) revArgs1 revArgs2)
361+ <*> sequenceA (zipWith (diff localizer RT.Func) revArgs1 revArgs2)
371362
372363 else if numArgs1 < numArgs2 then
373− diffArgMismatch dict ctx revArgs1 resultDoc1 revArgs2 resultDoc2
364+ diffArgMismatch localizer ctx revArgs1 resultDoc1 revArgs2 resultDoc2
374365
375366 else
376− diffArgMismatch dict ctx revArgs2 resultDoc2 revArgs1 resultDoc1
367+ diffArgMismatch localizer ctx revArgs2 resultDoc2 revArgs1 resultDoc1
377368
378369 Different resultDoc1 resultDoc2 problems ->
379370 let
380− (x1:y1:zs1) = reverse (resultDoc1 : map (toDoc dict RT.Func) revArgs1)
381− (x2:y2:zs2) = reverse (resultDoc2 : map (toDoc dict RT.Func) revArgs2)
371+ (x1:y1:zs1) = reverse (resultDoc1 : map (toDoc localizer RT.Func) revArgs1)
372+ (x2:y2:zs2) = reverse (resultDoc2 : map (toDoc localizer RT.Func) revArgs2)
382373 in
383374 Different
384375 (RT.lambda ctx x1 y1 zs1)
@@ -389,9 +380,9 @@ diffLambda dict ctx types1 types2 =
389380--
390381-- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2
391382--
392−diffArgMismatch :: Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc
393−diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
394− case toGreedyMatch dict shortRevArgs longRevArgs of
383+diffArgMismatch :: L.Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc
384+diffArgMismatch localizer ctx shortRevArgs shortResult longRevArgs longResult =
385+ case toGreedyMatch localizer shortRevArgs longRevArgs of
395386 Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->
396387 let
397388 (a:b:cs) = reverse (shortResult:shortRevArgDocs)
@@ -403,7 +394,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
403394 (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))
404395
405396 Nothing ->
406− case toGreedyMatch dict (reverse shortRevArgs) (reverse longRevArgs) of
397+ case toGreedyMatch localizer (reverse shortRevArgs) (reverse longRevArgs) of
407398 Just (GreedyMatch shortArgDocs longArgDocs) ->
408399 let
409400 (a:b:cs) = shortArgDocs ++ [shortResult]
@@ -417,7 +408,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
417408 Nothing ->
418409 let
419410 toYellowDoc tipe =
420− D.dullyellow (toDoc dict RT.Func tipe)
411+ D.dullyellow (toDoc localizer RT.Func tipe)
421412
422413 (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)
423414 (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )
@@ -439,26 +430,26 @@ data GreedyMatch =
439430--
440431-- INVARIANT: length shorterArgs < length longerArgs
441432--
442−toGreedyMatch :: Localizer -> [Type] -> [Type] -> Maybe GreedyMatch
443−toGreedyMatch dict shorterArgs longerArgs =
444− toGreedyMatchHelp dict shorterArgs longerArgs (GreedyMatch [] [])
433+toGreedyMatch :: L.Localizer -> [Type] -> [Type] -> Maybe GreedyMatch
434+toGreedyMatch localizer shorterArgs longerArgs =
435+ toGreedyMatchHelp localizer shorterArgs longerArgs (GreedyMatch [] [])
445436
446437
447−toGreedyMatchHelp :: Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe GreedyMatch
448−toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
438+toGreedyMatchHelp :: L.Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe GreedyMatch
439+toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
449440 let
450441 toYellowDoc tipe =
451− D.dullyellow (toDoc dict RT.Func tipe)
442+ D.dullyellow (toDoc localizer RT.Func tipe)
452443 in
453444 case (shorterArgs, longerArgs) of
454445 (x:xs, y:ys) ->
455− case diff dict RT.Func x y of
446+ case diff localizer RT.Func x y of
456447 Similar a b ->
457− toGreedyMatchHelp dict xs ys $
448+ toGreedyMatchHelp localizer xs ys $
458449 GreedyMatch (a:shorterDocs) (b:longerDocs)
459450
460451 Different _ _ _ ->
461− toGreedyMatchHelp dict shorterArgs ys $
452+ toGreedyMatchHelp localizer shorterArgs ys $
462453 GreedyMatch shorterDocs (toYellowDoc y : longerDocs)
463454
464455 ([], []) ->
@@ -475,14 +466,14 @@ toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs lon
475466-- RECORD DIFFS
476467
477468
478−diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc
479−diffRecord dict fields1 ext1 fields2 ext2 =
469+diffRecord :: L.Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc
470+diffRecord localizer fields1 ext1 fields2 ext2 =
480471 let
481472 only1 = Map.keys (Map.difference fields1 fields2)
482473 only2 = Map.keys (Map.difference fields2 fields1)
483474 in
484475 if null only1 && null only2 then
485− case findBadOverlaps dict fields1 fields2 of
476+ case findBadOverlaps localizer fields1 fields2 of
486477 [] ->
487478 case diffExt ext1 ext2 of
488479 Similar _ _ ->
@@ -602,10 +593,10 @@ data BadOverlap =
602593 }
603594
604595
605−findBadOverlaps :: Localizer -> Map.Map N.Name Type -> Map.Map N.Name Type -> [BadOverlap]
606−findBadOverlaps dict fields1 fields2 =
596+findBadOverlaps :: L.Localizer -> Map.Map N.Name Type -> Map.Map N.Name Type -> [BadOverlap]
597+findBadOverlaps localizer fields1 fields2 =
607598 findBadOverlapsHelp [] $ Map.toList $
608− Map.intersectionWith (diff dict RT.None) fields1 fields2
599+ Map.intersectionWith (diff localizer RT.None) fields1 fields2
609600
610601
611602findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff D.Doc)] -> [BadOverlap]