e02350a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Show plausible errors on record mismatch / give field typo suggestions

e02350aEvan Czaplicki9 years ago

compiler/src/Reporting/Error/Type.hs+105−145

compare with master

unifiedsplit

@@ -191,7 +191,7 @@ toPatternReport source localizer patternRegion category tipe expected =

191 ( "This pattern is being used in an unexpected way:"

192 , patternTypeComparison localizer tipe expectedType

193 (addPatternCategory "It is" category)

194− (singular "But it needs to match")

194+ "But it needs to match:"

195 []

196 )

197

@@ -203,9 +203,8 @@ toPatternReport source localizer patternRegion category tipe expected =

203 "The " <> D.ordinal index <> " argument to `" <> N.toString name <> "` is weird."

204 , patternTypeComparison localizer tipe expectedType

205 (addPatternCategory "The argument is a pattern that matches" category)

206− (singular $

207− "But the type annotation on `" <> N.toString name

206+ ( "But the type annotation on `" <> N.toString name

208− <> "` says the " <> D.ordinal index <> " argument should be"

207+ <> "` says the " <> D.ordinal index <> " argument should be:"

209 )

208 )

210 []

209 []

211 )

210 )

@@ -218,7 +217,7 @@ toPatternReport source localizer patternRegion category tipe expected =

218 ,

217 ,

219 patternTypeComparison localizer tipe expectedType

218 patternTypeComparison localizer tipe expectedType

220 (addPatternCategory "The first pattern is trying to match" category)

219 (addPatternCategory "The first pattern is trying to match" category)

221− (singular "But the expression between `case` and `of` is")

220+ "But the expression between `case` and `of` is:"

222 [ D.reflow $

221 [ D.reflow $

223 "These can never match! Is the pattern the problem? Or is it the expression?"

222 "These can never match! Is the pattern the problem? Or is it the expression?"

224 ]

223 ]

@@ -228,7 +227,7 @@ toPatternReport source localizer patternRegion category tipe expected =

228 "The " <> D.ordinal index <> " pattern in this `case` does not match the previous ones."

227 "The " <> D.ordinal index <> " pattern in this `case` does not match the previous ones."

229 , patternTypeComparison localizer tipe expectedType

228 , patternTypeComparison localizer tipe expectedType

230 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

229 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

231− (plural "But all the previous patterns match")

230+ "But all the previous patterns match:"

232 [ D.link "Note"

231 [ D.link "Note"

233 "A `case` expression can only handle one type of value, so you may want to use"

232 "A `case` expression can only handle one type of value, so you may want to use"

234 "union-types"

233 "union-types"

@@ -241,9 +240,8 @@ toPatternReport source localizer patternRegion category tipe expected =

241 "The " <> D.ordinal index <> " argument to `" <> N.toString name <> "` is weird."

240 "The " <> D.ordinal index <> " argument to `" <> N.toString name <> "` is weird."

242 , patternTypeComparison localizer tipe expectedType

241 , patternTypeComparison localizer tipe expectedType

243 (addPatternCategory "It is trying to match" category)

242 (addPatternCategory "It is trying to match" category)

244− (singular $

245− "But `" <> N.toString name <> "` needs its "

243+ ( "But `" <> N.toString name <> "` needs its "

246− <> D.ordinal index <> " argument to be"

244+ <> D.ordinal index <> " argument to be:"

247 )

245 )

248 []

246 []

249 )

247 )

@@ -253,7 +251,7 @@ toPatternReport source localizer patternRegion category tipe expected =

253 "The " <> D.ordinal index <> " pattern in this list does not match all the previous ones:"

251 "The " <> D.ordinal index <> " pattern in this list does not match all the previous ones:"

254 , patternTypeComparison localizer tipe expectedType

252 , patternTypeComparison localizer tipe expectedType

255 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

253 (addPatternCategory ("The " <> D.ordinal index <> " pattern is trying to match") category)

256− (plural "But all the previous patterns in the list are")

254+ "But all the previous patterns in the list are:"

257 [ D.toSimpleHint $

255 [ D.toSimpleHint $

258 "Everything in the list needs to be the same type of value.\

256 "Everything in the list needs to be the same type of value.\

259 \ This way you never run into unexpected values partway through.\

257 \ This way you never run into unexpected values partway through.\

@@ -267,7 +265,7 @@ toPatternReport source localizer patternRegion category tipe expected =

267 "The pattern after (::) is causing issues."

265 "The pattern after (::) is causing issues."

268 , patternTypeComparison localizer tipe expectedType

266 , patternTypeComparison localizer tipe expectedType

269 (addPatternCategory "The pattern after (::) is trying to match" category)

267 (addPatternCategory "The pattern after (::) is trying to match" category)

270− (\_ -> "But it needs to match lists like this:")

268+ "But it needs to match lists like this:"

271 []

269 []

272 )

270 )

273

271

@@ -276,144 +274,96 @@ toPatternReport source localizer patternRegion category tipe expected =

276-- PATTERN HELPERS

274-- PATTERN HELPERS

277

275

278

276

279−patternTypeComparison

277+patternTypeComparison :: L.Localizer -> T.Type -> T.Type -> String -> String -> [D.Doc] -> D.Doc

280− :: L.Localizer

281− -> T.Type

282− -> T.Type

283− -> (Maybe N.Name -> D.Doc)

284− -> (Maybe N.Name -> D.Doc)

285− -> [D.Doc]

286− -> D.Doc

287patternTypeComparison localizer actual expected iAmSeeing insteadOf contextHints =

278patternTypeComparison localizer actual expected iAmSeeing insteadOf contextHints =

288 let

279 let

289− (T.Comparison actualAlias actualDoc expectedAlias expectedDoc problems) =

280+ (actualDoc, expectedDoc, problems) =

290 T.toComparison localizer actual expected

281 T.toComparison localizer actual expected

291 in

282 in

292 D.stack $

283 D.stack $

293− [ iAmSeeing actualAlias

284+ [ D.reflow iAmSeeing

294 , D.indent 4 actualDoc

285 , D.indent 4 actualDoc

295− , insteadOf expectedAlias

286+ , D.reflow insteadOf

296 , D.indent 4 expectedDoc

287 , D.indent 4 expectedDoc

297 ]

288 ]

298 ++ problemsToHint problems

289 ++ problemsToHint problems

299 ++ contextHints

290 ++ contextHints

300

291

301

292

302−addPatternCategory :: String -> PCategory -> Maybe N.Name -> D.Doc

293+addPatternCategory :: String -> PCategory -> String

303−addPatternCategory iAmTryingToMatch category maybeAlias =

294+addPatternCategory iAmTryingToMatch category =

304− D.reflow $ iAmTryingToMatch <>

295+ iAmTryingToMatch <>

305− case maybeAlias of

306− Just alias ->

307− " `" <> N.toString alias <> "` values:"

308−

309− Nothing ->

310− case category of

296+ case category of

311− PRecord -> " record values of type:"

297+ PRecord -> " record values of type:"

312− PUnit -> " unit values:"

298+ PUnit -> " unit values:"

313− PTuple -> " tuples of type:"

299+ PTuple -> " tuples of type:"

314− PList -> " lists of type:"

300+ PList -> " lists of type:"

315− PCtor name -> " `" <> N.toString name <> "` values of type:"

301+ PCtor name -> " `" <> N.toString name <> "` values of type:"

316− PInt -> " integers:"

302+ PInt -> " integers:"

317− PStr -> " strings:"

303+ PStr -> " strings:"

318− PChr -> " characters:"

304+ PChr -> " characters:"

319

305

320

306

321

307

322-- EXPR HELPERS

308-- EXPR HELPERS

323

309

324

310

325−typeComparison

311+typeComparison :: L.Localizer -> T.Type -> T.Type -> String -> String -> [D.Doc] -> D.Doc

326− :: L.Localizer

327− -> T.Type

328− -> T.Type

329− -> (Maybe N.Name -> D.Doc)

330− -> (Maybe N.Name -> D.Doc)

331− -> [D.Doc]

332− -> D.Doc

333typeComparison localizer actual expected iAmSeeing insteadOf contextHints =

312typeComparison localizer actual expected iAmSeeing insteadOf contextHints =

334 let

313 let

335− (T.Comparison actualAlias actualDoc expectedAlias expectedDoc problems) =

314+ (actualDoc, expectedDoc, problems) =

336 T.toComparison localizer actual expected

315 T.toComparison localizer actual expected

337 in

316 in

338 D.stack $

317 D.stack $

339− [ iAmSeeing actualAlias

318+ [ D.reflow iAmSeeing

340 , D.indent 4 actualDoc

319 , D.indent 4 actualDoc

341− , insteadOf expectedAlias

320+ , D.reflow insteadOf

342 , D.indent 4 expectedDoc

321 , D.indent 4 expectedDoc

343 ]

322 ]

344 ++ problemsToHint problems

323 ++ problemsToHint problems

345 ++ contextHints

324 ++ contextHints

346

325

347

326

348−loneType

349− :: L.Localizer

327+loneType :: L.Localizer -> T.Type -> T.Type -> D.Doc -> [D.Doc] -> D.Doc

350− -> T.Type

351− -> T.Type

352− -> (Maybe N.Name -> D.Doc)

353− -> [D.Doc]

354− -> D.Doc

355loneType localizer actual expected iAmSeeing furtherDetails =

328loneType localizer actual expected iAmSeeing furtherDetails =

