Skip to content

Commit 40f96ca

Browse files
robinheghanrobinheghan
committed
Parse effect modules
1 parent b19f061 commit 40f96ca

2 files changed

Lines changed: 180 additions & 9 deletions

File tree

‎src/Compiler/Parse/Module.gren‎

Lines changed: 95 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ spaceParser =
6565
parser : Parser Context Error AST.Module
6666
parser =
6767
Parser.succeed
68-
(\name exports docs imports binops decls ->
68+
(\{ name, effects } exports docs imports binops decls ->
6969
let
7070
values =
7171
Array.mapAndKeepJust declarationToModuleValue decls
@@ -90,23 +90,39 @@ parser =
9090
, effects =
9191
when ports is
9292
[] ->
93-
AST.NoEffects
93+
-- TODO: support both ports and effects
94+
-- currently, only kernel devs can define effects
95+
-- so don't worry about it for now
96+
effects
9497

9598
_ ->
9699
AST.Ports ports
97100
}
98101
)
99-
|> Parser.skip
102+
|> Parser.keep
100103
(Parser.oneOf
101-
[ Parser.succeed {}
102-
|> Parser.skip (Parser.token "port" (ExpectedKeyword "port"))
104+
[ Parser.succeed (\name effects -> { name = name, effects = AST.Manager effects })
105+
|> Parser.skip (Parser.token "effect" (ExpectedKeyword "effect"))
106+
|> Parser.skip spaceParser
107+
|> Parser.skip (Parser.token "module" (ExpectedKeyword "module"))
108+
|> Parser.skip spaceParser
109+
|> Parser.keep moduleNameParser
110+
|> Parser.skip spaceParser
111+
|> Parser.keep effectParser
112+
, Parser.succeed (\name -> { name = name, effects = AST.NoEffects })
113+
|> Parser.skip
114+
(Parser.oneOf
115+
[ Parser.succeed {}
116+
|> Parser.skip (Parser.token "port" (ExpectedKeyword "port"))
117+
|> Parser.skip spaceParser
118+
, Parser.succeed {}
119+
]
120+
)
121+
|> Parser.skip (Parser.token "module" (ExpectedKeyword "module"))
103122
|> Parser.skip spaceParser
104-
, Parser.succeed {}
123+
|> Parser.keep moduleNameParser
105124
]
106125
)
107-
|> Parser.skip (Parser.token "module" (ExpectedKeyword "module"))
108-
|> Parser.skip spaceParser
109-
|> Parser.keep moduleNameParser
110126
|> Parser.skip spaceParser
111127
|> Parser.keep parseExposingStatement
112128
|> Parser.skip spaceParser
@@ -128,6 +144,76 @@ moduleNameParser =
128144
)
129145

130146

147+
effectParser : Parser Context Error AST.Manager
148+
effectParser =
149+
Parser.succeed identity
150+
|> Parser.skip (Parser.token "where" (ExpectedKeyword "where"))
151+
|> Parser.skip spaceParser
152+
|> Parser.skip (Parser.chompChar '{' (ExpectedChar '{'))
153+
|> Parser.skip spaceParser
154+
|> Parser.keep
155+
(Parser.oneOf
156+
[ Parser.succeed
157+
(\cmd maybeSub ->
158+
when maybeSub is
159+
Just sub ->
160+
AST.Fx { cmd = cmd, sub = sub }
161+
162+
Nothing ->
163+
AST.Cmd cmd
164+
)
165+
|> Parser.keep (cmdSubParser "command")
166+
|> Parser.skip spaceParser
167+
|> Parser.keep
168+
(Parser.oneOf
169+
[ Parser.succeed Just
170+
|> Parser.skip (Parser.chompChar ',' (ExpectedChar ','))
171+
|> Parser.skip spaceParser
172+
|> Parser.keep (cmdSubParser "subscription")
173+
, Parser.succeed Nothing
174+
]
175+
)
176+
, Parser.succeed
177+
(\sub maybeCmd ->
178+
when maybeCmd is
179+
Just cmd ->
180+
AST.Fx { cmd = cmd, sub = sub }
181+
182+
Nothing ->
183+
AST.Sub sub
184+
)
185+
|> Parser.keep (cmdSubParser "subscription")
186+
|> Parser.skip spaceParser
187+
|> Parser.keep
188+
(Parser.oneOf
189+
[ Parser.succeed Just
190+
|> Parser.skip (Parser.chompChar ',' (ExpectedChar ','))
191+
|> Parser.skip spaceParser
192+
|> Parser.keep (cmdSubParser "command")
193+
, Parser.succeed Nothing
194+
]
195+
)
196+
]
197+
)
198+
|> Parser.skip spaceParser
199+
|> Parser.skip (Parser.chompChar '}' (ExpectedChar '}'))
200+
201+
202+
cmdSubParser : String -> Parser Context Error (SourcePosition.Located String)
203+
cmdSubParser fieldName =
204+
Parser.succeed identity
205+
|> Parser.skip (Parser.token fieldName (ExpectedKeyword fieldName))
206+
|> Parser.skip spaceParser
207+
|> Parser.skip (Parser.chompChar '=' (ExpectedChar '='))
208+
|> Parser.skip spaceParser
209+
|> Parser.keep ctorNameParser
210+
211+
212+
ctorNameParser : Parser Context Error (SourcePosition.Located String)
213+
ctorNameParser =
214+
SourcePosition.parser (Parser.mapError VariableError Variable.upperCase)
215+
216+
131217
parseExposingStatement : Parser Context Error AST.Exposing
132218
parseExposingStatement =
133219
Parser.succeed identity

