ebb45ef · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #845 from purescript/object-syntax

ebb45efPhil Freeman12 years ago

examples/passing/ObjectGetter.pursnew file+11

compare with golang

unifiedsplit

@@ -0,0 +1,11 @@

1+module Main where

3+getX = (.x)

5+point = { x: 1, y: 0 }

7+main = do

8+ Debug.Trace.print $ getX point

9+ Debug.Trace.trace $ (." 123 string Prop Name ") { " 123 string Prop Name ": "OK" }

10+ Debug.Trace.trace $ ((.x) >>> (.y)) { x: { y: "Nested" } }

11+ Debug.Trace.trace $ (.value) { value: "Done!" }

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+10

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

325 --

326 | ObjectConstructor [(String, Maybe Expr)]

327 -- |

328+ -- An object property getter (e.g. `_.x`). This will be removed during

329+ -- desugaring and expanded into a lambda that reads a property from an object.

330+ --

331+ | ObjectGetter String

332+ -- |

328 -- An record property accessor expression

333 -- An record property accessor expression

329 --

334 --

330 | Accessor String Expr

335 | Accessor String Expr

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

333 --

338 --

334 | ObjectUpdate Expr [(String, Expr)]

339 | ObjectUpdate Expr [(String, Expr)]

335 -- |

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+ -- |

336 -- Function introduction

346 -- Function introduction

337 --

347 --

338 | Abs (Either Ident Binder) Expr

348 | Abs (Either Ident Binder) Expr

src/Language/PureScript/Parser/Declarations.hs+7−3

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

345 , P.try parseBooleanLiteral

346 , parseArrayLiteral

347 , P.try parseObjectLiteral

348+ , P.try parseObjectGetter

348 , parseAbs

349 , parseAbs

349 , P.try parseConstructor

350 , P.try parseConstructor

350 , P.try parseVar

351 , P.try parseVar

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

354 , parseLet

355 , parseLet

355 , Parens <$> parens parseValue ]

356 , Parens <$> parens parseValue ]

356

357

357−parsePropertyUpdate :: TokenParser (String, Expr)

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

358parsePropertyUpdate = do

359parsePropertyUpdate = do

359 name <- lname <|> stringLiteral

360 name <- lname <|> stringLiteral

360 _ <- C.indented *> equals

361 _ <- C.indented *> equals

361− value <- C.indented *> parseValue

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

362 return (name, value)

363 return (name, value)

363

364

364parseAccessor :: Expr -> TokenParser Expr

365parseAccessor :: Expr -> TokenParser Expr

@@ -383,6 +384,9 @@ parseDoNotationElement = P.choice

383 , parseDoNotationLet

384 , parseDoNotationLet

384 , P.try (DoNotationValue <$> parseValue) ]

385 , P.try (DoNotationValue <$> parseValue) ]

385

386

387+parseObjectGetter :: TokenParser Expr

388+parseObjectGetter = ObjectGetter <$> parens (dot *> C.indented *> (lname <|> stringLiteral))

389+

386-- |

390-- |

387-- Parse a value

391-- Parse a value

388--

392--

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

394 where

398 where

395 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

399 indexersAndAccessors = C.buildPostfixParser postfixTable1 parseValueAtom

396 postfixTable1 = [ parseAccessor

400 postfixTable1 = [ parseAccessor

397− , \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 ]

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

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

399 , \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

400 ]

404 ]

src/Language/PureScript/Pretty/Values.hs+33−27

