git.iko.soy/elk
on bbb6583 help sign in
elk/src/Nitpick/TopLevelTypes.hs
86 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
22topLevelTypes
23 :: Map.Map String Type.Canonical
24 -> [Decl.Valid]
25 -> Result.Result Warning.Warning Error.Error ()
26topLevelTypes typeEnv validDecls =
27 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
28 checkMainType typeEnv validDecls
32-- MISSING ANNOTATIONS
35warnMissingAnnotation
36 :: Map.Map String Type.Canonical
37 -> Decl.Valid
38 -> Result.Result Warning.Warning Error.Error ()
39warnMissingAnnotation typeEnv (A.A (region,_) decl) =
40 case decl of
41 Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
42 case Map.lookup name typeEnv of
43 Nothing ->
44 return ()
45 Just tipe ->
46 Result.warn region (Warning.MissingTypeAnnotation name tipe)
47 _ ->
48 return ()
52-- MAIN TYPE
55checkMainType
56 :: Map.Map String Type.Canonical
57 -> [Decl.Valid]
58 -> Result.Result w Error.Error ()
59checkMainType typeEnv decls =
60 case decls of
61 A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
62 case Map.lookup "main" typeEnv of
63 Nothing ->
64 return ()
66 Just tipe ->
67 case Type.deepDealias tipe of
68 Type.App (Type.Type name) [_] | name == virtualDomNode ->
69 return ()
71 _ ->
72 Result.throw region (Error.BadMain tipe)
74 _ : remainingDecls ->
75 checkMainType typeEnv remainingDecls
77 [] ->
78 return ()
81virtualDomNode :: Var.Canonical
82virtualDomNode =
83 Var.fromModule
84 (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
85 "Node"