git.iko.soy/elk
on 5ed4eea help sign in
elk/src/Nitpick/TopLevelTypes.hs
135 lines 3.5 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 Type.Record
97 [ ("element", core ["Graphics","Element"] "ElementPrim")
98 , ("props",
99 Type.Record
100 [ ("click" , builtin "_Tuple0")
101 , ("color" , maybe (core ["Color"] "Color"))
102 , ("height" , builtin "Int")
103 , ("hover" , builtin "_Tuple0")
104 , ("href" , builtin "String")
105 , ("id" , builtin "Int")
106 , ("opacity", builtin "Float")
107 , ("tag" , builtin "String")
108 , ("width" , builtin "Int")
109 ]
110 Nothing
111 )
112 ]
113 Nothing
116core :: [String] -> String -> Type.Canonical
117core home name =
118 Type.Type (Var.inCore home name)
121signal :: Type.Canonical -> Type.Canonical
122signal tipe =
123 Type.App (core ["Signal"] "Signal") [ tipe ]
126maybe :: Type.Canonical -> Type.Canonical
127maybe tipe =
128 Type.App (core ["Maybe"] "Maybe") [ tipe ]
131builtin :: String -> Type.Canonical
132builtin name =
133 Type.Type (Var.builtin name)