356 let

329 let

357− (T.Comparison actualAlias actualDoc _ _ problems) =

330+ (actualDoc, _, problems) =

358 T.toComparison localizer actual expected

331 T.toComparison localizer actual expected

359 in

332 in

360 D.stack $

333 D.stack $

361− [ iAmSeeing actualAlias

334+ [ iAmSeeing

362 , D.indent 4 actualDoc

335 , D.indent 4 actualDoc

363 ]

336 ]

364 ++ furtherDetails

337 ++ furtherDetails

365 ++ problemsToHint problems

338 ++ problemsToHint problems

366

339

367

340

368−singular :: String -> Maybe N.Name -> D.Doc

369−singular insteadOf maybeAlias =

370− D.reflow $ insteadOf <>

371− case maybeAlias of

372− Nothing -> ":"

373− Just a -> " a `" <> N.toString a <> "` value:"

374−

375−

376−plural :: String -> Maybe N.Name -> D.Doc

377−plural insteadOf maybeAlias =

378− D.reflow $ insteadOf <>

379− case maybeAlias of

380− Nothing -> ":"

381− Just a -> " `" <> N.toString a <> "` values:"

382−

383−

384−addCategory :: String -> Category -> Maybe N.Name -> D.Doc

341+addCategory :: String -> Category -> String

385−addCategory thisIs category maybeAlias =

342+addCategory thisIs category =

386− let

387− definitely whatever =

388− case maybeAlias of

389− Just alias -> " a `" <> N.toString alias <> "`:"

390− Nothing -> whatever

391− in

392− D.reflow $

393 case category of

343 case category of

394− Local name -> "This `" <> N.toString name <> "` value is" <> definitely " a:"

344+ Local name -> "This `" <> N.toString name <> "` value is a:"

395− Foreign name -> "This `" <> N.toString name <> "` value is" <> definitely " a:"

345+ Foreign name -> "This `" <> N.toString name <> "` value is a:"

396− Access field -> "The value at ." <> N.toString field <> " is" <> definitely " a:"

346+ Access field -> "The value at ." <> N.toString field <> " is a:"

397 Accessor field -> "This ." <> N.toString field <> " field access function has type:"

347 Accessor field -> "This ." <> N.toString field <> " field access function has type:"

398− If -> "This `if` expression produces" <> definitely ":"

348+ If -> "This `if` expression produces:"

399− Case -> "This `case` expression produces" <> definitely ":"

349+ Case -> "This `case` expression produces:"

400− List -> thisIs <> definitely " a list of type:"

350+ List -> thisIs <> " a list of type:"

401− Number -> thisIs <> definitely " a number of type:"

351+ Number -> thisIs <> " a number of type:"

402− Float -> thisIs <> definitely " a float of type:"

352+ Float -> thisIs <> " a float of type:"

403− String -> thisIs <> definitely " a string of type:"

353+ String -> thisIs <> " a string of type:"

404− Char -> thisIs <> definitely " a character of type:"

354+ Char -> thisIs <> " a character of type:"

405− Lambda -> thisIs <> definitely " an anonymous function of type:"

355+ Lambda -> thisIs <> " an anonymous function of type:"

406− Record -> thisIs <> definitely " a record of type:"

356+ Record -> thisIs <> " a record of type:"

407− Tuple -> thisIs <> definitely " a tuple of type:"

357+ Tuple -> thisIs <> " a tuple of type:"

408− Unit -> thisIs <> definitely " a unit value:"

358+ Unit -> thisIs <> " a unit value:"

409− Shader -> thisIs <> definitely " a GLSL shader of type:"

359+ Shader -> thisIs <> " a GLSL shader of type:"

410 Effects -> thisIs <> " a thing for CORE LIBRARIES ONLY."

360 Effects -> thisIs <> " a thing for CORE LIBRARIES ONLY."

411 CallResult maybeName ->

361 CallResult maybeName ->

412 case maybeName of

362 case maybeName of

413 NoName -> thisIs <> ":"

363 NoName -> thisIs <> ":"

414− FuncName name -> "This `" <> N.toString name <> "` call produces" <> definitely ":"

364+ FuncName name -> "This `" <> N.toString name <> "` call produces:"

415− CtorName name -> "This `" <> N.toString name <> "` call produces" <> definitely ":"

365+ CtorName name -> "This `" <> N.toString name <> "` call produces:"

416− OpName _ -> thisIs <> definitely ":"

366+ OpName _ -> thisIs <> ":"

417

367

418

368

419problemsToHint :: [T.Problem] -> [D.Doc]

369problemsToHint :: [T.Problem] -> [D.Doc]

@@ -531,6 +481,19 @@ problemToHint problem =

531 T.Tuple _ _ _ -> badRigidSuper super "a tuple"

481 T.Tuple _ _ _ -> badRigidSuper super "a tuple"

532 T.Alias _ n _ _ -> badRigidSuper super ("a `" ++ N.toString n ++ "` value")

482 T.Alias _ n _ _ -> badRigidSuper super ("a `" ++ N.toString n ++ "` value")

533

483

484+ T.FieldTypo typo possibilities ->

485+ case Suggest.sort (N.toString typo) N.toString possibilities of

486+ [] ->

487+ []

488+

489+ nearest:_ ->

490+ [ D.toFancyHint $

491+ ["Seems","like","a","record","field","typo.","Maybe"

492+ ,D.dullyellow (D.fromName typo),"should","be"

493+ ,D.green (D.fromName nearest) <> "?"

494+ ]

495+ ]

496+

534

497

535

498

536-- BAD RIGID HINTS

499-- BAD RIGID HINTS

@@ -659,7 +622,7 @@ toExprReport source localizer exprRegion category tipe expected =

659 ( "This expression is being used in an unexpected way:"

622 ( "This expression is being used in an unexpected way:"

660 , typeComparison localizer tipe expectedType

623 , typeComparison localizer tipe expectedType

661 (addCategory "It is" category)

624 (addCategory "It is" category)

662− (singular "But you are trying to use it as")

625+ "But you are trying to use it as:"

663 []

626 []

664 )

627 )

665

628

@@ -682,7 +645,7 @@ toExprReport source localizer exprRegion category tipe expected =

682 ( D.reflow ("Something is off with the " <> thing)

645 ( D.reflow ("Something is off with the " <> thing)

683 , typeComparison localizer tipe expectedType

646 , typeComparison localizer tipe expectedType

684 (addCategory itIs category)

647 (addCategory itIs category)

685− (singular $ "But the type annotation on `" <> N.toString name <> "` says it should be")

648+ ("But the type annotation on `" <> N.toString name <> "` says it should be:")

686 []

649 []

687 )

650 )

688

651

@@ -699,7 +662,7 @@ toExprReport source localizer exprRegion category tipe expected =

699 Report.Report "TYPE MISMATCH" exprRegion [] $

662 Report.Report "TYPE MISMATCH" exprRegion [] $

700 Report.toCodeSnippet source region maybeHighlight

663 Report.toCodeSnippet source region maybeHighlight

701 ( D.reflow problem

664 ( D.reflow problem

702− , loneType localizer tipe expectedType (addCategory thisIs category) furtherDetails

665+ , loneType localizer tipe expectedType (D.reflow (addCategory thisIs category)) furtherDetails

703 )

666 )

704

667

705 custom maybeHighlight docPair =

668 custom maybeHighlight docPair =

@@ -713,7 +676,7 @@ toExprReport source localizer exprRegion category tipe expected =

