git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Merge pull request #778 from hdgarrood/export-helpers
1d06e2cPhil Freeman
psc-docs/Main.hs+6−31
compare with golang
unifiedsplit
@@ -75,8 +75,8 @@ renderModules showHierarchy ms = do
75 mapM_ (renderModule showHierarchy) ms
75 mapM_ (renderModule showHierarchy) ms
76
76
77renderModule :: Bool -> P.Module -> Docs
77renderModule :: Bool -> P.Module -> Docs
78−renderModule showHierarchy (P.Module moduleName ds exps) =
78+renderModule showHierarchy mdl@(P.Module moduleName _ exps) =
79− let exported = filter (isExported exps) ds
79+ let ds = P.exportedDeclarations mdl
80 hasTypes = any isTypeDeclaration ds
80 hasTypes = any isTypeDeclaration ds
81 hasTypeclasses = any isTypeClassDeclaration ds
81 hasTypeclasses = any isTypeClassDeclaration ds
82 hasTypeclassInstances = any isTypeInstanceDeclaration ds
82 hasTypeclassInstances = any isTypeInstanceDeclaration ds
@@ -87,7 +87,7 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
87 when hasTypes $ do
87 when hasTypes $ do
88 headerLevel 3 "Types"
88 headerLevel 3 "Types"
89 spacer
89 spacer
90− renderTopLevel exps (filter isTypeDeclaration exported)
90+ renderTopLevel exps (filter isTypeDeclaration ds)
91 spacer
91 spacer
92 when hasTypeclasses $ do
92 when hasTypeclasses $ do
93 headerLevel 3 "Type Classes"
93 headerLevel 3 "Type Classes"
@@ -95,7 +95,7 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
95 when showHierarchy $ do
95 when showHierarchy $ do
96 renderTypeclassImage moduleName
96 renderTypeclassImage moduleName
97 spacer
97 spacer
98− renderTopLevel exps (filter isTypeClassDeclaration exported)
98+ renderTopLevel exps (filter isTypeClassDeclaration ds)
99 spacer
99 spacer
100 when hasTypeclassInstances $ do
100 when hasTypeclassInstances $ do
101 headerLevel 3 "Type Class Instances"
101 headerLevel 3 "Type Class Instances"
@@ -105,34 +105,9 @@ renderModule showHierarchy (P.Module moduleName ds exps) =
105 when hasValues $ do
105 when hasValues $ do
106 headerLevel 3 "Values"
106 headerLevel 3 "Values"
107 spacer
107 spacer
108− renderTopLevel exps (filter isValueDeclaration exported)
108+ renderTopLevel exps (filter isValueDeclaration ds)
109 spacer
109 spacer
110
110
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−
136renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
111renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
137renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
112renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
138 renderDeclaration 4 exps decl
113 renderDeclaration 4 exps decl
@@ -152,7 +127,7 @@ renderDeclaration n exps (P.DataDeclaration dtype name args ctors) = do
152 let
127 let
153 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
128 typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
154 typeName = prettyPrintType' typeApp
129 typeName = prettyPrintType' typeApp
155− exported = filter (isDctorExported name exps . fst) ctors
130+ exported = filter (P.isDctorExported name exps . fst) ctors
156 atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
131 atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
157 forM_ exported $ \(ctor, tys) ->
132 forM_ exported $ \(ctor, tys) ->
158 let ctorTy = foldr P.function typeApp tys
133 let ctorTy = foldr P.function typeApp tys
src/Language/PureScript/AST/Declarations.hs+45
@@ -34,6 +34,51 @@ import Language.PureScript.Environment
34--
34--
35data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
35data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
36
36
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+
37-- |
82-- |
38-- An item in a list of explicit imports or exports
83-- An item in a list of explicit imports or exports
39--
84--
src/Language/PureScript/Sugar/TypeClasses.hs+1−1
@@ -18,7 +18,7 @@ module Language.PureScript.Sugar.TypeClasses (
18 desugarTypeClasses
18 desugarTypeClasses
19) where
19) where
20
20
21−import Language.PureScript.AST
21+import Language.PureScript.AST hiding (isExported)
22import Language.PureScript.Names
22import Language.PureScript.Names
23import Language.PureScript.Types
23import Language.PureScript.Types
24import Language.PureScript.Kinds
24import Language.PureScript.Kinds