git.iko.soy/elk
on master help sign in
Simplify code that checks `main` type a little bit
4b1ea5cEvan Czaplicki
src/Nitpick/TopLevelTypes.hs+44−49
compare with master
unifiedsplit
@@ -1,10 +1,10 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Nitpick.TopLevelTypes (topLevelTypes) where
2module Nitpick.TopLevelTypes (topLevelTypes) where
3
3
4+import Control.Monad (foldM, when)
4import Data.Map ((!))
5import Data.Map ((!))
5−import Prelude hiding (maybe)
6−import qualified Data.Foldable as F
7import qualified Data.Map as Map
6import qualified Data.Map as Map
7+import qualified Data.Maybe as Maybe
8
8
9import qualified AST.Expression.Valid as Valid
9import qualified AST.Expression.Valid as Valid
10import qualified AST.Declaration as Decl
10import qualified AST.Declaration as Decl
@@ -15,18 +15,22 @@ import qualified AST.Variable as Var
15import qualified Elm.Package as Pkg
15import qualified Elm.Package as Pkg
16import qualified Reporting.Annotation as A
16import qualified Reporting.Annotation as A
17import qualified Reporting.Error.Type as Error
17import qualified Reporting.Error.Type as Error
18+import qualified Reporting.Region as R
18import qualified Reporting.Result as Result
19import qualified Reporting.Result as Result
19import qualified Reporting.Warning as Warning
20import qualified Reporting.Warning as Warning
20
21
21
22
22
23
24+-- CHECK TOP LEVEL TYPES
25+
26+
23topLevelTypes
27topLevelTypes
24− :: Map.Map String Type.Canonical
28+ :: Map.Map String Type.Canonical
25− -> [Decl.Valid]
29+ -> [Decl.Valid]
26− -> Result.Result Warning.Warning Error.Error ()
30+ -> Result.Result Warning.Warning Error.Error ()
27topLevelTypes typeEnv validDecls =
31topLevelTypes typeEnv validDecls =
28− do F.traverse_ (warnMissingAnnotation typeEnv) validDecls
32+ do maybeMainRegion <- foldM (warnMissingAnnotation typeEnv) Nothing validDecls
29− checkMainType typeEnv validDecls
33+ maybe (return ()) (checkMainType typeEnv) maybeMainRegion
30
34
31
35
32
36
@@ -34,59 +38,50 @@ topLevelTypes typeEnv validDecls =
34
38
35
39
36warnMissingAnnotation
40warnMissingAnnotation
37− :: Map.Map String Type.Canonical
41+ :: Map.Map String Type.Canonical
42+ -> Maybe R.Region
38− -> Decl.Valid
43+ -> Decl.Valid
39− -> Result.Result Warning.Warning Error.Error ()
44+ -> Result.Result Warning.Warning Error.Error (Maybe R.Region)
40−warnMissingAnnotation typeEnv (A.A (region,_) decl) =
45+warnMissingAnnotation typeEnv maybeMainRegion (A.A (region,_) decl) =
41 case decl of
46 case decl of
42− Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->
47+ Decl.Def (Valid.Definition (A.A _ (P.Var name)) _ maybeType) ->
48+ do when (Maybe.isNothing maybeType) $
43− Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name))
49+ Result.warn region (Warning.MissingTypeAnnotation name (typeEnv ! name))
44−
45− _ ->
46− return ()
47−
48
50
51+ return (if name == "main" then Just region else maybeMainRegion)
49
52
50−-- MAIN TYPE
53+ _ ->
51−
54+ return maybeMainRegion
52
55
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 ()
63
56
64− Just tipe ->
65− case Type.deepDealias tipe of
66− Type.App (Type.Type name) [_] | name == virtualDomNode ->
67− return ()
68
57
69− Type.App (Type.Type name) [_] | name == program ->
58+-- CHECK MAIN TYPE
70− return ()
71
59
72− _ ->
73− Result.throw region (Error.BadMain tipe)
74
60
75− _ : remainingDecls ->
61+checkMainType :: Map.Map String Type.Canonical -> R.Region -> Result.Result w Error.Error ()
76− checkMainType typeEnv remainingDecls
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 ()
77
70
78− [] ->
71+ _ ->
79− return ()
72+ Result.throw region (Error.BadMain tipe)
80
73
81
74
82−virtualDomNode :: Var.Canonical
75+program :: Type.Canonical
83−virtualDomNode =
76+program =
84− Var.fromModule
77+ Type.Type (Var.inCore ["Platform"] "Program")
85− (ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"])
86− "Node"
87
78
88
79
89−program :: Var.Canonical
80+vdomNode :: Type.Canonical
90−program =
81+vdomNode =
91− Var.fromModule (ModuleName.inCore ["Platform"]) "Program"
82+ let
83+ vdom =
84+ ModuleName.Canonical (Pkg.Name "evancz" "virtual-dom") ["VirtualDom"]
85+ in
86+ Type.Type (Var.fromModule vdom "Node")
92
87