713 ( Just exprRegion

676 ( Just exprRegion

714 , "The " <> ith <> " element of this list does not match all the previous elements:"

677 , "The " <> ith <> " element of this list does not match all the previous elements:"

715 , "The " <> ith <> " element is"

678 , "The " <> ith <> " element is"

716− , plural "But all the previous elements in the list are"

679+ , "But all the previous elements in the list are:"

717 , [ D.toSimpleHint $

680 , [ D.toSimpleHint $

718 "Everything in the list needs to be the same type of value.\

681 "Everything in the list needs to be the same type of value.\

719 \ This way you never run into unexpected values partway through.\

682 \ This way you never run into unexpected values partway through.\

@@ -761,7 +724,7 @@ toExprReport source localizer exprRegion category tipe expected =

761 ( Just exprRegion

724 ( Just exprRegion

762 , "The " <> ith <> " branch of this `if` does not match all the previous branches:"

725 , "The " <> ith <> " branch of this `if` does not match all the previous branches:"

763 , "The " <> ith <> " branch is"

726 , "The " <> ith <> " branch is"

764− , plural "But all the previous branches result in"

727+ , "But all the previous branches result in:"

765 , [ D.link "Hint"

728 , [ D.link "Hint"

766 "All branches in an `if` must produce the same type of values. This way, no\

729 "All branches in an `if` must produce the same type of values. This way, no\

767 \ matter which branch we take, the result is always a consistent shape. Read"

730 \ matter which branch we take, the result is always a consistent shape. Read"

@@ -776,7 +739,7 @@ toExprReport source localizer exprRegion category tipe expected =

776 ( Just exprRegion

739 ( Just exprRegion

777 , "The " <> ith <> " branch of this `case` does not match all the previous branches:"

740 , "The " <> ith <> " branch of this `case` does not match all the previous branches:"

778 , "The " <> ith <> " branch is"

741 , "The " <> ith <> " branch is"

779− , plural "But all the previous branches result in"

742+ , "But all the previous branches result in:"

780 , [ D.link "Hint"

743 , [ D.link "Hint"

781 "All branches in a `case` must produce the same type of values. This way, no\

744 "All branches in a `case` must produce the same type of values. This way, no\

782 \ matter which branch we take, the result is always a consistent shape. Read"

745 \ matter which branch we take, the result is always a consistent shape. Read"

@@ -830,7 +793,7 @@ toExprReport source localizer exprRegion category tipe expected =

830 ( Just exprRegion

793 ( Just exprRegion

831 , "The " <> ith <> " argument to " <> thisFunction <> " is not what I expect:"

794 , "The " <> ith <> " argument to " <> thisFunction <> " is not what I expect:"

832 , "This argument is"

795 , "This argument is"

833− , singular $ "But " <> thisFunction <> " needs the " <> ith <> " argument to be"

796+ , "But " <> thisFunction <> " needs the " <> ith <> " argument to be:"

834 ,

797 ,

835 if Index.toHuman index == 1 then

798 if Index.toHuman index == 1 then

836 []

799 []

@@ -884,7 +847,7 @@ toExprReport source localizer exprRegion category tipe expected =

884 ( Nothing

847 ( Nothing

885 , "Something is off with this record update:"

848 , "Something is off with this record update:"

886 , "The `" <> N.toString record <> "` record is"

849 , "The `" <> N.toString record <> "` record is"

887− , \_ -> "But this update needs it to be compatable with:"

850+ , "But this update needs it to be compatable with:"

888 , [ D.reflow

851 , [ D.reflow

889 "Do you mind creating an <http://sscce.org/> that produces this error message and\

852 "Do you mind creating an <http://sscce.org/> that produces this error message and\

890 \ sharing it at <https://github.com/elm-lang/error-message-catalog/issues> so we\

853 \ sharing it at <https://github.com/elm-lang/error-message-catalog/issues> so we\

@@ -929,7 +892,7 @@ toExprReport source localizer exprRegion category tipe expected =

929 ( Just exprRegion

892 ( Just exprRegion

930 , "I cannot update the `" <> N.toString field <> "` field like this:"

893 , "I cannot update the `" <> N.toString field <> "` field like this:"

931 , "You are trying to update `" <> N.toString field <> "` to be"

894 , "You are trying to update `" <> N.toString field <> "` to be"

932− , singular "But it should be"

895+ , "But it should be:"

933 , [ D.toSimpleNote

896 , [ D.toSimpleNote

934 "The record update syntax does not allow you to change the type of fields.\

897 "The record update syntax does not allow you to change the type of fields.\

935 \ You can achieve that with record constructors or the record literal syntax."

898 \ You can achieve that with record constructors or the record literal syntax."

@@ -941,7 +904,7 @@ toExprReport source localizer exprRegion category tipe expected =

941 ( Nothing

904 ( Nothing

942 , "This definition is causing issues:"

905 , "This definition is causing issues:"

943 , "You are defining"

906 , "You are defining"

944− , singular "But then trying to destructure it as"

907+ , "But then trying to destructure it as:"

945 , []

908 , []

946 )

909 )

947

910

@@ -1030,7 +993,7 @@ opLeftToDocs localizer category op tipe expected =

1030 "<|" ->

993 "<|" ->

1031 ( "The left side of (<|) needs to be a function so I can pipe arguments to it!"

994 ( "The left side of (<|) needs to be a function so I can pipe arguments to it!"

1032 , loneType localizer tipe expected

995 , loneType localizer tipe expected

1033− (addCategory "I am seeing" category)

996+ (D.reflow (addCategory "I am seeing" category))

1034 [ D.reflow $ "This needs to be some kind of function though!"

997 [ D.reflow $ "This needs to be some kind of function though!"

1035 ]

998 ]

1036 )

999 )

@@ -1040,7 +1003,7 @@ opLeftToDocs localizer category op tipe expected =

1040 "The left argument of (" <> N.toString op <> ") is causing problems:"

1003 "The left argument of (" <> N.toString op <> ") is causing problems:"

1041 , typeComparison localizer tipe expected

1004 , typeComparison localizer tipe expected

1042 (addCategory "The left argument is" category)

1005 (addCategory "The left argument is" category)

1043− (singular $ "But (" <> N.toString op <> ") needs the left argument to be")

1006+ ("But (" <> N.toString op <> ") needs the left argument to be:")

1044 []

1007 []

1045 )

1008 )

1046

1009

@@ -1101,7 +1064,7 @@ opRightToDocs localizer category op tipe expected =

1101 ( D.reflow $ "I cannot send this through the (<|) pipe:"

1064 ( D.reflow $ "I cannot send this through the (<|) pipe:"

1102 , typeComparison localizer tipe expected

1065 , typeComparison localizer tipe expected

1103 (addCategory "You are providing" category)

1066 (addCategory "You are providing" category)

1104− (singular "But (<|) is piping it a function that expects")

1067+ "But (<|) is piping it a function that expects:"

1105 []

1068 []

1106 )

1069 )

1107

1070

@@ -1112,7 +1075,7 @@ opRightToDocs localizer category op tipe expected =

1112 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"

1075 ( D.reflow $ "This function cannot handle the argument sent through the (|>) pipe:"

1113 , typeComparison localizer argType expectedArgType

1076 , typeComparison localizer argType expectedArgType

1114 (addCategory "The argument is" category)

1077 (addCategory "The argument is" category)

1115− (singular "But (|>) is piping it a function that expects")

1078+ "But (|>) is piping it a function that expects:"

1116 []

1079 []

1117 )

1080 )

1118

1081

@@ -1120,7 +1083,7 @@ opRightToDocs localizer category op tipe expected =

1120 EmphRight

1083 EmphRight

1121 ( D.reflow $ "The right side of (|>) needs to be a function so I can pipe arguments to it!"

1084 ( D.reflow $ "The right side of (|>) needs to be a function so I can pipe arguments to it!"

1122 , loneType localizer tipe expected

1085 , loneType localizer tipe expected

1123− (addCategory "But instead of a function, I am seeing" category)

1086+ (D.reflow (addCategory "But instead of a function, I am seeing" category))

1124 []

1087 []

1125 )

1088 )

1126

1089

@@ -1135,7 +1098,7 @@ badOpRightFallback localizer category op tipe expected =

1135 "The right argument of (" <> N.toString op <> ") is causing problems."

1098 "The right argument of (" <> N.toString op <> ") is causing problems."

1136 , typeComparison localizer tipe expected

1099 , typeComparison localizer tipe expected

1137 (addCategory "The right argument is" category)

1100 (addCategory "The right argument is" category)

1138− (singular $ "But (" <> N.toString op <> ") needs the right argument to be")

1101+ ("But (" <> N.toString op <> ") needs the right argument to be:")

1139 [ D.toSimpleHint $

1102 [ D.toSimpleHint $

1140 "With operators like (" ++ N.toString op ++ ") I always check the left\

1103 "With operators like (" ++ N.toString op ++ ") I always check the left\

1141 \ side first. If it seems fine, I assume it is correct and check the right\

1104 \ side first. If it seems fine, I assume it is correct and check the right\

@@ -1197,8 +1160,8 @@ badConsRight localizer category tipe expected =

1197 EmphBoth

1160 EmphBoth

1198 ( D.reflow "I am having trouble with this (::) operator:"

1161 ( D.reflow "I am having trouble with this (::) operator:"

1199 , typeComparison localizer expectedElement actualElement

1162 , typeComparison localizer expectedElement actualElement

1200− (singular "The left side of (::) is")

1163+ "The left side of (::) is:"

1201− (plural "But you are trying to put that into a list filled with")

1164+ "But you are trying to put that into a list filled with:"

1202 ( case expectedElement of

1165 ( case expectedElement of

1203 T.Type home name [_] | T.isList home name ->

1166 T.Type home name [_] | T.isList home name ->

1204 [ D.toSimpleHint

1167 [ D.toSimpleHint

@@ -1221,7 +1184,7 @@ badConsRight localizer category tipe expected =

1221 EmphRight

1184 EmphRight

1222 ( D.reflow "The (::) operator can only add elements onto lists."

1185 ( D.reflow "The (::) operator can only add elements onto lists."

1223 , loneType localizer tipe expected

1186 , loneType localizer tipe expected

1224− (addCategory "The right side is" category)

1187+ (D.reflow (addCategory "The right side is" category))

1225 [D.fillSep ["But","(::)","needs","a",D.dullyellow "List","on","the","right."]

1188 [D.fillSep ["But","(::)","needs","a",D.dullyellow "List","on","the","right."]

1226 ]

1189 ]

1227 )

1190 )

@@ -1271,7 +1234,7 @@ badAppendLeft localizer category tipe expected =

1271 ( D.reflow $

1234 ( D.reflow $

1272 "The (++) operator cannot append this type of value:"

1235 "The (++) operator cannot append this type of value:"

1273 , loneType localizer tipe expected

1236 , loneType localizer tipe expected

1274− (addCategory "I am seeing" category)

1237+ (D.reflow (addCategory "I am seeing" category))

1275 [ D.fillSep

1238 [ D.fillSep

1276 ["But","the","(++)","operator","is","only","for","appending"

1239 ["But","the","(++)","operator","is","only","for","appending"

1277 ,D.dullyellow "List","and",D.dullyellow "String","values."

1240 ,D.dullyellow "List","and",D.dullyellow "String","values."

@@ -1330,7 +1293,7 @@ badAppendRight localizer category tipe expected =

1330 ( D.reflow $

1293 ( D.reflow $

1331 "The (++) operator cannot append these two values:"

1294 "The (++) operator cannot append these two values:"

1332 , typeComparison localizer expected tipe

1295 , typeComparison localizer expected tipe

1333− (singular "I already figured out that the left side of (++) is")

1296+ "I already figured out that the left side of (++) is:"

1334 (addCategory "But this clashes with the right side, which is" category)

1297 (addCategory "But this clashes with the right side, which is" category)

1335 []

1298 []

1336 )

1299 )

@@ -1402,7 +1365,7 @@ badListAdd localizer category direction tipe expected =

1402 "I cannot do addition with lists:"

1365 "I cannot do addition with lists:"

1403 ,

1366 ,

1404 loneType localizer tipe expected

1367 loneType localizer tipe expected

1405− (addCategory ("The " <> direction <> " side of (+) is") category)

1368+ (D.reflow (addCategory ("The " <> direction <> " side of (+) is") category))

1406 [ D.fillSep

1369 [ D.fillSep

1407 ["But","(+)","only","works","with",D.dullyellow "Int","and",D.dullyellow "Float","values."

1370 ["But","(+)","only","works","with",D.dullyellow "Int","and",D.dullyellow "Float","values."

1408 ]

1371 ]

@@ -1432,7 +1395,7 @@ badMath localizer category operation direction op tipe expected otherHints =

1432 operation ++ " does not work with this value:"

1395 operation ++ " does not work with this value:"

1433 ,

1396 ,

1434 loneType localizer tipe expected

1397 loneType localizer tipe expected

1435− (addCategory ("The " <> direction <> " side of (" <> op <> ") is") category)

1398+ (D.reflow (addCategory ("The " <> direction <> " side of (" <> op <> ") is") category))

1436 ( [ D.fillSep

1399 ( [ D.fillSep

1437 ["But","(" <> D.fromString op <> ")","only","works","with"

1400 ["But","(" <> D.fromString op <> ")","only","works","with"

1438 ,D.dullyellow "Int","and",D.dullyellow "Float","values."

1401 ,D.dullyellow "Int","and",D.dullyellow "Float","values."

@@ -1466,11 +1429,10 @@ badFDiv localizer direction tipe expected =

1466

1429

1467 else

1430 else

1468 loneType localizer tipe expected

1431 loneType localizer tipe expected

1469− (\_ ->

1470− D.fillSep

1432+ (D.fillSep

1471− ["The",direction,"side","of","(/)","must","be","a"

1433+ ["The",direction,"side","of","(/)","must","be","a"

1472− ,D.dullyellow "Float" <> ",","but","instead","I","am","seeing:"

1434+ ,D.dullyellow "Float" <> ",","but","instead","I","am","seeing:"

1473− ]

1435+ ]

1474 )

1436 )

1475 []

1437 []

1476 )

1438 )

@@ -1501,11 +1463,10 @@ badIDiv localizer direction tipe expected =

1501 ]

1463 ]

1502 else

1464 else

1503 loneType localizer tipe expected

1465 loneType localizer tipe expected

1504− ( \_ ->

1505− D.fillSep

1466+ ( D.fillSep

1506− ["The",direction,"side","of","(//)","must","be","an"

1467+ ["The",direction,"side","of","(//)","must","be","an"

1507− ,D.dullyellow "Int" <> ",","but","instead","I","am","seeing:"

1468+ ,D.dullyellow "Int" <> ",","but","instead","I","am","seeing:"

1508− ]

1469+ ]

1509 )

1470 )

1510 []

1471 []

1511 )

1472 )

@@ -1522,11 +1483,10 @@ badBool localizer op direction tipe expected =

1522 "I am struggling with this boolean operation:"

1483 "I am struggling with this boolean operation:"

1523 ,

1484 ,

1524 loneType localizer tipe expected

1485 loneType localizer tipe expected

1525− ( \_ ->

1526− D.fillSep

1486+ ( D.fillSep

1527− ["Both","sides","of","(" <> op <> ")","must","be"

1487+ ["Both","sides","of","(" <> op <> ")","must","be"

1528− ,D.dullyellow "Bool","values,","but","the",direction,"side","is:"

1488+ ,D.dullyellow "Bool","values,","but","the",direction,"side","is:"

1529− ]

1489+ ]

1530 )

1490 )

1531 []

1491 []

1532 )

1492 )

@@ -1543,7 +1503,7 @@ badCompLeft localizer category op direction tipe expected =

1543 "I cannot do a comparison with this value:"

1503 "I cannot do a comparison with this value:"

1544 ,

1504 ,

1545 loneType localizer tipe expected

1505 loneType localizer tipe expected

1546− (addCategory ("The " <> direction <> " side of (" <> op <> ") is") category)

1506+ (D.reflow (addCategory ("The " <> direction <> " side of (" <> op <> ") is") category))

1547 [ D.fillSep

1507 [ D.fillSep

1548 ["But","(" <> D.fromString op <> ")","only","works","on"

1508 ["But","(" <> D.fromString op <> ")","only","works","on"

1549 ,D.dullyellow "Int" <> ","

1509 ,D.dullyellow "Int" <> ","

@@ -1567,8 +1527,8 @@ badCompRight localizer op tipe expected =

1567 "I need both sides of (" <> op <> ") to be the same type:"

1527 "I need both sides of (" <> op <> ") to be the same type:"

1568 ,

1528 ,

1569 typeComparison localizer expected tipe

1529 typeComparison localizer expected tipe

1570− (singular "The left side of is")

1530+ "The left side of is:"

1571− (singular "But the right side is")

1531+ "But the right side is:"

1572 [ D.reflow $

1532 [ D.reflow $

1573 "I cannot compare different types though! Which side of (" <> op <> ") is the problem?"

1533 "I cannot compare different types though! Which side of (" <> op <> ") is the problem?"

1574 ]

1534 ]

@@ -1587,8 +1547,8 @@ badEquality localizer op tipe expected =

1587 "I need both sides of (" <> op <> ") to be the same type:"

1547 "I need both sides of (" <> op <> ") to be the same type:"

1588 ,

1548 ,

1589 typeComparison localizer expected tipe

1549 typeComparison localizer expected tipe

1590− (singular "The left side of is")

1550+ "The left side of is:"

1591− (singular "But the right side is")

1551+ "But the right side is:"

1592 [ if isFloat tipe || isFloat expected then

1552 [ if isFloat tipe || isFloat expected then

1593 D.toSimpleNote $

1553 D.toSimpleNote $

1594 "Equality on floats is not 100% reliable due to the design of IEEE 754. I\

1554 "Equality on floats is not 100% reliable due to the design of IEEE 754. I\

compiler/src/Type/Error.hs+329−459

@@ -5,9 +5,7 @@ module Type.Error

5 , Super(..)

6 , Extension(..)

7 , iteratedDealias

8− , getFields

9 , toDoc

8 , toDoc

10− , Comparison(..)

11 , Problem(..)

9 , Problem(..)

12 , toComparison

10 , toComparison

13 , isInt

11 , isInt

@@ -73,19 +71,6 @@ iteratedDealias tipe =

73 tipe

71 tipe

76−getFields :: Type -> Maybe (Map.Map N.Name Type)

77−getFields tipe =

78− case tipe of

79− Alias _ _ _ real ->

80− getFields real

81−

82− Record fields _ ->

83− Just fields

84−

85− _ ->

86− Nothing

87−

88−

90-- TO DOC

75-- TO DOC

@@ -128,18 +113,7 @@ toDoc localizer ctx tipe =

128 (map (toDoc localizer RT.App) args)

113 (map (toDoc localizer RT.App) args)

129

114

130 Record fields ext ->

115 Record fields ext ->

131− let

116+ RT.record (fieldsToDocs localizer fields) (extToDoc ext)

132− entryToDocs (fieldName, fieldType) =

133− ( D.fromName fieldName, toDoc localizer RT.None fieldType )

134−

135− fieldDocs =

136− map entryToDocs (Map.toList fields)

137− in

138− RT.record fieldDocs $

139− case ext of

140− Closed -> Nothing

141− FlexOpen x -> Just (D.fromName x)

142− RigidOpen x -> Just (D.fromName x)

143

117

144 Unit ->

118 Unit ->

145 "()"

119 "()"

@@ -151,288 +125,251 @@ toDoc localizer ctx tipe =

151 (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))

125 (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))

152

126

153 Alias home name args _ ->

127 Alias home name args _ ->

154− RT.apply ctx

128+ aliasToDoc localizer ctx home name args

155− (nameToDoc localizer home name)

156− (map (toDoc localizer RT.App . snd) args)

157

129

158

130

131+aliasToDoc :: L.Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> [(N.Name, Type)] -> D.Doc

132+aliasToDoc localizer ctx home name args =

133+ RT.apply ctx

134+ (nameToDoc localizer home name)

135+ (map (toDoc localizer RT.App . snd) args)

159

136

160−-- DIFF

161

137

138+fieldsToDocs :: L.Localizer -> Map.Map N.Name Type -> [(D.Doc, D.Doc)]

139+fieldsToDocs localizer fields =

140+ Map.foldrWithKey (addField localizer) [] fields

162

141

163−data Diff

164− = Similar Type Type

165− | DiffLambda Aliases Diff Diff [Diff]

166− | DiffType Aliases ModuleName.Canonical N.Name [Diff]

167− | DiffRecord Aliases [N.Name] (Map.Map N.Name Diff) [N.Name] Extension Extension

168− | DiffTuple Aliases Diff Diff (Maybe Diff)

169− | Clash Type Type

170

142

143+addField :: L.Localizer -> N.Name -> Type -> [(D.Doc, D.Doc)] -> [(D.Doc, D.Doc)]

144+addField localizer fieldName fieldType docs =

145+ let

146+ f = D.fromName fieldName

147+ t = toDoc localizer RT.None fieldType

148+ in

149+ (f,t) : docs

171

150

172−same :: Type -> Diff

173−same tipe =

174− Similar tipe tipe

175

151

152+extToDoc :: Extension -> Maybe D.Doc

153+extToDoc ext =

154+ case ext of

155+ Closed -> Nothing

156+ FlexOpen x -> Just (D.fromName x)

157+ RigidOpen x -> Just (D.fromName x)

176

158

177−data Aliases =

178− Aliases

179− { _left :: Maybe N.Name

180− , _right :: Maybe N.Name

181− }

182

159

183

160

184−{-# NOINLINE noAliases #-}

161+-- DIFF

185−noAliases :: Aliases

186−noAliases =

187− Aliases Nothing Nothing

188

162

189

163

190−toDiff :: Type -> Type -> Diff

164+data Diff a =

191−toDiff t1 t2 =

165+ Diff a a Status

192− case (t1, t2) of

193− (Unit , Unit ) -> same t1

194− (Error , Error ) -> same t1

195− (Infinite, Infinite) -> same t1

196

166

197− (FlexVar x, FlexVar y) | x == y -> same t1

198− (FlexSuper _ x, FlexSuper _ y) | x == y -> same t1

199− (RigidVar x, RigidVar y) | x == y -> same t1

200− (RigidSuper _ x, RigidSuper _ y) | x == y -> same t1

201

167

168+data Status

202− (FlexVar _ , _ ) -> Similar t1 t2

169+ = Similar

203− (_ , FlexVar _ ) -> Similar t1 t2

170+ | Different (Bag.Bag Problem)

204

171

205− (Lambda a1 b1 cs1, Lambda a2 b2 cs2) | length cs1 == length cs2 ->

206− let

207− a = toDiff a1 a2

208− b = toDiff b1 b2

209− cs = zipWith toDiff cs1 cs2

210− in

211− if isSimilar a && isSimilar b && all isSimilar cs

212− then Similar t1 t2

213− else DiffLambda noAliases a b cs

214

172

215− (Tuple a1 b1 Nothing, Tuple a2 b2 Nothing) ->

173+data Problem

216− let

174+ = IntFloat

217− a = toDiff a1 a2

175+ | StringFromInt

218− b = toDiff b1 b2

176+ | StringFromFloat

219− in

177+ | StringToInt

220− if isSimilar a && isSimilar b

178+ | StringToFloat

221− then Similar t1 t2

179+ | AnythingToBool

222− else DiffTuple noAliases a b Nothing

180+ | AnythingFromMaybe

181+ | AnythingToList

182+ | MissingArgs Int

183+ | ReturnMismatch

184+ | BadFlexSuper Super N.Name Type

185+ | BadRigidVar N.Name Type

186+ | BadRigidSuper Super N.Name Type

187+ | FieldTypo N.Name [N.Name]

223

188

224− (Tuple a1 b1 (Just c1), Tuple a2 b2 (Just c2)) ->

225− let

226− a = toDiff a1 a2

227− b = toDiff b1 b2

228− c = toDiff c1 c2

229− in

230− if isSimilar a && isSimilar b && isSimilar c

231− then Similar t1 t2

232− else DiffTuple noAliases a b (Just c)

233

189

234− (Record fields1 ext1, Record fields2 ext2) ->

190+instance Functor Diff where

235− let

191+ fmap func (Diff a b status) =

236− left = Map.keys (Map.difference fields1 fields2)

192+ Diff (func a) (func b) status

237− both = Map.intersectionWith toDiff fields1 fields2

238− right = Map.keys (Map.difference fields2 fields1)

239− in

240− if null left && null right && all isSimilar both && isExtSimilar ext1 ext2

241− then Similar t1 t2

242− else DiffRecord noAliases left both right ext1 ext2

243

193

244− (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->

245− let

246− args = zipWith toDiff args1 args2

247− in

248− if all isSimilar args

249− then Similar t1 t2

250− else DiffType noAliases home1 name1 args

251

194

252− (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->

195+instance Applicative Diff where

253− let

196+ pure a =

254− args = zipWith toDiff (map snd args1) (map snd args2)

255− in

256− if all isSimilar args

257− then Similar t1 t2

197+ Diff a a Similar

258− else DiffType noAliases home1 name1 args

259

198

260− (alias@(Alias _ name _ tipe1), tipe2) ->

199+ (<*>) (Diff aFunc bFunc status1) (Diff aArg bArg status2) =

261− addAlias (const alias) id (\(Aliases _ t) -> Aliases (Just name) t) (toDiff tipe1 tipe2)

200+ Diff (aFunc aArg) (bFunc bArg) (merge status1 status2)

262

201

263− (tipe1, alias@(Alias _ name _ tipe2)) ->

264− addAlias id (const alias) (\(Aliases t _) -> Aliases t (Just name)) (toDiff tipe1 tipe2)

265

202

266− _ ->

203+merge :: Status -> Status -> Status

267− Clash t1 t2

204+merge status1 status2 =

205+ case status1 of

206+ Similar ->

207+ status2

268

208

209+ Different problems1 ->

210+ case status2 of

211+ Similar ->

212+ status1

269

213

270−isSimilar :: Diff -> Bool

214+ Different problems2 ->

271−isSimilar diff =

215+ Different (Bag.append problems1 problems2)

272− case diff of

273− Similar _ _ -> True

274− DiffLambda _ _ _ _ -> False

275− DiffType _ _ _ _ -> False

276− DiffRecord _ _ _ _ _ _ -> False

277− DiffTuple _ _ _ _ -> False

278− Clash _ _ -> False

279

216

280

217

281−addAlias :: (Type -> Type) -> (Type -> Type) -> (Aliases -> Aliases) -> Diff -> Diff

282−addAlias updateLeft updateRight updateAliases diff =

283− case diff of

284− Similar t1 t2 ->

285− Similar (updateLeft t1) (updateRight t2)

286

218

287− DiffLambda aliases a b cs ->

219+-- COMPARISON

288− DiffLambda (updateAliases aliases) a b cs

289

220

290− DiffType aliases home name args ->

291− DiffType (updateAliases aliases) home name args

292

221

293− DiffRecord aliases lefts boths rights ext1 ext2 ->

222+toComparison :: L.Localizer -> Type -> Type -> (D.Doc, D.Doc, [Problem])

294− DiffRecord (updateAliases aliases) lefts boths rights ext1 ext2

223+toComparison localizer tipe1 tipe2 =

224+ case toDiff localizer RT.None tipe1 tipe2 of

225+ Diff doc1 doc2 Similar ->

226+ (doc1, doc2, [])

295

227

296− DiffTuple aliases a b maybeC ->

228+ Diff doc1 doc2 (Different problems) ->

297− DiffTuple (updateAliases aliases) a b maybeC

229+ (doc1, doc2, Bag.toList problems)

298

230

299− Clash t1 t2 ->

300− Clash (updateLeft t1) (updateRight t2)

301

231

232+toDiff :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc

233+toDiff localizer ctx tipe1 tipe2 =

234+ case (tipe1, tipe2) of

235+ (Unit , Unit ) -> same localizer ctx tipe1

236+ (Error , Error ) -> same localizer ctx tipe1

237+ (Infinite, Infinite) -> same localizer ctx tipe1

302

238

239+ (FlexVar x, FlexVar y) | x == y -> same localizer ctx tipe1

240+ (FlexSuper _ x, FlexSuper _ y) | x == y -> same localizer ctx tipe1

241+ (RigidVar x, RigidVar y) | x == y -> same localizer ctx tipe1

242+ (RigidSuper _ x, RigidSuper _ y) | x == y -> same localizer ctx tipe1

303

243

304−-- COMPARISON

244+ (FlexVar _, _ ) -> similar localizer ctx tipe1 tipe2

245+ (_ , FlexVar _) -> similar localizer ctx tipe1 tipe2

305

246

247+ (Lambda a b cs, Lambda x y zs) ->

248+ if length cs == length zs then

249+ RT.lambda ctx

250+ <$> toDiff localizer RT.Func a x

251+ <*> toDiff localizer RT.Func b y

252+ <*> sequenceA (zipWith (toDiff localizer RT.Func) cs zs)

253+ else

254+ diffLambda localizer ctx a b cs x y zs

306

255

307−data Comparison =

256+ (Tuple a b Nothing, Tuple x y Nothing) ->

308− Comparison

257+ RT.tuple

309− { _alias1 :: Maybe N.Name

258+ <$> toDiff localizer RT.None a x

310− , _type1 :: D.Doc

259+ <*> toDiff localizer RT.None b y

311− , _alias2 :: Maybe N.Name

260+ <*> pure []

312− , _type2 :: D.Doc

313− , _problems :: [Problem]

314− }

315

261

262+ (Tuple a b (Just c), Tuple x y (Just z)) ->

263+ RT.tuple

264+ <$> toDiff localizer RT.None a x

265+ <*> toDiff localizer RT.None b y

266+ <*> ((:[]) <$> toDiff localizer RT.None c z)

316

267

317−data Problem

268+ (Record fields1 ext1, Record fields2 ext2) ->

318− = FieldMismatch [N.Name] [N.Name]

269+ diffRecord localizer fields1 ext1 fields2 ext2

319− | IntFloat

320− | StringFromInt

321− | StringFromFloat

322− | StringToInt

323− | StringToFloat

324− | AnythingToBool

325− | AnythingFromMaybe

326− | AnythingToList

327− | MissingArgs Int

328− | ReturnMismatch

329− | BadFlexSuper Super N.Name Type

330− | BadRigidVar N.Name Type

331− | BadRigidSuper Super N.Name Type

332

270

271+ (Type home1 name1 args1, Type home2 name2 args2) | home1 == home2 && name1 == name2 ->

272+ RT.apply ctx (nameToDoc localizer home1 name1)

273+ <$> sequenceA (zipWith (toDiff localizer RT.App) args1 args2)

333

274

334−toComparison :: L.Localizer -> Type -> Type -> Comparison

275+ (Alias home1 name1 args1 _, Alias home2 name2 args2 _) | home1 == home2 && name1 == name2 ->

335−toComparison localizer a b =

276+ RT.apply ctx (nameToDoc localizer home1 name1)

336− let

277+ <$> sequenceA (zipWith (toDiff localizer RT.App) (map snd args1) (map snd args2))

337− diff = toDiff a b

338− (Aliases aAlias bAlias) = getAliases diff

339− (Pair aDoc bDoc problems) = diffToPair localizer RT.None diff

340− in

341− Comparison aAlias aDoc bAlias bDoc (Bag.toList problems)

342

278

279+ -- start trying to find specific problems

343

280

344−getAliases :: Diff -> Aliases

281+ (Type home name [t1], t2) | isMaybe home name && isSimilar (toDiff localizer ctx t1 t2) ->

345−getAliases diff =

282+ different

346− case diff of

283+ (RT.apply ctx (D.dullyellow (nameToDoc localizer home name)) [toDoc localizer RT.App t1])

347− Similar _ _ -> noAliases

284+ (toDoc localizer ctx t2)

348− DiffLambda aliases _ _ _ -> aliases

285+ (Bag.one AnythingFromMaybe)

349− DiffType aliases _ _ _ -> aliases

350− DiffRecord aliases _ _ _ _ _ -> aliases

351− DiffTuple aliases _ _ _ -> aliases

352− Clash _ _ -> noAliases

353

286

287+ (t1, Type home name [t2]) | isList home name && isSimilar (toDiff localizer ctx t1 t2) ->

288+ different

289+ (toDoc localizer ctx t1)

290+ (RT.apply ctx (D.dullyellow (nameToDoc localizer home name)) [toDoc localizer RT.App t2])

291+ (Bag.one AnythingToList)

354

292

293+ (Alias home name args t1, t2) ->

294+ case diffAliasedRecord localizer t1 t2 of

295+ Just (Diff _ doc2 status) ->

296+ Diff (D.dullyellow (aliasToDoc localizer ctx home name args)) doc2 status

355

297

356−-- DIFF TO DOCS

298+ Nothing ->

299+ different

300+ (D.dullyellow (toDoc localizer ctx tipe1))

301+ (D.dullyellow (toDoc localizer ctx tipe2))

302+ Bag.empty

357

303

304+ (t1, Alias home name args t2) ->

305+ case diffAliasedRecord localizer t1 t2 of

306+ Just (Diff doc1 _ status) ->

307+ Diff doc1 (D.dullyellow (aliasToDoc localizer ctx home name args)) status

358

308

359−data Pair a =

309+ Nothing ->

360− Pair a a (Bag.Bag Problem)

310+ different

311+ (D.dullyellow (toDoc localizer ctx tipe1))

312+ (D.dullyellow (toDoc localizer ctx tipe2))

313+ Bag.empty

361

314

315+ pair ->

316+ let

317+ doc1 = D.dullyellow (toDoc localizer ctx tipe1)

318+ doc2 = D.dullyellow (toDoc localizer ctx tipe2)

319+ in

320+ different doc1 doc2 $

321+ case pair of

322+ (RigidVar x, other) -> Bag.one $ BadRigidVar x other

323+ (FlexSuper s x, other) -> Bag.one $ BadFlexSuper s x other

324+ (RigidSuper s x, other) -> Bag.one $ BadRigidSuper s x other

325+ (other, RigidVar x) -> Bag.one $ BadRigidVar x other

326+ (other, FlexSuper s x) -> Bag.one $ BadFlexSuper s x other

327+ (other, RigidSuper s x) -> Bag.one $ BadRigidSuper s x other

362

328

363−instance Functor Pair where

329+ (Type home1 name1 [], Type home2 name2 [])

364− fmap func (Pair a b ps) =

330+ | isInt home1 name1 && isFloat home2 name2 -> Bag.one IntFloat

365− Pair (func a) (func b) ps

331+ | isFloat home1 name1 && isInt home2 name2 -> Bag.one IntFloat

332+ | isInt home1 name1 && isString home2 name2 -> Bag.one StringFromInt

333+ | isFloat home1 name1 && isString home2 name2 -> Bag.one StringFromFloat

334+ | isString home1 name1 && isInt home2 name2 -> Bag.one StringToInt

335+ | isString home1 name1 && isFloat home2 name2 -> Bag.one StringToFloat

336+ | isBool home2 name2 -> Bag.one AnythingToBool

366

337

338+ (_, _) ->

339+ Bag.empty

367

340

368−instance Applicative Pair where

369− pure a =

370− Pair a a Bag.empty

371

341

372− (<*>) (Pair aFunc bFunc ps1) (Pair aArg bArg ps2) =

373− Pair (aFunc aArg) (bFunc bArg) (Bag.append ps1 ps2)

374

342

343+-- DIFF HELPERS

375

344

376−diffToPair :: L.Localizer -> RT.Context -> Diff -> Pair D.Doc

377−diffToPair localizer ctx diff =

378− case diff of

379− Similar tipe1 tipe2 ->

380− Pair (toDoc localizer ctx tipe1) (toDoc localizer ctx tipe2) Bag.empty

381

345

382− DiffLambda _ a b cs ->

346+same :: L.Localizer -> RT.Context -> Type -> Diff D.Doc

383− RT.lambda ctx

347+same localizer ctx tipe =

384− <$> diffToPair localizer RT.Func a

348+ let

385− <*> diffToPair localizer RT.Func b

349+ doc = toDoc localizer ctx tipe

386− <*> traverse (diffToPair localizer RT.Func) cs

350+ in

351+ Diff doc doc Similar

387

352

388− DiffType _ home name args ->

389− RT.apply ctx (nameToDoc localizer home name)

390− <$> traverse (diffToPair localizer RT.App) args

391

353

392− DiffRecord _ left both right ext1 ext2 ->

354+similar :: L.Localizer -> RT.Context -> Type -> Type -> Diff D.Doc

393− diffRecord localizer left both right ext1 ext2

355+similar localizer ctx t1 t2 =

356+ Diff (toDoc localizer ctx t1) (toDoc localizer ctx t2) Similar

357+

358+

359+different :: a -> a -> Bag.Bag Problem -> Diff a

360+different a b problems =

361+ Diff a b (Different problems)

362+

363+

364+isSimilar :: Diff a -> Bool

365+isSimilar (Diff _ _ status) =

366+ case status of

367+ Similar -> True

368+ Different _ -> False

394

369

395− DiffTuple _ a b maybeC ->

370+

396− RT.tuple

371+

397− <$> diffToPair localizer RT.None a

372+-- IS TYPE?

398− <*> diffToPair localizer RT.None b

399− <*> traverse (diffToPair localizer RT.None) (Maybe.maybeToList maybeC)

400−

401− Clash tipe1 tipe2 ->

402− case (tipe1, tipe2) of

403− (Lambda a b cs, Lambda x y zs) ->

404− diffLambda localizer ctx (a:b:cs) (x:y:zs)

405−

406− (Type home name [t1], t2) | isMaybe home name && isSimilar (toDiff t1 t2) ->

407− Pair (yellowApply localizer ctx home name t1) (toDoc localizer ctx t2) (Bag.one AnythingFromMaybe)

408−

409− (t1, Type home name [t2]) | isList home name && isSimilar (toDiff t1 t2) ->

410− Pair (toDoc localizer ctx t1) (yellowApply localizer ctx home name t2) (Bag.one AnythingToList)

411−

412− pair ->

413− let

414− doc1 = D.dullyellow (toDoc localizer ctx tipe1)

415− doc2 = D.dullyellow (toDoc localizer ctx tipe2)

416− in

417− Pair doc1 doc2 $

418− case pair of

419− (RigidVar x, other) -> Bag.one $ BadRigidVar x other

420− (FlexSuper s x, other) -> Bag.one $ BadFlexSuper s x other

421− (RigidSuper s x, other) -> Bag.one $ BadRigidSuper s x other

422− (other, RigidVar x) -> Bag.one $ BadRigidVar x other

423− (other, FlexSuper s x) -> Bag.one $ BadFlexSuper s x other

424− (other, RigidSuper s x) -> Bag.one $ BadRigidSuper s x other

425−

426− (Type home1 name1 [], Type home2 name2 [])

427− | isInt home1 name1 && isFloat home2 name2 -> Bag.one IntFloat

428− | isFloat home1 name1 && isInt home2 name2 -> Bag.one IntFloat

429− | isInt home1 name1 && isString home2 name2 -> Bag.one StringFromInt

430− | isFloat home1 name1 && isString home2 name2 -> Bag.one StringFromFloat

431− | isString home1 name1 && isInt home2 name2 -> Bag.one StringToInt

432− | isString home1 name1 && isFloat home2 name2 -> Bag.one StringToFloat

433− | isBool home2 name2 -> Bag.one AnythingToBool

434−

435− (_, _) -> Bag.empty

436

373

437

374

438isBool :: ModuleName.Canonical -> N.Name -> Bool

375isBool :: ModuleName.Canonical -> N.Name -> Bool

@@ -470,11 +407,18 @@ isList home name =

470 home == ModuleName.list && name == N.list

407 home == ModuleName.list && name == N.list

471

408

472

409

473−yellowApply :: L.Localizer -> RT.Context -> ModuleName.Canonical -> N.Name -> Type -> D.Doc

410+

474−yellowApply localizer ctx home name tipe =

411+-- DIFF ALIASED RECORD

475− RT.apply ctx

412+

476− (D.dullyellow (nameToDoc localizer home name))

413+

477− [toDoc localizer RT.App tipe]

414+diffAliasedRecord :: L.Localizer -> Type -> Type -> Maybe (Diff D.Doc)

415+diffAliasedRecord localizer t1 t2 =

416+ case (iteratedDealias t1, iteratedDealias t2) of

417+ (Record fields1 ext1, Record fields2 ext2) ->

418+ Just (diffRecord localizer fields1 ext1 fields2 ext2)

419+

420+ _ ->

421+ Nothing

478

422

479

423

480

424

@@ -483,83 +427,72 @@ yellowApply localizer ctx home name tipe =

483

427

484--

428--

485-- INVARIANTS:

429-- INVARIANTS:

486−-- length types1 >= 2

430+-- length cs1 /= length cs2

487−-- length types2 >= 2

488−-- length types1 /= length types2

489--

431--

490−diffLambda :: L.Localizer -> RT.Context -> [Type] -> [Type] -> Pair D.Doc

432+diffLambda :: L.Localizer -> RT.Context -> Type -> Type -> [Type] -> Type -> Type -> [Type] -> Diff D.Doc

491−diffLambda localizer ctx types1 types2 =

433+diffLambda localizer ctx a1 b1 cs1 a2 b2 cs2 =

492 let

434 let

493− (result1:revArgs1) = reverse types1

435+ (result1:revArgs1) = reverse (a1:b1:cs1)

494− (result2:revArgs2) = reverse types2

436+ (result2:revArgs2) = reverse (a2:b2:cs2)

495

437

496 numArgs1 = length revArgs1

438 numArgs1 = length revArgs1

497 numArgs2 = length revArgs2

439 numArgs2 = length revArgs2

498−

499− diff = toDiff result1 result2

500−

501− (Pair r1 r2 _) = diffToPair localizer RT.Func diff

502 in

440 in

503− if isSimilar diff then

441+ case toDiff localizer RT.Func result1 result2 of

442+ Diff resultDoc1 resultDoc2 Similar ->

443+ if numArgs1 < numArgs2 then

444+ diffArgMismatch localizer ctx revArgs1 resultDoc1 revArgs2 resultDoc2

504

445

505− if numArgs1 < numArgs2 then

506− diffArgMismatch localizer ctx revArgs1 r1 revArgs2 r2

507− else

446+ else

508− diffArgMismatch localizer ctx revArgs2 r2 revArgs1 r1

447+ diffArgMismatch localizer ctx revArgs2 resultDoc2 revArgs1 resultDoc1

509

448

510− else

449+ Diff resultDoc1 resultDoc2 (Different problems) ->

511− let

450+ let

512− (a1:b1:cs1) = reverse (r1 : map (toDoc localizer RT.Func) revArgs1)

451+ (a:b:cs) = reverse (resultDoc1 : map (toDoc localizer RT.Func) revArgs1)

513− (a2:b2:cs2) = reverse (r2 : map (toDoc localizer RT.Func) revArgs2)

452+ (x:y:zs) = reverse (resultDoc2 : map (toDoc localizer RT.Func) revArgs2)

514− in

453+ in

515− Pair

454+ different

516− (D.dullyellow (RT.lambda ctx a1 b1 cs1))

455+ (D.dullyellow (RT.lambda ctx a b cs))

517− (D.dullyellow (RT.lambda ctx a2 b2 cs2))

456+ (D.dullyellow (RT.lambda ctx x y zs))

518− (Bag.one ReturnMismatch)

457+ (Bag.append problems (Bag.one ReturnMismatch))

519

458

520

459

521--

460--

522-- INVARIANTS:

461-- INVARIANTS:

523-- length shortRevArgs >= 2

462-- length shortRevArgs >= 2

524-- length longRevArgs >= 2

463-- length longRevArgs >= 2

464+-- length shortRevArgs < length longRevArgs

525--

465--

526−diffArgMismatch :: L.Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Pair D.Doc

466+diffArgMismatch :: L.Localizer -> RT.Context -> [Type] -> D.Doc -> [Type] -> D.Doc -> Diff D.Doc

527diffArgMismatch localizer ctx shortRevArgs shortResult longRevArgs longResult =

467diffArgMismatch localizer ctx shortRevArgs shortResult longRevArgs longResult =

528− case toGreedyMatch localizer shortRevArgs longRevArgs of

468+ let

529− Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->

469+ (a:b:cs, x:y:zs) =

530− let

531− (a:b:cs) = reverse (shortResult:shortRevArgDocs)

532− (x:y:zs) = reverse (longResult:longRevArgDocs)

533− in

534− Pair

535− (RT.lambda ctx a b cs)

536− (RT.lambda ctx x y zs)

537− (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))

538−

539− Nothing ->

540− case toGreedyMatch localizer (reverse shortRevArgs) (reverse longRevArgs) of

470+ case toGreedyMatch localizer shortRevArgs longRevArgs of

541− Just (GreedyMatch shortArgDocs longArgDocs) ->

471+ Just (GreedyMatch shortRevArgDocs longRevArgDocs) ->

542− let

472+ ( reverse (shortResult:shortRevArgDocs)

543− (a:b:cs) = shortArgDocs ++ [shortResult]

473+ , reverse (longResult:longRevArgDocs)

544− (x:y:zs) = longArgDocs ++ [longResult]

474+ )

545− in

546− Pair

547− (RT.lambda ctx a b cs)

548− (RT.lambda ctx x y zs)

549− (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))

550

475

551 Nothing ->

476 Nothing ->

477+ case toGreedyMatch localizer (reverse shortRevArgs) (reverse longRevArgs) of

478+ Just (GreedyMatch shortArgDocs longArgDocs) ->

479+ ( shortArgDocs ++ [shortResult]

480+ , longArgDocs ++ [longResult]

481+ )

482+

483+ Nothing ->

552− let

484+ let

553− toYellowDoc tipe =

485+ toYellowDoc tipe =

554− D.dullyellow (toDoc localizer RT.Func tipe)

486+ D.dullyellow (toDoc localizer RT.Func tipe)

555−

487+ in

556− (a:b:cs) = reverse (shortResult : map toYellowDoc shortRevArgs)

488+ ( reverse (shortResult : map toYellowDoc shortRevArgs)

557− (x:y:zs) = reverse (longResult : map toYellowDoc longRevArgs )

489+ , reverse (longResult : map toYellowDoc longRevArgs )

490+ )

558− in

491+ in

559− Pair

492+ different

560− (RT.lambda ctx a b cs)

493+ (RT.lambda ctx a b cs)

561− (RT.lambda ctx x y zs)

494+ (RT.lambda ctx x y zs)

562− (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))

495+ (Bag.one (MissingArgs (length longRevArgs - length shortRevArgs)))

563

496

564

497

565

498

@@ -587,14 +520,12 @@ toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDoc

587 in

520 in

588 case (shorterArgs, longerArgs) of

521 case (shorterArgs, longerArgs) of

589 (x:xs, y:ys) ->

522 (x:xs, y:ys) ->

590− case toDiff x y of

523+ case toDiff localizer RT.Func x y of

591− Similar a b ->

524+ Diff a b Similar ->

592 toGreedyMatchHelp localizer xs ys $

525 toGreedyMatchHelp localizer xs ys $

593− GreedyMatch

526+ GreedyMatch (a:shorterDocs) (b:longerDocs)

594− (toDoc localizer RT.Func a : shorterDocs)

595− (toDoc localizer RT.Func b : longerDocs)

596

527

597− _ ->

528+ Diff _ _ (Different _) ->

598 toGreedyMatchHelp localizer shorterArgs ys $

529 toGreedyMatchHelp localizer shorterArgs ys $

599 GreedyMatch shorterDocs (toYellowDoc y : longerDocs)

530 GreedyMatch shorterDocs (toYellowDoc y : longerDocs)

600

531

@@ -612,165 +543,104 @@ toGreedyMatchHelp localizer shorterArgs longerArgs match@(GreedyMatch shorterDoc

612-- RECORD DIFFS

543-- RECORD DIFFS

613

544

614

545

615−diffRecord

546+diffRecord :: L.Localizer -> Map.Map N.Name Type -> Extension -> Map.Map N.Name Type -> Extension -> Diff D.Doc

616− :: L.Localizer

617− -> [N.Name]

618− -> Map.Map N.Name Diff

619− -> [N.Name]

620− -> Extension

621− -> Extension

622− -> Pair D.Doc

623−diffRecord localizer only1 both only2 ext1 ext2 =

547+diffRecord localizer fields1 ext1 fields2 ext2 =

624− if null only1 && null only2 then

548+ let

625− case findBadOverlaps localizer both of

549+ toUnknownDocs field tipe =

626− [] ->

550+ ( D.dullyellow (D.fromName field), toDoc localizer RT.None tipe )

627− case diffExt ext1 ext2 of

628− ExtSimilar ->

629− Pair

630− (toBoringRecord (Map.size both) ext1)

631− (toBoringRecord (Map.size both) ext2)

632− Bag.empty

633−

634− ExtDifferent maybeExt1 maybeExt2 problems ->

635− Pair

636− (RT.record [] (fmap (D.dullyellow . D.fromName) maybeExt1))

637− (RT.record [] (fmap (D.dullyellow . D.fromName) maybeExt2))

638− problems

639−

640− overlaps@(bad:bads) ->

641− if length overlaps < Map.size both then

642− Pair

643− (RT.recordSnippet (toOverlapDoc _doc1 bad) (map (toOverlapDoc _doc1) bads))

644− (RT.recordSnippet (toOverlapDoc _doc2 bad) (map (toOverlapDoc _doc2) bads))

645− (foldr Bag.append Bag.empty (map _problemBag overlaps))

646− else

647− Pair

648− (toOverlapRecord _doc1 bad bads ext1)

649− (toOverlapRecord _doc2 bad bads ext2)

650− (foldr Bag.append Bag.empty (map _problemBag overlaps))

651−

652− else

653− Pair

654− (toMissingDoc (Map.size both) only1 ext1)

655− (toMissingDoc (Map.size both) only2 ext2)

656− (Bag.one (FieldMismatch only1 only2))

657−

658−

659−toOverlapDoc :: (BadOverlap -> D.Doc) -> BadOverlap -> (D.Doc, D.Doc)

660−toOverlapDoc getDoc overlap@(BadOverlap field _ _ _) =

661− (D.fromName field, getDoc overlap)

662−

663−

664−toOverlapRecord :: (BadOverlap -> D.Doc) -> BadOverlap -> [BadOverlap] -> Extension -> D.Doc

665−toOverlapRecord getDoc bad bads ext =

666− let go = toOverlapDoc getDoc in

667− case ext of

668− Closed -> RT.record (map go (bad:bads)) Nothing

669− FlexOpen _ -> RT.recordSnippet (go bad) (map go bads)

670− RigidOpen _ -> RT.recordSnippet (go bad) (map go bads)

671−

672−

673−toMissingDoc :: Int -> [N.Name] -> Extension -> D.Doc

674−toMissingDoc numSharedFields uniqueFields ext =

675− case map emphasizeFieldName uniqueFields of

676− [] ->

677− toBoringRecord numSharedFields ext

678−

679− doc:docs ->

680− if length uniqueFields < numSharedFields then

681− RT.recordSnippet doc docs

682− else

683− case ext of

684− Closed -> RT.record (doc:docs) Nothing

685− FlexOpen _ -> RT.recordSnippet doc docs

686− RigidOpen _ -> RT.recordSnippet doc docs

687−

688

551

689−emphasizeFieldName :: N.Name -> (D.Doc, D.Doc)

552+ toOverlapDocs field t1 t2 =

690−emphasizeFieldName field =

691− ( D.dullyellow (D.fromName field), "..." )

553+ (,) (D.fromName field) <$> toDiff localizer RT.None t1 t2

692

554

555+ left = Map.mapWithKey toUnknownDocs (Map.difference fields1 fields2)

556+ both = Map.intersectionWithKey toOverlapDocs fields1 fields2

557+ right = Map.mapWithKey toUnknownDocs (Map.difference fields2 fields1)

693

558

694−toBoringRecord :: Int -> Extension -> D.Doc

559+ fieldsDiff =

695−toBoringRecord numFields ext =

560+ Map.elems <$>

561+ if Map.null left && Map.null right then

562+ sequenceA both

563+ else

564+ Map.union

565+ <$> sequenceA both

566+ <*> Diff left right (Different Bag.empty)

567+

568+ (Diff doc1 doc2 status) =

569+ RT.record

570+ <$> fieldsDiff

571+ <*> extToDiff ext1 ext2

572+ in

573+ Diff doc1 doc2 $ merge status $

574+ case (hasFixedFields ext1, hasFixedFields ext2) of

575+ (True, True) ->

576+ case Map.lookupMin left of

577+ Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields2)

578+ Nothing ->

579+ case Map.lookupMin right of

580+ Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields1)

581+ Nothing -> Similar

582+

583+ (False, True) ->

584+ case Map.lookupMin left of

585+ Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields2)

586+ Nothing -> Similar

587+

588+ (True, False) ->

589+ case Map.lookupMin right of

590+ Just (f,_) -> Different $ Bag.one $ FieldTypo f (Map.keys fields1)

591+ Nothing -> Similar

592+

593+ (False, False) ->

594+ Similar

595+

596+

597+hasFixedFields :: Extension -> Bool

598+hasFixedFields ext =

696 case ext of

599 case ext of

697− Closed -> if numFields == 0 then "{}" else "{ ... }"

600+ Closed -> True

698− FlexOpen _ -> "{ ... }"

601+ FlexOpen _ -> False

699− RigidOpen _ -> "{ ... }"

602+ RigidOpen _ -> True

700

603

701

604

702

605

703-- DIFF RECORD EXTENSION

606-- DIFF RECORD EXTENSION

704

607

705

608

706−isExtSimilar :: Extension -> Extension -> Bool

609+extToDiff :: Extension -> Extension -> Diff (Maybe D.Doc)

707−isExtSimilar ext1 ext2 =

610+extToDiff ext1 ext2 =

708− case diffExt ext1 ext2 of

611+ let

709− ExtSimilar ->

612+ status = extToStatus ext1 ext2

710− True

613+ extDoc1 = extToDoc ext1

711−

614+ extDoc2 = extToDoc ext2

712− ExtDifferent _ _ _ ->

615+ in

713− False

616+ case status of

714−

617+ Similar ->

618+ Diff extDoc1 extDoc2 status

715

619

716−data ExtDiff

620+ Different _ ->

717− = ExtSimilar

621+ Diff (D.dullyellow <$> extDoc1) (D.dullyellow <$> extDoc2) status

718− | ExtDifferent (Maybe N.Name) (Maybe N.Name) (Bag.Bag Problem)

719

622

720

623

721−diffExt :: Extension -> Extension -> ExtDiff

624+extToStatus :: Extension -> Extension -> Status

722−diffExt ext1 ext2 =

625+extToStatus ext1 ext2 =

723− let

724− different x y = ExtDifferent x y Bag.empty

725− in

726 case ext1 of

626 case ext1 of

727 Closed ->

627 Closed ->

728 case ext2 of

628 case ext2 of

729− Closed -> ExtSimilar

629+ Closed -> Similar

730− FlexOpen y -> different Nothing (Just y)

630+ FlexOpen _ -> Different Bag.empty

731− RigidOpen y -> different Nothing (Just y)

631+ RigidOpen _ -> Different Bag.empty

732

632

733− FlexOpen x ->

633+ FlexOpen _ ->

734 case ext2 of

634 case ext2 of

735− Closed -> different (Just x) Nothing

635+ Closed -> Different Bag.empty

736− FlexOpen _ -> ExtSimilar

636+ FlexOpen _ -> Similar

737− RigidOpen _ -> ExtSimilar

637+ RigidOpen _ -> Similar

738

638

739 RigidOpen x ->

639 RigidOpen x ->

740 case ext2 of

640 case ext2 of

741− Closed -> different (Just x) Nothing

641+ Closed -> Different Bag.empty

742− FlexOpen _ -> ExtSimilar

642+ FlexOpen _ -> Similar

743 RigidOpen y ->

643 RigidOpen y ->

744− if x == y then

644+ if x == y

745− ExtSimilar

645+ then Similar

746− else

747− ExtDifferent (Just x) (Just y) (Bag.one (BadRigidVar x (RigidVar y)))

646+ else Different $ Bag.one $ BadRigidVar x (RigidVar y)

748−

749−

750−

751−-- BAD OVERLAP

752−

753−

754−data BadOverlap =

755− BadOverlap

756− { _field :: N.Name

757− , _doc1 :: D.Doc

758− , _doc2 :: D.Doc

759− , _problemBag :: Bag.Bag Problem

760− }

761−

762−

763−findBadOverlaps :: L.Localizer -> Map.Map N.Name Diff -> [BadOverlap]

764−findBadOverlaps localizer overlaps =

765− Map.foldrWithKey (addBadOverlap localizer) [] overlaps

766−

767−

768−addBadOverlap :: L.Localizer -> N.Name -> Diff -> [BadOverlap] -> [BadOverlap]

769−addBadOverlap localizer field diff badOverlaps =

770− if isSimilar diff then

771− badOverlaps

772− else

773− let

774− (Pair aDoc bDoc problems) = diffToPair localizer RT.None diff

775− in

776− BadOverlap field aDoc bDoc problems : badOverlaps