git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #778 from hdgarrood/export-helpers

Export functions for extracting exported declarations

commit1d06e2cd18593765203119dcd6e172c4ca751f70 authorPhil Freeman <paf31@cantab.net> dateSun 21 Dec 2014, 18:38 (12 years ago) parent68263927b326f4
3 files changed+52−32
compare with golang
unifiedsplit
psc-docs/Main.hs+6−31 src/Language/PureScript/AST/Declarations.hs+45 src/Language/PureScript/Sugar/TypeClasses.hs+1−1
psc-docs/Main.hs+6−31
@@ -75,8 +75,8 @@ renderModules showHierarchy ms = do
7575 mapM_ (renderModule showHierarchy) ms
7676
7777renderModule :: Bool -> P.Module -> Docs
78−renderModule showHierarchy (P.Module moduleName ds exps) =
79− let exported = filter (isExported exps) ds
78+renderModule showHierarchy mdl@(P.Module moduleName _ exps) =
79+ let ds = P.exportedDeclarations mdl
8080 hasTypes = any isTypeDeclaration ds
8181 hasTypeclasses = any isTypeClassDeclaration ds
8282 hasTypeclassInstances = any isTypeInstanceDeclaration ds
@@ -87,7 +87,7 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
8787 when hasTypes $ do
8888 headerLevel 3 "Types"
8989 spacer
90− renderTopLevel exps (filter isTypeDeclaration exported)
90+ renderTopLevel exps (filter isTypeDeclaration ds)
9191 spacer
9292 when hasTypeclasses $ do
9393 headerLevel 3 "Type Classes"
@@ -95,7 +95,7 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
9595 when showHierarchy $ do
9696 renderTypeclassImage moduleName
9797 spacer
98− renderTopLevel exps (filter isTypeClassDeclaration exported)
98+ renderTopLevel exps (filter isTypeClassDeclaration ds)
9999 spacer
100100 when hasTypeclassInstances $ do
101101 headerLevel 3 "Type Class Instances"
@@ -105,34 +105,9 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
105105 when hasValues $ do
106106 headerLevel 3 "Values"
107107 spacer
108− renderTopLevel exps (filter isValueDeclaration exported)
108+ renderTopLevel exps (filter isValueDeclaration ds)
109109 spacer
110110
111−isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
112−isExported Nothing _ = True
113−isExported _ P.TypeInstanceDeclaration{} = True
114−isExported exps (P.PositionedDeclaration _ d) = isExported exps d
115−isExported (Just exps) decl = any (matches decl) exps
116− where
117− matches (P.TypeDeclaration ident _) (P.ValueRef ident') = ident == ident'
118− matches (P.ExternDeclaration _ ident _ _) (P.ValueRef ident') = ident == ident'
119− matches (P.DataDeclaration _ ident _ _) (P.TypeRef ident' _) = ident == ident'
120− matches (P.ExternDataDeclaration ident _) (P.TypeRef ident' _) = ident == ident'
121− matches (P.TypeSynonymDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
122− matches (P.TypeClassDeclaration ident _ _ _) (P.TypeClassRef ident') = ident == ident'
123− matches (P.PositionedDeclaration _ d) r = d `matches` r
124− matches d (P.PositionedDeclarationRef _ r) = d `matches` r
125− matches _ _ = False
126−
127−isDctorExported :: P.ProperName -> Maybe [P.DeclarationRef] -> P.ProperName -> Bool
128−isDctorExported _ Nothing _ = True
129−isDctorExported ident (Just exps) ctor = test `any` exps
130− where
131− test (P.PositionedDeclarationRef _ d) = test d
132− test (P.TypeRef ident' Nothing) = ident == ident'
133− test (P.TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
134− test _ = False
135−
136111renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
137112renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
138113 renderDeclaration 4 exps decl
@@ -152,7 +127,7 @@ renderDeclaration n exps (P.DataDeclaration dtype name args ctors) = do
152127 let
153128 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
154129 typeName = prettyPrintType' typeApp
155− exported = filter (isDctorExported name exps . fst) ctors
130+ exported = filter (P.isDctorExported name exps . fst) ctors
156131 atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
157132 forM_ exported $ \(ctor, tys) ->
158133 let ctorTy = foldr P.function typeApp tys
src/Language/PureScript/AST/Declarations.hs+45
@@ -34,6 +34,51 @@ import Language.PureScript.Environment
3434--
3535data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
3636
37+-- |
38+-- Test if a declaration is exported, given a module's export list.
39+--
40+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
41+isExported Nothing _ = True
42+isExported _ TypeInstanceDeclaration{} = True
43+isExported exps (PositionedDeclaration _ d) = isExported exps d
44+isExported (Just exps) decl = any (matches decl) exps
45+ where
46+ matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
47+ matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
48+ matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
49+ matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
50+ matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
51+ matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
52+ matches (PositionedDeclaration _ d) r = d `matches` r
53+ matches d (PositionedDeclarationRef _ r) = d `matches` r
54+ matches _ _ = False
55+
56+exportedDeclarations :: Module -> [Declaration]
57+exportedDeclarations (Module _ decls exps) = filter (isExported exps) decls
58+
59+-- |
60+-- Test if a data constructor for a given type is exported, given a module's export list.
61+--
62+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
63+isDctorExported _ Nothing _ = True
64+isDctorExported ident (Just exps) ctor = test `any` exps
65+ where
66+ test (PositionedDeclarationRef _ d) = test d
67+ test (TypeRef ident' Nothing) = ident == ident'
68+ test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
69+ test _ = False
70+
71+-- |
72+-- Return the exported data constructors for a given type.
73+--
74+exportedDctors :: Module -> ProperName -> [ProperName]
75+exportedDctors (Module _ decls exps) ident =
76+ filter (isDctorExported ident exps) dctors
77+ where
78+ dctors = concatMap getDctors decls
79+ getDctors (DataDeclaration _ _ _ ctors) = map fst ctors
80+ getDctors _ = []
81+
3782-- |
3883-- An item in a list of explicit imports or exports
3984--
src/Language/PureScript/Sugar/TypeClasses.hs+1−1
@@ -18,7 +18,7 @@ module Language.PureScript.Sugar.TypeClasses (
1818 desugarTypeClasses
1919) where
2020
21−import Language.PureScript.AST
21+import Language.PureScript.AST hiding (isExported)
2222import Language.PureScript.Names
2323import Language.PureScript.Types
2424import Language.PureScript.Kinds