235edea · rowtype-yoga/purescript-native

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

on golang help sign in

Require types to be exported if an type operator alias is

235edeaGary Burgess11 years ago

examples/failing/TypeOperatorAliasNoExport.pursnew file+6

compare with golang

unifiedsplit

@@ -0,0 +1,6 @@

1+-- @shouldFailWith TransitiveExportError

2+module Test (type (×)) where

4+data Tuple a b = Tuple a b

6+infixl 6 type Tuple as ×

src/Language/PureScript/AST/Declarations.hs+9

@@ -232,6 +232,15 @@ foldFixityAlias f _ _ (AliasValue name) = f name

232foldFixityAlias _ g _ (AliasConstructor name) = g name

233foldFixityAlias _ _ h (AliasType name) = h name

234

235+getValueAlias :: FixityAlias -> Maybe (Either Ident (ProperName 'ConstructorName))

236+getValueAlias (AliasValue name) = Just $ Left name

237+getValueAlias (AliasConstructor name) = Just $ Right name

238+getValueAlias _ = Nothing

239+

240+getTypeAlias :: FixityAlias -> Maybe (ProperName 'TypeName)

241+getTypeAlias (AliasType name) = Just name

242+getTypeAlias _ = Nothing

243+

235-- | The members of a type class instance declaration

244-- | The members of a type class instance declaration

236data TypeInstanceBody

245data TypeInstanceBody

237 -- | This is a derived instance

246 -- | This is a derived instance

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

@@ -1,6 +1,7 @@

1{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE PatternGuards #-}

5-- |

6-- |

6-- The top-level type checker, which checks all declarations in a module.

7-- The top-level type checker, which checks all declarations in a module.

@@ -438,22 +439,32 @@ typeCheckModule (Module ss coms mn decls (Just exps)) = warnAndRethrow (addHint

438

439

439 checkNonAliasesAreExported :: [ProperName 'ConstructorName] -> DeclarationRef -> m ()

440 checkNonAliasesAreExported :: [ProperName 'ConstructorName] -> DeclarationRef -> m ()

440 checkNonAliasesAreExported exportedDctors dr@(ValueRef (Op name)) =

441 checkNonAliasesAreExported exportedDctors dr@(ValueRef (Op name)) =

441− case listToMaybe (mapMaybe getAlias decls) of

442+ case listToMaybe (mapMaybe (getAlias getValueAlias name) decls) of

442− Just (AliasValue ident) ->

443+ Just (Left ident) ->

443 unless (ValueRef ident `elem` exps) $

444 unless (ValueRef ident `elem` exps) $

444 throwError . errorMessage $ TransitiveExportError dr [ValueRef ident]

445 throwError . errorMessage $ TransitiveExportError dr [ValueRef ident]

445− Just (AliasConstructor ctor) ->

446+ Just (Right ctor) ->

446 unless (ctor `elem` exportedDctors) $

447 unless (ctor `elem` exportedDctors) $

447 throwError . errorMessage $ TransitiveDctorExportError dr ctor

448 throwError . errorMessage $ TransitiveDctorExportError dr ctor

448 _ -> return ()

449 _ -> return ()

450+ checkNonAliasesAreExported _ dr@(TypeOpRef (Op name)) =

451+ case listToMaybe (mapMaybe (getAlias getTypeAlias name) decls) of

452+ Just ty ->

453+ unless (any (isTypeRefFor ty) exps) $

454+ throwError . errorMessage $ TransitiveExportError dr [TypeRef ty Nothing]

455+ _ -> return ()

449 where

456 where

450− getAlias :: Declaration -> Maybe FixityAlias

457+ isTypeRefFor :: ProperName 'TypeName -> DeclarationRef -> Bool

451− getAlias (PositionedDeclaration _ _ d) = getAlias d

458+ isTypeRefFor ty (TypeRef ty' _) = ty == ty'

452− getAlias (FixityDeclaration _ name' (Just (Qualified (Just mn') alias)))

459+ isTypeRefFor _ _ = False

453− | name == name' && mn == mn' = Just alias

454− getAlias _ = Nothing

455 checkNonAliasesAreExported _ _ = return ()

460 checkNonAliasesAreExported _ _ = return ()

456

461

462+ getAlias :: (FixityAlias -> Maybe a) -> String -> Declaration -> Maybe a

463+ getAlias match name (PositionedDeclaration _ _ d) = getAlias match name d

464+ getAlias match name (FixityDeclaration _ name' (Just (Qualified (Just mn') a)))

465+ | Just alias <- match a, name == name' && mn == mn' = Just alias

466+ getAlias _ _ _ = Nothing

467+

457 exportedDataConstructors :: [DeclarationRef] -> [ProperName 'ConstructorName]

468 exportedDataConstructors :: [DeclarationRef] -> [ProperName 'ConstructorName]

458 exportedDataConstructors = foldMap extractCtor

469 exportedDataConstructors = foldMap extractCtor

459 where

470 where