git.iko.soy/elk
on 0e50803 help sign in
elk/src/Nitpick/TopLevelTypes.hs
87 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
24-- CHECK TOP LEVEL TYPES
27topLevelTypes
28 :: Map.Map String Type.Canonical
29 -> Decl.Valid
30 -> Result.Result Warning.Warning Error.Error ()
31topLevelTypes typeEnv (Decl.Decls defs _ _ _) =
32 do maybeMainRegion <- foldM (warnMissingAnnotation typeEnv) Nothing defs
33 maybe (return ()) (checkMainType typeEnv) maybeMainRegion
37-- MISSING ANNOTATIONS
40warnMissingAnnotation
41 :: Map.Map String Type.Canonical
42 -> Maybe R.Region
43 -> A.Commented Valid.Def
44 -> Result.Result Warning.Warning Error.Error (Maybe R.Region)
45warnMissingAnnotation typeEnv maybeMainRegion (A.A (region,_) def) =
46 case def of
47 Valid.Def (A.A _ (P.Var name)) _ maybeType ->
48 do when (Maybe.isNothing maybeType) $
49 Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name))
51 return (if name == "main" then Just region else maybeMainRegion)
53 _ ->
54 return maybeMainRegion
58-- CHECK MAIN TYPE
61checkMainType :: Map.Map String Type.Canonical -> R.Region -> Result.Result w Error.Error ()
62checkMainType typeEnv region =
63 let
64 tipe =
65 typeEnv ! "main"
66 in
67 case Type.deepDealias tipe of
68 Type.App name [_] | name `elem` [program, vdomNode] ->
69 return ()
71 _ ->
72 Result.throw region (Error.BadMain tipe)
75program :: Type.Canonical
76program =
77 Type.Type (Var.inCore ["Platform"] "Program")
80vdomNode :: Type.Canonical
81vdomNode =
82 let
83 vdom =
84 ModuleName.Canonical (Pkg.Name "elm-lang" "virtual-dom") ["VirtualDom"]
85 in
86 Type.Type (Var.fromModule vdom "Node")