@@ -21,7 +21,7 @@ module Language.PureScript.Pretty.Values (

21import Data.Maybe (fromMaybe)

22import Data.List (intercalate)

24−import Control.Arrow ((<+>), runKleisli)

24+import Control.Arrow ((<+>), runKleisli, second)

25import Control.PatternArrows

26import Control.Monad.State

27import Control.Applicative

@@ -38,33 +38,28 @@ literals = mkPattern' match

38 match (StringLiteral s) = return $ show s

39 match (BooleanLiteral True) = return "true"

40 match (BooleanLiteral False) = return "false"

41− match (ArrayLiteral xs) = fmap concat $ sequence

41+ match (ArrayLiteral xs) = concat <$> sequence

42 [ return "[ "

43 , withIndent $ prettyPrintMany prettyPrintValue' xs

44 , return " ]"

45 ]

46− match (ObjectLiteral []) = return "{}"

46+ match (ObjectLiteral ps) = prettyPrintObject' $ second Just `map` ps

47− match (ObjectLiteral ps) = fmap concat $ sequence

47+ match (ObjectConstructor ps) = prettyPrintObject' ps

48− [ return "{\n"

48+ match (ObjectGetter prop) = return $ "(." ++ prop ++ ")"

49− , withIndent $ prettyPrintMany prettyPrintObjectProperty ps

50− , return "\n"

51− , currentIndent

52− , return "}"

53− ]

54− match (TypeClassDictionaryConstructorApp className ps) = fmap concat $ sequence

49+ match (TypeClassDictionaryConstructorApp className ps) = concat <$> sequence

55− [ return ((show className) ++ "(\n")

50+ [ return (show className ++ "(\n")

56 , match ps

51 , match ps

57 , return ")"

52 , return ")"

58 ]

53 ]

59 match (Constructor name) = return $ show name

54 match (Constructor name) = return $ show name

60− match (Case values binders) = fmap concat $ sequence

55+ match (Case values binders) = concat <$> sequence

61 [ return "case "

56 [ return "case "

62 , unwords <$> forM values prettyPrintValue'

57 , unwords <$> forM values prettyPrintValue'

63 , return " of\n"

58 , return " of\n"

64 , withIndent $ prettyPrintMany prettyPrintCaseAlternative binders

59 , withIndent $ prettyPrintMany prettyPrintCaseAlternative binders

65 , currentIndent

60 , currentIndent

66 ]

61 ]

67− match (Let ds val) = fmap concat $ sequence

62+ match (Let ds val) = concat <$> sequence

68 [ return "let\n"

63 [ return "let\n"

69 , withIndent $ prettyPrintMany prettyPrintDeclaration ds

64 , withIndent $ prettyPrintMany prettyPrintDeclaration ds

70 , return "\n"

65 , return "\n"

@@ -73,7 +68,7 @@ literals = mkPattern' match

73 , prettyPrintValue' val

68 , prettyPrintValue' val

74 ]

69 ]

75 match (Var ident) = return $ show ident

70 match (Var ident) = return $ show ident

76− match (Do els) = fmap concat $ sequence

71+ match (Do els) = concat <$> sequence

77 [ return "do "

72 [ return "do "

78 , withIndent $ prettyPrintMany prettyPrintDoNotationElement els

73 , withIndent $ prettyPrintMany prettyPrintDoNotationElement els

79 , currentIndent

74 , currentIndent

@@ -86,7 +81,7 @@ literals = mkPattern' match

87prettyPrintDeclaration :: Declaration -> StateT PrinterState Maybe String

82prettyPrintDeclaration :: Declaration -> StateT PrinterState Maybe String

88prettyPrintDeclaration (TypeDeclaration ident ty) = return $ show ident ++ " :: " ++ prettyPrintType ty

83prettyPrintDeclaration (TypeDeclaration ident ty) = return $ show ident ++ " :: " ++ prettyPrintType ty

89−prettyPrintDeclaration (ValueDeclaration ident _ [] (Right val)) = fmap concat $ sequence

84+prettyPrintDeclaration (ValueDeclaration ident _ [] (Right val)) = concat <$> sequence

90 [ return $ show ident ++ " = "

85 [ return $ show ident ++ " = "

91 , prettyPrintValue' val

86 , prettyPrintValue' val

92 ]

87 ]

@@ -95,7 +90,7 @@ prettyPrintDeclaration _ = error "Invalid argument to prettyPrintDeclaration"

96prettyPrintCaseAlternative :: CaseAlternative -> StateT PrinterState Maybe String

91prettyPrintCaseAlternative :: CaseAlternative -> StateT PrinterState Maybe String

97prettyPrintCaseAlternative (CaseAlternative binders result) =

92prettyPrintCaseAlternative (CaseAlternative binders result) =

98− fmap concat $ sequence

93+ concat <$> sequence

99 [ intercalate ", " <$> forM binders prettyPrintBinder'

94 [ intercalate ", " <$> forM binders prettyPrintBinder'

100 , prettyPrintResult result

95 , prettyPrintResult result

101 ]

96 ]

@@ -104,7 +99,7 @@ prettyPrintCaseAlternative (CaseAlternative binders result) =

104 prettyPrintResult (Right v) = (" -> " ++) <$> prettyPrintValue' v

99 prettyPrintResult (Right v) = (" -> " ++) <$> prettyPrintValue' v

105

100

106 prettyPrintGuardedValue (grd, val) =

101 prettyPrintGuardedValue (grd, val) =

107− fmap concat $ sequence

102+ concat <$> sequence

108 [ return "| "

103 [ return "| "

109 , prettyPrintValue' grd

104 , prettyPrintValue' grd

110 , return " -> "

105 , return " -> "

@@ -116,18 +111,28 @@ prettyPrintDoNotationElement :: DoNotationElement -> StateT PrinterState Maybe S

116prettyPrintDoNotationElement (DoNotationValue val) =

111prettyPrintDoNotationElement (DoNotationValue val) =

117 prettyPrintValue' val

112 prettyPrintValue' val

118prettyPrintDoNotationElement (DoNotationBind binder val) =

113prettyPrintDoNotationElement (DoNotationBind binder val) =

119− fmap concat $ sequence

114+ concat <$> sequence

120 [ prettyPrintBinder' binder

115 [ prettyPrintBinder' binder

121 , return " <- "

116 , return " <- "

122 , prettyPrintValue' val

117 , prettyPrintValue' val

123 ]

118 ]

124prettyPrintDoNotationElement (DoNotationLet ds) =

119prettyPrintDoNotationElement (DoNotationLet ds) =

125− fmap concat $ sequence

120+ concat <$> sequence

126 [ return "let "

121 [ return "let "

127 , withIndent $ prettyPrintMany prettyPrintDeclaration ds

122 , withIndent $ prettyPrintMany prettyPrintDeclaration ds

128 ]

123 ]

129prettyPrintDoNotationElement (PositionedDoNotationElement _ _ el) = prettyPrintDoNotationElement el

124prettyPrintDoNotationElement (PositionedDoNotationElement _ _ el) = prettyPrintDoNotationElement el

130

125

126+prettyPrintObject' :: [(String, Maybe Expr)] -> StateT PrinterState Maybe String

127+prettyPrintObject' [] = return "{}"

128+prettyPrintObject' ps = concat <$> sequence

129+ [ return "{\n"

130+ , withIndent $ prettyPrintMany prettyPrintObjectProperty ps

131+ , return "\n"

132+ , currentIndent

133+ , return "}"

134+ ]

135+

131ifThenElse :: Pattern PrinterState Expr ((Expr, Expr), Expr)

136ifThenElse :: Pattern PrinterState Expr ((Expr, Expr), Expr)

132ifThenElse = mkPattern match

137ifThenElse = mkPattern match

133 where

138 where

@@ -144,6 +149,7 @@ objectUpdate :: Pattern PrinterState Expr ([String], Expr)

144objectUpdate = mkPattern match

149objectUpdate = mkPattern match

145 where

150 where

146 match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)

151 match (ObjectUpdate o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ prettyPrintValue val, o)

152+ match (ObjectUpdater o ps) = Just (flip map ps $ \(key, val) -> key ++ " = " ++ maybe "_" prettyPrintValue val, o)

147 match _ = Nothing

153 match _ = Nothing

148

154

149app :: Pattern PrinterState Expr (String, Expr)

155app :: Pattern PrinterState Expr (String, Expr)

@@ -188,17 +194,17 @@ prettyPrintBinderAtom = mkPattern' match

188 match (BooleanBinder True) = return "true"

194 match (BooleanBinder True) = return "true"

189 match (BooleanBinder False) = return "false"

195 match (BooleanBinder False) = return "false"

190 match (VarBinder ident) = return $ show ident

196 match (VarBinder ident) = return $ show ident

191− match (ConstructorBinder ctor args) = fmap concat $ sequence

197+ match (ConstructorBinder ctor args) = concat <$> sequence

192 [ return $ show ctor ++ " "

198 [ return $ show ctor ++ " "

193 , unwords <$> forM args match

199 , unwords <$> forM args match

194 ]

200 ]

195− match (ObjectBinder bs) = fmap concat $ sequence

201+ match (ObjectBinder bs) = concat <$> sequence

196 [ return "{\n"

202 [ return "{\n"

197 , withIndent $ prettyPrintMany prettyPrintObjectPropertyBinder bs

203 , withIndent $ prettyPrintMany prettyPrintObjectPropertyBinder bs

198 , currentIndent

204 , currentIndent

199 , return "}"

205 , return "}"

200 ]

206 ]

201− match (ArrayBinder bs) = fmap concat $ sequence

207+ match (ArrayBinder bs) = concat <$> sequence

202 [ return "["

208 [ return "["

203 , unwords <$> mapM prettyPrintBinder' bs

209 , unwords <$> mapM prettyPrintBinder' bs

204 , return "]"

210 , return "]"

@@ -229,13 +235,13 @@ matchConsBinder = mkPattern match'

229 match' _ = Nothing

235 match' _ = Nothing

230

236

231prettyPrintObjectPropertyBinder :: (String, Binder) -> StateT PrinterState Maybe String

237prettyPrintObjectPropertyBinder :: (String, Binder) -> StateT PrinterState Maybe String

232−prettyPrintObjectPropertyBinder (key, binder) = fmap concat $ sequence

238+prettyPrintObjectPropertyBinder (key, binder) = concat <$> sequence

233 [ return $ prettyPrintObjectKey key ++ ": "

239 [ return $ prettyPrintObjectKey key ++ ": "

234 , prettyPrintBinder' binder

240 , prettyPrintBinder' binder

235 ]

241 ]

236

242

237−prettyPrintObjectProperty :: (String, Expr) -> StateT PrinterState Maybe String

243+prettyPrintObjectProperty :: (String, Maybe Expr) -> StateT PrinterState Maybe String

238−prettyPrintObjectProperty (key, value) = fmap concat $ sequence

244+prettyPrintObjectProperty (key, value) = concat <$> sequence

239 [ return $ prettyPrintObjectKey key ++ ": "

245 [ return $ prettyPrintObjectKey key ++ ": "

240− , prettyPrintValue' value

246+ , maybe (pure "_") prettyPrintValue' value

241 ]

247 ]

src/Language/PureScript/Sugar/ObjectWildcards.hs+10−4

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

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

34 desugarExpr :: Expr -> Expr

35− desugarExpr (ObjectConstructor ps) =

35+ desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps

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

37+ desugarExpr (ObjectGetter prop) =

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

39+ desugarExpr e = e

40+

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

42+ wrapLambda mkVal ps =

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

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

37 in if null args

44 in if null args

38− then ObjectLiteral $ second fromJust `map` props

45+ then mkVal $ second fromJust `map` props

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

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

40− desugarExpr e = e

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

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

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

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