git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Object updaters
ec3e3f1Gary Burgess
examples/passing/ObjectUpdater.pursnew file+23
@@ -0,0 +1,23 @@
1+module Main where
2+
3+import Control.Monad.Eff
4+import Debug.Trace
5+
6+foreign import data Error :: !
7+
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
338 --
338 --
339 | ObjectUpdate Expr [(String, Expr)]
339 | ObjectUpdate Expr [(String, Expr)]
340 -- |
340 -- |
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+ -- |
341 -- Function introduction
346 -- Function introduction
342 --
347 --
343 | Abs (Either Ident Binder) Expr
348 | Abs (Either Ident Binder) Expr
src/Language/PureScript/Parser/Declarations.hs+4−4
@@ -345,7 +345,7 @@ parseValueAtom = P.choice
345 , P.try parseBooleanLiteral
345 , P.try parseBooleanLiteral
346 , parseArrayLiteral
346 , parseArrayLiteral
347 , P.try parseObjectLiteral
347 , P.try parseObjectLiteral
348− , parseObjectGetter
348+ , P.try parseObjectGetter
349 , parseAbs
349 , parseAbs
350 , P.try parseConstructor
350 , P.try parseConstructor
351 , P.try parseVar
351 , P.try parseVar
@@ -355,11 +355,11 @@ parseValueAtom = P.choice
355 , parseLet
355 , parseLet
356 , Parens <$> parens parseValue ]
356 , Parens <$> parens parseValue ]
357
357
358−parsePropertyUpdate :: TokenParser (String, Expr)
358+parsePropertyUpdate :: TokenParser (String, Maybe Expr)
359parsePropertyUpdate = do
359parsePropertyUpdate = do
360 name <- lname <|> stringLiteral
360 name <- lname <|> stringLiteral
361 _ <- C.indented *> equals
361 _ <- C.indented *> equals
362− value <- C.indented *> parseValue
362+ value <- C.indented *> (underscore *> pure Nothing) <|> (Just <$> parseValue)
363 return (name, value)
363 return (name, value)
364
364
365parseAccessor :: Expr -> TokenParser Expr
365parseAccessor :: Expr -> TokenParser Expr
@@ -398,7 +398,7 @@ parseValue = withSourceSpan PositionedValue
398 where
398 where
399 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
399 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom
400 postfixTable1 = [ parseAccessor
400 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 ]
402 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v
402 postfixTable2 = [ \v -> P.try (flip App <$> (C.indented *> indexersAndAccessors)) <*> pure v
403 , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v
403 , \v -> flip (TypedValue True) <$> (P.try (C.indented *> doubleColon) *> parsePolyType) <*> pure v
404 ]
404 ]
src/Language/PureScript/Sugar/ObjectWildcards.hs+9−5
@@ -32,15 +32,19 @@ desugarObjectConstructors (Module mn ds exts) = Module mn (map desugarDecl ds) e
32 (desugarDecl, _, _) = everywhereOnValues id desugarExpr id
32 (desugarDecl, _, _) = everywhereOnValues id desugarExpr id
33
33
34 desugarExpr :: Expr -> Expr
34 desugarExpr :: Expr -> Expr
35− desugarExpr (ObjectConstructor ps) =
35+ desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps
36− let (props, args) = partition (isJust . snd) ps
36+ desugarExpr (ObjectUpdater obj ps) = wrapLambda (ObjectUpdate obj) 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
40 desugarExpr (ObjectGetter prop) =
37 desugarExpr (ObjectGetter prop) =
41 Abs (Left (Ident "obj")) (Accessor prop (Var (Qualified Nothing (Ident "obj"))))
38 Abs (Left (Ident "obj")) (Accessor prop (Var (Qualified Nothing (Ident "obj"))))
42 desugarExpr e = e
39 desugarExpr e = e
43
40
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+
44 mkProp :: (String, Maybe Expr) -> (String, Expr)
48 mkProp :: (String, Maybe Expr) -> (String, Expr)
45 mkProp (name, Just e) = (name, e)
49 mkProp (name, Just e) = (name, e)
46 mkProp (name, Nothing) = (name, Var (Qualified Nothing (Ident name)))
50 mkProp (name, Nothing) = (name, Var (Qualified Nothing (Ident name)))