@@ -157,18 +157,24 @@ desugarDecl mn _ d@(TypeClassDeclaration name args implies members) = do
157157desugarDecl mn exps d@(TypeInstanceDeclaration name deps className tys members) = do
158158 desugared <- lift $ desugarCases members
159159 dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared
160− let expRef = if isPublicClass className && all isPublicType (getConstructors `concatMap` tys)
160+ let expRef = if isExportedClass className && all isExportedType (getConstructors `concatMap` tys)
161161 then Just $ TypeInstanceRef name
162162 else Nothing
163163 return $ (expRef, [d, dictDecl])
164164 where
165− isPublicClass = isPublic (elem . TypeClassRef)
166− isPublicType = isPublic $ \pn -> isJust . find (isTypeRef pn)
167− isPublic test (Qualified (Just mn') pn) = mn /= mn' || test pn exps
168− isPublic _ _ = error "Names should have been qualified in name desugaring"
169− isTypeRef pn (TypeRef pn' _) = pn == pn'
170− isTypeRef _ _ = False
165+ isExportedClass :: Qualified ProperName -> Bool
166+ isExportedClass = isExported (elem . TypeClassRef)
167+ isExportedType :: Qualified ProperName -> Bool
168+ isExportedType = isExported $ \pn -> isJust . find (matchesTypeRef pn)
169+ isExported :: (ProperName -> [DeclarationRef] -> Bool) -> Qualified ProperName -> Bool
170+ isExported test (Qualified (Just mn') pn) = mn /= mn' || test pn exps
171+ isExported _ _ = error "Names should have been qualified in name desugaring"
172+ matchesTypeRef :: ProperName -> DeclarationRef -> Bool
173+ matchesTypeRef pn (TypeRef pn' _) = pn == pn'
174+ matchesTypeRef _ _ = False
175+ getConstructors :: Type -> [Qualified ProperName]
171176 getConstructors = everythingOnTypes (++) getConstructor
177+ getConstructor :: Type -> [Qualified ProperName]
172178 getConstructor (TypeConstructor tcname) = [tcname]
173179 getConstructor _ = []
174180desugarDecl mn exps (PositionedDeclaration pos d) = do