24caf2a · elk · git.iko.soy

git.iko.soy/elk

Verify that init/onEffects/onSelfMsg exist in canonicalization

commit24caf2aaa981b8dc1263f49829b46a4b80bda5d5 authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 2 Nov 2017, 15:34 (9 years ago) parent25ea6b6

10 files changed+170−87

compare with master

unifiedsplit

src/AST/Expression/Canonical.hs+33−18 src/AST/Expression/Source.hs+1−1 src/AST/Expression/Valid.hs+6−1 src/AST/Module/Name.hs+28−22 src/Canonicalize/Effects.hs+53−16 src/Canonicalize/Environment/Local.hs+12−10 src/Canonicalize/Module.hs+4−10 src/Elm/Name.hs+23 src/Parse/Module.hs+1−1 src/Validate.hs+9−8

src/AST/Expression/Canonical.hs+33−18

@@ -16,11 +16,12 @@ module AST.Expression.Canonical

1616 , Alias(..)

1717 , Union(..)

1818 , Binop(..)

19− , Effects(..)

20− , Port(..)

19+ , Docs(..)

2120 , Exports(..)

2221 , Export(..)

23− , Docs(..)

22+ , Effects(..)

23+ , Port(..)

24+ , Manager(..)

2425 )

2526 where

2627

@@ -38,6 +39,7 @@ import qualified AST.Type as Type

3839import qualified Elm.Name as N

3940import Elm.Name (Name)

4041import qualified Reporting.Annotation as A

42+import qualified Reporting.Region as R

4143

4244

4345

@@ -157,17 +159,20 @@ data Alias = Alias [N.Name] Type.Canonical (Maybe [N.Name])

157159data Union = Union [N.Name] [(N.Name, [Type.Canonical])]

158160data Binop = Binop_ Binop.Associativity Binop.Precedence N.Name

159161

160−data Effects

161− = NoEffects

162− | Ports (Map.Map N.Name Port)

163− | Cmd N.Name

164− | Sub N.Name

165− | Fx N.Name N.Name

166162

167163

168−data Port

169− = Incoming Type.Canonical

170− | Outgoing Type.Canonical

164+-- DOCS

165+

166+

167+data Docs =

168+ Docs

169+ { _overview :: B.ByteString

170+ , _comments :: Map.Map N.Name Text

171+ }

172+

173+

174+

175+-- EXPORTS

171176

172177

173178data Exports

@@ -185,14 +190,24 @@ data Export

185190

186191

187192

188−-- DOCS

193+-- EFFECTS

189194

190195

191−data Docs =

192− Docs

193− { _overview :: B.ByteString

194− , _comments :: Map.Map N.Name Text

195− }

196+data Effects

197+ = NoEffects

198+ | Ports (Map.Map N.Name Port)

199+ | Manager R.Region R.Region R.Region Manager

200+

201+

202+data Port

203+ = Incoming Type.Canonical

204+ | Outgoing Type.Canonical

205+

206+

207+data Manager

208+ = Cmd N.Name

209+ | Sub N.Name

210+ | Fx N.Name N.Name

196211

197212

198213

src/AST/Expression/Source.hs+1−1

@@ -129,7 +129,7 @@ data Import =

129129data Effects

130130 = NoEffects

131131 | Ports R.Region

132− | Effects R.Region Manager

132+ | Manager R.Region Manager

133133

134134

135135data Manager

src/AST/Expression/Valid.hs+6−1

@@ -9,6 +9,7 @@ module AST.Expression.Valid

99 , Binop(..)

1010 , Effects(..)

1111 , Port(..)

12+ , Manager(..)

1213 )

1314 where

1415

@@ -91,7 +92,11 @@ data Binop = Binop (A.Located N.Name) Binop.Associativity Binop.Precedence N.Nam

9192data Effects

9293 = NoEffects

9394 | Ports [Port]

94− | Cmd (A.Located N.Name)

95+ | Manager R.Region Manager

96+

97+

98+data Manager

99+ = Cmd (A.Located N.Name)

95100 | Sub (A.Located N.Name)

96101 | Fx (A.Located N.Name) (A.Located N.Name)

97102

src/AST/Module/Name.hs+28−22

@@ -3,8 +3,8 @@

33module AST.Module.Name

44 ( Canonical(..)

55 , basics, maybe, list, array

6+ , platform, cmd, sub

67 , jsonDecode, jsonEncode

7− , cmd, sub

88 , canonicalToText

99 , isKernel, getKernel, canonicalIsKernel

1010 )

@@ -12,6 +12,7 @@ module AST.Module.Name

1212

1313

1414import Prelude hiding (maybe)

15+import Control.Monad (liftM2)

1516import Data.Binary

1617import qualified Data.Text as Text

1718import Data.Text (Text)

@@ -36,44 +37,49 @@ data Canonical =

3637-- HELPERS

3738

3839

