git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #1529 from purescript/revert-1525-remove-type-export-check
6d1aa33Gary Burgess
examples/failing/TransitiveDctorExport.pursnew file+5
compare with golang
unifiedsplit
@@ -0,0 +1,5 @@
1+-- @shouldFailWith TransitiveExportError
2+module Main (Y(..)) where
3+
4+type X = Int
5+data Y = Y X
examples/failing/TransitiveSynonymExport.pursnew file+5
@@ -0,0 +1,5 @@
1+-- @shouldFailWith TransitiveExportError
2+module Main (Y()) where
3+
4+type X = Int
5+type Y = X
src/Language/PureScript/TypeChecker.hs+38−11
@@ -286,27 +286,54 @@ typeCheckModule (Module ss coms mn decls (Just exps)) = warnAndRethrow (addHint
286 modify (\s -> s { checkCurrentModule = Just mn })
286 modify (\s -> s { checkCurrentModule = Just mn })
287 decls' <- typeCheckAll mn exps decls
287 decls' <- typeCheckAll mn exps decls
288 forM_ exps $ \e -> do
288 forM_ exps $ \e -> do
289+ checkTypesAreExported e
289 checkClassMembersAreExported e
290 checkClassMembersAreExported e
290 checkClassesAreExported e
291 checkClassesAreExported e
291 return $ Module ss coms mn decls' (Just exps)
292 return $ Module ss coms mn decls' (Just exps)
292 where
293 where
293
294
294 checkMemberExport :: (Type -> [DeclarationRef]) -> DeclarationRef -> Check ()
295 checkMemberExport :: (Type -> [DeclarationRef]) -> DeclarationRef -> Check ()
296+ checkMemberExport extract dr@(TypeRef name dctors) = do
297+ env <- getEnv
298+ case M.lookup (Qualified (Just mn) name) (typeSynonyms env) of
299+ Nothing -> return ()
300+ Just (_, ty) -> checkExport dr extract ty
301+ case dctors of
302+ Nothing -> return ()
303+ Just dctors' -> forM_ dctors' $ \dctor ->
304+ case M.lookup (Qualified (Just mn) dctor) (dataConstructors env) of
305+ Nothing -> return ()
306+ Just (_, _, ty, _) -> checkExport dr extract ty
307+ return ()
295 checkMemberExport extract dr@(ValueRef name) = do
308 checkMemberExport extract dr@(ValueRef name) = do
296 ty <- lookupVariable mn (Qualified (Just mn) name)
309 ty <- lookupVariable mn (Qualified (Just mn) name)
297− case filter (not . exported) (extract ty) of
310+ checkExport dr extract ty
298− [] -> return ()
299− hidden -> throwError . errorMessage $ TransitiveExportError dr hidden
300− where
301− exported e = any (exports e) exps
302− exports (TypeRef pn1 _) (TypeRef pn2 _) = pn1 == pn2
303− exports (ValueRef id1) (ValueRef id2) = id1 == id2
304− exports (TypeClassRef pn1) (TypeClassRef pn2) = pn1 == pn2
305− exports (PositionedDeclarationRef _ _ r1) r2 = exports r1 r2
306− exports r1 (PositionedDeclarationRef _ _ r2) = exports r1 r2
307− exports _ _ = False
308 checkMemberExport _ _ = return ()
311 checkMemberExport _ _ = return ()
309
312
313+ checkExport :: DeclarationRef -> (Type -> [DeclarationRef]) -> Type -> Check ()
314+ checkExport dr extract ty = case filter (not . exported) (extract ty) of
315+ [] -> return ()
316+ hidden -> throwError . errorMessage $ TransitiveExportError dr hidden
317+ where
318+ exported e = any (exports e) exps
319+ exports (TypeRef pn1 _) (TypeRef pn2 _) = pn1 == pn2
320+ exports (ValueRef id1) (ValueRef id2) = id1 == id2
321+ exports (TypeClassRef pn1) (TypeClassRef pn2) = pn1 == pn2
322+ exports (PositionedDeclarationRef _ _ r1) r2 = exports r1 r2
323+ exports r1 (PositionedDeclarationRef _ _ r2) = exports r1 r2
324+ exports _ _ = False
325+
326+ -- Check that all the type constructors defined in the current module that appear in member types
327+ -- have also been exported from the module
328+ checkTypesAreExported :: DeclarationRef -> Check ()
329+ checkTypesAreExported = checkMemberExport findTcons
330+ where
331+ findTcons :: Type -> [DeclarationRef]
332+ findTcons = everythingOnTypes (++) go
333+ where
334+ go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [TypeRef name (error "Data constructors unused in checkTypesAreExported")]
335+ go _ = []
336+
310 -- Check that all the classes defined in the current module that appear in member types have also
337 -- Check that all the classes defined in the current module that appear in member types have also
311 -- been exported from the module
338 -- been exported from the module
312 checkClassesAreExported :: DeclarationRef -> Check ()
339 checkClassesAreExported :: DeclarationRef -> Check ()