git.iko.soy/elk
on ddd48ba help sign in
elk/src/Nitpick/TopLevelTypes.hs
108 lines 2.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Nitpick.TopLevelTypes (topLevelTypes) where
4import Prelude hiding (maybe)
5import qualified Data.Foldable as F
6import qualified Data.Map as Map
8import qualified AST.Expression.Valid as Valid
9import qualified AST.Declaration as Decl
10import qualified AST.Module.Name as ModuleName
11import qualified AST.Pattern as P
12import qualified AST.Type as Type
13import qualified AST.Variable as Var
14import qualified Elm.Package as Pkg
15import qualified Reporting.Annotation as A
16import qualified Reporting.Error.Type as Error
17import qualified Reporting.Result as Result
18import qualified Reporting.Warning as Warning
21topLevelTypes
22 :: Map.Map String Type.Canonical
23 -> [Decl.ValidDecl]
24 -> Result.Result Warning.Warning Error.Error ()
25topLevelTypes typeEnv validDecls =
26 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
27 checkMainType typeEnv validDecls
30-- MISSING ANNOTATIONS
32warnMissingAnnotation
33 :: Map.Map String Type.Canonical
34 -> Decl.ValidDecl
35 -> Result.Result Warning.Warning Error.Error ()
36warnMissingAnnotation typeEnv (A.A (region,_) decl) =
37 case decl of
38 Decl.Definition (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
39 case Map.lookup name typeEnv of
40 Nothing ->
41 return ()
42 Just tipe ->
43 Result.warn region (Warning.MissingTypeAnnotation name tipe)
44 _ ->
45 return ()
48-- MAIN TYPE
50checkMainType
51 :: Map.Map String Type.Canonical
52 -> [Decl.ValidDecl]
53 -> Result.Result w Error.Error ()
54checkMainType typeEnv decls =
55 case decls of
56 A.A (region,_) (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
57 case Map.lookup "main" typeEnv of
58 Nothing ->
59 return ()
61 Just typeOfMain ->
62 let tipe = Type.deepDealias typeOfMain
63 in
64 if tipe `elem` validMainTypes
65 then return ()
66 else Result.throw region (Error.BadMain typeOfMain)
68 _ : remainingDecls ->
69 checkMainType typeEnv remainingDecls
71 [] ->
72 return ()
75validMainTypes :: [Type.Canonical]
76validMainTypes =
77 [ element
78 , html
79 , signal element
80 , signal html
81 ]
84html :: Type.Canonical
85html =
86 Type.Type (Var.fromModule virtualDom "Node")
89virtualDom :: ModuleName.Canonical
90virtualDom =
91 ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"]
94element :: Type.Canonical
95element =
96 core ["Graphics","Element"] "Element"
99signal :: Type.Canonical -> Type.Canonical
100signal tipe =
101 Type.App (core ["Signal"] "Signal") [ tipe ]
104core :: [String] -> String -> Type.Canonical
105core home name =
106 Type.Type (Var.inCore home name)