@@ -207,7 +207,19 @@ valueToJs opts m e (Case values binders) = do
207207 bindersToJs opts m e binders vals
208208valueToJs opts m e (IfThenElse cond th el) = JSConditional <$> valueToJs opts m e cond <*> valueToJs opts m e th <*> valueToJs opts m e el
209209valueToJs opts m e (Accessor prop val) = accessorString prop <$> valueToJs opts m e val
210−valueToJs opts m e (App val arg) = JSApp <$> valueToJs opts m e val <*> (return <$> valueToJs opts m e arg)
210+valueToJs opts m e v@App{} = do
211+ let (f, args) = unApp v []
212+ args' <- mapM (valueToJs opts m e) args
213+ case f of
214+ Constructor name | getConstructorArity e name == length args ->
215+ return $ JSUnary JSNew $ JSApp (qualifiedToJS m (Ident . runProperName) name) args'
216+ _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs opts m e f
217+ where
218+ unApp :: Value -> [Value] -> (Value, [Value])
219+ unApp (App val arg) args = unApp val (arg : args)
220+ unApp (PositionedValue _ val) args = unApp val args
221+ unApp (TypedValue _ val _) args = unApp val args
222+ unApp other args = (other, args)
211223valueToJs opts m e (Let ds val) = do
212224 decls <- concat . catMaybes <$> mapM (flip (declToJs opts m) e) ds
213225 ret <- valueToJs opts m e val
@@ -385,23 +397,37 @@ binderToJs m e varName done (PositionedBinder _ binder) =
385397 binderToJs m e varName done binder
386398
387399-- |
388−-- Checks whether a data constructor is the only constructor for that type, used to simplify the
389−-- check when generating code for binders.
400+-- Finds the value stored for a data constructor in the current environment.
401+-- This is a partial function, but if an invalid type has reached this far then
402+-- something has gone wrong in typechecking.
403+--
404+lookupConstructor :: Environment -> Qualified ProperName -> (ProperName, Type)
405+lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
406+
407+-- |
408+-- Checks whether a data constructor is the only constructor for that type, used
409+-- to simplify the check when generating code for binders.
390410--
391411isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
392−isOnlyConstructor e ctor =
393− let ty = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
394− in numConstructors (ctor, ty) == 1
412+isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
395413 where
396414 numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
397415 typeConstructor (Qualified (Just moduleName) _, (tyCtor, _)) = (moduleName, tyCtor)
398416 typeConstructor _ = error "Invalid argument to isOnlyConstructor"
399417
400−isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
401−isNullaryConstructor e ctor =
402− not . isFunction . snd . fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
418+-- |
419+-- Checks the number of arguments a data constructor accepts.
420+--
421+getConstructorArity :: Environment -> Qualified ProperName -> Int
422+getConstructorArity e = go . snd . lookupConstructor e
403423 where
404− isFunction :: Type -> Bool
405− isFunction (ForAll _ t _) = isFunction t
406− isFunction (TypeApp t _) = isFunction t
407− isFunction t = t == tyFunction
424+ go :: Type -> Int
425+ go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
426+ go (ForAll _ ty _) = go ty
427+ go _ = 0
428+
429+-- |
430+-- Checks whether a data constructor has no arguments, for example, `Nothing`.
431+--
432+isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
433+isNullaryConstructor e = (== 0) . getConstructorArity e