git.iko.soy/elk
on master help sign in
Add Type.Error.toDoc
commit11e44c9a973b9941a613988ea65db073359b725c authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 9 Feb 2018, 21:33 (9 years ago) parent785bc76
3 files changed+97−16
compare with master
unifiedsplit
src/Reporting/Error/Canonicalize.hs+20−11 src/Reporting/Render/Type.hs+3−3 src/Type/Error.hs+74−2
src/Reporting/Error/Canonicalize.hs+20−11
@@ -1110,10 +1110,19 @@ aliasToUnionDoc name args tipe =
11101110typeToDoc :: RT.Context -> Src.Type -> Doc
11111111typeToDoc context (A.At _ tipe) =
11121112 case tipe of
1113− Src.TLambda a b ->
1114− RT.lambda context
1115− (typeToDoc RT.Func a)
1116− (map (typeToDoc RT.Func) (collectArgs b))
1113+ Src.TLambda arg1 next ->
1114+ case next of
1115+ A.At _ (Src.TLambda arg2 result) ->
1116+ RT.lambda context
1117+ (typeToDoc RT.Func arg1)
1118+ (typeToDoc RT.Func arg2)
1119+ (map (typeToDoc RT.Func) (collectArgs result))
1120+
1121+ _ ->
1122+ RT.lambda context
1123+ (typeToDoc RT.Func arg1)
1124+ (typeToDoc RT.Func next)
1125+ []
11171126
11181127 Src.TVar name ->
11191128 H.nameToDoc name
@@ -1143,6 +1152,13 @@ typeToDoc context (A.At _ tipe) =
11431152 (map (typeToDoc RT.None) cs)
11441153
11451154
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+
11461162collectArgs :: Src.Type -> [Src.Type]
11471163collectArgs tipe =
11481164 case tipe of
@@ -1151,10 +1167,3 @@ collectArgs tipe =
11511167
11521168 _ ->
11531169 [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
2525 | App
2626
2727
28−lambda :: Context -> Doc -> [Doc] -> Doc
29−lambda context arg args =
28+lambda :: Context -> Doc -> Doc -> [Doc] -> Doc
29+lambda context arg1 arg2 args =
3030 let
3131 lambdaDoc =
32− H.sep (arg : map ("->" <+>) args)
32+ H.sep (arg1 : map ("->" <+>) (arg2:args))
3333 in
3434 case context of
3535 None -> lambdaDoc
src/Type/Error.hs+74−2
@@ -1,16 +1,22 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE OverloadedStrings #-}
13module Type.Error
24 ( Type(..)
35 , Extension(..)
46 , iteratedDealias
57 , Localizer
8+ , toDoc
69 )
710 where
811
912
1013import qualified Data.Map as Map
14+import qualified Data.Maybe as Maybe
1115
1216import qualified AST.Module.Name as ModuleName
1317import qualified Elm.Name as N
18+import qualified Reporting.Helpers as H
19+import qualified Reporting.Render.Type as RT
1420
1521
1622
@@ -49,12 +55,78 @@ iteratedDealias tipe =
4955
5056
5157
52−-- LOCALIZE
58+-- TO DOC
5359
5460
55−type Localizer = Map.Map N.Name ()
61+type Localizer = Map.Map (ModuleName.Canonical, N.Name) (Maybe N.Name)
5662
5763
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+
58130
59131
60132{-- DIFF