785bc76 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Fix TODO for self-recursive aliases

785bc76Evan Czaplicki9 years ago

src/Reporting/Error/Canonicalize.hs+74−5

compare with master

unifiedsplit

@@ -25,6 +25,7 @@ import qualified Elm.Name as N

25import qualified Reporting.Annotation as A

26import qualified Reporting.Region as R

27import qualified Reporting.Render.Code as Code

28+import qualified Reporting.Render.Type as RT

28import qualified Reporting.Report as Report

29import qualified Reporting.Report as Report

29import qualified Reporting.Helpers as H

30import qualified Reporting.Helpers as H

30import Reporting.Helpers ( Doc, (<+>), (<>) )

31import Reporting.Helpers ( Doc, (<+>), (<>) )

@@ -310,7 +311,8 @@ toReport source err =

310 ExportNotFound region kind rawName possibleNames ->

311 ExportNotFound region kind rawName possibleNames ->

311 let

312 let

312 suggestions =

313 suggestions =

314+ map N.toString $ take 4 $

313− take 4 (H.nearbyNames (N.toString rawName) (map N.toString possibleNames))

315+ H.nearbyNames N.toString rawName possibleNames

314 in

316 in

315 Report.Report "UNKNOWN EXPORT" region suggestions $

317 Report.Report "UNKNOWN EXPORT" region suggestions $

316 let (a, thing, name) = toKindInfo kind rawName in

318 let (a, thing, name) = toKindInfo kind rawName in

@@ -395,7 +397,8 @@ toReport source err =

395 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->

397 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->

396 let

398 let

397 suggestions =

399 suggestions =

400+ map N.toString $ take 4 $

398− take 4 $ H.nearbyNames (N.toString home) (map N.toString possibleNames)

401+ H.nearbyNames N.toString home possibleNames

399 in

402 in

400 Report.Report "BAD IMPORT" region suggestions $

403 Report.Report "BAD IMPORT" region suggestions $

401 Report.toCodeSnippet source region Nothing

404 Report.toCodeSnippet source region Nothing

@@ -467,7 +470,8 @@ toReport source err =

467 else

470 else

468 let

471 let

469 suggestions =

472 suggestions =

473+ map N.toString $ take 2 $

470− take 2 $ H.nearbyNames (N.toString op) (map N.toString (Set.toList locals))

474+ H.nearbyNames N.toString op (Set.toList locals)

471

475

472 format altOp =

476 format altOp =

473 H.dullyellow $ "(" <> altOp <> ")"

477 H.dullyellow $ "(" <> altOp <> ")"

@@ -889,7 +893,7 @@ notFound source region maybePrefix name thing (PossibleNames locals quals) =

889 Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals

893 Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals

890

894

891 nearbyNames =

895 nearbyNames =

892− take 4 (H.nearbyNames givenName possibleNames)

896+ take 4 (H.nearbyNames id givenName possibleNames)

893

897

894 toDetails noSuggestionDetails yesSuggestionDetails =

898 toDetails noSuggestionDetails yesSuggestionDetails =

895 case nearbyNames of

899 case nearbyNames of

@@ -1066,7 +1070,7 @@ aliasRecursionReport source region name args tipe others =

1066 "When I expand a recursive type alias, it just keeps getting bigger and bigger.\

1070 "When I expand a recursive type alias, it just keeps getting bigger and bigger.\

1067 \ So dealiasing results in an infinitely large type! Try this instead:"

1071 \ So dealiasing results in an infinitely large type! Try this instead:"

1068 , H.indent 4 $

1072 , H.indent 4 $

1069− error "TODO alias to doc" name args tipe

1073+ aliasToUnionDoc name args tipe

1070 , H.link "Hint"

1074 , H.link "Hint"

1071 "This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading"

1075 "This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading"

1072 "recursive-alias"

1076 "recursive-alias"

@@ -1089,3 +1093,68 @@ aliasRecursionReport source region name args tipe others =

1089 "to learn why this `type` vs `type alias` distinction matters. It is subtle but important!"

1093 "to learn why this `type` vs `type alias` distinction matters. It is subtle but important!"

1090 ]

1094 ]

1091 )

1095 )

1096+

1097+

1098+aliasToUnionDoc :: N.Name -> [N.Name] -> Src.Type -> Doc

1099+aliasToUnionDoc name args tipe =

1100+ H.vcat

1101+ [ H.dullyellow $

1102+ "type" <+> H.nameToDoc name <+> (foldr (<+>) "=" (map H.nameToDoc args))

1103+ , H.green $

1104+ H.indent 4 (H.nameToDoc name)

1105+ , H.dullyellow $

1106+ H.indent 8 (typeToDoc RT.App tipe)

1107+ ]

1108+

1109+

1110+typeToDoc :: RT.Context -> Src.Type -> Doc

1111+typeToDoc context (A.At _ tipe) =

1112+ case tipe of

