git.iko.soy/elk
on master help sign in
Add Type.Error.toDoc
11e44c9Evan Czaplicki
src/Reporting/Error/Canonicalize.hs+20−11
compare with master
unifiedsplit
@@ -1110,10 +1110,19 @@ aliasToUnionDoc name args tipe =
1110typeToDoc :: RT.Context -> Src.Type -> Doc
1110typeToDoc :: RT.Context -> Src.Type -> Doc
1111typeToDoc context (A.At _ tipe) =
1111typeToDoc context (A.At _ tipe) =
1112 case tipe of
1112 case tipe of
1113− Src.TLambda a b ->
1113+ Src.TLambda arg1 next ->
1114+ case next of
1115+ A.At _ (Src.TLambda arg2 result) ->
1114− RT.lambda context
1116+ RT.lambda context
1115− (typeToDoc RT.Func a)
1117+ (typeToDoc RT.Func arg1)
1118+ (typeToDoc RT.Func arg2)
1116− (map (typeToDoc RT.Func) (collectArgs b))
1119+ (map (typeToDoc RT.Func) (collectArgs result))
1120+
1121+ _ ->
1122+ RT.lambda context
1123+ (typeToDoc RT.Func arg1)
1124+ (typeToDoc RT.Func next)
1125+ []
1117
1126
1118 Src.TVar name ->
1127 Src.TVar name ->
1119 H.nameToDoc name
1128 H.nameToDoc name
@@ -1143,6 +1152,13 @@ typeToDoc context (A.At _ tipe) =
1143 (map (typeToDoc RT.None) cs)
1152 (map (typeToDoc RT.None) cs)
1144
1153
1145
1154
1155+fieldToDocs :: (A.Located N.Name, Src.Type) -> (Doc, Doc)
1156+fieldToDocs (A.At _ fieldName, fieldType) =
1157+ ( H.nameToDoc fieldName
1158+ , typeToDoc RT.None fieldType
1159+ )
1160+
1161+
1146collectArgs :: Src.Type -> [Src.Type]
1162collectArgs :: Src.Type -> [Src.Type]
1147collectArgs tipe =
1163collectArgs tipe =
1148 case tipe of
1164 case tipe of
@@ -1151,10 +1167,3 @@ collectArgs tipe =
1151
1167
1152 _ ->
1168 _ ->
1153 [tipe]
1169 [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/Render/Type.hs+3−3
@@ -25,11 +25,11 @@ data Context
25 | App
25 | App
26
26
27
27
28−lambda :: Context -> Doc -> [Doc] -> Doc
28+lambda :: Context -> Doc -> Doc -> [Doc] -> Doc
29−lambda context arg args =
29+lambda context arg1 arg2 args =
30 let
30 let
31 lambdaDoc =
31 lambdaDoc =
32− H.sep (arg : map ("->" <+>) args)
32+ H.sep (arg1 : map ("->" <+>) (arg2:args))
33 in
33 in
34 case context of
34 case context of
35 None -> lambdaDoc
35 None -> lambdaDoc
src/Type/Error.hs+74−2
@@ -1,16 +1,22 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
1module Type.Error
3module Type.Error
2 ( Type(..)
4 ( Type(..)
3 , Extension(..)
5 , Extension(..)
4 , iteratedDealias
6 , iteratedDealias
5 , Localizer
7 , Localizer
8+ , toDoc
6 )
9 )
7 where
10 where
8
11
9
12
10import qualified Data.Map as Map
13import qualified Data.Map as Map
14+import qualified Data.Maybe as Maybe
11
15
12import qualified AST.Module.Name as ModuleName
16import qualified AST.Module.Name as ModuleName
13import qualified Elm.Name as N
17import qualified Elm.Name as N
18+import qualified Reporting.Helpers as H
19+import qualified Reporting.Render.Type as RT
14
20
15
21
16
22
@@ -49,12 +55,78 @@ iteratedDealias tipe =
49
55
50
56
51
57
52−-- LOCALIZE
58+-- TO DOC
53
59
54
60
55−type Localizer = Map.Map N.Name ()
61+type Localizer = Map.Map (ModuleName.Canonical, N.Name) (Maybe N.Name)
56
62
57
63
64+toDoc :: Localizer -> RT.Context -> Type -> H.Doc
65+toDoc localizer context tipe =
66+ case tipe of
67+ Lambda a b cs ->
68+ RT.lambda context
69+ (toDoc localizer RT.Func a)
70+ (toDoc localizer RT.Func b)
71+ (map (toDoc localizer RT.Func) cs)
72+
73+ Infinite ->
74+ "∞"
75+
76+ Error ->
77+ "?"
78+
79+ FlexVar name ->
80+ H.nameToDoc name
81+
82+ FlexSuper name ->
83+ H.nameToDoc name
84+
85+ RigidVar name ->
86+ H.nameToDoc name
87+
88+ RigidSuper name ->
89+ H.nameToDoc name
90+
91+ Type home name args ->
92+ RT.apply context
93+ (toLocal localizer home name)
94+ (map (toDoc localizer RT.App) args)
95+
96+ Record fields ext ->
97+ let
98+ entryToDocs (fieldName, fieldType) =
99+ ( H.nameToDoc fieldName, toDoc localizer RT.None fieldType )
100+
101+ fieldDocs =
102+ map entryToDocs (Map.toList fields)
103+ in
104+ RT.record fieldDocs $
105+ case ext of
106+ Closed -> Nothing
107+ FlexOpen x -> Just (H.nameToDoc x)
108+ RigidOpen x -> Just (H.nameToDoc x)
109+
110+
111+ Unit ->
112+ "()"
113+
114+ Tuple a b maybeC ->
115+ RT.tuple
116+ (toDoc localizer RT.None a)
117+ (toDoc localizer RT.None b)
118+ (map (toDoc localizer RT.None) (Maybe.maybeToList maybeC))
119+
120+ Alias home name args _ ->
121+ RT.apply context
122+ (toLocal localizer home name)
123+ (map (toDoc localizer RT.App . snd) args)
124+
125+
126+toLocal :: Localizer -> ModuleName.Canonical -> N.Name -> H.Doc
127+toLocal localizer home name =
128+ error "TODO toLocal" localizer home name
129+
58
130
59
131
60{-- DIFF
132{-- DIFF