git.iko.soy/elk
on master help sign in
Finish TODO for bad `main` types
ce99d51Evan Czaplicki
src/Reporting/Error/Main.hs+71−4
compare with master
unifiedsplit
@@ -7,13 +7,18 @@ module Reporting.Error.Main
7 where
7 where
8
8
9
9
10+import qualified Data.Map as Map
11+import qualified Data.Maybe as Maybe
12+import Data.Monoid ((<>))
13+
10import qualified AST.Canonical as Can
14import qualified AST.Canonical as Can
15+import qualified AST.Module.Name as ModuleName
11import qualified Elm.Name as N
16import qualified Elm.Name as N
12import qualified Reporting.Error.Canonicalize as E
17import qualified Reporting.Error.Canonicalize as E
13import qualified Reporting.Helpers as H
18import qualified Reporting.Helpers as H
14import qualified Reporting.Region as R
19import qualified Reporting.Region as R
15import qualified Reporting.Render.Code as Code
20import qualified Reporting.Render.Code as Code
16−import qualified Reporting.Render.Type as RenderType
21+import qualified Reporting.Render.Type as RT
17import qualified Reporting.Report as Report
22import qualified Reporting.Report as Report
18
23
19
24
@@ -31,8 +36,8 @@ data Error
31-- TO REPORT
36-- TO REPORT
32
37
33
38
34−toReport :: Code.Source -> RenderType.Localizer -> Error -> Report.Report
39+toReport :: Code.Source -> Error -> Report.Report
35−toReport source localizer err =
40+toReport source err =
36 case err of
41 case err of
37 BadType region tipe ->
42 BadType region tipe ->
38 Report.Report "BAD MAIN TYPE" region [] $
43 Report.Report "BAD MAIN TYPE" region [] $
@@ -42,7 +47,7 @@ toReport source localizer err =
42 ,
47 ,
43 H.stack
48 H.stack
44 [ "The type of `main` value I am seeing is:"
49 [ "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
46 , H.reflow $
51 , H.reflow $
47 "I only know how to handle Html, Svg, and Programs\
52 "I only know how to handle Html, Svg, and Programs\
48 \ though. Modify `main` to be one of those types of values!"
53 \ though. Modify `main` to be one of those types of values!"
@@ -120,3 +125,65 @@ toReport source localizer err =
120 \ everything with encoders and decoders for more control and better errors."
125 \ everything with encoders and decoders for more control and better errors."
121 ]
126 ]
122 )
127 )
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, [])