40+{-# NOINLINE basics #-}

3941basics :: Canonical

40−basics =

41− Canonical Pkg.core "Basics"

42+basics = Canonical Pkg.core "Basics"

4243

4344

45+{-# NOINLINE maybe #-}

4446maybe :: Canonical

45−maybe =

46− Canonical Pkg.core "Maybe"

47+maybe = Canonical Pkg.core "Maybe"

4748

4849

50+{-# NOINLINE list #-}

4951list :: Canonical

50−list =

51− Canonical Pkg.core "List"

52+list = Canonical Pkg.core "List"

5253

5354

55+{-# NOINLINE array #-}

5456array :: Canonical

55−array =

56− Canonical Pkg.core "Array"

57+array = Canonical Pkg.core "Array"

5758

5859

59−jsonDecode :: Canonical

60−jsonDecode =

61− Canonical Pkg.core "Json.Decode"

62−

63−

64−jsonEncode :: Canonical

65−jsonEncode =

66− Canonical Pkg.core "Json.Encode"

60+{-# NOINLINE platform #-}

61+platform :: Canonical

62+platform = Canonical Pkg.core "Platform"

6763

6864

65+{-# NOINLINE cmd #-}

6966cmd :: Canonical

70−cmd =

71− Canonical Pkg.core "Platform.Cmd"

67+cmd = Canonical Pkg.core "Platform.Cmd"

7268

7369

70+{-# NOINLINE sub #-}

7471sub :: Canonical

75−sub =

76− Canonical Pkg.core "Platform.Sub"

72+sub = Canonical Pkg.core "Platform.Sub"

73+

74+

75+{-# NOINLINE jsonDecode #-}

76+jsonDecode :: Canonical

77+jsonDecode = Canonical Pkg.core "Json.Decode"

78+

79+

80+{-# NOINLINE jsonEncode #-}

81+jsonEncode :: Canonical

82+jsonEncode = Canonical Pkg.core "Json.Encode"

7783

7884

7985

@@ -113,4 +119,4 @@ instance Binary Canonical where

113119 put a >> put b

114120

115121 get =

116− Canonical <$> get <*> get

122+ liftM2 Canonical get get

src/Canonicalize/Effects.hs+53−16

@@ -20,6 +20,7 @@ import qualified Canonicalize.Type as Type

2020import qualified Elm.Name as N

2121import qualified Reporting.Annotation as A

2222import qualified Reporting.Error.Canonicalize as Error

23+import qualified Reporting.Region as R

2324import qualified Reporting.Result as Result

2425import qualified Reporting.Warning as Warning

2526

@@ -36,8 +37,13 @@ type Result a =

3637-- CANONICALIZE

3738

3839

39−canonicalize :: Env.Env -> Map.Map N.Name a -> Valid.Effects -> Result Can.Effects

40−canonicalize env unions effects =

40+canonicalize

41+ :: Env.Env

42+ -> [A.Located Valid.Decl]

43+ -> Map.Map N.Name union

44+ -> Valid.Effects

45+ -> Result Can.Effects

46+canonicalize env decls unions effects =

4147 case effects of

4248 Valid.NoEffects ->

4349 Result.ok Can.NoEffects

@@ -46,24 +52,28 @@ canonicalize env unions effects =

4652 do pairs <- traverse (canonicalizePort env) ports

4753 return $ Can.Ports (Map.fromList pairs)

4854

49− Valid.Cmd cmdType ->

50− Can.Cmd <$> verifyEffectType cmdType unions

55+ Valid.Manager region manager ->

56+ let dict = Map.fromList (map toNameRegion decls) in

57+ Can.Manager

58+ <$> verifyManager region dict "init"

59+ <*> verifyManager region dict "onEffects"

60+ <*> verifyManager region dict "onSelfMsg"

61+ <*>

62+ case manager of

63+ Valid.Cmd cmdType ->

64+ Can.Cmd <$> verifyEffectType cmdType unions

5165

52− Valid.Sub subType ->

53− Can.Sub <$> verifyEffectType subType unions

66+ Valid.Sub subType ->

67+ Can.Sub <$> verifyEffectType subType unions

5468

55− Valid.Fx cmdType subType ->

56− Can.Fx

57− <$> verifyEffectType cmdType unions

58− <*> verifyEffectType subType unions

69+ Valid.Fx cmdType subType ->

70+ Can.Fx

71+ <$> verifyEffectType cmdType unions

72+ <*> verifyEffectType subType unions

5973

6074

61−verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name

62−verifyEffectType (A.A region name) unions =

63− if Map.member name unions then

64− Result.ok name

65− else

66− Result.throw region (Error.EffectNotFound name)

75+

76+-- CANONICALIZE PORT

6777

6878

6979canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)

@@ -93,6 +103,33 @@ canonicalizePort env (Valid.Port (A.A region portName) tipe) =

93103

94104

95105

106+-- VERIFY MANAGER

107+

108+

109+verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name

110+verifyEffectType (A.A region name) unions =

111+ if Map.member name unions then

112+ Result.ok name

113+ else

114+ Result.throw region (Error.EffectNotFound name)

115+

116+

117+toNameRegion :: A.Located Valid.Decl -> (N.Name, R.Region)

118+toNameRegion (A.A _ (Valid.Decl (A.A region name) _ _ _)) =

119+ (name, region)

120+

121+

122+verifyManager :: R.Region -> Map.Map N.Name R.Region -> N.Name -> Result R.Region

123+verifyManager tagRegion decls name =

124+ case Map.lookup name decls of

125+ Just region ->

126+ Result.ok region

127+

128+ Nothing ->

129+ Result.throw tagRegion (Error.EffectFunctionNotFound name)

130+

131+

132+

96133-- CHECK PAYLOAD TYPES

97134

98135

src/Canonicalize/Environment/Local.hs+12−10

@@ -157,16 +157,18 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

157157 Valid.Ports ports ->

158158 map portToInfo ports

159159

160− Valid.Cmd (A.A region _) ->

161− [ Dups.info "command" region () () ]

162−

163− Valid.Sub (A.A region _) ->

164− [ Dups.info "subscription" region () () ]

165−

166− Valid.Fx (A.A regionCmd _) (A.A regionSub _) ->

167− [ Dups.info "command" regionCmd () ()

168− , Dups.info "subscription" regionSub () ()

169− ]

160+ Valid.Manager _ manager ->

161+ case manager of

162+ Valid.Cmd (A.A region _) ->

163+ [ Dups.info "command" region () () ]

164+

165+ Valid.Sub (A.A region _) ->

166+ [ Dups.info "subscription" region () () ]

167+

168+ Valid.Fx (A.A regionCmd _) (A.A regionSub _) ->

169+ [ Dups.info "command" regionCmd () ()

170+ , Dups.info "subscription" regionSub () ()

171+ ]

170172

171173 toError name () () =

172174 Error.DuplicateDecl name

src/Canonicalize/Module.hs+4−10

@@ -58,7 +58,7 @@ canonicalize pkg importDict interfaces module_ =

5858 <*> (Map.fromList <$> traverse (canonicalizeAlias env) aliases)

5959

6060 let cbinops = Map.fromList (map canonicalizeBinop binops)

61− ceffects <- Effects.canonicalize env cunions effects

61+ ceffects <- Effects.canonicalize env decls cunions effects

6262 cexports <- canonicalizeExports decls cunions caliases cbinops ceffects exports

6363

6464 let home = ModuleName.Canonical pkg name

@@ -238,9 +238,9 @@ canonicalizeExports decls unions aliases binops effects exposing =

238238 Can.Export <$> Dups.detect toError infos

239239

240240

241−declToName :: A.Located Valid.Decl -> (N.Name, Can.Export)

241+declToName :: A.Located Valid.Decl -> ( N.Name, () )

242242declToName (A.A _ (Valid.Decl (A.A _ name) _ _ _)) =

243− (name, Can.ExportValue)

243+ ( name, () )

244244

245245

246246checkExposed

@@ -300,11 +300,5 @@ checkPorts effects name =

300300 Can.Ports ports ->

301301 if Map.member name ports then Nothing else Just (Map.keys ports)

302302

303− Can.Cmd _ ->

304− Just []

305−

306− Can.Sub _ ->

307− Just []

308−

309− Can.Fx _ _ ->

303+ Can.Manager _ _ _ _ ->

310304 Just []

src/Elm/Name.hs+23

@@ -5,6 +5,7 @@ module Elm.Name

55 , toString

66 , int, float, bool, char, string

77 , maybe, list, array

8+ , task, router, cmd, sub

89 )

910 where

1011

@@ -63,3 +64,25 @@ list = "List"

6364{-# NOINLINE array #-}

6465array :: Name

6566array = "Array"

67+

68+

69+{-# NOINLINE task #-}

70+task :: Name

71+task = "Task"

72+

73+

74+{-# NOINLINE router #-}

75+router :: Name

76+router = "Router"

77+

78+

79+{-# NOINLINE cmd #-}

80+cmd :: Name

81+cmd = "Cmd"

82+

83+

84+{-# NOINLINE sub #-}

85+sub :: Name

86+sub = "Sub"

87+

88+

src/Parse/Module.hs+1−1

@@ -85,7 +85,7 @@ chompNameAndEffects =

8585 name <- Var.moduleName

8686 P.spaces

8787 manager <- chompManager

88− return ( name, Src.Effects (R.Region start end) manager )

88+ return ( name, Src.Manager (R.Region start end) manager )

8989 ]

9090

9191

src/Validate.hs+9−8

@@ -299,17 +299,18 @@ validateEffects effects ports =

299299 Src.Ports _ ->

300300 return (Valid.Ports ports)

301301

302− Src.Effects _ manager ->

302+ Src.Manager region manager ->

303303 do noPorts ports

304− case manager of

305− Src.Cmd cmd ->

306− return (Valid.Cmd cmd)

304+ return $ Valid.Manager region $

305+ case manager of

306+ Src.Cmd cmd ->

307+ Valid.Cmd cmd

307308

308− Src.Sub sub ->

309− return (Valid.Sub sub)

309+ Src.Sub sub ->

310+ Valid.Sub sub

310311

311− Src.Fx cmd sub ->

312− return (Valid.Fx cmd sub)

312+ Src.Fx cmd sub ->

313+ Valid.Fx cmd sub

313314

314315

315316noPorts :: [Valid.Port] -> Result w ()