8c8e70a · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Do a better job with missing fields

8c8e70aEvan Czaplicki10 years ago

src/Reporting/Error/Helpers.hs+9−4

compare with master

unifiedsplit

@@ -3,7 +3,7 @@ module Reporting.Error.Helpers

3 ( (|>)

4 , functionName, hintLink, stack, reflowParagraph

5 , commaSep, capitalize, ordinalize, drawCycle

6− , findPotentialTypos, vetTypos

6+ , findPotentialTypos, findTypoPairs, vetTypos

7 , nearbyNames, distance, maybeYouWant

8 )

9 where

@@ -132,11 +132,16 @@ drawCycle strings =

132-- FIND TYPOS

133

134

135−findPotentialTypos :: [String] -> [String] -> [(String, String)]

135+findPotentialTypos :: [String] -> String -> [String]

136+findPotentialTypos knownNames badName =

137+ filter ((==1) . distance badName) knownNames

138+

139+

140+findTypoPairs :: [String] -> [String] -> [(String, String)]

136−findPotentialTypos leftOnly rightOnly =

141+findTypoPairs leftOnly rightOnly =

137 let

142 let

138 veryNear leftName =

143 veryNear leftName =

139− map ((,) leftName) (filter ((==1) . distance leftName) rightOnly)

144+ map ((,) leftName) (findPotentialTypos rightOnly leftName)

140 in

145 in

141 concatMap veryNear leftOnly

146 concatMap veryNear leftOnly

142

147

src/Reporting/Error/Type.hs+98−24

@@ -39,7 +39,7 @@ data Mismatch = MismatchInfo

40data Reason

41 = BadFields [(String, Maybe Reason)]

42− | MessyFields [String] [String]

42+ | MessyFields [String] [String] [String]

43 | IntFloat

44 | TooLongComparableTuple Int

45 | MissingArgs Int

@@ -591,8 +591,8 @@ flipReason reason =

591 BadFields fields ->

592 BadFields (map (second (fmap flipReason)) fields)

593

594− MessyFields leftOnly rightOnly ->

594+ MessyFields both left right ->

595− MessyFields rightOnly leftOnly

595+ MessyFields both right left

596

597 IntFloat ->

598 IntFloat

@@ -667,10 +667,8 @@ reasonToStringHelp reason =

667 ++ Help.commaSep (map fst fields) ++ " fields. "

668 ++ badFieldElaboration

669

670− MessyFields leftOnly rightOnly ->

670+ MessyFields both leftOnly rightOnly ->

671− do let typos = Help.findPotentialTypos leftOnly rightOnly

671+ messyFieldsHelp both leftOnly rightOnly

672− _ <- Help.vetTypos typos

673− misspellingMessage typos

674

672

675 IntFloat ->

673 IntFloat ->

676 go $

674 go $

@@ -741,28 +739,104 @@ toHint str =

741 fillSep (hintDoc : map text (words str))

739 fillSep (hintDoc : map text (words str))

742

740

743

741

744−misspellingMessage :: [(String,String)] -> Maybe (String, [Doc])

742+messyFieldsHelp :: [String] -> [String] -> [String] -> Maybe (String, [Doc])

745−misspellingMessage typos =

743+messyFieldsHelp both leftOnly rightOnly =

744+ case (leftOnly, rightOnly) of

745+ ([], [missingField]) ->

746+ oneMissingField both missingField

747+

748+ ([missingField], []) ->

749+ oneMissingField both missingField

750+

751+ ([], missingFields) ->

752+ manyMissingFields both missingFields

753+

754+ (missingFields, []) ->

755+ manyMissingFields both missingFields

756+

757+ _ ->

758+ let

759+ typoPairs =

760+ case Help.findTypoPairs leftOnly rightOnly of

761+ [] ->

762+ Help.findTypoPairs (both ++ leftOnly) (both ++ rightOnly)

763+

764+ pairs ->

765+ pairs

766+ in

746− if null typos then

767+ if null typoPairs then

747− Nothing

768+ Just

769+ ( "The record fields do not match up. One has "

770+ ++ Help.commaSep leftOnly ++ ". The other has "

771+ ++ Help.commaSep rightOnly ++ "."

772+ , []

773+ )

774+

775+ else

776+ Just

777+ ( "The record fields do not match up. Maybe you made one of these typos?"

778+ , typoDocs "<->" typoPairs

779+ )

780+

781+

782+oneMissingField :: [String] -> String -> Maybe (String, [Doc])

783+oneMissingField knownFields missingField =

784+ case Help.findPotentialTypos knownFields missingField of

785+ [] ->

786+ Just

787+ ( "Looks like a record is missing the `" ++ missingField ++ "` field."

788+ , []

789+ )

790+

791+ [typo] ->

792+ Just

793+ ( "Looks like a record is missing the `" ++ missingField

794+ ++ "` field. Maybe it is a typo?"

795+ , typoDocs "->" [(missingField, typo)]

796+ )

797+

798+ typos ->

799+ Just

800+ ( "Looks like a record is missing the `" ++ missingField

801+ ++ "` field. It is close to names like "

802+ ++ Help.commaSep typos ++ " so maybe it is a typo?"

803+ , []

804+ )