‎tests/src/Test/Compiler/Parse/Module.gren‎

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,91 @@ tests =
101101
, binops = []
102102
, effects = AST.NoEffects
103103
}
104+
, test "effect module with defined cmd" <| \_ ->
105+
Parser.run PM.parser Context.empty
106+
"""
107+
effect module CmdModule where { command = MyCmd } exposing (..)
108+
"""
109+
|> expect
110+
{ name =
111+
SourcePosition.at
112+
{ row = 1, col = 15 }
113+
{ row = 1, col = 24 }
114+
"CmdModule"
115+
, exports = AST.Open
116+
, docs = Nothing
117+
, imports = []
118+
, values = []
119+
, unions = []
120+
, aliases = []
121+
, binops = []
122+
, effects =
123+
SourcePosition.at
124+
{ row = 1, col = 43 }
125+
{ row = 1, col = 48 }
126+
"MyCmd"
127+
|> AST.Cmd
128+
|> AST.Manager
129+
}
130+
, test "effect module with defined sub" <| \_ ->
131+
Parser.run PM.parser Context.empty
132+
"""
133+
effect module SubModule where { subscription = MySub } exposing (..)
134+
"""
135+
|> expect
136+
{ name =
137+
SourcePosition.at
138+
{ row = 1, col = 15 }
139+
{ row = 1, col = 24 }
140+
"SubModule"
141+
, exports = AST.Open
142+
, docs = Nothing
143+
, imports = []
144+
, values = []
145+
, unions = []
146+
, aliases = []
147+
, binops = []
148+
, effects =
149+
SourcePosition.at
150+
{ row = 1, col = 48 }
151+
{ row = 1, col = 53 }
152+
"MySub"
153+
|> AST.Sub
154+
|> AST.Manager
155+
}
156+
, test "effect module with defined fx" <| \_ ->
157+
Parser.run PM.parser Context.empty
158+
"""
159+
effect module FxModule where { command = MyCmd, subscription = MySub } exposing (..)
160+
"""
161+
|> expect
162+
{ name =
163+
SourcePosition.at
164+
{ row = 1, col = 15 }
165+
{ row = 1, col = 23 }
166+
"FxModule"
167+
, exports = AST.Open
168+
, docs = Nothing
169+
, imports = []
170+
, values = []
171+
, unions = []
172+
, aliases = []
173+
, binops = []
174+
, effects =
175+
{ cmd =
176+
SourcePosition.at
177+
{ row = 1, col = 42 }
178+
{ row = 1, col = 47 }
179+
"MyCmd"
180+
, sub =
181+
SourcePosition.at
182+
{ row = 1, col = 64 }
183+
{ row = 1, col = 69 }
184+
"MySub"
185+
}
186+
|> AST.Fx
187+
|> AST.Manager
188+
}
104189
, test "Docs" <| \_ ->
105190
Parser.run PM.parser Context.empty
106191
"""

0 commit comments

Comments
 (0)