@@ -1,10 +1,10 @@
11{-# OPTIONS_GHC -Wall #-}
22module Nitpick.TopLevelTypes (topLevelTypes) where
33
4+import Control.Monad (foldM, when)
45import Data.Map ((!))
5−import Prelude hiding (maybe)
6−import qualified Data.Foldable as F
76import qualified Data.Map as Map
7+import qualified Data.Maybe as Maybe
88
99import qualified AST.Expression.Valid as Valid
1010import qualified AST.Declaration as Decl
@@ -15,18 +15,22 @@ import qualified AST.Variable as Var
1515import qualified Elm.Package as Pkg
1616import qualified Reporting.Annotation as A
1717import qualified Reporting.Error.Type as Error
18+import qualified Reporting.Region as R
1819import qualified Reporting.Result as Result
1920import qualified Reporting.Warning as Warning
2021
2122
2223
24+-- CHECK TOP LEVEL TYPES
25+
26+
2327topLevelTypes
24− :: Map.Map String Type.Canonical
25− -> [Decl.Valid]
26− -> Result.Result Warning.Warning Error.Error ()
28+ :: Map.Map String Type.Canonical
29+ -> [Decl.Valid]
30+ -> Result.Result Warning.Warning Error.Error ()
2731topLevelTypes typeEnv validDecls =
28− do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
29− checkMainType typeEnv validDecls
32+ do maybeMainRegion <- foldM (warnMissingAnnotation typeEnv) Nothing validDecls
33+ maybe (return ()) (checkMainType typeEnv) maybeMainRegion
3034
3135
3236
@@ -34,59 +38,50 @@ topLevelTypes typeEnv validDecls =
3438
3539
3640warnMissingAnnotation
37− :: Map.Map String Type.Canonical
38− -> Decl.Valid
39− -> Result.Result Warning.Warning Error.Error ()
40−warnMissingAnnotation typeEnv (A.A (region,_) decl) =
41+ :: Map.Map String Type.Canonical
42+ -> Maybe R.Region
43+ -> Decl.Valid
44+ -> Result.Result Warning.Warning Error.Error (Maybe R.Region)
45+warnMissingAnnotation typeEnv maybeMainRegion (A.A (region,_) decl) =
4146 case decl of
42− Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
43− Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name))
44−
45− _ ->
46− return ()
47−
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))
4850
51+ return (if name == "main" then Just region else maybeMainRegion)
4952
50−-- MAIN TYPE
51−
53+ _ ->
54+ return maybeMainRegion
5255
53−checkMainType
54− :: Map.Map String Type.Canonical
55− -> [Decl.Valid]
56− -> Result.Result w Error.Error ()
57−checkMainType typeEnv decls =
58− case decls of
59− A.A (region,_) (Decl.Def (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->
60− case Map.lookup "main" typeEnv of
61− Nothing ->
62− return ()
6356
64− Just tipe ->
65− case Type.deepDealias tipe of
66− Type.App (Type.Type name) [_] | name == virtualDomNode ->
67− return ()
6857
69− Type.App (Type.Type name) [_] | name == program ->
70− return ()
58+-- CHECK MAIN TYPE
7159
72− _ ->
73− Result.throw region (Error.BadMain tipe)
7460
75− _ : remainingDecls ->
76− checkMainType typeEnv remainingDecls
61+checkMainType :: Map.Map String Type.Canonical -> R.Region -> Result.Result w Error.Error ()
62+checkMainType 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 ()
7770
78− [] ->
79− return ()
71+ _ ->
72+ Result.throw region (Error.BadMain tipe)
8073
8174
82−virtualDomNode :: Var.Canonical
83−virtualDomNode =
84− Var.fromModule
85− (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
86− "Node"
75+program :: Type.Canonical
76+program =
77+ Type.Type (Var.inCore ["Platform"] "Program")
8778
8879
89−program :: Var.Canonical
90−program =
91− Var.fromModule (ModuleName.inCore ["Platform"]) "Program"
80+vdomNode :: Type.Canonical
81+vdomNode =
82+ let
83+ vdom =
84+ ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"]
85+ in
86+ Type.Type (Var.fromModule vdom "Node")
9287