@@ -60,55 +60,78 @@ renderModules ms = do
6060
6161-- TODO: filter everything by exports
6262renderModule :: P.Module -> Docs
63−renderModule (P.Module moduleName ds exps) = do
64− headerLevel 2 $ "Module " ++ P.runModuleName moduleName
65− spacer
66− headerLevel 3 "Types"
67− spacer
68− renderTopLevel (filter isTypeDeclaration ds)
69− spacer
70− headerLevel 3 "Type Classes"
71− spacer
72− renderTopLevel (filter isTypeClassDeclaration ds)
73− spacer
74− headerLevel 3 "Type Class Instances"
75− spacer
76− renderTopLevel (filter isTypeInstanceDeclaration ds)
77− spacer
78− headerLevel 3 "Values"
79− spacer
80− renderTopLevel (filter isValueDeclaration ds)
81− spacer
82−
83−renderTopLevel :: [P.Declaration] -> Docs
84−renderTopLevel decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
85− renderDeclaration 4 decl
63+renderModule (P.Module moduleName ds exps) =
64+ let exported = filter (isExported exps) ds
65+ in do
66+ headerLevel 2 $ "Module " ++ P.runModuleName moduleName
67+ spacer
68+ headerLevel 3 "Types"
69+ spacer
70+ renderTopLevel exps (filter isTypeDeclaration exported)
71+ spacer
72+ headerLevel 3 "Type Classes"
73+ spacer
74+ renderTopLevel exps (filter isTypeClassDeclaration exported)
75+ spacer
76+ headerLevel 3 "Type Class Instances"
77+ spacer
78+ renderTopLevel exps (filter isTypeInstanceDeclaration ds)
79+ spacer
80+ headerLevel 3 "Values"
81+ spacer
82+ renderTopLevel exps (filter isValueDeclaration exported)
83+ spacer
84+
85+isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
86+isExported Nothing _ = True
87+isExported _ (P.TypeInstanceDeclaration _ _ _ _ _) = True
88+isExported (Just exps) decl = any (matches decl) exps
89+ where
90+ matches (P.TypeDeclaration ident _) (P.ValueRef ident') = ident == ident'
91+ matches (P.ExternDeclaration _ ident _ _) (P.ValueRef ident') = ident == ident'
92+ matches (P.DataDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
93+ matches (P.ExternDataDeclaration ident _) (P.TypeRef ident' _) = ident == ident'
94+ matches (P.TypeSynonymDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
95+ matches (P.TypeClassDeclaration ident _ _) (P.TypeClassRef ident') = ident == ident'
96+ matches _ _ = False
97+
98+isDctorExported :: P.ProperName -> Maybe [P.DeclarationRef] -> P.ProperName -> Bool
99+isDctorExported _ Nothing _ = True
100+isDctorExported ident (Just exps) ctor = flip any exps $ \e -> case e of
101+ P.TypeRef ident' Nothing -> ident == ident'
102+ P.TypeRef ident' (Just ctors) -> ident == ident' && ctor `elem` ctors
103+ _ -> False
104+
105+renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
106+renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
107+ renderDeclaration 4 exps decl
86108 spacer
87109
88−renderDeclaration :: Int -> P.Declaration -> Docs
89−renderDeclaration n (P.TypeDeclaration ident ty) =
110+renderDeclaration :: Int -> Maybe [P.DeclarationRef] -> P.Declaration -> Docs
111+renderDeclaration n _ (P.TypeDeclaration ident ty) =
90112 atIndent n $ show ident ++ " :: " ++ P.prettyPrintType ty
91−renderDeclaration n (P.ExternDeclaration _ ident _ ty) =
113+renderDeclaration n _ (P.ExternDeclaration _ ident _ ty) =
92114 atIndent n $ show ident ++ " :: " ++ P.prettyPrintType ty
93−renderDeclaration n (P.DataDeclaration name args ctors) = do
115+renderDeclaration n exps (P.DataDeclaration name args ctors) = do
94116 let typeName = P.runProperName name ++ " " ++ unwords args
95117 atIndent n $ "data " ++ typeName ++ " where"
96− forM_ ctors $ \(ctor, tys) ->
118+ let exported = filter (isDctorExported name exps . fst) ctors
119+ forM_ exported $ \(ctor, tys) ->
97120 atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concatMap (\ty -> P.prettyPrintType ty ++ " -> ") tys ++ typeName
98−renderDeclaration n (P.ExternDataDeclaration name kind) =
121+renderDeclaration n _ (P.ExternDataDeclaration name kind) =
99122 atIndent n $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
100−renderDeclaration n (P.TypeSynonymDeclaration name args ty) = do
123+renderDeclaration n _ (P.TypeSynonymDeclaration name args ty) = do
101124 let typeName = P.runProperName name ++ " " ++ unwords args
102125 atIndent n $ "type " ++ typeName ++ " = " ++ P.prettyPrintType ty
103−renderDeclaration n (P.TypeClassDeclaration name args ds) = do
126+renderDeclaration n exps (P.TypeClassDeclaration name args ds) = do
104127 atIndent n $ "class " ++ P.runProperName name ++ " " ++ unwords args ++ " where"
105− mapM_ (renderDeclaration (n + 2)) ds
106−renderDeclaration n (P.TypeInstanceDeclaration name constraints className tys _) = do
128+ mapM_ (renderDeclaration (n + 2) exps) ds
129+renderDeclaration n _ (P.TypeInstanceDeclaration name constraints className tys _) = do
107130 let constraintsText = case constraints of
108131 [] -> ""
109132 cs -> "(" ++ intercalate "," (map (\(pn, tys') -> show pn ++ " (" ++ unwords (map (("(" ++) . (++ ")") . P.prettyPrintType) tys') ++ ")") cs) ++ ") => "
110133 atIndent n $ constraintsText ++ "instance " ++ show name ++ " :: " ++ show className ++ " " ++ unwords (map (("(" ++) . (++ ")") . P.prettyPrintType) tys)
111−renderDeclaration _ _ = return ()
134+renderDeclaration _ _ _ = return ()
112135
113136getName :: P.Declaration -> String
114137getName (P.TypeDeclaration ident _) = show ident