@@ -7,13 +7,18 @@ module Reporting.Error.Main
77 where
88
99
10+import qualified Data.Map as Map
11+import qualified Data.Maybe as Maybe
12+import Data.Monoid ((<>))
13+
1014import qualified AST.Canonical as Can
15+import qualified AST.Module.Name as ModuleName
1116import qualified Elm.Name as N
1217import qualified Reporting.Error.Canonicalize as E
1318import qualified Reporting.Helpers as H
1419import qualified Reporting.Region as R
1520import qualified Reporting.Render.Code as Code
16−import qualified Reporting.Render.Type as RenderType
21+import qualified Reporting.Render.Type as RT
1722import qualified Reporting.Report as Report
1823
1924
@@ -31,8 +36,8 @@ data Error
3136-- TO REPORT
3237
3338
34−toReport :: Code.Source -> RenderType.Localizer -> Error -> Report.Report
35−toReport source localizer err =
39+toReport :: Code.Source -> Error -> Report.Report
40+toReport source err =
3641 case err of
3742 BadType region tipe ->
3843 Report.Report "BAD MAIN TYPE" region [] $
@@ -42,7 +47,7 @@ toReport source localizer err =
4247 ,
4348 H.stack
4449 [ "The type of `main` value I am seeing is:"
45− , H.indent 4 (RenderType.toDoc localizer tipe)
50+ , H.indent 4 $ H.dullyellow $ typeToDoc RT.None tipe
4651 , H.reflow $
4752 "I only know how to handle Html, Svg, and Programs\
4853 \ though. Modify `main` to be one of those types of values!"
@@ -120,3 +125,65 @@ toReport source localizer err =
120125 \ everything with encoders and decoders for more control and better errors."
121126 ]
122127 )
128+
129+
130+
131+-- TYPE TO DOC
132+
133+
134+typeToDoc :: RT.Context -> Can.Type -> H.Doc
135+typeToDoc context tipe =
136+ case tipe of
137+ Can.TLambda arg1 result ->
138+ let
139+ (arg2, rest) = collectArgs result
140+ in
141+ RT.lambda context
142+ (typeToDoc RT.Func arg1)
143+ (typeToDoc RT.Func arg2)
144+ (map (typeToDoc RT.Func) rest)
145+
146+ Can.TVar name ->
147+ H.nameToDoc name
148+
149+ Can.TType (ModuleName.Canonical _ home) name args ->
150+ RT.apply context
151+ (H.nameToDoc home <> "." <> H.nameToDoc name)
152+ (map (typeToDoc RT.App) args)
153+
154+ Can.TRecord fields ext ->
155+ RT.record
156+ (map entryToDocs (Map.toList fields))
157+ (fmap H.nameToDoc ext)
158+
159+ Can.TUnit ->
160+ "()"
161+
162+ Can.TTuple a b maybeC ->
163+ RT.tuple
164+ (typeToDoc RT.None a)
165+ (typeToDoc RT.None b)
166+ (map (typeToDoc RT.None) (Maybe.maybeToList maybeC))
167+
168+ Can.TAlias (ModuleName.Canonical _ home) name args _ ->
169+ RT.apply context
170+ (H.nameToDoc home <> "." <> H.nameToDoc name)
171+ (map (typeToDoc RT.App . snd) args)
172+
173+
174+entryToDocs :: (N.Name, Can.Type) -> (H.Doc, H.Doc)
175+entryToDocs (name, tipe) =
176+ (H.nameToDoc name, typeToDoc RT.None tipe)
177+
178+
179+collectArgs :: Can.Type -> (Can.Type, [Can.Type])
180+collectArgs tipe =
181+ case tipe of
182+ Can.TLambda a rest ->
183+ let
184+ (b, cs) = collectArgs rest
185+ in
186+ (a, b:cs)
187+
188+ _ ->
189+ (tipe, [])