@@ -26,7 +26,7 @@ import Language.PureScript.TypeChecker.Types as T
2626import Language.PureScript.TypeChecker.Synonyms as T
2727
2828import Data.Maybe
29−import Data.List (nub, (\\), find)
29+import Data.List (nub, (\\), find, intercalate)
3030import Data.Monoid ((<>))
3131import Data.Foldable (for_)
3232import qualified Data.Map as M
@@ -250,7 +250,9 @@ typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elabora
250250typeCheckModule mainModuleName (Module mn decls (Just exps)) = do
251251 modify (\s -> s { checkCurrentModule = Just mn })
252252 decls' <- typeCheckAll mainModuleName mn exps decls
253− mapM_ (checkTypesAreExported >> checkClassesAreExported) exps
253+ forM_ exps checkTypesAreExported
254+ forM_ exps checkClassMembersAreExported
255+ forM_ exps checkClassesAreExported
254256 return $ Module mn decls' (Just exps)
255257 where
256258
@@ -298,3 +300,25 @@ typeCheckModule mainModuleName (Module mn decls (Just exps)) = do
298300 where
299301 go (TypeClassRef clsName') = clsName' /= clsName
300302 go _ = True
303+
304+ checkClassMembersAreExported :: DeclarationRef -> Check ()
305+ checkClassMembersAreExported (TypeClassRef name) = do
306+ let members = ValueRef `map` head (mapMaybe findClassMembers decls)
307+ let missingMembers = members \\ exps
308+ unless (null missingMembers) $
309+ throwError . strMsg $
310+ "Error in module '" ++ show mn ++ "':\n\
311+ \Class '" ++ show name ++ "' is exported but is missing member exports for '" ++ intercalate "', '" (map (show . runValueRef) missingMembers) ++ "'"
312+ where
313+ runValueRef :: DeclarationRef -> Ident
314+ runValueRef (ValueRef refName) = refName
315+ runValueRef _ = error "non-ValueRef passed to runValueRef"
316+ findClassMembers :: Declaration -> Maybe [Ident]
317+ findClassMembers (TypeClassDeclaration name' _ _ ds) | name == name' = Just $ map extractMemberName ds
318+ findClassMembers (PositionedDeclaration _ d) = findClassMembers d
319+ findClassMembers _ = Nothing
320+ extractMemberName :: Declaration -> Ident
321+ extractMemberName (PositionedDeclaration _ d) = extractMemberName d
322+ extractMemberName (TypeDeclaration memberName _) = memberName
323+ extractMemberName _ = error "Unexpected declaration in typeclass member list"
324+ checkClassMembersAreExported _ = return ()