276ad25 · elk · git.iko.soy

git.iko.soy/elk

Add warnings for top-level values without type annotations

Relevant to #834 Also properly reports region for BadMain

commit276ad2523dd554e39a4efbbac69b6ed54c9751a3 authorEvan Czaplicki <info@elm-lang.org> dateFri 8 May 2015, 10:24 (11 years ago) parent65a825d

6 files changed+126−110

compare with master

unifiedsplit

elm-compiler.cabal+1−1 src/Compile.hs+6−1 src/Nitpick/TopLevelTypes.hs+115 src/Reporting/Warning.hs+2−20 src/Type/ExtraChecks.hs−78 src/Type/Inference.hs+2−10

elm-compiler.cabal+1−1

@@ -76,6 +76,7 @@ Library

7676 Generate.JavaScript.Port,

7777 Generate.JavaScript.Variable,

7878 Generate.Substitute,

79+ Nitpick.TopLevelTypes,

7980 Parse.Binop,

8081 Parse.Declaration,

8182 Parse.Expression,

@@ -99,7 +100,6 @@ Library

99100 Type.Constrain.Literal,

100101 Type.Constrain.Pattern,

101102 Type.Environment,

102− Type.ExtraChecks,

103103 Type.Fragment,

104104 Type.Inference,

105105 Type.PrettyPrint,

src/Compile.hs+6−1

@@ -5,6 +5,7 @@ import qualified Data.Map as Map

55import qualified AST.Module as Module

66import qualified Canonicalize

77import Elm.Utils ((|>))

8+import qualified Nitpick.TopLevelTypes as Nitpick

89import qualified Parse.Helpers as Parse

910import qualified Parse.Parse as Parse

1011import qualified Reporting.Error as Error

@@ -41,7 +42,11 @@ compile user projectName interfaces source =

4142 Result.from Error.Type $

4243 TI.infer interfaces canonicalModule

4344

44− -- Add the real list of tyes

45+ -- One last round of checks

46+ Result.mapError Error.Type $

47+ Nitpick.topLevelTypes types (Module.body validModule)

48+

49+ -- Add the real list of types

4550 let body = (Module.body canonicalModule) { Module.types = types }

4651

4752 return $ canonicalModule { Module.body = body }

src/Nitpick/TopLevelTypes.hsnew file+115

@@ -0,0 +1,115 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Nitpick.TopLevelTypes (topLevelTypes) where

4+import Prelude hiding (maybe)

5+import qualified Data.Foldable as F

6+import qualified Data.Map as Map

8+import qualified AST.Expression.Valid as Valid

9+import qualified AST.Declaration as Decl

10+import qualified AST.Pattern as P

11+import qualified AST.Type as Type

12+import qualified AST.Variable as Var

13+import qualified Reporting.Annotation as A

14+import qualified Reporting.Error.Type as Error

15+import qualified Reporting.Result as Result

16+import qualified Reporting.Warning as Warning

17+

18+

19+topLevelTypes

20+ :: Map.Map String Type.Canonical

21+ -> [Decl.ValidDecl]

22+ -> Result.Result Warning.Warning Error.Error ()

23+topLevelTypes typeEnv validDecls =

24+ do F.traverse_ (warnMissingAnnotation typeEnv) validDecls

25+ checkMainType typeEnv validDecls

26+

27+

28+-- MISSING ANNOTATIONS

29+

30+warnMissingAnnotation

31+ :: Map.Map String Type.Canonical

32+ -> Decl.ValidDecl

33+ -> Result.Result Warning.Warning Error.Error ()

34+warnMissingAnnotation typeEnv (A.A region decl) =

35+ case decl of

36+ Decl.Definition (Valid.Definition (A.A _ (P.Var name)) _ Nothing) ->

37+ case Map.lookup name typeEnv of

38+ Nothing ->

39+ return ()

40+ Just tipe ->

41+ Result.warn region (Warning.MissingTypeAnnotation name tipe)

42+ _ ->

43+ return ()

44+

45+

46+-- MAIN TYPE

47+

48+checkMainType

49+ :: Map.Map String Type.Canonical

50+ -> [Decl.ValidDecl]

51+ -> Result.Result w Error.Error ()

52+checkMainType typeEnv decls =

53+ case decls of

54+ A.A region (Decl.Definition (Valid.Definition (A.A _ (P.Var "main")) _ _)) : _ ->

55+ case Map.lookup "main" typeEnv of

56+ Nothing ->

57+ return ()

58+

59+ Just typeOfMain ->

60+ let tipe = Type.deepDealias typeOfMain

61+ in

62+ if tipe `elem` validMainTypes

63+ then return ()

64+ else Result.throw region (Error.BadMain typeOfMain)

65+

66+ _ : remainingDecls ->

67+ checkMainType typeEnv remainingDecls

68+

69+ [] ->

70+ return ()

71+

72+

73+validMainTypes :: [Type.Canonical]

74+validMainTypes =

75+ [ element

76+ , html

77+ , signal element

78+ , signal html

79+ ]

80+ where

81+ fromModule :: [String] -> String -> Type.Canonical

82+ fromModule home name =

83+ Type.Type (Var.fromModule home name)

84+

85+ html =

86+ fromModule ["VirtualDom"] "Node"

87+

88+ signal tipe =

89+ Type.App (fromModule ["Signal"] "Signal") [ tipe ]

90+

91+ element =

92+ let builtin name =

