git.iko.soy/elk
on 7dfbc30 help sign in
elk/src/Nitpick/TopLevelTypes.hs
111 lines 3.2 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 Optimize.Names as Names
20import qualified Optimize.Port as Port
21import qualified Reporting.Annotation as A
22import qualified Reporting.Error.Main as Error
23import qualified Reporting.Region as R
24import qualified Reporting.Result as Result
25import qualified Reporting.Warning as W
29-- CHECK TOP-LEVEL TYPES
32type Result i w a =
33 Result.Result i w Error.Error a
36type Annotations =
37 Map.Map N.Name Can.Annotation
40type Mains =
41 Map.Map ModuleName.Canonical Opt.Main
44check :: Annotations -> Can.Module -> Result i [W.Warning] Mains
45check annotations (Can.Module home _ _ decls _ _ _ _) =
46 checkDecls home annotations decls Map.empty
49checkDecls :: ModuleName.Canonical -> Annotations -> Can.Decls -> Mains -> Result i [W.Warning] Mains
50checkDecls home annotations decls mains =
51 case decls of
52 Can.Declare def subDecls ->
53 checkDecls home annotations subDecls =<<
54 checkDef home annotations mains def
56 Can.DeclareRec defs subDecls ->
57 checkDecls home annotations subDecls =<<
58 foldM (checkDef home annotations) mains defs
60 Can.SaveTheEnvironment ->
61 Result.ok mains
65-- MISSING ANNOTATIONS
68checkDef :: ModuleName.Canonical -> Annotations -> Mains -> Can.Def -> Result i [W.Warning] Mains
69checkDef home annotations mains def =
70 case def of
71 Can.Def (A.At region name) _ _ ->
72 do let (Can.Forall _ annotation) = annotations ! name
73 Result.warn $ W.MissingTypeAnnotation region name annotation
74 checkMain region annotations home name mains
76 Can.TypedDef (A.At region name) _ _ _ _ ->
77 checkMain region annotations home name mains
81-- CHECK MAIN TYPE
84checkMain :: R.Region -> Annotations -> ModuleName.Canonical -> N.Name -> Mains -> Result i w Mains
85checkMain region annotations home name mains =
86 if name == N.main then
87 do mainType <- checkMainType region (annotations ! name)
88 Result.ok $ Map.insert home mainType mains
89 else
90 Result.ok mains
93checkMainType :: R.Region -> Can.Annotation -> Result i w Opt.Main
94checkMainType region (Can.Forall _ tipe) =
95 case Type.deepDealias tipe of
96 Can.TType home name [_]
97 | home == ModuleName.virtualDom && name == N.node ->
98 Result.ok Opt.Static
100 Can.TType home name [flags, message, _]
101 | home == ModuleName.platform && name == N.program ->
102 case Effects.checkPayload flags of
103 Left (subType, invalidPayload) ->
104 Result.throw (Error.BadFlags region subType invalidPayload)
106 Right () ->
107 let (_, _, flagDecoder) = Names.run (Port.toFlagsDecoder flags) in
108 Result.ok (Opt.Dynamic flagDecoder message)
110 _ ->
111 Result.throw (Error.BadType region tipe)