ec3e3f1 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Object updaters

commitec3e3f177939564c255f1940f0bbc710570f6dc4 authorGary Burgess <gary.burgess@gmail.com> dateSat 7 Feb 2015, 12:10 (12 years ago) parent4813b5f

4 files changed+41−9

compare with golang

unifiedsplit

examples/passing/ObjectUpdater.purs+23 src/Language/PureScript/AST/Declarations.hs+5 src/Language/PureScript/Parser/Declarations.hs+4−4 src/Language/PureScript/Sugar/ObjectWildcards.hs+9−5

examples/passing/ObjectUpdater.pursnew file+23

@@ -0,0 +1,23 @@

1+module Main where

3+import Control.Monad.Eff

4+import Debug.Trace

6+foreign import data Error :: !

8+foreign import error

9+ """

10+ function error() {

11+ throw new Error("Object update failed");

12+ }

13+ """ :: forall e. Eff (error :: Error | e) Unit

14+

15+getValue :: forall e. Eff (| e) Boolean

16+getValue = return true

17+

18+main = do

19+ let record = { value: false }

20+ record2 <- record { value = _ } <$> getValue

21+ if record2.value

22+ then trace "Done"

23+ else error

src/Language/PureScript/AST/Declarations.hs+5

@@ -338,6 +338,11 @@ data Expr

338338 --

339339 | ObjectUpdate Expr [(String, Expr)]

340340 -- |

341+ -- Partial record updater. This will be removed during desugaring and

342+ -- expanded into a lambda that returns an object update.

343+ --

344+ | ObjectUpdater Expr [(String, Maybe Expr)]

345+ -- |

341346 -- Function introduction

342347 --

343348 | Abs (Either Ident Binder) Expr

src/Language/PureScript/Parser/Declarations.hs+4−4

@@ -345,7 +345,7 @@ parseValueAtom = P.choice

345345 , P.try parseBooleanLiteral

346346 , parseArrayLiteral

347347 , P.try parseObjectLiteral

348− , parseObjectGetter

348+ , P.try parseObjectGetter

349349 , parseAbs

350350 , P.try parseConstructor

351351 , P.try parseVar

@@ -355,11 +355,11 @@ parseValueAtom = P.choice

355355 , parseLet

356356 , Parens <$> parens parseValue ]

357357

358−parsePropertyUpdate :: TokenParser (String, Expr)

358+parsePropertyUpdate :: TokenParser (String, Maybe Expr)

359359parsePropertyUpdate = do

360360 name <- lname <|> stringLiteral

361361 _ <- C.indented *> equals

362− value <- C.indented *> parseValue

362+ value <- C.indented *> (underscore *> pure Nothing) <|> (Just <$> parseValue)

363363 return (name, value)

364364

365365parseAccessor :: Expr -> TokenParser Expr

@@ -398,7 +398,7 @@ parseValue = withSourceSpan PositionedValue

398398 where

399399 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

400400 postfixTable1 = [ parseAccessor

401− , \v -> P.try $ flip ObjectUpdate <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]

401+ , \v -> P.try $ flip ObjectUpdater <$> (C.indented *> braces (commaSep1 (C.indented *> parsePropertyUpdate))) <*> pure v ]

402402 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v

403403 , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v

404404 ]

src/Language/PureScript/Sugar/ObjectWildcards.hs+9−5

@@ -32,15 +32,19 @@ desugarObjectConstructors (Module mn ds exts) = Module mn (map desugarDecl ds) e

3232 (desugarDecl, _, _) = everywhereOnValues id desugarExpr id

3333

3434 desugarExpr :: Expr -> Expr

35− desugarExpr (ObjectConstructor ps) =

36− let (props, args) = partition (isJust . snd) ps

37− in if null args

38− then ObjectLiteral $ second fromJust `map` props

39− else foldr (Abs . Left . Ident . fst) (ObjectLiteral (mkProp `map` ps)) args

35+ desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps

36+ desugarExpr (ObjectUpdater obj ps) = wrapLambda (ObjectUpdate obj) ps

4037 desugarExpr (ObjectGetter prop) =

4138 Abs (Left (Ident "obj")) (Accessor prop (Var (Qualified Nothing (Ident "obj"))))

4239 desugarExpr e = e

4340

41+ wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Maybe Expr)] -> Expr

42+ wrapLambda mkVal ps =

43+ let (props, args) = partition (isJust . snd) ps

44+ in if null args

45+ then mkVal $ second fromJust `map` props

46+ else foldr (Abs . Left . Ident . fst) (mkVal (mkProp `map` ps)) args

47+

4448 mkProp :: (String, Maybe Expr) -> (String, Expr)

4549 mkProp (name, Just e) = (name, e)

4650 mkProp (name, Nothing) = (name, Var (Qualified Nothing (Ident name)))