git.iko.soy/elk
on f41abda help sign in
elk/src/Nitpick/TopLevelTypes.hs
108 lines 3.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Nitpick.TopLevelTypes
4 ( check
5 )
6 where
9import Control.Monad (foldM)
10import qualified Data.Map as Map
11import Data.Map ((!))
13import qualified AST.Canonical as Can
14import qualified AST.Optimized as Opt
15import qualified AST.Module.Name as ModuleName
16import qualified AST.Utils.Type as Type
17import qualified Canonicalize.Effects as Effects
18import qualified Elm.Name as N
19import qualified Reporting.Annotation as A
20import qualified Reporting.Error.Main as Error
21import qualified Reporting.Region as R
22import qualified Reporting.Result as Result
23import qualified Reporting.Warning as W
27-- CHECK TOP-LEVEL TYPES
30type Result i w a =
31 Result.Result i w Error.Error a
34type Annotations =
35 Map.Map N.Name Can.Annotation
38type Mains =
39 Map.Map ModuleName.Canonical Opt.Main
42check :: Annotations -> Can.Module -> Result i [W.Warning] Mains
43check annotations (Can.Module home _ _ decls _ _ _ _) =
44 checkDecls home annotations decls Map.empty
47checkDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Mains -> Result i [W.Warning] Mains
48checkDecls home annotations decls mains =
49 case decls of
50 Can.Declare def subDecls ->
51 checkDecls home annotations subDecls =<<
52 checkDef home annotations mains def
54 Can.DeclareRec defs subDecls ->
55 checkDecls home annotations subDecls =<<
56 foldM (checkDef home annotations) mains defs
58 Can.SaveTheEnvironment ->
59 Result.ok mains
63-- MISSING ANNOTATIONS
66checkDef :: ModuleName.Canonical -> Annotations -> Mains -> Can.Def -> Result i [W.Warning] Mains
67checkDef home annotations mains def =
68 case def of
69 Can.Def (A.At region name) _ _ ->
70 do let (Can.Forall _ annotation) = annotations ! name
71 Result.warn $ W.MissingTypeAnnotation region name annotation
72 checkMain region annotations home name mains
74 Can.TypedDef (A.At region name) _ _ _ _ ->
75 checkMain region annotations home name mains
79-- CHECK MAIN TYPE
82checkMain :: R.Region -> Annotations -> ModuleName.Canonical -> N.Name -> Mains -> Result i w Mains
83checkMain region annotations home name mains =
84 if name == N.main then
85 do mainType <- checkMainType region (annotations ! name)
86 Result.ok $ Map.insert home mainType mains
87 else
88 Result.ok mains
91checkMainType :: R.Region -> Can.Annotation -> Result i w Opt.Main
92checkMainType region (Can.Forall _ tipe) =
93 case Type.deepDealias tipe of
94 Can.TType home name [_]
95 | home == ModuleName.virtualDom && name == N.node ->
96 Result.ok Opt.Static
98 Can.TType home name [flags, _, _]
99 | home == ModuleName.platform && name == N.program ->
100 case Effects.checkPayload flags of
101 Left (subType, invalidPayload) ->
102 Result.throw (Error.BadFlags region subType invalidPayload)
104 Right () ->
105 Result.ok (Opt.Dynamic flags)
107 _ ->
108 Result.throw (Error.BadType region tipe)