git.iko.soy/elk
on 0d58dee 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 validDecls =
32 do maybeMainRegion <- foldM (warnMissingAnnotation typeEnv) Nothing validDecls
33 maybe (return ()) (checkMainType typeEnv) maybeMainRegion
37-- MISSING ANNOTATIONS
40warnMissingAnnotation
41 :: Map.Map String Type.Canonical
42 -> Maybe R.Region
43 -> Decl.Valid
44 -> Result.Result Warning.Warning Error.Error (Maybe R.Region)
45warnMissingAnnotation typeEnv maybeMainRegion (A.A (region,_) decl) =
46 case decl of
47 Decl.Def (Valid.Definition (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 "evancz" "virtual-dom") ["VirtualDom"]
85 in
86 Type.Type (Var.fromModule vdom "Node")