git.iko.soy/elk
on 50efcd0 help sign in
elk/src/Nitpick/TopLevelTypes.hs
115 lines 3.3 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.Pattern as P
11import qualified AST.Type as Type
12import qualified AST.Variable as Var
13import qualified Reporting.Annotation as A
14import qualified Reporting.Error.Type as Error
15import qualified Reporting.Result as Result
16import qualified Reporting.Warning as Warning
19topLevelTypes
20 :: Map.Map String Type.Canonical
21 -> [Decl.ValidDecl]
22 -> Result.Result Warning.Warning Error.Error ()
23topLevelTypes typeEnv validDecls =
24 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
25 checkMainType typeEnv validDecls
28-- MISSING ANNOTATIONS
30warnMissingAnnotation
31 :: Map.Map String Type.Canonical
32 -> Decl.ValidDecl
33 -> Result.Result Warning.Warning Error.Error ()
34warnMissingAnnotation typeEnv (A.A (region,_) decl) =
35 case decl of
36 Decl.Definition (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
37 case Map.lookup name typeEnv of
38 Nothing ->
39 return ()
40 Just tipe ->
41 Result.warn region (Warning.MissingTypeAnnotation name tipe)
42 _ ->
43 return ()
46-- MAIN TYPE
48checkMainType
49 :: Map.Map String Type.Canonical
50 -> [Decl.ValidDecl]
51 -> Result.Result w Error.Error ()
52checkMainType typeEnv decls =
53 case decls of
54 A.A (region,_) (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
55 case Map.lookup "main" typeEnv of
56 Nothing ->
57 return ()
59 Just typeOfMain ->
60 let tipe = Type.deepDealias typeOfMain
61 in
62 if tipe `elem` validMainTypes
63 then return ()
64 else Result.throw region (Error.BadMain typeOfMain)
66 _ : remainingDecls ->
67 checkMainType typeEnv remainingDecls
69 [] ->
70 return ()
73validMainTypes :: [Type.Canonical]
74validMainTypes =
75 [ element
76 , html
77 , signal element
78 , signal html
79 ]
80 where
81 fromModule :: [String] -> String -> Type.Canonical
82 fromModule home name =
83 Type.Type (Var.fromModule home name)
85 html =
86 fromModule ["VirtualDom"] "Node"
88 signal tipe =
89 Type.App (fromModule ["Signal"] "Signal") [ tipe ]
91 element =
92 let builtin name =
93 Type.Type (Var.builtin name)
95 maybe tipe =
96 Type.App (fromModule ["Maybe"] "Maybe") [ tipe ]
97 in
98 Type.Record
99 [ ("element", fromModule ["Graphics","Element"] "ElementPrim")
100 , ("props",
101 Type.Record
102 [ ("click" , builtin "_Tuple0")
103 , ("color" , maybe (fromModule ["Color"] "Color"))
104 , ("height" , builtin "Int")
105 , ("hover" , builtin "_Tuple0")
106 , ("href" , builtin "String")
107 , ("id" , builtin "Int")
108 , ("opacity", builtin "Float")
109 , ("tag" , builtin "String")
110 , ("width" , builtin "Int")
111 ]
112 Nothing
113 )
114 ]
115 Nothing