git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
make `exportedDeclarations` filter everything
783061dHarry Garrood
examples/manual/passing/ExportedInstanceDeclarations.pursnew file+41
compare with golang
unifiedsplit
@@ -0,0 +1,41 @@
1+
2+-- Tests that instances for non-exported classes / types do not appear in the
3+-- result of `exportedDeclarations`.
4+
5+module ExportedInstanceDeclarations
6+ ( Const(..)
7+ , Foo
8+ , foo
9+ ) where
10+
11+data Const a b = Const a
12+
13+class Foo a where
14+ foo :: a
15+
16+data NonexportedType = NonexportedType
17+
18+class NonexportedClass a where
19+ notExported :: a
20+
21+-- There are three places that a nonexported type or type class can occur,
22+-- leading an instance to count as non-exported:
23+-- * Constraints
24+-- * The type class itself
25+-- * The instance types
26+
27+-- Case 1: constraints
28+instance nonExportedFoo :: (NonexportedClass a) => Foo a where
29+ foo = notExported
30+
31+-- Another instance of case 1:
32+instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
33+ foo = id
34+
35+-- Case 2: type class
36+instance nonExportedNonexportedType :: NonexportedClass (Const Number a) where
37+ notExported = Const 0
38+
39+-- Case 3: instance types
40+instance constFoo :: Foo (Const NonexportedType b) where
41+ foo = Const NonexportedType
psci/Completion.hs+5−14
@@ -204,21 +204,12 @@ identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations
204 getDeclName _ = Nothing
204 getDeclName _ = Nothing
205
205
206dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
206dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
207−dctorNames m = nubOnFst $ concatMap dctors dnames
207+dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
208 where
208 where
209− getDataDeclName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
209+ go :: P.Declaration -> [(N.ProperName, P.Declaration)]
210− getDataDeclName d@(P.DataDeclaration _ name _ _) = Just (name, d)
210+ go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
211− getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d
211+ go (P.PositionedDeclaration _ _ d) = go d
212− getDataDeclName _ = Nothing
212+ go _ = []
213−
214− dnames :: [(N.ProperName, P.Declaration)]
215− dnames = (mapMaybe getDataDeclName onlyDataDecls)
216−
217− onlyDataDecls :: [P.Declaration]
218− onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
219−
220− dctors :: (N.ProperName, P.Declaration) -> [(N.ProperName, P.Declaration)]
221− dctors (name, decl) = map (\n -> (n, decl)) (map fst (P.exportedDctors m name))
222
213
223moduleNames :: [P.Module] -> [String]
214moduleNames :: [P.Module] -> [String]
224moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
215moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
purescript.cabal+1
@@ -43,6 +43,7 @@ library
43 Language.PureScript.AST.Operators
43 Language.PureScript.AST.Operators
44 Language.PureScript.AST.SourcePos
44 Language.PureScript.AST.SourcePos
45 Language.PureScript.AST.Traversals
45 Language.PureScript.AST.Traversals
46+ Language.PureScript.AST.Exported
46 Language.PureScript.CodeGen
47 Language.PureScript.CodeGen
47 Language.PureScript.CodeGen.Externs
48 Language.PureScript.CodeGen.Externs
48 Language.PureScript.CodeGen.JS
49 Language.PureScript.CodeGen.JS
src/Language/PureScript/AST.hs+1
@@ -21,3 +21,4 @@ import Language.PureScript.AST.Declarations as AST
21import Language.PureScript.AST.Operators as AST
21import Language.PureScript.AST.Operators as AST
22import Language.PureScript.AST.SourcePos as AST
22import Language.PureScript.AST.SourcePos as AST
23import Language.PureScript.AST.Traversals as AST
23import Language.PureScript.AST.Traversals as AST
24+import Language.PureScript.AST.Exported as AST
src/Language/PureScript/AST/Declarations.hs−47
@@ -40,53 +40,6 @@ data Module = Module [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])
40getModuleName :: Module -> ModuleName
40getModuleName :: Module -> ModuleName
41getModuleName (Module _ name _ _) = name
41getModuleName (Module _ name _ _) = name
42
42
43−-- |
44−-- Test if a declaration is exported, given a module's export list.
45−--
46−isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
47−isExported Nothing _ = True
48−isExported _ TypeInstanceDeclaration{} = True
49−isExported exps (PositionedDeclaration _ _ d) = isExported exps d
50−isExported (Just exps) decl = any (matches decl) exps
51− where
52− matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
53− matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
54− matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
55− matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
56− matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
57− matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
58− matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
59− matches (PositionedDeclaration _ _ d) r = d `matches` r
60− matches d (PositionedDeclarationRef _ _ r) = d `matches` r
61− matches _ _ = False
62−
63−exportedDeclarations :: Module -> [Declaration]
64−exportedDeclarations (Module _ _ decls exps) = filter (isExported exps) (flattenDecls decls)
65−
66−-- |
67−-- Test if a data constructor for a given type is exported, given a module's export list.
68−--
69−isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
70−isDctorExported _ Nothing _ = True
71−isDctorExported ident (Just exps) ctor = test `any` exps
72− where
73− test (PositionedDeclarationRef _ _ d) = test d
74− test (TypeRef ident' Nothing) = ident == ident'
75− test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
76− test _ = False
77−
78−-- |
79−-- Return the exported data constructors for a given type.
80−--
81−exportedDctors :: Module -> ProperName -> [(ProperName, [Type])]
82−exportedDctors (Module _ _ decls exps) ident =
83− filter (isDctorExported ident exps . fst) dctors
84− where
85− dctors = concatMap getDctors (flattenDecls decls)
86− getDctors (DataDeclaration _ _ _ ctors) = ctors
87− getDctors (PositionedDeclaration _ _ d) = getDctors d
88− getDctors _ = []
89−
90-- |
43-- |
91-- An item in a list of explicit imports or exports
44-- An item in a list of explicit imports or exports
92--
45--
src/Language/PureScript/AST/Exported.hsnew file+132
@@ -0,0 +1,132 @@
1+
2+module Language.PureScript.AST.Exported (
3+ exportedDeclarations,
4+ isExported
5+) where
6+
7+import Control.Category ((>>>))
8+import Data.Maybe (mapMaybe)
9+
10+import Language.PureScript.AST.Declarations
11+import Language.PureScript.Types
12+import Language.PureScript.Names
13+
14+-- |
15+-- Return a list of all declarations which are exported from a module.
16+-- This function descends into data declarations to filter out unexported
17+-- data constructors, and also filters out type instance declarations if
18+-- they refer to classes or types which are not themselves exported.
19+--
20+-- Note that this function assumes that the module has already had its imports
21+-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
22+-- produce incorrect results if this is not the case - for example, type class
23+-- instances will be incorrectly removed in some cases.
24+--
25+exportedDeclarations :: Module -> [Declaration]
26+exportedDeclarations (Module _ _ decls exps) = go decls
27+ where
28+ go = flattenDecls
29+ >>> filter (isExported exps)
30+ >>> map (filterDataConstructors exps)
31+ >>> filterInstances exps
32+
33+-- |
34+-- Filter out all data constructors from a declaration which are not exported.
35+-- If the supplied declaration is not a data declaration, this function returns
36+-- it unchanged.
37+--
38+filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
39+filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
40+ DataDeclaration dType tyName tyArgs $
41+ filter (isDctorExported tyName exps . fst) dctors
42+filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
43+ PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
44+filterDataConstructors _ other = other
45+
46+-- |
47+-- Filter out all the type instances from a list of declarations which
48+-- reference a type or type class which is both local and not exported.
49+--
50+-- Note that this function assumes that the module has already had its imports
51+-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
52+-- produce incorrect results if this is not the case - for example, type class
53+-- instances will be incorrectly removed in some cases.
54+--
55+filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
56+filterInstances Nothing = id
57+filterInstances (Just exps) =
58+ let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps
59+ in filter (all (visibleOutside refs) . typeInstanceConstituents)
60+ where
61+ -- Given a Qualified ProperName, and a list of all exported types and type
62+ -- classes, returns whether the supplied Qualified ProperName is visible
63+ -- outside this module. This is true if one of the following hold:
64+ --
65+ -- * the name is defined in the same module and is exported,
66+ -- * the name is defined in a different module (and must be exported from
67+ -- that module; the code would fail to compile otherwise).
68+ visibleOutside _ (Qualified (Just _) _) = True
69+ visibleOutside refs (Qualified Nothing n) = any (== n) refs
70+
71+ typeName (TypeRef n _) = Just n
72+ typeName (PositionedDeclarationRef _ _ r) = typeName r
73+ typeName _ = Nothing
74+
75+ typeClassName (TypeClassRef n) = Just n
76+ typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
77+ typeClassName _ = Nothing
78+
79+-- |
80+-- Get all type and type class names referenced by a type instance declaration.
81+--
82+typeInstanceConstituents :: Declaration -> [Qualified ProperName]
83+typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
84+ className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
85+ where
86+
87+ fromConstraint (name, tys') = name : concatMap fromType tys'
88+ fromType = everythingOnTypes (++) go
89+
90+ -- Note that type synonyms are disallowed in instance declarations, so
91+ -- we don't need to handle them here.
92+ go (TypeConstructor n) = [n]
93+ go (ConstrainedType cs _) = concatMap fromConstraint cs
94+ go _ = []
95+
96+typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
97+typeInstanceConstituents _ = []
98+
99+
100+-- |
101+-- Test if a declaration is exported, given a module's export list. Prefer
102+-- 'exportedDeclarations' to this function, where possible.
103+--
104+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
105+isExported Nothing _ = True
106+isExported _ TypeInstanceDeclaration{} = True
107+isExported exps (PositionedDeclaration _ _ d) = isExported exps d
108+isExported (Just exps) decl = any (matches decl) exps
109+ where
110+ matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
111+ matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
112+ matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
113+ matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
114+ matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
115+ matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
116+ matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
117+ matches (PositionedDeclaration _ _ d) r = d `matches` r
118+ matches d (PositionedDeclarationRef _ _ r) = d `matches` r
119+ matches _ _ = False
120+
121+-- |
122+-- Test if a data constructor for a given type is exported, given a module's
123+-- export list. Prefer 'exportedDeclarations' to this function, where possible.
124+--
125+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
126+isDctorExported _ Nothing _ = True
127+isDctorExported ident (Just exps) ctor = test `any` exps
128+ where
129+ test (PositionedDeclarationRef _ _ d) = test d
130+ test (TypeRef ident' Nothing) = ident == ident'
131+ test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
132+ test _ = False
src/Language/PureScript/Docs/Render.hs+14−15
@@ -35,14 +35,14 @@ renderPackage name vers mods =
35-- Render a single Module.
35-- Render a single Module.
36--
36--
37renderModule :: P.Module -> RenderedModule
37renderModule :: P.Module -> RenderedModule
38−renderModule m@(P.Module coms moduleName _ exps) =
38+renderModule m@(P.Module coms moduleName _ _) =
39 RenderedModule (show moduleName) comments declarations
39 RenderedModule (show moduleName) comments declarations
40 where
40 where
41 comments = renderComments coms
41 comments = renderComments coms
42 declarations = groupChildren declarationsWithChildren
42 declarations = groupChildren declarationsWithChildren
43 declarationsWithChildren = mapMaybe go (P.exportedDeclarations m)
43 declarationsWithChildren = mapMaybe go (P.exportedDeclarations m)
44 go decl = getDeclarationTitle decl
44 go decl = getDeclarationTitle decl
45− >>= renderDeclaration exps decl
45+ >>= renderDeclaration decl
46
46
47-- | An intermediate stage which we go through during rendering.
47-- | An intermediate stage which we go through during rendering.
48--
48--
@@ -95,39 +95,38 @@ getDeclarationTitle _ = Nothing
95basicDeclaration :: String -> RenderedCode -> Maybe IntermediateDeclaration
95basicDeclaration :: String -> RenderedCode -> Maybe IntermediateDeclaration
96basicDeclaration title code = Just (Right (RenderedDeclaration title Nothing code Nothing []))
96basicDeclaration title code = Just (Right (RenderedDeclaration title Nothing code Nothing []))
97
97
98−renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> String -> Maybe IntermediateDeclaration
98+renderDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
99−renderDeclaration _ (P.TypeDeclaration ident' ty) title =
99+renderDeclaration (P.TypeDeclaration ident' ty) title =
100 basicDeclaration title code
100 basicDeclaration title code
101 where
101 where
102 code = ident (show ident')
102 code = ident (show ident')
103 <> sp <> syntax "::" <> sp
103 <> sp <> syntax "::" <> sp
104 <> renderType ty
104 <> renderType ty
105−renderDeclaration _ (P.ExternDeclaration _ ident' _ ty) title =
105+renderDeclaration (P.ExternDeclaration _ ident' _ ty) title =
106 basicDeclaration title code
106 basicDeclaration title code
107 where
107 where
108 code = ident (show ident')
108 code = ident (show ident')
109 <> sp <> syntax "::" <> sp
109 <> sp <> syntax "::" <> sp
110 <> renderType ty
110 <> renderType ty
111−renderDeclaration exps (P.DataDeclaration dtype name args ctors) title =
111+renderDeclaration (P.DataDeclaration dtype name args ctors) title =
112 Just (Right (RenderedDeclaration title Nothing code Nothing children))
112 Just (Right (RenderedDeclaration title Nothing code Nothing children))
113 where
113 where
114 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
114 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
115− exported = filter (P.isDctorExported name exps . fst) ctors
116 code = keyword (show dtype) <> sp <> renderType typeApp
115 code = keyword (show dtype) <> sp <> renderType typeApp
117− children = map renderCtor exported
116+ children = map renderCtor ctors
118 -- TODO: Comments for data constructors?
117 -- TODO: Comments for data constructors?
119 renderCtor (ctor', tys) =
118 renderCtor (ctor', tys) =
120 let typeApp' = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing ctor')) tys
119 let typeApp' = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing ctor')) tys
121 childCode = renderType typeApp'
120 childCode = renderType typeApp'
122 in RenderedChildDeclaration (show ctor') Nothing childCode Nothing ChildDataConstructor
121 in RenderedChildDeclaration (show ctor') Nothing childCode Nothing ChildDataConstructor
123−renderDeclaration _ (P.ExternDataDeclaration name kind') title =
122+renderDeclaration (P.ExternDataDeclaration name kind') title =
124 basicDeclaration title code
123 basicDeclaration title code
125 where
124 where
126 code = keywordData <> sp
125 code = keywordData <> sp
127 <> renderType (P.TypeConstructor (P.Qualified Nothing name))
126 <> renderType (P.TypeConstructor (P.Qualified Nothing name))
128 <> sp <> syntax "::" <> sp
127 <> sp <> syntax "::" <> sp
129 <> renderKind kind'
128 <> renderKind kind'
130−renderDeclaration _ (P.TypeSynonymDeclaration name args ty) title =
129+renderDeclaration (P.TypeSynonymDeclaration name args ty) title =
131 basicDeclaration title code
130 basicDeclaration title code
132 where
131 where
133 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
132 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
@@ -137,7 +136,7 @@ renderDeclaration _ (P.TypeSynonymDeclaration name args ty) title =
137 , syntax "="
136 , syntax "="
138 , renderType ty
137 , renderType ty
139 ]
138 ]
140−renderDeclaration _ (P.TypeClassDeclaration name args implies ds) title = do
139+renderDeclaration (P.TypeClassDeclaration name args implies ds) title = do
141 Just (Right (RenderedDeclaration title Nothing code Nothing children))
140 Just (Right (RenderedDeclaration title Nothing code Nothing children))
142 where
141 where
143 code = mintersperse sp $
142 code = mintersperse sp $
@@ -172,7 +171,7 @@ renderDeclaration _ (P.TypeClassDeclaration name args implies ds) title = do
172 ]
171 ]
173 in RenderedChildDeclaration (show ident') Nothing childCode Nothing ChildTypeClassMember
172 in RenderedChildDeclaration (show ident') Nothing childCode Nothing ChildTypeClassMember
174 renderClassMember _ = error "Invalid argument to renderClassMember."
173 renderClassMember _ = error "Invalid argument to renderClassMember."
175−renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) title = do
174+renderDeclaration (P.TypeInstanceDeclaration name constraints className tys _) title = do
176 Just (Left (classNameString : typeNameStrings, childDecl))
175 Just (Left (classNameString : typeNameStrings, childDecl))
177 where
176 where
178 classNameString = unQual className
177 classNameString = unQual className
@@ -204,15 +203,15 @@ renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _)
204 in renderType supApp
203 in renderType supApp
205
204
206 classApp = foldl P.TypeApp (P.TypeConstructor className) tys
205 classApp = foldl P.TypeApp (P.TypeConstructor className) tys
207−renderDeclaration exps (P.PositionedDeclaration srcSpan com d') title =
206+renderDeclaration (P.PositionedDeclaration srcSpan com d') title =
208− fmap (addComments . addSourceSpan) (renderDeclaration exps d' title)
207+ fmap (addComments . addSourceSpan) (renderDeclaration d' title)
209 where
208 where
210 addComments (Left (t, d)) = Left (t, d { rcdComments = renderComments com })
209 addComments (Left (t, d)) = Left (t, d { rcdComments = renderComments com })
211 addComments (Right d) = Right (d { rdComments = renderComments com })
210 addComments (Right d) = Right (d { rdComments = renderComments com })
212
211
213 addSourceSpan (Left (t, d)) = Left (t, d { rcdSourceSpan = Just srcSpan })
212 addSourceSpan (Left (t, d)) = Left (t, d { rcdSourceSpan = Just srcSpan })
214 addSourceSpan (Right d) = Right (d { rdSourceSpan = Just srcSpan })
213 addSourceSpan (Right d) = Right (d { rdSourceSpan = Just srcSpan })
215−renderDeclaration _ _ _ = Nothing
214+renderDeclaration _ _ = Nothing
216
215
217renderComments :: [P.Comment] -> Maybe String
216renderComments :: [P.Comment] -> Maybe String
218renderComments cs = do
217renderComments cs = do