git.iko.soy/elk
on eb7feba help sign in
elk/src/Nitpick/TopLevelTypes.hs
95 lines 2.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
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 ()
46 Just tipe ->
47 Result.warn region (Warning.MissingTypeAnnotation name tipe)
48 _ ->
49 return ()
53-- MAIN TYPE
56checkMainType
57 :: Map.Map String Type.Canonical
58 -> [Decl.Valid]
59 -> Result.Result w Error.Error ()
60checkMainType typeEnv decls =
61 case decls of
62 A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
63 case Map.lookup "main" typeEnv of
64 Nothing ->
65 return ()
67 Just tipe ->
68 case Type.deepDealias tipe of
69 Type.App (Type.Type name) [_] | name == virtualDomNode ->
70 return ()
72 Type.App (Type.Type name) [_] | name == program ->
73 return ()
75 _ ->
76 Result.throw region (Error.BadMain tipe)
78 _ : remainingDecls ->
79 checkMainType typeEnv remainingDecls
81 [] ->
82 return ()
85virtualDomNode :: Var.Canonical
86virtualDomNode =
87 Var.fromModule
88 (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
89 "Node"
92program :: Var.Canonical
93program =
94 Var.fromModule (ModuleName.inCore ["Platform"]) "Program"