git.iko.soy/Idris-dev
on master help sign in
Merge pull request #1221 from paulkoerbitz/fix/911-make-doc-show-superclasses

Fix/911 make doc show superclasses

commitd3eb1b76898d5db944a52df92ed6752cbc06ae9f authorEdwin Brady <edwin.brady@gmail.com> dateMon 12 May 2014, 11:20 (12 years ago) parent9274248a713659
2 files changed+28−22
compare with master
unifiedsplit
src/Idris/Docs.hs+19−13 src/Idris/IdrisDoc.hs+9−9
src/Idris/Docs.hs+19−13
@@ -29,6 +29,7 @@ data Docs = FunDoc FunDoc
2929 [FunDoc] -- method docs
3030 [(Name, Maybe Docstring)] -- parameters and their docstrings
3131 [PTerm] -- instances
32+ [PTerm] -- superclasses
3233 deriving Show
3334
3435showDoc d | nullDocstring d = empty
@@ -77,7 +78,7 @@ pprintDocs ist (DataDoc t args)
7778 if null args then text "No constructors."
7879 else nest 4 (text "Constructors:" <> line <>
7980 vsep (map (pprintFD ist) args))
80−pprintDocs ist (ClassDoc n doc meths params instances)
81+pprintDocs ist (ClassDoc n doc meths params instances superclasses)
8182 = nest 4 (text "Type class" <+> prettyName (ppopt_impl ppo) [] n <>
8283 if nullDocstring doc then empty else line <> renderDocstring doc)
8384 <> line <$>
@@ -90,9 +91,13 @@ pprintDocs ist (ClassDoc n doc meths params instances)
9091 vsep (if null instances' then [text "<no instances>"]
9192 else map dumpInstance instances'))
9293 <>
93− if null subclasses then empty
94− else line <$> nest 4 (text "Subclasses:" <$>
95− vsep (map (dumpInstance . prettifySubclasses) subclasses))
94+ (if null subclasses then empty
95+ else line <$> nest 4 (text "Subclasses:" <$>
96+ vsep (map (dumpInstance . prettifySubclasses) subclasses)))
97+ <>
98+ (if null superclasses then empty
99+ else line <$> nest 4 (text "Default superclass instances:" <$>
100+ vsep (map dumpInstance superclasses)))
96101 where
97102 params' = zip pNames (repeat False)
98103
@@ -119,11 +124,11 @@ pprintDocs ist (ClassDoc n doc meths params instances)
119124 updateRef nm (PRef fc _) = PRef fc nm
120125 updateRef _ pt = pt
121126
122− hasConstraint (PPi (Constraint _ _) _ _ _) = True
123− hasConstraint (PPi _ _ _ pt) = hasConstraint pt
124− hasConstraint _ = False
127+ isSubclass (PPi (Constraint _ _) _ (PApp _ _ args) (PApp _ (PRef _ nm) args')) = nm == n && map getTm args == map getTm args'
128+ isSubclass (PPi _ _ _ pt) = isSubclass pt
129+ isSubclass _ = False
125130
126− (subclasses, instances') = partition hasConstraint instances
131+ (subclasses, instances') = partition isSubclass instances
127132
128133 prettyParameters = if any (isJust . snd) params
129134 then vsep (map (\(nm,md) -> prettyName False params' nm <+> maybe empty showDoc md) params)
@@ -152,8 +157,12 @@ docClass n ci
152157 docstr = maybe emptyDocstring fst docStrings
153158 params = map (\pn -> (pn, docStrings >>= (lookup pn . snd))) (class_params ci)
154159 instances = map (delabTy i) (class_instances ci)
155− mdocs <- mapM (docFun .fst) (class_methods ci)
156− return $ ClassDoc n docstr mdocs params instances
160+ superclasses = catMaybes $ map getDInst (class_default_superclasses ci)
161+ mdocs <- mapM (docFun . fst) (class_methods ci)
162+ return $ ClassDoc n docstr mdocs params instances superclasses
163+ where
164+ getDInst (PInstance _ _ _ _ _ t _ _) = Just t
165+ getDInst _ = Nothing
157166
158167docFun :: Name -> Idris FunDoc
159168docFun n
@@ -192,6 +201,3 @@ pprintConstDocs ist c str = text "Primitive" <+> text (if constIsType c then "ty
192201 t (Str _) = PConstant StrType
193202 t (Ch c) = PConstant $ AType (ATInt ITChar)
194203 t _ = PType
195−
196−
197−
src/Idris/IdrisDoc.hs+9−9
@@ -157,9 +157,9 @@ removeOrphans list =
157157 let children = S.fromList $ concatMap (names . (\(_, d, _) -> d)) list
158158 in filter ((`S.notMember` children) . (\(n, _, _) -> n)) list
159159
160− where names (Just (DataDoc _ fds)) = map (\(FD n _ _ _ _) -> n) fds
161− names (Just (ClassDoc _ _ fds _ _)) = map (\(FD n _ _ _ _) -> n) fds
162− names _ = []
160+ where names (Just (DataDoc _ fds)) = map (\(FD n _ _ _ _) -> n) fds
161+ names (Just (ClassDoc _ _ fds _ _ _)) = map (\(FD n _ _ _ _) -> n) fds
162+ names _ = []
163163
164164-- | Whether a Name names something which should be documented
165165filterName :: Name -- ^ Name to check
@@ -207,11 +207,11 @@ referredNss (n, Just d, _) =
207207 names = concatMap (extractPTermNames) ts
208208 in S.map getNs $ S.fromList names
209209
210− where getFunDocs (FunDoc f) = [f]
211− getFunDocs (DataDoc f fs) = f:fs
212− getFunDocs (ClassDoc _ _ fs _ _) = fs
213− types (FD _ _ args t _) = t:(map second args)
214− second (_, x, _, _) = x
210+ where getFunDocs (FunDoc f) = [f]
211+ getFunDocs (DataDoc f fs) = f:fs
212+ getFunDocs (ClassDoc _ _ fs _ _ _) = fs
213+ types (FD _ _ args t _) = t:(map second args)
214+ second (_, x, _, _) = x
215215
216216
217217-- | Returns an NsDict of containing all known namespaces and their contents
@@ -555,7 +555,7 @@ createOtherDoc :: IState -- ^ Needed to determine the types of names
555555 -> H.Html -- ^ Resulting HTML
556556createOtherDoc ist (FunDoc fd) = createFunDoc ist fd
557557
558−createOtherDoc ist (ClassDoc n docstring fds _ _) = do
558+createOtherDoc ist (ClassDoc n docstring fds _ _ _) = do
559559 H.dt ! (A.id $ toValue $ show n) $ do
560560 H.span ! class_ "word" $ do "class"; nbsp
561561 H.span ! class_ "name type"