24caf2a · elk · git.iko.soy

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

compare with master

unifiedsplit

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

16 , Alias(..)

17 , Union(..)

18 , Binop(..)

19− , Effects(..)

19+ , Docs(..)

20− , Port(..)

21 , Exports(..)

20 , Exports(..)

22 , Export(..)

21 , Export(..)

23− , Docs(..)

22+ , Effects(..)

23+ , Port(..)

24+ , Manager(..)

24 )

25 )

25 where

26 where

26

27

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

38import qualified Elm.Name as N

39import qualified Elm.Name as N

39import Elm.Name (Name)

40import Elm.Name (Name)

40import qualified Reporting.Annotation as A

41import qualified Reporting.Annotation as A

42+import qualified Reporting.Region as R

41

43

42

44

43

45

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

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

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

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

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

159

161

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

166

162

167

163

164+-- DOCS

165+

166+

168−data Port

167+data Docs =

169− = Incoming Type.Canonical

168+ Docs

170− | Outgoing Type.Canonical

169+ { _overview :: B.ByteString

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

171+ }

172+

173+

174+

175+-- EXPORTS

171

176

172

177

173data Exports

178data Exports

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

185

190

186

191

187

192

188−-- DOCS

193+-- EFFECTS

189

194

190

195

191−data Docs =

196+data Effects

192− Docs

197+ = NoEffects

193− { _overview :: B.ByteString

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

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

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

195− }

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

196

211

197

212

198

213

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

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

129data Effects

130 = NoEffects

131 | Ports R.Region

132− | Effects R.Region Manager

132+ | Manager R.Region Manager

133

134

135data Manager

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

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

9 , Binop(..)

10 , Effects(..)

11 , Port(..)

12+ , Manager(..)

12 )

13 )

13 where

14 where

14

15

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

91data Effects

92data Effects

92 = NoEffects

93 = NoEffects

93 | Ports [Port]

94 | Ports [Port]

95+ | Manager R.Region Manager

96+

97+

98+data Manager

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

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

95 | Sub (A.Located N.Name)

100 | Sub (A.Located N.Name)

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

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

97

102

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

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

3module AST.Module.Name

4 ( Canonical(..)

5 , basics, maybe, list, array

6+ , platform, cmd, sub

6 , jsonDecode, jsonEncode

7 , jsonDecode, jsonEncode

7− , cmd, sub

8 , canonicalToText

9 , isKernel, getKernel, canonicalIsKernel

10 )

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

12

13

14import Prelude hiding (maybe)

15+import Control.Monad (liftM2)

15import Data.Binary

16import Data.Binary

16import qualified Data.Text as Text

17import qualified Data.Text as Text

17import Data.Text (Text)

18import Data.Text (Text)

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

36-- HELPERS

37-- HELPERS

37

38

39

