git.iko.soy/elk
on 5af390d help sign in
elk/src/Nitpick/TopLevelTypes.hs
92 lines 2.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Nitpick.TopLevelTypes (topLevelTypes) where
4import Data.Map ((!))
5import Prelude hiding (maybe)
6import qualified Data.Foldable as F
7import qualified Data.Map as Map
9import qualified AST.Expression.Valid as Valid
10import qualified AST.Declaration as Decl
11import qualified AST.Module.Name as ModuleName
12import qualified AST.Pattern as P
13import qualified AST.Type as Type
14import qualified AST.Variable as Var
15import qualified Elm.Package as Pkg
16import qualified Reporting.Annotation as A
17import qualified Reporting.Error.Type as Error
18import qualified Reporting.Result as Result
19import qualified Reporting.Warning as Warning
23topLevelTypes
24 :: Map.Map String Type.Canonical
25 -> [Decl.Valid]
26 -> Result.Result Warning.Warning Error.Error ()
27topLevelTypes typeEnv validDecls =
28 do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
29 checkMainType typeEnv validDecls
33-- MISSING ANNOTATIONS
36warnMissingAnnotation
37 :: Map.Map String Type.Canonical
38 -> Decl.Valid
39 -> Result.Result Warning.Warning Error.Error ()
40warnMissingAnnotation typeEnv (A.A (region,_) decl) =
41 case decl of
42 Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
43 Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name))
45 _ ->
46 return ()
50-- MAIN TYPE
53checkMainType
54 :: Map.Map String Type.Canonical
55 -> [Decl.Valid]
56 -> Result.Result w Error.Error ()
57checkMainType typeEnv decls =
58 case decls of
59 A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
60 case Map.lookup "main" typeEnv of
61 Nothing ->
62 return ()
64 Just tipe ->
65 case Type.deepDealias tipe of
66 Type.App (Type.Type name) [_] | name == virtualDomNode ->
67 return ()
69 Type.App (Type.Type name) [_] | name == program ->
70 return ()
72 _ ->
73 Result.throw region (Error.BadMain tipe)
75 _ : remainingDecls ->
76 checkMainType typeEnv remainingDecls
78 [] ->
79 return ()
82virtualDomNode :: Var.Canonical
83virtualDomNode =
84 Var.fromModule
85 (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
86 "Node"
89program :: Var.Canonical
90program =
91 Var.fromModule (ModuleName.inCore ["Platform"]) "Program"