93+ Type.Type (Var.builtin name)

94+

95+ maybe tipe =

96+ Type.App (fromModule ["Maybe"] "Maybe") [ tipe ]

97+ in

98+ Type.Record

99+ [ ("element", fromModule ["Graphics","Element"] "ElementPrim")

100+ , ("props",

101+ Type.Record

102+ [ ("click" , builtin "_Tuple0")

103+ , ("color" , maybe (fromModule ["Color"] "Color"))

104+ , ("height" , builtin "Int")

105+ , ("hover" , builtin "_Tuple0")

106+ , ("href" , builtin "String")

107+ , ("id" , builtin "Int")

108+ , ("opacity", builtin "Float")

109+ , ("tag" , builtin "String")

110+ , ("width" , builtin "Int")

111+ ]

112+ Nothing

113+ )

114+ ]

115+ Nothing

src/Reporting/Warning.hs+2−20

@@ -1,27 +1,9 @@

11module Reporting.Warning where

33import qualified AST.Module as Module

4−

5−import qualified Reporting.Annotation as A

4+import qualified AST.Type as Type

87data Warning

98 = UnusedImport Module.Name

10− | MissingTypeAnnotation String

11−

12−

13−-- TO STRING

14−

15−toString :: A.Located Warning -> String

16−toString (A.A region warning) =

17− case warning of

18− _ -> error "Warning.toString" region

19−

20−

21−-- TO JSON

22−

23−toJson :: A.Located Warning -> String

24−toJson (A.A region warning) =

25− case warning of

26− _ -> error "Warning.toJson" region

27−

9+ | MissingTypeAnnotation String Type.Canonical

src/Type/ExtraChecks.hsdeleted−78

@@ -1,78 +0,0 @@

1−{-# OPTIONS_GHC -Wall #-}

2−

3−{-| This module contains checks to be run *after* type inference has completed

4−successfully. At that point we still need to ensure that `main` has an

5−acceptable type.

6−-}

7−module Type.ExtraChecks (mainType) where

8−

9−import Prelude hiding (maybe)

10−import Control.Monad.Except (ExceptT, throwError)

11−import qualified Data.Map as Map

12−

13−import qualified AST.Type as ST

14−import qualified AST.Variable as Var

15−

16−

17−-- MAIN TYPE

18−

19−mainType

20− :: (Monad m)

21− => Map.Map String ST.Canonical

22− -> ExceptT ST.Canonical m ()

23−mainType env =

24− case Map.lookup "main" env of

25− Nothing ->

26− return ()

27−

28− Just typeOfMain ->

29− let tipe = ST.deepDealias typeOfMain

30− in

31− if tipe `elem` validMainTypes

32− then return ()

33− else throwError typeOfMain

34−

35−

36−validMainTypes :: [ST.Canonical]

37−validMainTypes =

38− [ element

39− , html

40− , signal element

41− , signal html

42− ]

43− where

44− fromModule :: [String] -> String -> ST.Canonical

45− fromModule home name =

46− ST.Type (Var.fromModule home name)

47−

48− html =

49− fromModule ["VirtualDom"] "Node"

50−

51− signal tipe =

52− ST.App (fromModule ["Signal"] "Signal") [ tipe ]

53−

54− element =

55− let builtin name =

56− ST.Type (Var.builtin name)

57−

58− maybe tipe =

59− ST.App (fromModule ["Maybe"] "Maybe") [ tipe ]

60− in

61− ST.Record

62− [ ("element", fromModule ["Graphics","Element"] "ElementPrim")

63− , ("props",

64− ST.Record

65− [ ("click" , builtin "_Tuple0")

66− , ("color" , maybe (fromModule ["Color"] "Color"))

67− , ("height" , builtin "Int")

68− , ("hover" , builtin "_Tuple0")

69− , ("href" , builtin "String")

70− , ("id" , builtin "Int")

71− , ("opacity", builtin "Float")

72− , ("tag" , builtin "String")

73− , ("width" , builtin "Int")

74− ]

75− Nothing

76− )

77− ]

78− Nothing

src/Type/Inference.hs+2−10

@@ -1,7 +1,7 @@

11module Type.Inference where

33import Control.Arrow (first, second)

4−import Control.Monad.Except (Except, forM, liftIO, runExceptT, throwError, withExceptT)

4+import Control.Monad.Except (Except, forM, liftIO, runExceptT, throwError)

55import qualified Data.Map as Map

66import qualified Data.Traversable as Traverse

@@ -12,7 +12,6 @@ import qualified Reporting.Annotation as A

1212import qualified Reporting.Error.Type as Error

1313import qualified Type.Constrain.Expression as TcExpr

1414import qualified Type.Environment as Env

15−import qualified Type.ExtraChecks as Check

1615import qualified Type.Solve as Solve

1716import qualified Type.State as TS

1817import qualified Type.Type as T

@@ -36,14 +35,7 @@ infer interfaces modul =

3635 let header' = Map.delete "::" header

3736 let types = Map.difference (TS.sSavedEnv state) header'

3837

39− srcTypes <-

40− liftIO (Traverse.traverse T.toSrcType types)

41−

42− withExceptT

43− (\tipe -> [A.A (error "TODO:infer") (Error.BadMain tipe)])

44− (Check.mainType srcTypes)

45−

46− return srcTypes

38+ liftIO (Traverse.traverse T.toSrcType types)

4739

4840

4941genConstraints