git.iko.soy/elk
on master help sign in
Fix TODO for self-recursive aliases
commit785bc76ddcd28f88b1e6e93161551824171d1c91 authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 9 Feb 2018, 20:43 (9 years ago) parentb5df201
3 files changed+93−18
compare with master
unifiedsplit
src/Reporting/Error/Canonicalize.hs+74−5 src/Reporting/Helpers.hs+16−7 src/Reporting/Render/Type.hs+3−6
src/Reporting/Error/Canonicalize.hs+74−5
@@ -25,6 +25,7 @@ import qualified Elm.Name as N
2525import qualified Reporting.Annotation as A
2626import qualified Reporting.Region as R
2727import qualified Reporting.Render.Code as Code
28+import qualified Reporting.Render.Type as RT
2829import qualified Reporting.Report as Report
2930import qualified Reporting.Helpers as H
3031import Reporting.Helpers ( Doc, (<+>), (<>) )
@@ -310,7 +311,8 @@ toReport source err =
310311 ExportNotFound region kind rawName possibleNames ->
311312 let
312313 suggestions =
313− take 4 (H.nearbyNames (N.toString rawName) (map N.toString possibleNames))
314+ map N.toString $ take 4 $
315+ H.nearbyNames N.toString rawName possibleNames
314316 in
315317 Report.Report "UNKNOWN EXPORT" region suggestions $
316318 let (a, thing, name) = toKindInfo kind rawName in
@@ -395,7 +397,8 @@ toReport source err =
395397 ImportExposingNotFound region (ModuleName.Canonical _ home) value possibleNames ->
396398 let
397399 suggestions =
398− take 4 $ H.nearbyNames (N.toString home) (map N.toString possibleNames)
400+ map N.toString $ take 4 $
401+ H.nearbyNames N.toString home possibleNames
399402 in
400403 Report.Report "BAD IMPORT" region suggestions $
401404 Report.toCodeSnippet source region Nothing
@@ -467,7 +470,8 @@ toReport source err =
467470 else
468471 let
469472 suggestions =
470− take 2 $ H.nearbyNames (N.toString op) (map N.toString (Set.toList locals))
473+ map N.toString $ take 2 $
474+ H.nearbyNames N.toString op (Set.toList locals)
471475
472476 format altOp =
473477 H.dullyellow $ "(" <> altOp <> ")"
@@ -889,7 +893,7 @@ notFound source region maybePrefix name thing (PossibleNames locals quals) =
889893 Map.foldrWithKey addQuals (map N.toString (Set.toList locals)) quals
890894
891895 nearbyNames =
892− take 4 (H.nearbyNames givenName possibleNames)
896+ take 4 (H.nearbyNames id givenName possibleNames)
893897
894898 toDetails noSuggestionDetails yesSuggestionDetails =
895899 case nearbyNames of
@@ -1066,7 +1070,7 @@ aliasRecursionReport source region name args tipe others =
10661070 "When I expand a recursive type alias, it just keeps getting bigger and bigger.\
10671071 \ So dealiasing results in an infinitely large type! Try this instead:"
10681072 , H.indent 4 $
1069− error "TODO alias to doc" name args tipe
1073+ aliasToUnionDoc name args tipe
10701074 , H.link "Hint"
10711075 "This is kind of a subtle distinction. I suggested the naive fix, but I recommend reading"
10721076 "recursive-alias"
@@ -1089,3 +1093,68 @@ aliasRecursionReport source region name args tipe others =
10891093 "to learn why this `type` vs `type alias` distinction matters. It is subtle but important!"
10901094 ]
10911095 )
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
1111 , findPotentialTypos, findTypoPairs, vetTypos
1212 , nearbyNames, distance
1313 -- re-exports
14− , Doc, (<+>), (<>), black, cat, dullyellow, fillSep, green, hang, hardline
14+ , Doc, (<+>), (<>), black, blue, cat, dullyellow, fillSep, green, hang, hardline
1515 , hcat, hsep, indent, magenta, parens, sep, text, underline, vcat
1616 )
1717 where
@@ -21,8 +21,9 @@ import Data.Function (on)
2121import qualified Data.Char as Char
2222import qualified Data.List as List
2323import qualified Data.Map as Map
24−import Data.Monoid ((<>))
24+import qualified Data.Maybe as Maybe
2525import qualified Data.Set as Set
26+import Data.Monoid ((<>))
2627import qualified Data.Text as Text
2728import Data.Text (Text)
2829import qualified Elm.Name as N
@@ -218,16 +219,24 @@ vetTypos potentialTypos =
218219-- NEARBY NAMES
219220
220221
221−nearbyNames :: String -> [String] -> [String]
222−nearbyNames name names =
222+nearbyNames :: (a -> String) -> a -> [a] -> [a]
223+nearbyNames toString value possibleValues =
223224 let
225+ name =
226+ toString value
227+
224228 editDistance =
225229 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
226236 in
227237 map snd $
228− filter ( (<= editDistance) . abs . fst ) $
229− List.sortBy (compare `on` fst) $
230− map (\x -> (distance name x, x)) names
238+ List.sortBy (compare `on` fst) $
239+ Maybe.mapMaybe getDistance possibleValues
231240
232241
233242distance :: String -> String -> Int
src/Reporting/Render/Type.hs+3−6
@@ -54,18 +54,15 @@ apply context name args =
5454 None -> applyDoc
5555
5656
57−tuple :: Doc -> Doc -> Maybe Doc -> Doc
58−tuple a b maybeC =
57+tuple :: Doc -> Doc -> [Doc] -> Doc
58+tuple a b cs =
5959 let
6060 entries =
61− case maybeC of
62− Nothing -> [ "(" <+> a, "," <+> b ]
63− Just c -> [ "(" <+> a, "," <+> b, "," <+> c ]
61+ zipWith (<+>) ("(" : repeat ",") (a:b:cs)
6462 in
6563 H.sep [ H.cat entries, ")" ]
6664
6765
68−
6966record :: [(Doc, Doc)] -> Maybe Doc -> Doc
7067record entries maybeExt =
7168 case (map entryToDoc entries, maybeExt) of