git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Require types to be exported if an type operator alias is
commit235edea1676776d05b16bd9728edabc7924eb36f authorGary Burgess <gary.burgess@gmail.com> dateSun 17 Apr 2016, 18:00 (11 years ago) parent8bab509
3 files changed+34−8
compare with golang
unifiedsplit
examples/failing/TypeOperatorAliasNoExport.purs+6 src/Language/PureScript/AST/Declarations.hs+9 src/Language/PureScript/TypeChecker.hs+19−8
examples/failing/TypeOperatorAliasNoExport.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith TransitiveExportError
2+module Test (type (×)) where
3+
4+data Tuple a b = Tuple a b
5+
6+infixl 6 type Tuple as ×
src/Language/PureScript/AST/Declarations.hs+9
@@ -232,6 +232,15 @@ foldFixityAlias f _ _ (AliasValue name) = f name
232232foldFixityAlias _ g _ (AliasConstructor name) = g name
233233foldFixityAlias _ _ h (AliasType name) = h name
234234
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+
235244-- | The members of a type class instance declaration
236245data TypeInstanceBody
237246 -- | This is a derived instance
src/Language/PureScript/TypeChecker.hs+19−8
@@ -1,6 +1,7 @@
11{-# LANGUAGE ScopedTypeVariables #-}
22{-# LANGUAGE FlexibleInstances #-}
33{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE PatternGuards #-}
45
56-- |
67-- 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
438439
439440 checkNonAliasesAreExported :: [ProperName 'ConstructorName] -> DeclarationRef -> m ()
440441 checkNonAliasesAreExported exportedDctors dr@(ValueRef (Op name)) =
441− case listToMaybe (mapMaybe getAlias decls) of
442− Just (AliasValue ident) ->
442+ case listToMaybe (mapMaybe (getAlias getValueAlias name) decls) of
443+ Just (Left ident) ->
443444 unless (ValueRef ident `elem` exps) $
444445 throwError . errorMessage $ TransitiveExportError dr [ValueRef ident]
445− Just (AliasConstructor ctor) ->
446+ Just (Right ctor) ->
446447 unless (ctor `elem` exportedDctors) $
447448 throwError . errorMessage $ TransitiveDctorExportError dr ctor
448449 _ -> 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 ()
449456 where
450− getAlias :: Declaration -> Maybe FixityAlias
451− getAlias (PositionedDeclaration _ _ d) = getAlias d
452− getAlias (FixityDeclaration _ name' (Just (Qualified (Just mn') alias)))
453− | name == name' && mn == mn' = Just alias
454− getAlias _ = Nothing
457+ isTypeRefFor :: ProperName 'TypeName -> DeclarationRef -> Bool
458+ isTypeRefFor ty (TypeRef ty' _) = ty == ty'
459+ isTypeRefFor _ _ = False
455460 checkNonAliasesAreExported _ _ = return ()
456461
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+
457468 exportedDataConstructors :: [DeclarationRef] -> [ProperName 'ConstructorName]
458469 exportedDataConstructors = foldMap extractCtor
459470 where