@@ -16,35 +16,43 @@ module Language.PureScript.Sugar.ObjectWildcards (
1616 desugarObjectConstructors
1717) where
1818
19+import Control.Applicative
1920import Control.Arrow (second)
2021
2122import Data.List (partition)
22−import Data.Maybe (isJust, fromJust)
23+import Data.Maybe (isJust, fromJust, catMaybes)
2324
2425import Language.PureScript.AST
26+import Language.PureScript.Errors
2527import Language.PureScript.Names
28+import Language.PureScript.Supply
2629
27−desugarObjectConstructors :: Module -> Module
28−desugarObjectConstructors (Module mn ds exts) = Module mn (map desugarDecl ds) exts
30+desugarObjectConstructors :: Module -> SupplyT (Either ErrorStack) Module
31+desugarObjectConstructors (Module mn ds exts) = Module mn <$> mapM desugarDecl ds <*> pure exts
2932 where
3033
31− desugarDecl :: Declaration -> Declaration
32− (desugarDecl, _, _) = everywhereOnValues id desugarExpr id
34+ desugarDecl :: Declaration -> SupplyT (Either ErrorStack) Declaration
35+ (desugarDecl, _, _) = everywhereOnValuesM return desugarExpr return
3336
34− desugarExpr :: Expr -> Expr
37+ desugarExpr :: Expr -> SupplyT (Either ErrorStack) Expr
3538 desugarExpr (ObjectConstructor ps) = wrapLambda ObjectLiteral ps
3639 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+ desugarExpr (ObjectGetter prop) = do
41+ arg <- Ident <$> freshName
42+ return $ Abs (Left arg) (Accessor prop (Var (Qualified Nothing arg)))
43+ desugarExpr e = return e
4044
41− wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Maybe Expr)] -> Expr
45+ wrapLambda :: ([(String, Expr)] -> Expr) -> [(String, Maybe Expr)] -> SupplyT (Either ErrorStack) Expr
4246 wrapLambda mkVal ps =
4347 let (props, args) = partition (isJust . snd) ps
4448 in if null args
45− then mkVal $ second fromJust `map` props
46− else foldr (Abs . Left . Ident . fst) (mkVal (mkProp `map` ps)) args
47−
48− mkProp :: (String, Maybe Expr) -> (String, Expr)
49− mkProp (name, Just e) = (name, e)
50− mkProp (name, Nothing) = (name, Var (Qualified Nothing (Ident name)))
49+ then return . mkVal $ second fromJust `map` props
50+ else do
51+ (args', ps') <- unzip <$> mapM mkProp ps
52+ return $ foldr (Abs . Left) (mkVal ps') (catMaybes args')
53+
54+ mkProp :: (String, Maybe Expr) -> SupplyT (Either ErrorStack) (Maybe Ident, (String, Expr))
55+ mkProp (name, Just e) = return (Nothing, (name, e))
56+ mkProp (name, Nothing) = do
57+ arg <- Ident <$> freshName
58+ return (Just arg, (name, Var (Qualified Nothing arg)))