1113+ Src.TLambda a b ->

1114+ RT.lambda context

1115+ (typeToDoc RT.Func a)

1116+ (map (typeToDoc RT.Func) (collectArgs b))

1117+

1118+ Src.TVar name ->

1119+ H.nameToDoc name

1120+

1121+ Src.TType _ name args ->

1122+ RT.apply context

1123+ (H.nameToDoc name)

1124+ (map (typeToDoc RT.App) args)

1125+

1126+ Src.TTypeQual _ home name args ->

1127+ RT.apply context

1128+ (H.nameToDoc home <> "." <> H.nameToDoc name)

1129+ (map (typeToDoc RT.App) args)

1130+

1131+ Src.TRecord fields ext ->

1132+ RT.record

1133+ (map fieldToDocs fields)

1134+ (fmap (H.nameToDoc . A.toValue) ext)

1135+

1136+ Src.TUnit ->

1137+ "()"

1138+

1139+ Src.TTuple a b cs ->

1140+ RT.tuple

1141+ (typeToDoc RT.None a)

1142+ (typeToDoc RT.None b)

1143+ (map (typeToDoc RT.None) cs)

1144+

1145+

1146+collectArgs :: Src.Type -> [Src.Type]

1147+collectArgs tipe =

1148+ case tipe of

1149+ A.At _ (Src.TLambda a b) ->

1150+ a : collectArgs b

1151+

1152+ _ ->

1153+ [tipe]

1154+

1155+

1156+fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc)

1157+fieldToDocs (A.At _ fieldName, fieldType) =

1158+ ( H.nameToDoc fieldName

1159+ , typeToDoc RT.None fieldType

1160+ )

src/Reporting/Helpers.hs+16−7

@@ -11,7 +11,7 @@ module Reporting.Helpers

11 , findPotentialTypos, findTypoPairs, vetTypos

12 , nearbyNames, distance

13 -- re-exports

14− , Doc, (<+>), (<>), black, cat, dullyellow, fillSep, green, hang, hardline

14+ , Doc, (<+>), (<>), black, blue, cat, dullyellow, fillSep, green, hang, hardline

15 , hcat, hsep, indent, magenta, parens, sep, text, underline, vcat

16 )

17 where

@@ -21,8 +21,9 @@ import Data.Function (on)

21import qualified Data.Char as Char

22import qualified Data.List as List

23import qualified Data.Map as Map

24−import Data.Monoid ((<>))

24+import qualified Data.Maybe as Maybe

25import qualified Data.Set as Set

26+import Data.Monoid ((<>))

26import qualified Data.Text as Text

27import qualified Data.Text as Text

27import Data.Text (Text)

28import Data.Text (Text)

28import qualified Elm.Name as N

29import qualified Elm.Name as N

@@ -218,16 +219,24 @@ vetTypos potentialTypos =

218-- NEARBY NAMES

219-- NEARBY NAMES

219

220

221

221−nearbyNames :: String -> [String] -> [String]

222+nearbyNames :: (a -> String) -> a -> [a] -> [a]

222−nearbyNames name names =

223+nearbyNames toString value possibleValues =

223 let

224 let

225+ name =

226+ toString value

227+

224 editDistance =

228 editDistance =

225 if length name < 3 then 1 else 2

229 if length name < 3 then 1 else 2

230+

231+ getDistance pValue =

232+ let

233+ dist = abs (distance name (toString pValue))

234+ in

235+ if dist <= editDistance then Just (dist, pValue) else Nothing

226 in

236 in

227 map snd $

237 map snd $

228− filter ( (<= editDistance) . abs . fst ) $

229− List.sortBy (compare `on` fst) $

238+ List.sortBy (compare `on` fst) $

230− map (\x -> (distance name x, x)) names

239+ Maybe.mapMaybe getDistance possibleValues

231

240

232

241

233distance :: String -> String -> Int

242distance :: String -> String -> Int

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

@@ -54,18 +54,15 @@ apply context name args =

54 None -> applyDoc

57−tuple :: Doc -> Doc -> Maybe Doc -> Doc

57+tuple :: Doc -> Doc -> [Doc] -> Doc

58−tuple a b maybeC =

58+tuple a b cs =

59 let

60 entries =

61− case maybeC of

61+ zipWith (<+>) ("(" : repeat ",") (a:b:cs)

62− Nothing -> [ "(" <+> a, "," <+> b ]

63− Just c -> [ "(" <+> a, "," <+> b, "," <+> c ]

64 in

62 in

65 H.sep [ H.cat entries, ")" ]

63 H.sep [ H.cat entries, ")" ]

68−

69record :: [(Doc, Doc)] -> Maybe Doc -> Doc

66record :: [(Doc, Doc)] -> Maybe Doc -> Doc

70record entries maybeExt =

67record entries maybeExt =

71 case (map entryToDoc entries, maybeExt) of

68 case (map entryToDoc entries, maybeExt) of