40+{-# NOINLINE basics #-}

39basics :: Canonical

41basics :: Canonical

40−basics =

41− Canonical Pkg.core "Basics"

42+basics = Canonical Pkg.core "Basics"

42

43

44

45+{-# NOINLINE maybe #-}

44maybe :: Canonical

46maybe :: Canonical

45−maybe =

46− Canonical Pkg.core "Maybe"

47+maybe = Canonical Pkg.core "Maybe"

47

48

49

50+{-# NOINLINE list #-}

49list :: Canonical

51list :: Canonical

50−list =

51− Canonical Pkg.core "List"

52+list = Canonical Pkg.core "List"

52

53

54

55+{-# NOINLINE array #-}

54array :: Canonical

56array :: Canonical

55−array =

56− Canonical Pkg.core "Array"

57+array = Canonical Pkg.core "Array"

57

58

59

59−jsonDecode :: Canonical

60+{-# NOINLINE platform #-}

60−jsonDecode =

61− Canonical Pkg.core "Json.Decode"

62−

63−

64−jsonEncode :: Canonical

61+platform :: Canonical

65−jsonEncode =

66− Canonical Pkg.core "Json.Encode"

62+platform = Canonical Pkg.core "Platform"

67

63

68

64

65+{-# NOINLINE cmd #-}

69cmd :: Canonical

66cmd :: Canonical

70−cmd =

71− Canonical Pkg.core "Platform.Cmd"

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

72

68

73

69

70+{-# NOINLINE sub #-}

74sub :: Canonical

71sub :: 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"

77

83

78

84

79

85

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

113 put a >> put b

119 put a >> put b

114

120

115 get =

121 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

20import qualified Elm.Name as N

21import qualified Reporting.Annotation as A

22import qualified Reporting.Error.Canonicalize as Error

23+import qualified Reporting.Region as R

23import qualified Reporting.Result as Result

24import qualified Reporting.Result as Result

24import qualified Reporting.Warning as Warning

25import qualified Reporting.Warning as Warning

25

26

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

36-- CANONICALIZE

37-- CANONICALIZE

37

38

39

40+canonicalize

41+ :: Env.Env

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

43+ -> Map.Map N.Name union

44+ -> Valid.Effects

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

45+ -> Result Can.Effects

40−canonicalize env unions effects =

46+canonicalize env decls unions effects =

41 case effects of

47 case effects of

42 Valid.NoEffects ->

48 Valid.NoEffects ->

43 Result.ok Can.NoEffects

49 Result.ok Can.NoEffects

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

46 do pairs <- traverse (canonicalizePort env) ports

52 do pairs <- traverse (canonicalizePort env) ports

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

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

48

54

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

49− Valid.Cmd cmdType ->

63+ Valid.Cmd cmdType ->

50− Can.Cmd <$> verifyEffectType cmdType unions

64+ Can.Cmd <$> verifyEffectType cmdType unions

51

65

52− Valid.Sub subType ->

66+ Valid.Sub subType ->

53− Can.Sub <$> verifyEffectType subType unions

67+ Can.Sub <$> verifyEffectType subType unions

54

68

55− Valid.Fx cmdType subType ->

69+ Valid.Fx cmdType subType ->

56− Can.Fx

70+ Can.Fx

57− <$> verifyEffectType cmdType unions

71+ <$> verifyEffectType cmdType unions

58− <*> verifyEffectType subType unions

72+ <*> verifyEffectType subType unions

59

73

60

74

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

75+

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

76+-- CANONICALIZE PORT

63− if Map.member name unions then

64− Result.ok name

65− else

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

67

77

68

78

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

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

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

93

103

94

104

95

105

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+

96-- CHECK PAYLOAD TYPES

133-- CHECK PAYLOAD TYPES

97

134

98

135

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

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

157 Valid.Ports ports ->

158 map portToInfo ports

159

160+ Valid.Manager _ manager ->

161+ case manager of

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

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

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

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

162−

164+

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

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

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

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

165−

167+

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

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

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

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

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

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

169− ]

171+ ]

170

172

171 toError name () () =

173 toError name () () =

172 Error.DuplicateDecl name

174 Error.DuplicateDecl name

src/Canonicalize/Module.hs+4−10

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

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

59

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

61− ceffects <- Effects.canonicalize env cunions effects

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

62 cexports <- canonicalizeExports decls cunions caliases cbinops ceffects exports

63

64 let home = ModuleName.Canonical pkg name

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

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

239

240

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

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

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

243− (name, Can.ExportValue)

243+ ( name, () )

244

245

246checkExposed

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

300 Can.Ports ports ->

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

302

303− Can.Cmd _ ->

303+ Can.Manager _ _ _ _ ->

304− Just []

305−

306− Can.Sub _ ->

307− Just []

308−

309− Can.Fx _ _ ->

310 Just []

304 Just []

src/Elm/Name.hs+23

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

5 , toString

6 , int, float, bool, char, string

7 , maybe, list, array

8+ , task, router, cmd, sub

8 )

9 )

9 where

10 where

10

11

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

63{-# NOINLINE array #-}

64{-# NOINLINE array #-}

64array :: Name

65array :: Name

65array = "Array"

66array = "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 =

85 name <- Var.moduleName

86 P.spaces

87 manager <- chompManager

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

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

89 ]

90

91

src/Validate.hs+9−8

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

299 Src.Ports _ ->

300 return (Valid.Ports ports)

301

302− Src.Effects _ manager ->

302+ Src.Manager region manager ->

303 do noPorts ports

304+ return $ Valid.Manager region $

304− case manager of

305+ case manager of

305− Src.Cmd cmd ->

306+ Src.Cmd cmd ->

306− return (Valid.Cmd cmd)

307+ Valid.Cmd cmd

307

308

308− Src.Sub sub ->

309+ Src.Sub sub ->

309− return (Valid.Sub sub)

310+ Valid.Sub sub

310

311

311− Src.Fx cmd sub ->

312+ Src.Fx cmd sub ->

312− return (Valid.Fx cmd sub)

313+ Valid.Fx cmd sub

313

314

315

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

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