git.iko.soy/elk
on 8a89c86 help sign in
elk/src/Nitpick/TopLevelTypes.hs
107 lines 2.8 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 Canonicalize.Result as Result
19import qualified Elm.Name as N
20import qualified Reporting.Annotation as A
21import qualified Reporting.Error.Canonicalize as Error
22import qualified Reporting.Region as R
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 Types =
35 Map.Map N.Name Can.Type
38type Mains =
39 Map.Map ModuleName.Canonical Opt.Main
42check :: Types -> Can.Module -> Result i [W.Warning] Mains
43check types (Can.Module home _ _ decls _ _ _ _) =
44 checkDecls home types decls Map.empty
47checkDecls :: ModuleName.Canonical -> Types -> Can.Decls -> Mains -> Result i [W.Warning] Mains
48checkDecls home types decls mains =
49 case decls of
50 Can.Declare def subDecls ->
51 checkDecls home types subDecls =<<
52 checkDef home types mains def
54 Can.DeclareRec defs subDecls ->
55 checkDecls home types subDecls =<<
56 foldM (checkDef home types) mains defs
58 Can.SaveTheEnvironment ->
59 Result.ok mains
63-- MISSING ANNOTATIONS
66checkDef :: ModuleName.Canonical -> Types -> Mains -> Can.Def -> Result i [W.Warning] Mains
67checkDef home types mains def =
68 case def of
69 Can.Def (A.At region name) _ _ ->
70 do Result.warn $ W.MissingTypeAnnotation region name (types ! name)
71 checkMain region types home name mains
73 Can.TypedDef (A.At region name) _ _ _ _ ->
74 checkMain region types home name mains
78-- CHECK MAIN TYPE
81checkMain :: R.Region -> Types -> ModuleName.Canonical -> N.Name -> Mains -> Result i w Mains
82checkMain region types home name mains =
83 if name == N.main then
84 do mainType <- checkMainType region (types ! name)
85 Result.ok $ Map.insert home mainType mains
86 else
87 Result.ok mains
90checkMainType :: R.Region -> Can.Type -> Result i w Opt.Main
91checkMainType region tipe =
92 case Type.deepDealias tipe of
93 Can.TType home name [_]
94 | home == ModuleName.virtualDom && name == N.node ->
95 Result.ok Opt.Static
97 Can.TType home name [flags, _, _]
98 | home == ModuleName.platform && name == N.program ->
99 case Effects.checkPayload flags of
100 Left (subType, invalidPayload) ->
101 Result.throw (Error.MainFlags region subType invalidPayload)
103 Right () ->
104 Result.ok (Opt.Dynamic flags)
106 _ ->
107 Result.throw (Error.MainType region tipe)