805+

748

806

749− else

807+manyMissingFields :: [String] -> [String] -> Maybe (String, [Doc])

750− let

808+manyMissingFields knownFields missingFields =

751− maxLen =

809+ case Help.findTypoPairs missingFields knownFields of

752− maximum (map (length . fst) typos)

810+ [] ->

753− in

754 Just

811 Just

755− ( "I compared the record fields and found some potential typos."

812+ ( "Looks like a record is missing these fields: "

756− , text "" : map (pad maxLen) typos

813+ ++ Help.commaSep missingFields

814+ , []

757 )

815 )

758

816

817+ typoPairs ->

818+ Just

819+ ( "Looks like a record is missing these fields: " ++ Help.commaSep missingFields

820+ ++ ". Potential typos include:"

821+ , typoDocs "->" typoPairs

822+ )

823+

824+

825+typoDocs :: String -> [(String, String)] -> [Doc]

826+typoDocs arrow typoPairs =

827+ let

828+ maxLen =

829+ maximum (map (length . fst) typoPairs)

830+ in

831+ text "" : map (padTypo arrow maxLen) typoPairs

832+

759

833

760−pad :: Int -> (String, String) -> Doc

834+padTypo :: String -> Int -> (String, String) -> Doc

761−pad maxLen (leftField, rightField) =

835+padTypo arrow maxLen (missingField, knownField) =

762− text (replicate (maxLen - length leftField) ' ')

836+ text (replicate (maxLen - length missingField) ' ')

763− <> dullyellow (text leftField)

837+ <> dullyellow (text missingField)

764− <+> text "<->"

838+ <+> text arrow

765− <+> dullyellow (text rightField)

839+ <+> dullyellow (text knownField)

766

840

767

841

768

842

src/Reporting/Render/Type.hs+3−3

@@ -327,8 +327,8 @@ unzipDiffs diffPairs =

327analyzeFields :: [String] -> [String] -> ( [(Doc, Doc)], [(Doc, Doc)] )

328analyzeFields leftOnly rightOnly =

329 let

330− potentialTypos =

330+ typoPairs =

331− Help.findPotentialTypos leftOnly rightOnly

331+ Help.findTypoPairs leftOnly rightOnly

332

333 mkField func name =

334 ( func (text name), text "..." )

@@ -336,7 +336,7 @@ analyzeFields leftOnly rightOnly =

336 mkFieldWith counts name =

337 mkField (if Set.member name counts then dullyellow else id) name

338 in

339− case Help.vetTypos potentialTypos of

339+ case Help.vetTypos typoPairs of

340 Just (leftTypos, rightTypos) ->

341 ( map (mkFieldWith leftTypos) leftOnly

342 , map (mkFieldWith rightTypos) rightOnly

src/Type/Unify.hs+7−4

@@ -623,11 +623,12 @@ unifyRecord context firstStructure secondStructure =

623 do let (RecordStructure expFields expVar expStruct) = firstStructure

624 let (RecordStructure actFields actVar actStruct) = secondStructure

625

626+ let sharedFields = Map.intersectionWith (,) expFields actFields

627+

626 -- call after unifying extension, make sure record shape matches before

628 -- call after unifying extension, make sure record shape matches before

627 -- looking into whether the particular field types match.

629 -- looking into whether the particular field types match.

628 let unifySharedFields otherFields ext =

630 let unifySharedFields otherFields ext =

629− do let sharedFields = Map.intersectionWith (,) expFields actFields

630− unifySharedFieldsHelp context sharedFields

631+ do unifySharedFieldsHelp context sharedFields

631 let allFields = Map.union (Map.map fst sharedFields) otherFields

632 let allFields = Map.union (Map.map fst sharedFields) otherFields

632 merge context (Structure (Record1 allFields ext))

633 merge context (Structure (Record1 allFields ext))

633

634

@@ -640,10 +641,12 @@ unifyRecord context firstStructure secondStructure =

640 unifySharedFields Map.empty expVar

641 unifySharedFields Map.empty expVar

641

642

642 (Empty, _, _, False) ->

643 (Empty, _, _, False) ->

644+ mismatch context $ Just $

643− mismatch context (Just (Error.MessyFields (Map.keys uniqueExpFields) (Map.keys uniqueActFields)))

645+ Error.MessyFields (Map.keys sharedFields) (Map.keys uniqueExpFields) (Map.keys uniqueActFields)

644

646

645 (_, False, Empty, _) ->

647 (_, False, Empty, _) ->

648+ mismatch context $ Just $

646− mismatch context (Just (Error.MessyFields (Map.keys uniqueExpFields) (Map.keys uniqueActFields)))

649+ Error.MessyFields (Map.keys sharedFields) (Map.keys uniqueExpFields) (Map.keys uniqueActFields)

647

650

648 (_, False, _, True) ->

651 (_, False, _, True) ->

649 do subRecord <- fresh context (Structure (Record1 uniqueExpFields expVar))

652 do subRecord <- fresh context (Structure (Record1 uniqueExpFields expVar))