git.iko.soy/elk
on master help sign in
Start flowing Localizer through other modules
cb14fe8Evan Czaplicki
compiler/src/Compile.hs+7−4
compare with master
unifiedsplit
@@ -10,6 +10,8 @@ module Compile
10import qualified Data.ByteString as BS
10import qualified Data.ByteString as BS
11import qualified Data.Map as Map
11import qualified Data.Map as Map
12
12
13+import qualified AST.Source as Src
14+import qualified AST.Valid as Valid
13import qualified AST.Canonical as Can
15import qualified AST.Canonical as Can
14import qualified AST.Optimized as Opt
16import qualified AST.Optimized as Opt
15import qualified AST.Module.Name as ModuleName
17import qualified AST.Module.Name as ModuleName
@@ -22,6 +24,7 @@ import qualified Nitpick.PatternMatches as PatternMatches
22import qualified Optimize.Module as Optimize
24import qualified Optimize.Module as Optimize
23import qualified Parse.Parse as Parse
25import qualified Parse.Parse as Parse
24import qualified Reporting.Error as Error
26import qualified Reporting.Error as Error
27+import qualified Reporting.Render.Type.Localizer as L
25import qualified Reporting.Result as Result
28import qualified Reporting.Result as Result
26import qualified Reporting.Warning as Warning
29import qualified Reporting.Warning as Warning
27import qualified Type.Constrain.Module as Type
30import qualified Type.Constrain.Module as Type
@@ -60,7 +63,7 @@ compile flag pkg importDict interfaces source =
60 Canonicalize.canonicalize pkg importDict interfaces valid
63 Canonicalize.canonicalize pkg importDict interfaces valid
61
64
62 annotations <-
65 annotations <-
63− runTypeInference canonical
66+ runTypeInference (Valid._imports valid) canonical
64
67
65 () <-
68 () <-
66 exhaustivenessCheck canonical
69 exhaustivenessCheck canonical
@@ -83,11 +86,11 @@ compile flag pkg importDict interfaces source =
83-- TYPE INFERENCE
86-- TYPE INFERENCE
84
87
85
88
86−runTypeInference :: Can.Module -> Result i (Map.Map N.Name Can.Annotation)
89+runTypeInference :: [Src.Import] -> Can.Module -> Result i (Map.Map N.Name Can.Annotation)
87−runTypeInference canonical =
90+runTypeInference imports canonical =
88 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
91 case unsafePerformIO (Type.run =<< Type.constrain canonical) of
89 Left errors ->
92 Left errors ->
90− Result.throw (Error.Type errors)
93+ Result.throw (Error.Type (L.fromImports imports) errors)
91
94
92 Right annotations ->
95 Right annotations ->
93 Result.ok annotations
96 Result.ok annotations
compiler/src/Elm/Compiler.hs+2−2
@@ -66,7 +66,7 @@ errorsToDoc :: FilePath -> Text.Text -> [Error.Error] -> D.Doc
66errorsToDoc filePath source errors =
66errorsToDoc filePath source errors =
67 let
67 let
68 reports =
68 reports =
69− concatMap (Error.toReports (Code.toSource source) Map.empty) errors
69+ concatMap (Error.toReports (Code.toSource source)) errors
70 in
70 in
71 D.vcat $ map (Report.toDoc filePath) reports
71 D.vcat $ map (Report.toDoc filePath) reports
72
72
@@ -79,7 +79,7 @@ errorsToJson :: M.Raw -> FilePath -> Text.Text -> [Error.Error] -> Encode.Value
79errorsToJson moduleName filePath source errors =
79errorsToJson moduleName filePath source errors =
80 let
80 let
81 reports =
81 reports =
82− concatMap (Error.toReports (Code.toSource source) Map.empty) errors
82+ concatMap (Error.toReports (Code.toSource source)) errors
83 in
83 in
84 Encode.object
84 Encode.object
85 [ ("path", Encode.text (Text.pack filePath))
85 [ ("path", Encode.text (Text.pack filePath))
compiler/src/Reporting/Error/Type.hs+23−22
@@ -28,6 +28,7 @@ import qualified Reporting.Doc as D
28import qualified Reporting.Region as R
28import qualified Reporting.Region as R
29import qualified Reporting.Render.Code as Code
29import qualified Reporting.Render.Code as Code
30import qualified Reporting.Render.Type as RT
30import qualified Reporting.Render.Type as RT
31+import qualified Reporting.Render.Type.Localizer as L
31import qualified Reporting.Report as Report
32import qualified Reporting.Report as Report
32import qualified Type.Error as T
33import qualified Type.Error as T
33
34
@@ -161,7 +162,7 @@ ptypeReplace expectation tipe =
161-- TO REPORT
162-- TO REPORT
162
163
163
164
164−toReport :: Code.Source -> T.Localizer -> Error -> Report.Report
165+toReport :: Code.Source -> L.Localizer -> Error -> Report.Report
165toReport source localizer err =
166toReport source localizer err =
166 case err of
167 case err of
167 BadExpr region category actualType expected ->
168 BadExpr region category actualType expected ->
@@ -178,7 +179,7 @@ toReport source localizer err =
178-- TO PATTERN REPORT
179-- TO PATTERN REPORT
179
180
180
181
181−toPatternReport :: Code.Source -> T.Localizer -> R.Region -> PCategory -> T.Type -> PExpected T.Type -> Report.Report
182+toPatternReport :: Code.Source -> L.Localizer -> R.Region -> PCategory -> T.Type -> PExpected T.Type -> Report.Report
182toPatternReport source localizer patternRegion category tipe expected =
183toPatternReport source localizer patternRegion category tipe expected =
183 Report.Report "TYPE MISMATCH" patternRegion [] $
184 Report.Report "TYPE MISMATCH" patternRegion [] $
184 case expected of
185 case expected of
@@ -306,7 +307,7 @@ toPatternReport source localizer patternRegion category tipe expected =
306-- PATTERN HELPERS
307-- PATTERN HELPERS
307
308
308
309
309−patternTypeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc
310+patternTypeComparison :: L.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc
310patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) =
311patternTypeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) =
311 let
312 let
312 (actualDoc, expectedDoc, problems) =
313 (actualDoc, expectedDoc, problems) =
@@ -340,7 +341,7 @@ toPatternDescription category iAmTryingToMatch =
340-- EXPR HELPERS
341-- EXPR HELPERS
341
342
342
343
343−typeComparison :: T.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc
344+typeComparison :: L.Localizer -> T.Type -> T.Type -> ( String, String, [D.Doc] ) -> D.Doc
344typeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) =
345typeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints ) =
345 let
346 let
346 (actualDoc, expectedDoc, problems) =
347 (actualDoc, expectedDoc, problems) =
@@ -356,7 +357,7 @@ typeComparison localizer actual expected ( iAmSeeing, insteadOf, contextHints )
356 ++ contextHints
357 ++ contextHints
357
358
358
359
359−loneType :: T.Localizer -> T.Type -> T.Type -> ( D.Doc, [D.Doc] ) -> D.Doc
360+loneType :: L.Localizer -> T.Type -> T.Type -> ( D.Doc, [D.Doc] ) -> D.Doc
360loneType localizer actual expected ( iAmSeeing, furtherDetails ) =
361loneType localizer actual expected ( iAmSeeing, furtherDetails ) =
361 let
362 let
362 (actualDoc, _, problems) =
363 (actualDoc, _, problems) =
@@ -634,7 +635,7 @@ badFlexFlexSuper s1 s2 =
634-- TO EXPR REPORT
635-- TO EXPR REPORT
635
636
636
637
637−toExprReport :: Code.Source -> T.Localizer -> R.Region -> Category -> T.Type -> Expected T.Type -> Report.Report
638+toExprReport :: Code.Source -> L.Localizer -> R.Region -> Category -> T.Type -> Expected T.Type -> Report.Report
638toExprReport source localizer exprRegion category tipe expected =
639toExprReport source localizer exprRegion category tipe expected =
639 Report.Report "TYPE MISMATCH" exprRegion [] $
640 Report.Report "TYPE MISMATCH" exprRegion [] $
640 case expected of
641 case expected of
@@ -1041,7 +1042,7 @@ countArgs tipe =
1041-- OP LEFT
1042-- OP LEFT
1042
1043
1043
1044
1044−opLeftToDocs :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> (D.Doc, D.Doc)
1045+opLeftToDocs :: L.Localizer -> Category -> N.Name -> T.Type -> T.Type -> (D.Doc, D.Doc)
1045opLeftToDocs localizer category op tipe expected =
1046opLeftToDocs localizer category op tipe expected =
1046 case op of
1047 case op of
1047 "+"
1048 "+"
@@ -1101,7 +1102,7 @@ data RightDocs
1101 | EmphRight (D.Doc, D.Doc)
1102 | EmphRight (D.Doc, D.Doc)
1102
1103
1103
1104
1104−opRightToDocs :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> RightDocs
1105+opRightToDocs :: L.Localizer -> Category -> N.Name -> T.Type -> T.Type -> RightDocs
1105opRightToDocs localizer category op tipe expected =
1106opRightToDocs localizer category op tipe expected =
1106 case op of
1107 case op of
1107 "+"
1108 "+"
@@ -1192,7 +1193,7 @@ opRightToDocs localizer category op tipe expected =
1192 badOpRightFallback localizer category op tipe expected
1193 badOpRightFallback localizer category op tipe expected
1193
1194
1194
1195
1195−badOpRightFallback :: T.Localizer -> Category -> N.Name -> T.Type -> T.Type -> RightDocs
1196+badOpRightFallback :: L.Localizer -> Category -> N.Name -> T.Type -> T.Type -> RightDocs
1196badOpRightFallback localizer category op tipe expected =
1197badOpRightFallback localizer category op tipe expected =
1197 EmphRight
1198 EmphRight
1198 (
1199 (
@@ -1258,7 +1259,7 @@ isList tipe =
1258-- BAD CONS
1259-- BAD CONS
1259
1260
1260
1261
1261−badConsRight :: T.Localizer -> Category -> T.Type -> T.Type -> RightDocs
1262+badConsRight :: L.Localizer -> Category -> T.Type -> T.Type -> RightDocs
1262badConsRight localizer category tipe expected =
1263badConsRight localizer category tipe expected =
1263 case tipe of
1264 case tipe of
1264 T.Type home1 name1 [actualElement] | T.isList home1 name1 ->
1265 T.Type home1 name1 [actualElement] | T.isList home1 name1 ->
@@ -1332,7 +1333,7 @@ toAppendType tipe =
1332 _ -> AOther
1333 _ -> AOther
1333
1334
1334
1335
1335−badAppendLeft :: T.Localizer -> Category -> T.Type -> T.Type -> (D.Doc, D.Doc)
1336+badAppendLeft :: L.Localizer -> Category -> T.Type -> T.Type -> (D.Doc, D.Doc)
1336badAppendLeft localizer category tipe expected =
1337badAppendLeft localizer category tipe expected =
1337 case toAppendType tipe of
1338 case toAppendType tipe of
1338 ANumber thing stringFromThing ->
1339 ANumber thing stringFromThing ->
@@ -1367,7 +1368,7 @@ badAppendLeft localizer category tipe expected =
1367 )
1368 )
1368
1369
1369
1370
1370−badAppendRight :: T.Localizer -> Category -> T.Type -> T.Type -> RightDocs
1371+badAppendRight :: L.Localizer -> Category -> T.Type -> T.Type -> RightDocs
1371badAppendRight localizer category tipe expected =
1372badAppendRight localizer category tipe expected =
1372 case (toAppendType expected, toAppendType tipe) of
1373 case (toAppendType expected, toAppendType tipe) of
1373 (AString, ANumber thing stringFromThing) ->
1374 (AString, ANumber thing stringFromThing) ->
@@ -1501,7 +1502,7 @@ badStringAdd =
1501 )
1502 )
1502
1503
1503
1504
1504−badListAdd :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1505+badListAdd :: L.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1505badListAdd localizer category direction tipe expected =
1506badListAdd localizer category direction tipe expected =
1506 (
1507 (
1507 "I cannot do addition with lists:"
1508 "I cannot do addition with lists:"
@@ -1522,7 +1523,7 @@ badListAdd localizer category direction tipe expected =
1522 )
1523 )
1523
1524
1524
1525
1525−badListMul :: T.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1526+badListMul :: L.Localizer -> Category -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1526badListMul localizer category direction tipe expected =
1527badListMul localizer category direction tipe expected =
1527 badMath localizer category "Multiplication" direction "*" tipe expected
1528 badMath localizer category "Multiplication" direction "*" tipe expected
1528 [
1529 [
@@ -1534,7 +1535,7 @@ badListMul localizer category direction tipe expected =
1534 ]
1535 ]
1535
1536
1536
1537
1537−badMath :: T.Localizer -> Category -> String -> String -> String -> T.Type -> T.Type -> [D.Doc] -> (D.Doc, D.Doc)
1538+badMath :: L.Localizer -> Category -> String -> String -> String -> T.Type -> T.Type -> [D.Doc] -> (D.Doc, D.Doc)
1538badMath localizer category operation direction op tipe expected otherHints =
1539badMath localizer category operation direction op tipe expected otherHints =
1539 (
1540 (
1540 D.reflow $
1541 D.reflow $
@@ -1554,7 +1555,7 @@ badMath localizer category operation direction op tipe expected otherHints =
1554 )
1555 )
1555
1556
1556
1557
1557−badFDiv :: T.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1558+badFDiv :: L.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1558badFDiv localizer direction tipe expected =
1559badFDiv localizer direction tipe expected =
1559 (
1560 (
1560 D.reflow $
1561 D.reflow $
@@ -1588,7 +1589,7 @@ badFDiv localizer direction tipe expected =
1588 )
1589 )
1589
1590
1590
1591
1591−badIDiv :: T.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1592+badIDiv :: L.Localizer -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1592badIDiv localizer direction tipe expected =
1593badIDiv localizer direction tipe expected =
1593 (
1594 (
1594 D.reflow $
1595 D.reflow $
@@ -1628,7 +1629,7 @@ badIDiv localizer direction tipe expected =
1628-- BAD BOOLS
1629-- BAD BOOLS
1629
1630
1630
1631
1631−badBool :: T.Localizer -> D.Doc -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1632+badBool :: L.Localizer -> D.Doc -> D.Doc -> T.Type -> T.Type -> (D.Doc, D.Doc)
1632badBool localizer op direction tipe expected =
1633badBool localizer op direction tipe expected =
1633 (
1634 (
1634 D.reflow $
1635 D.reflow $
@@ -1650,7 +1651,7 @@ badBool localizer op direction tipe expected =
1650-- BAD COMPARISON
1651-- BAD COMPARISON
1651
1652
1652
1653
1653−badCompLeft :: T.Localizer -> Category -> String -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1654+badCompLeft :: L.Localizer -> Category -> String -> String -> T.Type -> T.Type -> (D.Doc, D.Doc)
1654badCompLeft localizer category op direction tipe expected =
1655badCompLeft localizer category op direction tipe expected =
1655 (
1656 (
1656 D.reflow $
1657 D.reflow $
@@ -1677,7 +1678,7 @@ badCompLeft localizer category op direction tipe expected =
1677 )
1678 )
1678
1679
1679
1680
1680−badCompRight :: T.Localizer -> String -> T.Type -> T.Type -> RightDocs
1681+badCompRight :: L.Localizer -> String -> T.Type -> T.Type -> RightDocs
1681badCompRight localizer op tipe expected =
1682badCompRight localizer op tipe expected =
1682 EmphBoth
1683 EmphBoth
1683 (
1684 (
@@ -1701,7 +1702,7 @@ badCompRight localizer op tipe expected =
1701-- BAD EQUALITY
1702-- BAD EQUALITY
1702
1703
1703
1704
1704−badEquality :: T.Localizer -> String -> T.Type -> T.Type -> RightDocs
1705+badEquality :: L.Localizer -> String -> T.Type -> T.Type -> RightDocs
1705badEquality localizer op tipe expected =
1706badEquality localizer op tipe expected =
1706 EmphBoth
1707 EmphBoth
1707 (
1708 (
@@ -1731,7 +1732,7 @@ badEquality localizer op tipe expected =
1731-- INFINITE TYPES
1732-- INFINITE TYPES
1732
1733
1733
1734
1734−toInfiniteReport :: Code.Source -> T.Localizer -> R.Region -> N.Name -> T.Type -> Report.Report
1735+toInfiniteReport :: Code.Source -> L.Localizer -> R.Region -> N.Name -> T.Type -> Report.Report
1735toInfiniteReport source localizer region name overallType =
1736toInfiniteReport source localizer region name overallType =
1736 Report.Report "INFINITE TYPE" region [] $
1737 Report.Report "INFINITE TYPE" region [] $
1737 Report.toCodeSnippet source region Nothing
1738 Report.toCodeSnippet source region Nothing
compiler/src/Type/Error.hs+74−83
@@ -5,7 +5,6 @@ module Type.Error
5 , Super(..)
5 , Super(..)
6 , Extension(..)
6 , Extension(..)
7 , iteratedDealias
7 , iteratedDealias
8− , Localizer
9 , toDoc
8 , toDoc
10 , toDiffDocs
9 , toDiffDocs
11 , Problem(..)
10 , Problem(..)
@@ -20,13 +19,13 @@ module Type.Error
20
19
21import qualified Data.Map as Map
20import qualified Data.Map as Map
22import qualified Data.Maybe as Maybe
21import qualified Data.Maybe as Maybe
23−import Data.Monoid ((<>))
24
22
25import qualified AST.Module.Name as ModuleName
23import qualified AST.Module.Name as ModuleName
26import qualified Data.Bag as Bag
24import qualified Data.Bag as Bag
27import qualified Elm.Name as N
25import qualified Elm.Name as N
28import qualified Reporting.Doc as D
26import qualified Reporting.Doc as D
29import qualified Reporting.Render.Type as RT
27import qualified Reporting.Render.Type as RT
28+import qualified Reporting.Render.Type.Localizer as L
30
29
31
30
32
31
@@ -75,27 +74,19 @@ iteratedDealias tipe =
75-- TO DOC
74-- TO DOC
76
75
77
76
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
79
80
80
81
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
82+toDoc :: L.Localizer -> RT.Context -> Type -> D.Doc
92−toDoc dict ctx tipe =
83+toDoc localizer ctx tipe =
93 case tipe of
84 case tipe of
94 Lambda a b cs ->
85 Lambda a b cs ->
95 RT.lambda ctx
86 RT.lambda ctx
96− (toDoc dict RT.Func a)
87+ (toDoc localizer RT.Func a)
97− (toDoc dict RT.Func b)
88+ (toDoc localizer RT.Func b)
98− (map (toDoc dict RT.Func) cs)
89+ (map (toDoc localizer RT.Func) cs)
99
90
100 Infinite ->
91 Infinite ->
101 "∞"
92 "∞"
@@ -117,13 +108,13 @@ toDoc dict ctx tipe =
117
108
118 Type home name args ->
109 Type home name args ->
119 RT.apply ctx
110 RT.apply ctx
120− (nameToDoc dict home name)
111+ (nameToDoc localizer home name)
121− (map (toDoc dict RT.App) args)
112+ (map (toDoc localizer RT.App) args)
122
113
123 Record fields ext ->
114 Record fields ext ->
124 let
115 let
125 entryToDocs (fieldName, fieldType) =
116 entryToDocs (fieldName, fieldType) =
126− ( D.fromName fieldName, toDoc dict RT.None fieldType )
117+ ( D.fromName fieldName, toDoc localizer RT.None fieldType )
127
118
128 fieldDocs =
119 fieldDocs =
129 map entryToDocs (Map.toList fields)
120 map entryToDocs (Map.toList fields)
@@ -139,23 +130,23 @@ toDoc dict ctx tipe =
139
130
140 Tuple a b maybeC ->
131 Tuple a b maybeC ->
141 RT.tuple
132 RT.tuple
142− (toDoc dict RT.None a)
133+ (toDoc localizer RT.None a)
143− (toDoc dict RT.None b)
134+ (toDoc localizer RT.None b)
144− (map (toDoc dict RT.None) (Maybe.maybeToList maybeC))
135+ (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))
145
136
146 Alias home name args _ ->
137 Alias home name args _ ->
147 RT.apply ctx
138 RT.apply ctx
148− (nameToDoc dict home name)
139+ (nameToDoc localizer home name)
149− (map (toDoc dict RT.App . snd) args)
140+ (map (toDoc localizer RT.App . snd) args)
150
141
151
142
152
143
153-- DIFF
144-- DIFF
154
145
155
146
156−toDiffDocs :: Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
147+toDiffDocs :: L.Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])
157−toDiffDocs dict a b =
148+toDiffDocs localizer a b =
158− case diff dict RT.None a b of
149+ case diff localizer RT.None a b of
159 Similar aDoc bDoc ->
150 Similar aDoc bDoc ->
160 (aDoc, bDoc, [])
151 (aDoc, bDoc, [])
161
152
@@ -217,8 +208,8 @@ data Problem
217-- COMPUTE DIFF
208-- COMPUTE DIFF
218
209
219
210
220−diff :: Localizer -> RT.Context -> Type -> Type -> Diff D.Doc
211+diff :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc
221−diff dict ctx tipe1 tipe2 =
212+diff localizer ctx tipe1 tipe2 =
222 case (tipe1, tipe2) of
213 case (tipe1, tipe2) of
223 (FlexVar x, FlexVar y) | x == y -> pure (D.fromName x)
214 (FlexVar x, FlexVar y) | x == y -> pure (D.fromName x)
224 (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x)
215 (FlexSuper _ x, FlexSuper _ y) | x == y -> pure (D.fromName x)
@@ -231,45 +222,45 @@ diff dict ctx tipe1 tipe2 =
231
222
232 (Tuple a b maybeC, Tuple x y maybeZ) ->
223 (Tuple a b maybeC, Tuple x y maybeZ) ->
233 RT.tuple
224 RT.tuple
234− <$> diff dict RT.None a x
225+ <$> diff localizer RT.None a x
235− <*> diff dict RT.None b y
226+ <*> diff localizer RT.None b y
236 <*>
227 <*>
237 case (maybeC, maybeZ) of
228 case (maybeC, maybeZ) of
238 (Nothing, Nothing) -> pure []
229 (Nothing, Nothing) -> pure []
239− (Just c , Nothing) -> Different [D.dullyellow (toDoc dict RT.None c)] [] Bag.empty
230+ (Just c , Nothing) -> Different [D.dullyellow (toDoc localizer RT.None c)] [] Bag.empty
240− (Nothing, Just z ) -> Different [] [D.dullyellow (toDoc dict RT.None z)] Bag.empty
231+ (Nothing, Just z ) -> Different [] [D.dullyellow (toDoc localizer RT.None z)] Bag.empty
241− (Just c , Just z ) -> (:[]) <$> diff dict RT.None c z
232+ (Just c , Just z ) -> (:[]) <$> diff localizer RT.None c z
242
233
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
244
235
245 (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->
236 (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->
246− RT.apply ctx (nameToDoc dict home1 name1) <$>
237+ RT.apply ctx (nameToDoc localizer home1 name1) <$>
247− sequenceA (zipWith (diff dict RT.App) args1 args2)
238+ sequenceA (zipWith (diff localizer RT.App) args1 args2)
248
239
249 (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->
240 (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->
250− RT.apply ctx (nameToDoc dict home1 name1) <$>
241+ RT.apply ctx (nameToDoc localizer home1 name1) <$>
251− sequenceA (zipWith (diff dict RT.App) (map snd args1) (map snd args2))
242+ sequenceA (zipWith (diff localizer RT.App) (map snd args1) (map snd args2))
252
243
253− (Alias _ _ _ alias1, other) -> diff dict ctx alias1 other
244+ (Alias _ _ _ alias1, other) -> diff localizer ctx alias1 other
254− (other, Alias _ _ _ alias2) -> diff dict ctx other alias2
245+ (other, Alias _ _ _ alias2) -> diff localizer ctx other alias2
255
246
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)
257
248
258− (FlexVar x, other) -> Similar (D.fromName x) (toDoc dict ctx other)
249+ (FlexVar x, other) -> Similar (D.fromName x) (toDoc localizer ctx other)
259− (other, FlexVar x) -> Similar (toDoc dict ctx other) (D.fromName x)
250+ (other, FlexVar x) -> Similar (toDoc localizer ctx other) (D.fromName x)
260
251
261 pair ->
252 pair ->
262 case pair of
253 case pair of
263 (Type home name [t1], t2) | isMaybe home name && isSimilar t1 t2 ->
254 (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)
265
256
266 (t1, Type home name [t2]) | isList home name && isSimilar t1 t2 ->
257 (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)
268
259
269 _ ->
260 _ ->
270 let
261 let
271− doc1 = D.dullyellow (toDoc dict ctx tipe1)
262+ doc1 = D.dullyellow (toDoc localizer ctx tipe1)
272− doc2 = D.dullyellow (toDoc dict ctx tipe2)
263+ doc2 = D.dullyellow (toDoc localizer ctx tipe2)
273 in
264 in
274 Different doc1 doc2 $
265 Different doc1 doc2 $
275 case pair of
266 case pair of
@@ -329,16 +320,16 @@ isList home name =
329
320
330isSimilar :: Type -> Type -> Bool
321isSimilar :: Type -> Type -> Bool
331isSimilar tipe1 tipe2 =
322isSimilar tipe1 tipe2 =
332− case diff Map.empty RT.None tipe1 tipe2 of
323+ case diff L.empty RT.None tipe1 tipe2 of
333 Similar _ _ -> True
324 Similar _ _ -> True
334 Different _ _ _ -> False
325 Different _ _ _ -> False
335
326
336
327
337−yellowApply :: Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc
328+yellowApply :: L.Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc
338−yellowApply dict ctx home name tipe =
329+yellowApply localizer ctx home name tipe =
339 RT.apply ctx
330 RT.apply ctx
340− (D.dullyellow (nameToDoc dict home name))
331+ (D.dullyellow (nameToDoc localizer home name))
341− [toDoc dict RT.App tipe]
332+ [toDoc localizer RT.App tipe]
342
333
343
334
344
335
@@ -348,8 +339,8 @@ yellowApply dict ctx home name tipe =
348--
339--
349-- INVARIANT: length types1 >= 2 && length types2 >= 2
340-- INVARIANT: length types1 >= 2 && length types2 >= 2
350--
341--
351−diffLambda :: Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc
342+diffLambda :: L.Localizer -> RT.Context -> [Type] -> [Type] -> Diff D.Doc
352−diffLambda dict ctx types1 types2 =
343+diffLambda localizer ctx types1 types2 =
353 let
344 let
354 (result1:revArgs1) = reverse types1
345 (result1:revArgs1) = reverse types1
355 (result2:revArgs2) = reverse types2
346 (result2:revArgs2) = reverse types2
@@ -357,7 +348,7 @@ diffLambda dict ctx types1 types2 =
357 numArgs1 = length revArgs1
348 numArgs1 = length revArgs1
358 numArgs2 = length revArgs2
349 numArgs2 = length revArgs2
359
350
360− resultDiff = diff dict RT.Func result1 result2
351+ resultDiff = diff localizer RT.Func result1 result2
361 in
352 in
362 case resultDiff of
353 case resultDiff of
363 Similar resultDoc1 resultDoc2 ->
354 Similar resultDoc1 resultDoc2 ->
@@ -367,18 +358,18 @@ diffLambda dict ctx types1 types2 =
367 RT.lambda ctx x y zs
358 RT.lambda ctx x y zs
368 )
359 )
369 <$> resultDiff
360 <$> resultDiff
370− <*> sequenceA (zipWith (diff dict RT.Func) revArgs1 revArgs2)
361+ <*> sequenceA (zipWith (diff localizer RT.Func) revArgs1 revArgs2)
371
362
372 else if numArgs1 < numArgs2 then
363 else if numArgs1 < numArgs2 then
373− diffArgMismatch dict ctx revArgs1 resultDoc1 revArgs2 resultDoc2
364+ diffArgMismatch localizer ctx revArgs1 resultDoc1 revArgs2 resultDoc2
374
365
375 else
366 else
376− diffArgMismatch dict ctx revArgs2 resultDoc2 revArgs1 resultDoc1
367+ diffArgMismatch localizer ctx revArgs2 resultDoc2 revArgs1 resultDoc1
377
368
378 Different resultDoc1 resultDoc2 problems ->
369 Different resultDoc1 resultDoc2 problems ->
379 let
370 let
380− (x1:y1:zs1) = reverse (resultDoc1 : map (toDoc dict RT.Func) revArgs1)
371+ (x1:y1:zs1) = reverse (resultDoc1 : map (toDoc localizer RT.Func) revArgs1)
381− (x2:y2:zs2) = reverse (resultDoc2 : map (toDoc dict RT.Func) revArgs2)
372+ (x2:y2:zs2) = reverse (resultDoc2 : map (toDoc localizer RT.Func) revArgs2)
382 in
373 in
383 Different
374 Different
384 (RT.lambda ctx x1 y1 zs1)
375 (RT.lambda ctx x1 y1 zs1)
@@ -389,9 +380,9 @@ diffLambda dict ctx types1 types2 =
389--
380--
390-- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2
381-- INVARIANT: length shortRevArgs >= 2 && length longRevArgs >= 2
391--
382--
392−diffArgMismatch :: Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc
383+diffArgMismatch :: L.Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc
393−diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
384+diffArgMismatch localizer ctx shortRevArgs shortResult longRevArgs longResult =
394− case toGreedyMatch dict shortRevArgs longRevArgs of
385+ case toGreedyMatch localizer shortRevArgs longRevArgs of
395 Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->
386 Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->
396 let
387 let
397 (a:b:cs) = reverse (shortResult:shortRevArgDocs)
388 (a:b:cs) = reverse (shortResult:shortRevArgDocs)
@@ -403,7 +394,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
403 (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))
394 (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))
404
395
405 Nothing ->
396 Nothing ->
406− case toGreedyMatch dict (reverse shortRevArgs) (reverse longRevArgs) of
397+ case toGreedyMatch localizer (reverse shortRevArgs) (reverse longRevArgs) of
407 Just (GreedyMatch shortArgDocs longArgDocs) ->
398 Just (GreedyMatch shortArgDocs longArgDocs) ->
408 let
399 let
409 (a:b:cs) = shortArgDocs ++ [shortResult]
400 (a:b:cs) = shortArgDocs ++ [shortResult]
@@ -417,7 +408,7 @@ diffArgMismatch dict ctx shortRevArgs shortResult longRevArgs longResult =
417 Nothing ->
408 Nothing ->
418 let
409 let
419 toYellowDoc tipe =
410 toYellowDoc tipe =
420− D.dullyellow (toDoc dict RT.Func tipe)
411+ D.dullyellow (toDoc localizer RT.Func tipe)
421
412
422 (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)
413 (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)
423 (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )
414 (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )
@@ -439,26 +430,26 @@ data GreedyMatch =
439--
430--
440-- INVARIANT: length shorterArgs < length longerArgs
431-- INVARIANT: length shorterArgs < length longerArgs
441--
432--
442−toGreedyMatch :: Localizer -> [Type] -> [Type] -> Maybe GreedyMatch
433+toGreedyMatch :: L.Localizer -> [Type] -> [Type] -> Maybe GreedyMatch
443−toGreedyMatch dict shorterArgs longerArgs =
434+toGreedyMatch localizer shorterArgs longerArgs =
444− toGreedyMatchHelp dict shorterArgs longerArgs (GreedyMatch [] [])
435+ toGreedyMatchHelp localizer shorterArgs longerArgs (GreedyMatch [] [])
445
436
446
437
447−toGreedyMatchHelp :: Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe GreedyMatch
438+toGreedyMatchHelp :: L.Localizer -> [Type] -> [Type] -> GreedyMatch -> Maybe GreedyMatch
448−toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
439+toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDocs longerDocs) =
449 let
440 let
450 toYellowDoc tipe =
441 toYellowDoc tipe =
451− D.dullyellow (toDoc dict RT.Func tipe)
442+ D.dullyellow (toDoc localizer RT.Func tipe)
452 in
443 in
453 case (shorterArgs, longerArgs) of
444 case (shorterArgs, longerArgs) of
454 (x:xs, y:ys) ->
445 (x:xs, y:ys) ->
455− case diff dict RT.Func x y of
446+ case diff localizer RT.Func x y of
456 Similar a b ->
447 Similar a b ->
457− toGreedyMatchHelp dict xs ys $
448+ toGreedyMatchHelp localizer xs ys $
458 GreedyMatch (a:shorterDocs) (b:longerDocs)
449 GreedyMatch (a:shorterDocs) (b:longerDocs)
459
450
460 Different _ _ _ ->
451 Different _ _ _ ->
461− toGreedyMatchHelp dict shorterArgs ys $
452+ toGreedyMatchHelp localizer shorterArgs ys $
462 GreedyMatch shorterDocs (toYellowDoc y : longerDocs)
453 GreedyMatch shorterDocs (toYellowDoc y : longerDocs)
463
454
464 ([], []) ->
455 ([], []) ->
@@ -475,14 +466,14 @@ toGreedyMatchHelp dict shorterArgs longerArgs match@(GreedyMatch shorterDocs lon
475-- RECORD DIFFS
466-- RECORD DIFFS
476
467
477
468
478−diffRecord :: Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc
469+diffRecord :: L.Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc
479−diffRecord dict fields1 ext1 fields2 ext2 =
470+diffRecord localizer fields1 ext1 fields2 ext2 =
480 let
471 let
481 only1 = Map.keys (Map.difference fields1 fields2)
472 only1 = Map.keys (Map.difference fields1 fields2)
482 only2 = Map.keys (Map.difference fields2 fields1)
473 only2 = Map.keys (Map.difference fields2 fields1)
483 in
474 in
484 if null only1 && null only2 then
475 if null only1 && null only2 then
485− case findBadOverlaps dict fields1 fields2 of
476+ case findBadOverlaps localizer fields1 fields2 of
486 [] ->
477 [] ->
487 case diffExt ext1 ext2 of
478 case diffExt ext1 ext2 of
488 Similar _ _ ->
479 Similar _ _ ->
@@ -602,10 +593,10 @@ data BadOverlap =
602 }
593 }
603
594
604
595
605−findBadOverlaps :: Localizer -> Map.Map N.Name Type -> Map.Map N.Name Type -> [BadOverlap]
596+findBadOverlaps :: L.Localizer -> Map.Map N.Name Type -> Map.Map N.Name Type -> [BadOverlap]
606−findBadOverlaps dict fields1 fields2 =
597+findBadOverlaps localizer fields1 fields2 =
607 findBadOverlapsHelp [] $ Map.toList $
598 findBadOverlapsHelp [] $ Map.toList $
608− Map.intersectionWith (diff dict RT.None) fields1 fields2
599+ Map.intersectionWith (diff localizer RT.None) fields1 fields2
609
600
610
601
611findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff D.Doc)] -> [BadOverlap]
602findBadOverlapsHelp :: [BadOverlap] -> [(N.Name, Diff D.Doc)] -> [BadOverlap]
compiler/src/Type/Solve.hs+2−1
@@ -17,6 +17,7 @@ import qualified Elm.Name as N
17import qualified Reporting.Annotation as A
17import qualified Reporting.Annotation as A
18import qualified Reporting.Error.Type as Error
18import qualified Reporting.Error.Type as Error
19import qualified Reporting.Render.Type as RT
19import qualified Reporting.Render.Type as RT
20+import qualified Reporting.Render.Type.Localizer as L
20import qualified Type.Occurs as Occurs
21import qualified Type.Occurs as Occurs
21import Type.Type as Type
22import Type.Type as Type
22import qualified Type.Error as ET
23import qualified Type.Error as ET
@@ -203,7 +204,7 @@ isGeneric var =
203 do tipe <- Type.toErrorType var
204 do tipe <- Type.toErrorType var
204 error $
205 error $
205 "You ran into a compiler bug. Here are some details for the developers:\n\n"
206 "You ran into a compiler bug. Here are some details for the developers:\n\n"
206− ++ " " ++ show (ET.toDoc Map.empty RT.None tipe) ++ " [rank = " ++ show rank ++ "]\n\n"
207+ ++ " " ++ show (ET.toDoc L.empty RT.None tipe) ++ " [rank = " ++ show rank ++ "]\n\n"
207 ++
208 ++
208 "Please create an <http://sscce.org/> and then report it\n\
209 "Please create an <http://sscce.org/> and then report it\n\
209 \at <https://github.com/elm-lang/elm-compiler/issues>\n\n"
210 \at <https://github.com/elm-lang/elm-compiler/issues>\n\n"