087045f · elk · git.iko.soy

git.iko.soy/elk

Update the parser code for AST changes

For example, generate Src.Call instead of a chain of Src.App

commit087045f407b663dc681bf7046adb57e0a9bf15cd authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 25 Oct 2017, 19:12 (9 years ago) parent903977a

9 files changed+319−307

compare with master

unifiedsplit

src/Parse/Declaration.hs+65−63 src/Parse/Expression.hs+57−52 src/Parse/Kernel.hs+8−5 src/Parse/Literal.hs+1−1 src/Parse/Module.hs+141−132 src/Parse/Parse.hs+26−32 src/Parse/Primitives/Keyword.hs+10−18 src/Parse/Primitives/Symbol.hs+7−1 src/Parse/Type.hs+4−3

src/Parse/Declaration.hs+65−63

@@ -1,13 +1,19 @@

11{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Declaration where

3+module Parse.Declaration

4+ ( declaration

5+ )

6+ where

59import Data.Text (Text)

610import qualified Data.Text.Encoding as Text

711

8−import qualified AST.Declaration as Decl

12+import qualified AST.Expression.Source as Src

13+import qualified AST.Pattern as Pattern

914import qualified AST.Type as Type

1015import qualified Parse.Expression as Expr

16+import qualified Parse.Pattern as Pattern

1117import Parse.Primitives

1218import qualified Parse.Primitives.Keyword as Keyword

1319import qualified Parse.Primitives.Symbol as Symbol

@@ -23,16 +29,15 @@ import qualified Reporting.Region as R

2329-- DECLARATION

2430

2531

26−declaration :: SParser Decl.Source

32+declaration :: SParser Src.Decl

2733declaration =

2834 hint E.Decl $

2935 do start <- getPosition

3036 oneOf

31− [ docDecl start

32− , typeDecl start

33− , infixDecl start

34− , portDecl start

35− , defDecl start

37+ [ doc_ start

38+ , type_ start

39+ , port_ start

40+ , def_ start

3641 ]

3742

3843

@@ -40,30 +45,58 @@ declaration =

4045-- DOC COMMENTS

4146

4247

43−docDecl :: R.Position -> SParser Decl.Source

44−docDecl start =

48+{-# INLINE doc_ #-}

49+doc_ :: R.Position -> SParser Src.Decl

50+doc_ start =

4551 do doc <- W.docComment

4652 end <- getPosition

4753 pos <- W.whitespace

48− return ( Decl.Comment (A.at start end (Text.decodeUtf8 doc)), end, pos )

54+ return ( A.at start end (Src.Docs (Text.decodeUtf8 doc)), end, pos )

55+

4956

5057

51−-- TYPE ANNOTATIONS and DEFINITIONS

58+-- DEFINITION and ANNOTATION

5259

5360

54−defDecl :: R.Position -> SParser Decl.Source

55−defDecl start =

56− do (def, end, pos) <- Expr.definition

57− let decl = A.at start end (Decl.Def def)

58− return ( Decl.Whatever decl, end, pos )

61+{-# INLINE def_ #-}

62+def_ :: R.Position -> SParser Src.Decl

63+def_ start =

64+ do name <- Var.lower

65+ nameEnd <- getPosition

66+ let locatedName = A.at start nameEnd name

67+ spaces

68+ oneOf

69+ [ do Symbol.hasType

70+ inContext start (E.Annotation name) $

71+ do spaces

72+ (tipe, end, space) <- Type.expression

73+ return ( A.at start end (Src.Annotation locatedName tipe), end, space )

74+ , inContext start (E.Definition name) $

75+ definitionHelp start locatedName []

76+ ]

77+

78+

79+definitionHelp :: R.Position -> A.Located Text -> [Pattern.Raw] -> SParser Src.Decl

80+definitionHelp start name revArgs =

81+ oneOf

82+ [ do arg <- hint E.Arg Pattern.term

83+ spaces

84+ definitionHelp start name (arg : revArgs)

85+ , do Symbol.equals

86+ spaces

87+ (body, end, space) <- Expr.expression

88+ let def = A.at start end (Src.Definition name (reverse revArgs) body)

89+ return ( def, end, space )

90+ ]

5991

6092

6193

6294-- TYPE ALIAS and UNION TYPES

6395

6496

65−typeDecl :: R.Position -> SParser Decl.Source

66−typeDecl start =

97+{-# INLINE type_ #-}

98+type_ :: R.Position -> SParser Src.Decl

99+type_ start =

67100 do Keyword.type_

68101 spaces

69102 oneOf

@@ -72,28 +105,26 @@ typeDecl start =

72105 do spaces

73106 (name, args) <- nameArgsEquals

74107 (tipe, end, pos) <- Type.expression

75− let decl = A.at start end (Decl.Alias (Decl.Type name args tipe))

76− return ( Decl.Whatever decl, end, pos )

108+ return ( A.at start end (Src.Alias name args tipe), end, pos )

77109 , inContext start E.TypeUnion $

78110 do (name, args) <- nameArgsEquals

79111 (firstCtor, firstEnd, firstSpace) <- Type.unionConstructor

80112 (ctors, end, pos) <- chompConstructors [firstCtor] firstEnd firstSpace

81− let decl = A.at start end (Decl.Union (Decl.Type name args ctors))

82− return ( Decl.Whatever decl, end, pos )

113+ return ( A.at start end (Src.Union name args ctors), end, pos )

83114 ]

84115

85116

86−nameArgsEquals :: Parser (Text, [Text])

117+nameArgsEquals :: Parser (A.Located Text, [A.Located Text])

87118nameArgsEquals =

88− do name <- Var.upper

119+ do name <- addLocation Var.upper

89120 spaces

90121 nameArgsEqualsHelp name []

91122

92123

93−nameArgsEqualsHelp :: Text -> [Text] -> Parser (Text, [Text])

124+nameArgsEqualsHelp :: A.Located Text -> [A.Located Text] -> Parser (A.Located Text, [A.Located Text])

94125nameArgsEqualsHelp name args =

95126 oneOf

96− [ do arg <- Var.lower

127+ [ do arg <- addLocation Var.lower

97128 spaces

98129 nameArgsEqualsHelp name (arg:args)

99130 , do Symbol.equals

@@ -102,7 +133,7 @@ nameArgsEqualsHelp name args =

102133 ]

103134

104135

105−chompConstructors :: [(Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(Text, [Type.Raw])]

136+chompConstructors :: [(A.Located Text, [Type.Raw])] -> R.Position -> SPos -> SParser [(A.Located Text, [Type.Raw])]

106137chompConstructors ctors end pos =

107138 oneOf

108139 [ do checkSpace pos

@@ -115,47 +146,18 @@ chompConstructors ctors end pos =

115146

116147

117148

118−-- INFIX

149+-- PORT

119150

120151

121−infixDecl :: R.Position -> SParser Decl.Source

122−infixDecl start =

123− oneOf

124− [ do Keyword.infixl_

125− inContext start E.Infix $ infixDeclHelp start Decl.Left

126− , do Keyword.infixr_

127− inContext start E.Infix $ infixDeclHelp start Decl.Right

128− , do Keyword.infix_

129− inContext start E.Infix $ infixDeclHelp start Decl.Non

130− ]

131−

132−

133−infixDeclHelp :: R.Position -> Decl.Assoc -> SParser Decl.Source

134−infixDeclHelp start assoc =

135− do spaces

136− n <- digit

137− spaces

138− op <- Symbol.binop

139− end <- getPosition

140− pos <- W.whitespace

141− let decl = A.at start end (Decl.Fixity (Decl.Infix op assoc n))

142− return ( Decl.Whatever decl, end, pos )

143−

144−

145−

146−-- FOREIGN

147−

148−

149−portDecl :: R.Position -> SParser Decl.Source

150−portDecl start =

152+{-# INLINE port_ #-}

153+port_ :: R.Position -> SParser Src.Decl

154+port_ start =

151155 do Keyword.port_

152156 inContext start E.Port $

153157 do spaces

154− name <- Var.lower

158+ name <- addLocation Var.lower

155159 spaces

156160 Symbol.hasType

157161 spaces

158162 (tipe, end, pos) <- Type.expression

159− let decl = A.at start end (Decl.Port name tipe)

160− return ( Decl.Whatever decl, end, pos )

161−

163+ return ( A.at start end (Src.Port name tipe), end, pos )

src/Parse/Expression.hs+57−52

@@ -1,6 +1,10 @@

11{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

22{-# LANGUAGE OverloadedStrings #-}

3−module Parse.Expression (term, expression, definition) where

3+module Parse.Expression

4+ ( expression

5+ )

6+ where

59import Control.Monad (guard)

610import qualified Data.List as List

@@ -26,7 +30,7 @@ import qualified Reporting.Region as R

2630-- TERMS

2731

2832

29−term :: Parser Src.RawExpr

33+term :: Parser Src.Expr

3034term =

3135 hint E.Expr $

3236 do start <- getPosition

@@ -41,14 +45,14 @@ term =

4145 ]

4246

4347

44−literal :: R.Position -> Parser Src.RawExpr

48+literal :: R.Position -> Parser Src.Expr

4549literal start =

4650 do value <- Literal.literal

4751 end <- getPosition

4852 return (A.at start end (Src.Literal value))

4953

5054

51−accessor :: R.Position -> Parser Src.RawExpr

55+accessor :: R.Position -> Parser Src.Expr

5256accessor start =

5357 do Symbol.dot

5458 field <- Var.lower

@@ -56,14 +60,14 @@ accessor start =

5660 return (A.at start end (Src.Accessor field))

5761

5862

59−variable :: R.Position -> Parser Src.RawExpr

63+variable :: R.Position -> Parser Src.Expr

6064variable start =

6165 do (maybePrefix, name) <- Var.foreignAlpha

6266 end <- getPosition

6367 return (A.at start end (Src.Var maybePrefix name))

6468

6569

66−accessible :: R.Position -> Src.RawExpr -> Parser Src.RawExpr

70+accessible :: R.Position -> Src.Expr -> Parser Src.Expr

6771accessible start expr =

6872 oneOf

6973 [ do Symbol.dot

@@ -79,7 +83,7 @@ accessible start expr =

7983-- LISTS

8084

8185

82−list :: R.Position -> Parser Src.RawExpr

86+list :: R.Position -> Parser Src.Expr

8387list start =

8488 do Symbol.leftSquare

8589 inContext start E.ExprList $

@@ -94,7 +98,7 @@ list start =

9498 ]

9599

96100

97−listHelp :: R.Position -> [Src.RawExpr] -> Parser Src.RawExpr

101+listHelp :: R.Position -> [Src.Expr] -> Parser Src.Expr

98102listHelp start entries =

99103 oneOf

100104 [ do Symbol.comma

@@ -112,7 +116,7 @@ listHelp start entries =

112116-- TUPLES

113117

114118

115−tuple :: R.Position -> Parser Src.RawExpr

119+tuple :: R.Position -> Parser Src.Expr

116120tuple start =

117121 do Symbol.leftParen

118122 pos <- getPosition

@@ -142,7 +146,7 @@ tuple start =

142146 ]

143147

144148

145−tupleHelp :: R.Position -> Src.RawExpr -> [Src.RawExpr] -> Parser Src.RawExpr

149+tupleHelp :: R.Position -> Src.Expr -> [Src.Expr] -> Parser Src.Expr

146150tupleHelp start firstExpr revExprs =

147151 oneOf

148152 [ do Symbol.comma

@@ -165,7 +169,7 @@ tupleHelp start firstExpr revExprs =

165169-- RECORDS

166170

167171

168−record :: R.Position -> Parser Src.RawExpr

172+record :: R.Position -> Parser Src.Expr

169173record start =

170174 do Symbol.leftCurly

171175 inContext start E.ExprRecord $

@@ -194,7 +198,7 @@ record start =

194198 ]

195199

196200

197−type Field = ( A.Located Text, Src.RawExpr )

201+type Field = ( A.Located Text, Src.Expr )

198202

199203

200204chompFields :: [Field] -> Parser [Field]

@@ -225,7 +229,7 @@ chompField =

225229

226230

227231type ExprParser =

228− SParser Src.RawExpr

232+ SParser Src.Expr

229233

230234

231235expression :: ExprParser

@@ -237,24 +241,25 @@ expression =

237241 , if_ start

238242 , case_ start

239243 , function start

240− , do starter <- possiblyNegativeTerm start

244+ , do expr <- possiblyNegativeTerm start

241245 end <- getPosition

242246 space <- W.whitespace

243− exprHelp start (State [] starter end space)

247+ exprHelp start (State [] expr [] end space)

244248 ]

245249

246250

247251data State =

248252 State

249− { _ops :: ![(Src.RawExpr, A.Located Text)]

250− , _last :: !Src.RawExpr

253+ { _ops :: ![(Src.Expr, A.Located Text)]

254+ , _expr :: !Src.Expr

255+ , _args :: ![Src.Expr]

251256 , _end :: !R.Position

252257 , _pos :: !SPos

253258 }

254259

255260

256261exprHelp :: R.Position -> State -> ExprParser

257−exprHelp start (State ops lastExpr end pos) =

262+exprHelp start (State ops expr args end pos) =

258263 oneOf

259264 [ -- argument

260265 hint E.Arg $

@@ -262,8 +267,7 @@ exprHelp start (State ops lastExpr end pos) =

262267 arg <- term

263268 newEnd <- getPosition

264269 newPos <- W.whitespace

265− let newLast = A.merge lastExpr arg (Src.App lastExpr arg)

266− exprHelp start (State ops newLast newEnd newPos)

270+ exprHelp start (State ops expr (arg:args) newEnd newPos)

267271

268272 , -- infix operator

269273 do checkSpace pos

@@ -280,19 +284,15 @@ exprHelp start (State ops lastExpr end pos) =

280284 rawTerm <- term

281285 newEnd <- getPosition

282286 newPos <- W.whitespace

283−

284− let ann x = A.merge op rawTerm x

285− let negatedTerm = ann (Src.Binop [(ann Src.zero, op)] rawTerm)

286− let newLast = A.merge lastExpr rawTerm (Src.App lastExpr negatedTerm)

287−

288− exprHelp start (State ops newLast newEnd newPos)

287+ let arg = A.at opStart newEnd (Src.Negate rawTerm)

288+ exprHelp start (State ops expr (arg:args) newEnd newPos)

289289

290290 , -- term

291− do newLast <- possiblyNegativeTerm newStart

291+ do newExpr <- possiblyNegativeTerm newStart

292292 newEnd <- getPosition

293293 newPos <- W.whitespace

294− let newOps = (lastExpr, op) : ops

295− exprHelp start (State newOps newLast newEnd newPos)

294+ let newOps = (toCall expr args, op) : ops

295+ exprHelp start (State newOps newExpr [] newEnd newPos)

296296

297297 , -- final term

298298 do (newLast, newEnd, newPos) <-

@@ -302,37 +302,43 @@ exprHelp start (State ops lastExpr end pos) =

302302 , if_ newStart

303303 , function newStart

304304 ]

305− let newOps = (lastExpr, op) : ops

306− let finalExpr = A.at start newEnd (Src.Binop (reverse newOps) newLast)

305+ let newOps = (toCall expr args, op) : ops

306+ let finalExpr = A.at start newEnd (Src.Binops (reverse newOps) newLast)

307307 return ( finalExpr, newEnd, newPos )

308308 ]

309309

310310 , -- done

311+ let finalExpr = toCall expr args in

311312 case ops of

312313 [] ->

313− return ( lastExpr, end, pos )

314+ return ( finalExpr, end, pos )

314315

315316 _ ->

316− let

317− finalExpr =

318− A.at start end (Src.Binop (reverse ops) lastExpr)

319− in

320− return ( finalExpr, end, pos )

317+ return ( A.at start end (Src.Binops (reverse ops) finalExpr), end, pos )

321318 ]

322319

323320

324−possiblyNegativeTerm :: R.Position -> Parser Src.RawExpr

321+possiblyNegativeTerm :: R.Position -> Parser Src.Expr

325322possiblyNegativeTerm start =

326323 oneOf

327324 [ do Symbol.minus

328325 expr <- term

329326 end <- getPosition

330− let ann x = A.at start end x

331− return (ann (Src.Binop [(ann Src.zero, ann "-")] expr))

327+ return (A.at start end (Src.Negate expr))

332328 , term

333329 ]

334330

335331

332+toCall :: Src.Expr -> [Src.Expr] -> Src.Expr

333+toCall func revArgs =

334+ case revArgs of

335+ [] ->

336+ func

337+

338+ lastArg : _ ->

339+ A.merge func lastArg (Src.Call func (reverse revArgs))

340+

341+

336342

337343-- IF EXPRESSION

338344

@@ -343,7 +349,7 @@ if_ start =

343349 inContext start E.ExprIf $ ifHelp start []

344350

345351

346−ifHelp :: R.Position -> [(Src.RawExpr, Src.RawExpr)] -> ExprParser

352+ifHelp :: R.Position -> [(Src.Expr, Src.Expr)] -> ExprParser

347353ifHelp start branches =

348354 do spaces

349355 (condition, _, condPos) <- expression

@@ -419,7 +425,7 @@ case_ start =

419425 )

420426

421427

422−branchHelp :: SParser (P.Raw, Src.RawExpr)

428+branchHelp :: SParser (P.Raw, Src.Expr)

423429branchHelp =

424430 do (pattern, patternPos) <- Pattern.expression

425431 checkSpace patternPos

@@ -429,7 +435,7 @@ branchHelp =

429435 return ( (pattern, branchExpr), end, pos )

430436

431437

432−caseHelp :: [(P.Raw, Src.RawExpr)] -> R.Position -> SPos -> SParser [(P.Raw, Src.RawExpr)]

438+caseHelp :: [(P.Raw, Src.Expr)] -> R.Position -> SPos -> SParser [(P.Raw, Src.Expr)]

433439caseHelp branches end pos =

434440 oneOf

435441 [ do checkAligned pos

@@ -457,7 +463,7 @@ let_ start =

457463 letHelp start oldIndent [def] end space

458464

459465

460−letHelp :: R.Position -> Int -> [Src.RawDef] -> R.Position -> SPos -> ExprParser

466+letHelp :: R.Position -> Int -> [A.Located Src.Def] -> R.Position -> SPos -> ExprParser

461467letHelp start oldIndent revDefs end pos =

462468 oneOf

463469 [ do checkAligned pos

@@ -479,7 +485,7 @@ letHelp start oldIndent revDefs end pos =

479485-- LET DEFINITIONS

480486

481487

482−letDef :: SParser Src.RawDef

488+letDef :: SParser (A.Located Src.Def)

483489letDef =

484490 oneOf

485491 [ definition

@@ -491,7 +497,7 @@ letDef =

491497-- DEFINITION

492498

493499

494−definition :: SParser Src.RawDef

500+definition :: SParser (A.Located Src.Def)

495501definition =

496502 do start <- getPosition

497503 name <- Var.lower

@@ -501,13 +507,13 @@ definition =

501507 inContext start (E.Annotation name) $

502508 do spaces

503509 (tipe, end, space) <- Type.expression

504− return ( A.at start end (Src.Annotation name tipe), end, space )

510+ return ( A.at start end (Src.Annotate name tipe), end, space )

505511 , inContext start (E.Definition name) $

506512 definitionHelp start name []

507513 ]

508514

509515

510−definitionHelp :: R.Position -> Text -> [P.Raw] -> SParser Src.RawDef

516+definitionHelp :: R.Position -> Text -> [P.Raw] -> SParser (A.Located Src.Def)

511517definitionHelp start name revArgs =

512518 oneOf

513519 [ do arg <- hint E.Arg Pattern.term

@@ -516,7 +522,7 @@ definitionHelp start name revArgs =

516522 , do Symbol.equals

517523 spaces

518524 (body, end, space) <- expression

519− let def = A.at start end (Src.Definition name (reverse revArgs) body)

525+ let def = A.at start end (Src.Define name (reverse revArgs) body)

520526 return ( def, end, space )

521527 ]

522528

@@ -525,7 +531,7 @@ definitionHelp start name revArgs =

525531-- DESTRUCTURE

526532

527533

528−destructure :: SParser Src.RawDef

534+destructure :: SParser (A.Located Src.Def)

529535destructure =

530536 do start <- getPosition

531537 pattern <- Pattern.term

@@ -533,5 +539,4 @@ destructure =

533539 Symbol.equals

534540 spaces

535541 (expr, end, space) <- expression

536− let def = A.at start end (Src.Destructure pattern expr)

537− return ( def, end, space )

542+ return ( A.at start end (Src.Destruct pattern expr), end, space )

src/Parse/Kernel.hs+8−5

@@ -22,7 +22,7 @@ import Generate.JavaScript.Helpers as Help (toFieldName)

2222import Generate.JavaScript.Variable as Var (intToAscii)

2323import Parse.Primitives (Parser)

2424import qualified Parse.Primitives.Kernel as K

25−import qualified Parse.Module as Parse

25+import qualified Parse.Module as Module

2626import qualified Reporting.Annotation as A

2727

2828

@@ -32,8 +32,11 @@ import qualified Reporting.Annotation as A

3232

3333parser :: Parser Kernel.Content

3434parser =

35− do header <- Parse.kernelHeader

36− let imports = Map.unions (map headerToImport header)

35+ do Symbol.jsMultiCommentOpen

36+ freshLine

37+ rawImports <- chompImports []

38+ Symbol.jsMultiCommentClose

39+ let imports = Map.unions (map destructImport rawImports)

3740 chunks <- parserHelp imports Map.empty Map.empty []

3841 return (Kernel.Content (Map.elems imports) chunks)

3942

@@ -135,8 +138,8 @@ type Imports =

135138 Map.Map Text (Module.Raw, Text)

136139

137140

138−headerToImport :: Module.UserImport -> Imports

139−headerToImport (A.A _ ( A.A _ fullName, Module.ImportMethod maybeAlias exposed )) =

141+destructImport :: Import.ByUser -> Imports

142+destructImport (A.A _ ( A.A _ fullName, Module.ImportMethod maybeAlias exposed )) =

140143 let

141144 shortName =

142145 case maybeAlias of

src/Parse/Literal.hs+1−1

@@ -36,7 +36,7 @@ literal =

3636-- SHADERS

3737

3838

39−shader :: R.Position -> Parser Src.RawExpr

39+shader :: R.Position -> Parser Src.Expr

4040shader start@(R.Position row col) =

4141 do src <- Shader.block

4242 shdr <- parseSource row col (Text.unpack src)

src/Parse/Module.hs+141−132

@@ -1,8 +1,8 @@

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE OverloadedStrings #-}

33module Parse.Module

4− ( header

5− , kernelHeader

4+ ( module_

5+ , chompImports

66 )

77 where

@@ -10,8 +10,8 @@ module Parse.Module

1010import qualified Data.ByteString as B

1111import Data.Text (Text)

1212

13−import qualified AST.Exposing as Exposing

14−import qualified AST.Module as Module

13+import qualified AST.Expression.Source as Src

14+import qualified Elm.Name as N

1515import Parse.Primitives (Parser, oneOf)

1616import qualified Parse.Primitives as P

1717import qualified Parse.Primitives.Keyword as Keyword

@@ -24,122 +24,131 @@ import qualified Reporting.Region as R

2424

2525

2626

27−-- MODULE HEADER

27+-- HEADER

2828

2929

30−header :: Parser (Module.Header [Module.UserImport])

31−header =

30+module_ :: Parser decls -> Parser (Src.Module decls)

31+module_ chompDecls =

3232 do freshLine

33− Module.Header <$> maybeHeaderDecl <*> chompImports []

34−

35−

36−kernelHeader :: Parser [Module.UserImport]

37−kernelHeader =

38− do Symbol.jsMultiCommentOpen

39− freshLine

40− imports <- chompImports []

41− Symbol.jsMultiCommentClose

42− return imports

43−

44−

45−

46−-- HEADER DECL

47−

48−

49−maybeHeaderDecl :: Parser (Maybe Module.HeaderDecl)

50−maybeHeaderDecl =

51− oneOf

52− [ Just <$> headerDecl

53− , return Nothing

54− ]

55−

56−

57−headerDecl :: Parser Module.HeaderDecl

58−headerDecl =

59− do start <- P.getPosition

60− P.pushContext start E.Module

61− tag <- sourceTag

62− P.spaces

63− name <- Var.moduleName

64− P.spaces

65− settings <- effectSettings

66− P.hint E.Exposing $ Keyword.exposing_

67− P.spaces

68− exports <- exposing exposingEntry

69− P.popContext ()

70− docs <- maybeDocComment

71− return (Module.HeaderDecl tag name exports settings docs)

72−

73−

33+ oneOf

34+ [ do start <- P.getPosition

35+ P.pushContext start E.Module

36+ (name, effects) <- chompNameAndEffects

37+ P.hint E.Exposing $ Keyword.exposing_

38+ P.spaces

39+ exports <- exposing

40+ P.popContext ()

41+ docs <- maybeDocComment

42+ imports <- chompImports []

43+ decls <- chompDecls

44+ return (Src.Module name effects docs exports imports decls)

45+ , Src.defaultModule

46+ <$> chompImports []

47+ <*> chompDecls

48+ ]

7449

75−-- MODULE TAGS - module, effect module, port module

7650

7751

78−sourceTag :: Parser Module.SourceTag

79−sourceTag =

52+-- MODULE NAME

53+--

54+-- module MyThing

55+-- port module MyThing

56+-- effect module MyThing where { command = MyCmd }

57+--

58+chompNameAndEffects :: Parser (N.Name, Src.Effects)

59+chompNameAndEffects =

8060 oneOf

8161 [

8262 do Keyword.module_

83− return Module.Normal

63+ P.spaces

64+ name <- Var.moduleName

65+ P.spaces

66+ return ( name, Src.NoEffects )

8467 ,

8568 do start <- P.getPosition

8669 Keyword.port_

8770 P.spaces

8871 Keyword.module_

8972 end <- P.getPosition

90− return (Module.Port (R.Region start end))

73+ P.spaces

74+ name <- Var.moduleName

75+ P.spaces

76+ return ( name, Src.Ports (R.Region start end) )

9177 ,

9278 do start <- P.getPosition

9379 Keyword.effect_

9480 P.spaces

9581 Keyword.module_

9682 end <- P.getPosition

97− return (Module.Effect (R.Region start end))

83+ P.spaces

84+ name <- Var.moduleName

85+ P.spaces

86+ manager <- chompManager

87+ return ( name, Src.Effects (R.Region start end) manager )

9888 ]

9989

10090

10191

102−-- EFFECTS - where { command = MyCmd }

103−

104−

105−effectSettings :: Parser Module.SourceSettings

106−effectSettings =

107− oneOf

108− [ do Keyword.where_

109− P.spaces

110− start <- P.getPosition

111− Symbol.leftCurly

112− P.spaces

113− entry <- setting

114− P.spaces

115− effectSettingsHelp start [entry]

116− , return Module.emptySettings

117− ]

92+-- MANAGER

93+--

94+-- where { command = MyCmd }

95+-- where { subscription = MySub }

96+-- where { command = MyCmd, subscription = MySub }

97+--

98+chompManager :: Parser Src.Manager

99+chompManager =

100+ do Keyword.where_

101+ P.spaces

102+ Symbol.leftCurly

103+ P.spaces

104+ oneOf

105+ [ do cmd <- chompCommand

106+ P.spaces

107+ oneOf

108+ [ do Symbol.rightCurly

109+ P.spaces

110+ return (Src.Cmd cmd)

111+ , do Symbol.comma

112+ P.spaces

113+ sub <- chompSubscription

114+ P.spaces

115+ Symbol.rightCurly

116+ P.spaces

117+ return (Src.Fx cmd sub)

118+ ]

119+ , do sub <- chompSubscription

120+ P.spaces

121+ oneOf

122+ [ do Symbol.rightCurly

123+ P.spaces

124+ return (Src.Sub sub)

125+ , do Symbol.comma

126+ P.spaces

127+ cmd <- chompCommand

128+ P.spaces

129+ Symbol.rightCurly

130+ P.spaces

131+ return (Src.Fx cmd sub)

132+ ]

133+ ]

118134

119135

120−effectSettingsHelp :: R.Position -> [(A.Located Text, A.Located Text)] -> Parser Module.SourceSettings

121−effectSettingsHelp start entries =

122− oneOf

123− [ do Symbol.comma

124− P.spaces

125− entry <- setting

126− P.spaces

127− effectSettingsHelp start (entry:entries)

128− , do Symbol.rightCurly

129− end <- P.getPosition

130− P.spaces

131− return (A.at start end entries)

132− ]

136+chompCommand :: Parser (A.Located Text)

137+chompCommand =

138+ do Keyword.command_

139+ P.spaces

140+ Symbol.equals

141+ P.spaces

142+ P.addLocation Var.upper

133143

134144

135−setting :: Parser (A.Located Text, A.Located Text)

136−setting =

137− do name <- P.addLocation Var.lower

145+chompSubscription :: Parser (A.Located Text)

146+chompSubscription =

147+ do Keyword.subscription_

138148 P.spaces

139149 Symbol.equals

140150 P.spaces

141− tipe <- P.addLocation Var.upper

142− return (name, tipe)

151+ P.addLocation Var.upper

143152

144153

145154

@@ -164,7 +173,7 @@ maybeDocComment =

164173-- IMPORTS

165174

166175

167−chompImports :: [Module.UserImport] -> Parser [Module.UserImport]

176+chompImports :: [Src.Import] -> Parser [Src.Import]

168177chompImports imports =

169178 oneOf

170179 [ do start <- P.getPosition

@@ -172,106 +181,106 @@ chompImports imports =

172181 P.pushContext start E.Import

173182 P.spaces

174183 name <- P.addLocation Var.moduleName

175− end <- P.getPosition

176184 pos <- W.whitespace

177185 oneOf

178186 [ do P.checkFreshLine pos

179− let userImport = method start end name Nothing Exposing.closed

180187 P.popContext ()

181− chompImports (userImport:imports)

188+ chompImports $

189+ Src.Import name Nothing (Src.Explicit []) : imports

182190 , do P.checkSpace pos

183191 oneOf

184− [ chompAs start name imports

185− , chompExposing start name Nothing imports

192+ [ chompAs name imports

193+ , chompExposing name Nothing imports

186194 ]

187195 ]

188196 , return (reverse imports)

189197 ]

190198

191199

192−chompAs :: R.Position -> A.Located Text -> [Module.UserImport] -> Parser [Module.UserImport]

193−chompAs start name imports =

200+chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]

201+chompAs name imports =

194202 do Keyword.as_

195203 P.spaces

196204 alias <- Var.upper

197− end <- P.getPosition

198205 pos <- W.whitespace

199206 oneOf

200207 [ do P.checkFreshLine pos

201− let userImport = method start end name (Just alias) (Exposing.Explicit [])

202208 P.popContext ()

203− chompImports (userImport:imports)

209+ chompImports $

210+ Src.Import name (Just alias) (Src.Explicit []) : imports

204211 , do P.checkSpace pos

205− chompExposing start name (Just alias) imports

212+ chompExposing name (Just alias) imports

206213 ]

207214

208215

209−chompExposing :: R.Position -> A.Located Text -> Maybe Text -> [Module.UserImport] -> Parser [Module.UserImport]

210−chompExposing start name maybeAlias imports =

216+chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]

217+chompExposing name maybeAlias imports =

211218 do Keyword.exposing_

212219 P.spaces

213− exposed <- exposing exposingEntry

214− end <- P.getPosition

220+ exposed <- exposing

215221 freshLine

216− let userImport = method start end name maybeAlias exposed

217222 P.popContext ()

218− chompImports (userImport:imports)

219−

220−

221−method :: R.Position -> R.Position -> A.Located Text -> Maybe Text -> Exposing.Raw -> Module.UserImport

222−method start end name maybeAlias exposed =

223− A.at start end ( name, Module.ImportMethod maybeAlias exposed )

223+ chompImports $

224+ Src.Import name maybeAlias exposed : imports

224225

225226

226227

227228-- LISTING

228229

229230

230−exposing :: Parser a -> Parser (Exposing.Exposing a)

231−exposing parser =

231+exposing :: Parser Src.Exposing

232+exposing =

232233 P.hint E.Listing $

233234 do Symbol.leftParen

234235 P.spaces

235236 oneOf

236− [ do Symbol.dot

237− Symbol.dot

237+ [ do Symbol.doubleDot

238238 P.spaces

239239 Symbol.rightParen

240− return Exposing.Open

241− , do value <- P.addLocation parser

240+ return Src.Open

241+ , do entry <- P.addLocation chompEntry

242242 P.spaces

243− exposingHelp parser [value]

243+ exposingHelp [entry]

244244 ]

245245

246246

247−exposingHelp :: Parser a -> [A.Located a] -> Parser (Exposing.Exposing a)

248−exposingHelp parser values =

247+exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing

248+exposingHelp revEntries =

249249 oneOf

250250 [ do Symbol.comma

251251 P.spaces

252− value <- P.addLocation parser

252+ entry <- P.addLocation chompEntry

253253 P.spaces

254− exposingHelp parser (value:values)

254+ exposingHelp (entry:revEntries)

255255 , do Symbol.rightParen

256− return (Exposing.Explicit (reverse values))

256+ return (Src.Explicit (reverse revEntries))

257257 ]

258258

259259

260−exposingEntry :: Parser Exposing.Entry

261−exposingEntry =

260+chompEntry :: Parser Src.Exposed

261+chompEntry =

262262 oneOf

263− [ Exposing.Lower <$> Var.lower

263+ [ Src.Lower <$> Var.lower

264264 , do Symbol.leftParen

265265 op <- Symbol.binop

266266 Symbol.rightParen

267− return (Exposing.Lower op)

267+ return (Src.Lower op)

268268 , do name <- Var.upper

269269 P.spaces

270− Exposing.Upper name <$>

271− oneOf

272− [ Just <$> exposing Var.upper

273− , return Nothing

274− ]

270+ Src.Upper name <$> privacy

271+ ]

272+

273+

274+privacy :: Parser Src.Privacy

275+privacy =

276+ oneOf

277+ [ do Symbol.leftParen

278+ P.spaces

279+ Symbol.doubleDot

280+ P.spaces

281+ Symbol.rightParen

282+ return Src.Public

283+ , return Src.Private

275284 ]

276285

277286

src/Parse/Parse.hs+26−32

@@ -1,15 +1,17 @@

1−{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

2−module Parse.Parse (program) where

3−

4−import Data.Text (Text)

5−

6−import qualified AST.Declaration as Decl

7−import qualified AST.Module as Module

8−import qualified AST.Module.Name as ModuleName

9−import qualified Elm.Package as Package

10−import Parse.Helpers

11−import qualified Parse.Module as Parse (header)

12−import qualified Parse.Declaration as Parse (declaration)

1+{-# OPTIONS_GHC -Wall #-}

2+module Parse.Parse

3+ ( program

4+ )

5+ where

8+import qualified Data.ByteString as B

10+import qualified AST.Expression.Source as Src

11+import qualified AST.Expression.Valid as Valid

12+import qualified Parse.Declaration as Decl

13+import qualified Parse.Module as Module

14+import qualified Parse.Primitives as P

1315import qualified Reporting.Annotation as A

1416import qualified Reporting.Result as Result

1517import qualified Validate

@@ -19,9 +21,9 @@ import qualified Validate

1921-- PROGRAM

2022

2123

22−program :: Package.Name -> Text -> Validate.Result wrn Module.Valid

23−program pkgName src =

24− case run (chompProgram pkgName) src of

24+program :: B.ByteString -> Validate.Result wrn Valid.Module

25+program src =

26+ case P.run chompProgram src of

2527 Right modul ->

2628 Validate.validate modul

2729

@@ -29,26 +31,18 @@ program pkgName src =

2931 Result.throw region syntaxError

3032

3133

32−

33−chompProgram :: Package.Name -> Parser Module.Source

34−chompProgram pkgName =

35− do (Module.Header maybeHeaderDecl imports) <- Parse.header

36− decls <- chompDeclarations []

37− endOfFile

38−

39− let (Module.HeaderDecl tag name exports settings docs) =

40− maybe Module.defaultHeaderDecl id maybeHeaderDecl

41−

42− let moduleName = ModuleName.Canonical pkgName name

43− let source = Module.Source tag settings docs exports imports decls

44− return (Module.Module moduleName source)

34+chompProgram :: P.Parser (Src.Module [Src.Decl])

35+chompProgram =

36+ do srcModule <- Module.module_ (chompDeclarations [])

37+ P.endOfFile

38+ return srcModule

4539

4640

47−chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]

41+chompDeclarations :: [Src.Decl] -> P.Parser [Src.Decl]

4842chompDeclarations decls =

49− do (decl, _, pos) <- Parse.declaration

50− oneOf

51− [ do checkFreshLine pos

43+ do (decl, _, pos) <- Decl.declaration

44+ P.oneOf

45+ [ do P.checkFreshLine pos

5246 chompDeclarations (decl:decls)

5347 , return (reverse (decl:decls))

5448 ]

src/Parse/Primitives/Keyword.hs+10−18

@@ -6,7 +6,7 @@ module Parse.Primitives.Keyword

66 , case_, of_

77 , let_, in_

88 , module_, import_, exposing_, as_, where_, effect_

9− , infix_, infixr_, infixl_

9+ , command_, subscription_

1010 )

1111 where

1212

@@ -168,24 +168,16 @@ effect_ =

168168

169169

170170

171−-- INFIX

171+-- EFFECTS

172172

173173

174−{-# NOINLINE infix_ #-}

175−infix_ :: Parser ()

176−infix_ =

177− keyword "infix"

178−

179−

180−{-# NOINLINE infixr_ #-}

181−infixr_ :: Parser ()

182−infixr_ =

183− keyword "infixr"

184−

185−

186−{-# NOINLINE infixl_ #-}

187−infixl_ :: Parser ()

188−infixl_ =

189− keyword "infixl"

174+{-# NOINLINE command_ #-}

175+command_ :: Parser ()

176+command_ =

177+ keyword "command"

190178

191179

180+{-# NOINLINE subscription_ #-}

181+subscription_ :: Parser ()

182+subscription_ =

183+ keyword "subscription"

src/Parse/Primitives/Symbol.hs+7−1

@@ -3,7 +3,7 @@

33module Parse.Primitives.Symbol

44 ( underscore

55 , binop, binopTable

6− , equals, rightArrow, hasType, comma, pipe, cons, dot, minus, lambda

6+ , equals, rightArrow, hasType, comma, pipe, cons, dot, doubleDot, minus, lambda

77 , leftParen, rightParen, leftSquare, rightSquare, leftCurly, rightCurly

88 , elmDocCommentOpen, jsMultiCommentOpen, jsMultiCommentClose

99 , shaderBlockOpen

@@ -178,6 +178,12 @@ dot =

178178 symbol "."

179179

180180

181+{-# NOINLINE doubleDot #-}

182+doubleDot :: Parser ()

183+doubleDot =

184+ symbol ".."

185+

186+

181187{-# NOINLINE minus #-}

182188minus :: Parser ()

183189minus =

src/Parse/Type.hs+4−3

@@ -90,13 +90,14 @@ app start =

9090 return ( A.at start end tipe, end, pos )

9191

9292

93−unionConstructor :: SParser (Text, [Type.Raw])

93+unionConstructor :: SParser (A.Located Text, [Type.Raw])

9494unionConstructor =

95− do name <- Var.upper

95+ do start <- getPosition

96+ name <- Var.upper

9697 nameEnd <- getPosition

9798 namePos <- whitespace

9899 (args, end, pos) <- eatArgs [] nameEnd namePos

99− return ( (name, args), end, pos )

100+ return ( (A.at start nameEnd name, args), end, pos )

100101

101102

102103eatArgs :: [Type.Raw] -> R.Position -> SPos -> SParser [Type.Raw]