git.iko.soy/elk
on 94ebc2d help sign in
elk/src/Nitpick/TopLevelTypes.hs
88 lines 2.2 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Nitpick.TopLevelTypes (topLevelTypes) where
4import Control.Monad (foldM, when)
5import Data.Map ((!))
6import qualified Data.Map as Map
7import qualified Data.Maybe as Maybe
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.Region as R
19import qualified Reporting.Result as Result
20import qualified Reporting.Warning as Warning
24type Result =
25 Result.Result () Warning.Warning Error.Error
28-- CHECK TOP LEVEL TYPES
31topLevelTypes :: Map.Map String Type.Canonical -> Decl.Valid -> Result ()
32topLevelTypes typeEnv (Decl.Decls defs _ _ _) =
33 do maybeMainRegion <- foldM (warnMissingAnnotation typeEnv) Nothing defs
34 maybe (return ()) (checkMainType typeEnv) maybeMainRegion
38-- MISSING ANNOTATIONS
41warnMissingAnnotation
42 :: Map.Map String Type.Canonical
43 -> Maybe R.Region
44 -> A.Commented Valid.Def
45 -> Result (Maybe R.Region)
46warnMissingAnnotation typeEnv maybeMainRegion (A.A (region,_) def) =
47 case def of
48 Valid.Def (A.A _ (P.Var name)) _ maybeType ->
49 do when (Maybe.isNothing maybeType) $
50 Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name)) ()
52 return (if name == "main" then Just region else maybeMainRegion)
54 _ ->
55 return maybeMainRegion
59-- CHECK MAIN TYPE
62checkMainType :: Map.Map String Type.Canonical -> R.Region -> Result ()
63checkMainType typeEnv region =
64 let
65 tipe =
66 typeEnv ! "main"
67 in
68 case Type.deepDealias tipe of
69 Type.App name [_] | name `elem` [program, vdomNode] ->
70 return ()
72 _ ->
73 Result.throw region (Error.BadMain tipe)
76program :: Type.Canonical
77program =
78 Type.Type (Var.inCore ["Platform"] "Program")
81vdomNode :: Type.Canonical
82vdomNode =
83 let
84 vdom =
85 ModuleName.Canonical (Pkg.Name "elm-lang" "virtual-dom") ["VirtualDom"]
86 in
87 Type.Type (Var.fromModule vdom "Node")