@@ -219,7 +219,7 @@ typeCheckAll mainModuleName moduleName exps = go
219219 addTypeClass moduleName pn args implies tys
220220 ds <- go rest
221221 return $ d : ds
222− go (TypeInstanceDeclaration dictName deps className tys _ : rest) = do
222+ go (TypeInstanceDeclaration dictName deps className tys _ : rest) =
223223 go (ExternInstanceDeclaration dictName deps className tys : rest)
224224 go (d@(ExternInstanceDeclaration dictName deps className tys) : rest) = do
225225 mapM_ (checkTypeClassInstance moduleName) tys
@@ -241,37 +241,60 @@ typeCheckAll mainModuleName moduleName exps = go
241241 (d' : rest') <- go (d : rest)
242242 return (PositionedDeclaration pos d' : rest')
243243
244+-- |
245+-- Type check an entire module and ensure all types and classes defined within the module that are
246+-- required by exported members are also exported.
247+--
244248typeCheckModule :: Maybe ModuleName -> Module -> Check Module
245249typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elaborated"
246250typeCheckModule mainModuleName (Module mn decls (Just exps)) = do
247251 modify (\s -> s { checkCurrentModule = Just mn })
248252 decls' <- typeCheckAll mainModuleName mn exps decls
249− mapM_ checkTypesAreExported exps
253+ mapM_ (checkTypesAreExported >> checkClassesAreExported) exps
250254 return $ Module mn decls' (Just exps)
251255 where
252256
253− -- Check that all the type constructors defined in the current module that appear in member types
254− -- have also been exported from the module
255− checkTypesAreExported :: DeclarationRef -> Check ()
256− checkTypesAreExported (ValueRef name) = do
257+ checkMemberExport :: (Show a) => String -> (Type -> [a]) -> (a -> Bool) -> DeclarationRef -> Check ()
258+ checkMemberExport thing extract test (ValueRef name) = do
257259 ty <- lookupVariable mn (Qualified (Just mn) name)
258− case find isTconHidden (findTcons ty) of
260+ case find test (extract ty) of
259261 Just hiddenType -> throwError . strMsg $
260262 "Error in module '" ++ show mn ++ "':\n\
261− \Exporting declaration '" ++ show name ++ "' requires type '" ++ show hiddenType ++ "' to be exported as well"
263+ \Exporting declaration '" ++ show name ++ "' requires " ++ thing ++ " '" ++ show hiddenType ++ "' to be exported as well"
262264 Nothing -> return ()
263− checkTypesAreExported _ = return ()
265+ checkMemberExport _ _ _ _ = return ()
264266
265− -- Find the type constructors exported from the current module used in a type
266− findTcons :: Type -> [ProperName]
267− findTcons = everythingOnTypes (++) go
267+ -- Check that all the type constructors defined in the current module that appear in member types
268+ -- have also been exported from the module
269+ checkTypesAreExported :: DeclarationRef -> Check ()
270+ checkTypesAreExported = checkMemberExport "type" findTcons isTconHidden
268271 where
269− go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]
270− go _ = []
272+ findTcons :: Type -> [ProperName]
273+ findTcons = everythingOnTypes (++) go
274+ where
275+ go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]
276+ go _ = []
277+ isTconHidden :: ProperName -> Bool
278+ isTconHidden tyName = all go exps
279+ where
280+ go (TypeRef tyName' _) = tyName' /= tyName
281+ go _ = True
271282
272− -- Checks whether a type constructor is not being exported from the current module
273− isTconHidden :: ProperName -> Bool
274− isTconHidden tyName = all go exps
283+ -- Check that all the classes defined in the current module that appear in member types have also
284+ -- been exported from the module
285+ checkClassesAreExported :: DeclarationRef -> Check ()
286+ checkClassesAreExported = checkMemberExport "class" findClasses isClassHidden
275287 where
276− go (TypeRef tyName' _) = tyName' /= tyName
277− go _ = True
288+ findClasses :: Type -> [ProperName]
289+ findClasses = everythingOnTypes (++) go
290+ where
291+ go (ConstrainedType cs _) = mapMaybe (extractCurrentModuleClass . fst) cs
292+ go _ = []
293+ extractCurrentModuleClass :: Qualified ProperName -> Maybe ProperName
294+ extractCurrentModuleClass (Qualified (Just mn') name) | mn == mn' = Just name
295+ extractCurrentModuleClass _ = Nothing
296+ isClassHidden :: ProperName -> Bool
297+ isClassHidden clsName = all go exps
298+ where
299+ go (TypeClassRef clsName') = clsName' /= clsName
300+ go _ = True