@@ -1,5 +1,6 @@
11module Language.PureScript.Sugar.ObjectWildcards
22 ( desugarObjectConstructors
3+ , desugarDecl
34 ) where
45
56import Prelude.Compat
@@ -21,13 +22,12 @@ desugarObjectConstructors
2122 => Module
2223 -> m Module
2324desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts
24− where
2525
26− desugarDecl :: Declaration -> m Declaration
27− desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d
28− desugarDecl other = f other
29− where
30− (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return
26+desugarDecl :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration
27+desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d
28+desugarDecl other = fn other
29+ where
30+ (fn, _, _) = everywhereOnValuesTopDownM return desugarExpr return
3131
3232 desugarExpr :: Expr -> m Expr
3333 desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument
@@ -45,9 +45,10 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
4545 obj <- freshIdent'
4646 Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps
4747 desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps
48− desugarExpr (Accessor prop u) | isAnonymousArgument u = do
49− arg <- freshIdent'
50− return $ Abs (Left arg) (Accessor prop (argToExpr arg))
48+ desugarExpr (Accessor prop u)
49+ | Just props <- peelAnonAccessorChain u = do
50+ arg <- freshIdent'
51+ return $ Abs (Left arg) $ foldr Accessor (argToExpr arg) (prop:props)
5152 desugarExpr (Case args cas) | any isAnonymousArgument args = do
5253 argIdents <- forM args freshIfAnon
5354 let args' = zipWith (`maybe` argToExpr) args argIdents
@@ -73,6 +74,12 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma
7374 stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e
7475 stripPositionInfo e = e
7576
77+ peelAnonAccessorChain :: Expr -> Maybe [String]
78+ peelAnonAccessorChain (Accessor p e) = (p :) <$> peelAnonAccessorChain e
79+ peelAnonAccessorChain (PositionedValue _ _ e) = peelAnonAccessorChain e
80+ peelAnonAccessorChain AnonymousArgument = Just []
81+ peelAnonAccessorChain _ = Nothing
82+
7683 isAnonymousArgument :: Expr -> Bool
7784 isAnonymousArgument AnonymousArgument = True
7885 isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e