@@ -106,11 +106,12 @@ declToJs opts mp (BindingGroupDeclaration vals) e = do
106 js <- valueToJs opts mp e val
106 js <- valueToJs opts mp e val
107 return $ JSVariableIntroduction (identToJs ident) (Just js)
107 return $ JSVariableIntroduction (identToJs ident) (Just js)
108 return $ Just jss
108 return $ Just jss
109−declToJs _ _ (DataDeclaration _ _ ctors) _ = do
109+declToJs _ mp (DataDeclaration _ _ ctors) e = do
110 return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
110 return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
111+ let propName = if isNullaryConstructor e (Qualified (Just mp) pn) then "value" else "create"
111− [ makeConstructor ctor (length tys)
112+ in [ makeConstructor ctor (length tys)
112− , JSAssignment (JSAccessor "create" (JSVar ctor)) (go pn 0 (length tys) [])
113+ , JSAssignment (JSAccessor propName (JSVar ctor)) (go pn 0 (length tys) [])
115 makeConstructor :: String -> Int -> JS
116 makeConstructor :: String -> Int -> JS
116 makeConstructor ctorName n =
117 makeConstructor ctorName n =
@@ -198,7 +199,9 @@ valueToJs opts m e (ObjectUpdate o ps) = do
198 obj <- valueToJs opts m e o
199 obj <- valueToJs opts m e o
199 sts <- mapM (sndM (valueToJs opts m e)) ps
200 sts <- mapM (sndM (valueToJs opts m e)) ps
200 extendObj obj sts
201 extendObj obj sts
202+valueToJs _ m e (Constructor name) =
203+ let propName = if isNullaryConstructor e name then "value" else "create"
201−valueToJs _ m _ (Constructor name) = return $ JSAccessor "create" $ qualifiedToJS m (Ident . runProperName) name
204+ in return $ JSAccessor propName $ qualifiedToJS m (Ident . runProperName) name
202valueToJs opts m e (Case values binders) = do
205valueToJs opts m e (Case values binders) = do
203 vals <- mapM (valueToJs opts m e) values
206 vals <- mapM (valueToJs opts m e) values
204 bindersToJs opts m e binders vals
207 bindersToJs opts m e binders vals
@@ -394,3 +397,8 @@ isOnlyConstructor e ctor =
394 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)
397 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)
395 typeConstructor _ = error "Invalid argument to isOnlyConstructor"
398 typeConstructor _ = error "Invalid argument to isOnlyConstructor"
400+isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
401+isNullaryConstructor e ctor =
402+ case fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e of
403+ (_, TypeConstructor{}) -> True