f157680 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Check exported members don't use private classes

f157680Gary Burgess12 years ago

examples/failing/MissingClassExport.pursnew file+4

compare with golang

unifiedsplit

@@ -0,0 +1,4 @@

1+module Test (bar) where

3+ class Foo a where

4+ bar :: a -> a

src/Language/PureScript/TypeChecker.hs+42−19

@@ -219,7 +219,7 @@ typeCheckAll mainModuleName moduleName exps = go

219 addTypeClass moduleName pn args implies tys

220 ds <- go rest

221 return $ d : ds

222− go (TypeInstanceDeclaration dictName deps className tys _ : rest) = do

222+ go (TypeInstanceDeclaration dictName deps className tys _ : rest) =

223 go (ExternInstanceDeclaration dictName deps className tys : rest)

224 go (d@(ExternInstanceDeclaration dictName deps className tys) : rest) = do

225 mapM_ (checkTypeClassInstance moduleName) tys

@@ -241,37 +241,60 @@ typeCheckAll mainModuleName moduleName exps = go

241 (d' : rest') <- go (d : rest)

242 return (PositionedDeclaration pos d' : rest')

243

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+--

244typeCheckModule :: Maybe ModuleName -> Module -> Check Module

248typeCheckModule :: Maybe ModuleName -> Module -> Check Module

245typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elaborated"

249typeCheckModule _ (Module _ _ Nothing) = error "exports should have been elaborated"

246typeCheckModule mainModuleName (Module mn decls (Just exps)) = do

250typeCheckModule mainModuleName (Module mn decls (Just exps)) = do

247 modify (\s -> s { checkCurrentModule = Just mn })

251 modify (\s -> s { checkCurrentModule = Just mn })

248 decls' <- typeCheckAll mainModuleName mn exps decls

252 decls' <- typeCheckAll mainModuleName mn exps decls

249− mapM_ checkTypesAreExported exps

253+ mapM_ (checkTypesAreExported >> checkClassesAreExported) exps

250 return $ Module mn decls' (Just exps)

254 return $ Module mn decls' (Just exps)

251 where

255 where

252

256

253− -- Check that all the type constructors defined in the current module that appear in member types

257+ checkMemberExport :: (Show a) => String -> (Type -> [a]) -> (a -> Bool) -> DeclarationRef -> Check ()

254− -- have also been exported from the module

258+ checkMemberExport thing extract test (ValueRef name) = do

255− checkTypesAreExported :: DeclarationRef -> Check ()

256− checkTypesAreExported (ValueRef name) = do

257 ty <- lookupVariable mn (Qualified (Just mn) name)

259 ty <- lookupVariable mn (Qualified (Just mn) name)

258− case find isTconHidden (findTcons ty) of

260+ case find test (extract ty) of

259 Just hiddenType -> throwError . strMsg $

261 Just hiddenType -> throwError . strMsg $

260 "Error in module '" ++ show mn ++ "':\n\

262 "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"

262 Nothing -> return ()

264 Nothing -> return ()

263− checkTypesAreExported _ = return ()

265+ checkMemberExport _ _ _ _ = return ()

264

266

267+ -- Check that all the type constructors defined in the current module that appear in member types

265− -- Find the type constructors exported from the current module used in a type

268+ -- have also been exported from the module

266− findTcons :: Type -> [ProperName]

269+ checkTypesAreExported :: DeclarationRef -> Check ()

267− findTcons = everythingOnTypes (++) go

270+ checkTypesAreExported = checkMemberExport "type" findTcons isTconHidden

268 where

271 where

272+ findTcons :: Type -> [ProperName]

273+ findTcons = everythingOnTypes (++) go

274+ where

269− go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]

275+ go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]

270− go _ = []

276+ go _ = []

277+ isTconHidden :: ProperName -> Bool

278+ isTconHidden tyName = all go exps

279+ where

280+ go (TypeRef tyName' _) = tyName' /= tyName

281+ go _ = True

271

282

283+ -- Check that all the classes defined in the current module that appear in member types have also

272− -- Checks whether a type constructor is not being exported from the current module

284+ -- been exported from the module

273− isTconHidden :: ProperName -> Bool

285+ checkClassesAreExported :: DeclarationRef -> Check ()

274− isTconHidden tyName = all go exps

286+ checkClassesAreExported = checkMemberExport "class" findClasses isClassHidden

275 where

287 where

276− go (TypeRef tyName' _) = tyName' /= tyName

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

277− go _ = True

300+ go _ = True