git.iko.soy/elk
on bed2393 help sign in
elk/src/Nitpick/TopLevelTypes.hs
81 lines 2.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.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.Valid]
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.Valid
35 -> Result.Result Warning.Warning Error.Error ()
36warnMissingAnnotation typeEnv (A.A (region,_) decl) =
37 case decl of
38 Decl.Def (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.Valid]
53 -> Result.Result w Error.Error ()
54checkMainType typeEnv decls =
55 case decls of
56 A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
57 case Map.lookup "main" typeEnv of
58 Nothing ->
59 return ()
61 Just tipe ->
62 case Type.deepDealias tipe of
63 Type.App (Type.Type name) [_] | name == virtualDomNode ->
64 return ()
66 _ ->
67 Result.throw region (Error.BadMain tipe)
69 _ : remainingDecls ->
70 checkMainType typeEnv remainingDecls
72 [] ->
73 return ()
76virtualDomNode :: Var.Canonical
77virtualDomNode =
78 Var.fromModule
79 (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
80 "Node"