git.iko.soy/Idris-dev
on master help sign in
Merge pull request #1166 from paulkoerbitz/fix/1158-consistify-typeclass-parameter-names-in-doc
9b05293David Christiansen
src/Idris/Docs.hs+19−7
compare with master
unifiedsplit
@@ -89,16 +89,29 @@ pprintDocs imp (ClassDoc n doc meths params instances)
89 <>
89 <>
90 if null subclasses then empty
90 if null subclasses then empty
91 else line <$> nest 4 (text "Subclasses:" <$>
91 else line <$> nest 4 (text "Subclasses:" <$>
92− vsep (map (dumpInstance . remConstraint) subclasses))
92+ vsep (map (dumpInstance . prettifySubclasses) subclasses))
93 where
93 where
94− params' = map (\x -> (fst x, False)) params
94+ params' = zip pNames (repeat False)
95
95
96+ pNames = map fst params
97+
96 dumpInstance :: PTerm -> Doc OutputAnnotation
98 dumpInstance :: PTerm -> Doc OutputAnnotation
97 dumpInstance = pprintPTerm imp params' []
99 dumpInstance = pprintPTerm imp params' []
98
100
99− remConstraint (PPi (Constraint _ _) _ tm _) = tm
101+ prettifySubclasses (PPi (Constraint _ _) _ tm _) = prettifySubclasses tm
100− remConstraint (PPi x y z pt) = PPi x y z (remConstraint pt)
102+ prettifySubclasses (PPi plcity nm t1 t2) = PPi plcity (safeHead nm pNames) (prettifySubclasses t1) (prettifySubclasses t2)
101− remConstraint p = p
103+ prettifySubclasses (PApp fc ref args) = PApp fc ref $ updateArgs pNames args
104+ prettifySubclasses tm = tm
105+
106+ safeHead _ (y:_) = y
107+ safeHead x [] = x
108+
109+ updateArgs (p:ps) ((PExp prty opts _ ref):as) = (PExp prty opts p (updateRef p ref)) : updateArgs ps as
110+ updateArgs ps (a:as) = a : updateArgs ps as
111+ updateArgs _ _ = []
112+
113+ updateRef nm (PRef fc _) = PRef fc nm
114+ updateRef _ pt = pt
102
115
103 hasConstraint (PPi (Constraint _ _) _ _ _) = True
116 hasConstraint (PPi (Constraint _ _) _ _ _) = True
104 hasConstraint (PPi _ _ _ pt) = hasConstraint pt
117 hasConstraint (PPi _ _ _ pt) = hasConstraint pt
@@ -107,7 +120,7 @@ pprintDocs imp (ClassDoc n doc meths params instances)
107 (subclasses, instances') = partition hasConstraint instances
120 (subclasses, instances') = partition hasConstraint instances
108
121
109 prettyParameters = if any (isJust . snd) params
122 prettyParameters = if any (isJust . snd) params
110− then vsep (map (\(n,md) -> prettyName False params' n <+> maybe empty showDoc md) params)
123+ then vsep (map (\(nm,md) -> prettyName False params' nm <+> maybe empty showDoc md) params)
111 else hsep (punctuate comma (map (prettyName False params' . fst) params))
124 else hsep (punctuate comma (map (prettyName False params' . fst) params))
112
125
113getDocs :: Name -> Idris Docs
126getDocs :: Name -> Idris Docs
@@ -129,7 +142,6 @@ docData n ti
129docClass :: Name -> ClassInfo -> Idris Docs
142docClass :: Name -> ClassInfo -> Idris Docs
130docClass n ci
143docClass n ci
131 = do i <- getIState
144 = do i <- getIState
132− ctxt <- getContext
133 let docStrings = listToMaybe $ lookupCtxt n $ idris_docstrings i
145 let docStrings = listToMaybe $ lookupCtxt n $ idris_docstrings i
134 docstr = maybe emptyDocstring fst docStrings
146 docstr = maybe emptyDocstring fst docStrings
135 params = map (\pn -> (pn, docStrings >>= (lookup pn . snd))) (class_params ci)
147 params = map (\pn -> (pn, docStrings >>= (lookup pn . snd))) (class_params ci)