git.iko.soy/elk
on ea5c662 help sign in
elk/src/Nitpick/TopLevelTypes.hs
119 lines 2.7 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Nitpick.TopLevelTypes (topLevelTypes) where
5import qualified Data.Foldable as F
6import Data.Map ((!))
7import qualified Data.Map as Map
8import Data.Text (Text)
10import qualified AST.Expression.Canonical as Can
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 Canonicalize.Effects as Effects
16import qualified Elm.Package as Pkg
17import qualified Reporting.Annotation as A
18import qualified Reporting.Error.Type as Error
19import qualified Reporting.Result as Result
20import qualified Reporting.Warning as Warning
24type Result =
25 Result.Result () Warning.Warning Error.Error
28type TypeDict =
29 Map.Map Text Type.Canonical
33-- CHECK TOP LEVEL TYPES
36topLevelTypes :: TypeDict -> Can.SortedDefs -> Result [Can.Def]
37topLevelTypes typeEnv sortedDefs =
38 let
39 check =
40 checkAnnotation typeEnv
41 in
42 case sortedDefs of
43 Can.NoMain defs ->
44 pure defs
45 <* F.traverse_ check defs
47 Can.YesMain before main after ->
48 do check main
49 <* F.traverse_ check before
50 <* F.traverse_ check after
52 mainDef <- checkMain typeEnv main
54 return (before ++ mainDef : after)
58-- MISSING ANNOTATIONS
61checkAnnotation :: TypeDict -> Can.Def -> Result ()
62checkAnnotation typeEnv (Can.Def _ (A.A region pattern) _ maybeType) =
63 case (pattern, maybeType) of
64 (P.Var name, Nothing) ->
65 let
66 warning =
67 Warning.MissingTypeAnnotation name (typeEnv ! name)
68 in
69 Result.warn region warning ()
71 _ ->
72 return ()
76-- CHECK MAIN TYPE
79checkMain :: TypeDict -> Can.Def -> Result Can.Def
80checkMain typeEnv (Can.Def facts pattern@(A.A region _) body maybeType) =
81 let
82 mainType =
83 typeEnv ! "main"
85 makeError tipe maybeMsg =
86 A.A region (Error.BadFlags tipe maybeMsg)
88 getMainKind =
89 case Type.deepDealias mainType of
90 Type.Type name [_]
91 | name == vdomNode ->
92 return Can.Static
94 Type.Type name [flags, _, _]
95 | name == program ->
96 return (Can.Dynamic flags)
97 <* Effects.checkPortType makeError flags
99 _ ->
100 Result.throw region (Error.BadMain mainType)
101 in
102 do kind <- getMainKind
103 let newBody = A.A undefined (Can.Program kind body)
104 return (Can.Def facts pattern newBody maybeType)
107program :: Var.Canonical
108program =
109 Var.inCore "Platform" "Program"
112vdomNode :: Var.Canonical
113vdomNode =
114 let
115 vdom =
116 ModuleName.Canonical Pkg.virtualDom "VirtualDom"
117 in
118 Var.fromModule vdom "Node"