Verified Commit f6606482 authored by Camil Staps's avatar Camil Staps 🚀

Parse documentation of shorthand classes correctly

parent 406e40d0
......@@ -65,7 +65,7 @@ from CloogleDB import :: Location(Location), filterLocations,
from Doc import :: Documentation(FunctionDoc), :: ResultDoc, :: VarDoc,
:: ParamDoc, :: Description, :: TypeRhsDoc(RecordDoc), :: RecordFieldDoc,
:: ClassMemberDoc,
:: ParseWarning(UsedReturn), :: ParseError(IllegalState),
:: ParseWarning(UsedReturn,IllegalField), :: ParseError(IllegalState),
parseFunctionDoc, parseConstructorDoc, parseADTypeDoc, parseRecordTypeDoc,
parseSynonymTypeDoc, parseAbstractTypeDoc, parseFieldDoc, parseClassDoc,
parseModuleDoc, traceParseError, traceParseWarnings, getTypeRhsDoc,
......@@ -278,14 +278,14 @@ where
pd_module :: ![ParsedDefinition] -> ModuleEntry
pd_module [PD_Documentation _ doc:_]
= { zero
& me_documentation = docParseResultToMaybe $ parseModuleDoc doc
& me_documentation = docParseResultToMaybe (const True) $ parseModuleDoc doc
}
pd_module _ = zero
pd_rewriterules :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.FunctionEntry)]
pd_rewriterules dcl defs st
= [( setLine dcl pos {zero & name=Just id.id_name}
, let doc = findDoc parseFunctionDoc id st in
, let doc = findDoc hideIsUsedReturn parseFunctionDoc id st in
{ zero
& fe_kind=Macro
, fe_type=getTypeDoc =<< doc
......@@ -322,7 +322,7 @@ where
& fe_type=Just $ 'T'.toType gen_type
, fe_generic_vars=Just $ map 'T'.toTypeVar gen_vars
, fe_representation=Just $ cpp gen
, fe_documentation=findDoc parseFunctionDoc id st
, fe_documentation=findDoc hideIsUsedReturn parseFunctionDoc id st
}
) \\ gen=:(PD_Generic {gen_ident=id=:{id_name},gen_pos,gen_type,gen_vars}) <- defs]
......@@ -333,7 +333,7 @@ where
& fe_type=Just $ 'T'.toType t
, fe_priority = 'T'.toMaybePriority p
, fe_representation = Just $ cpp ts
, fe_documentation = findDoc parseFunctionDoc id st
, fe_documentation = findDoc hideIsUsedReturn parseFunctionDoc id st
}
) \\ ts=:(PD_TypeSpec pos id=:{id_name} p (Yes t) funspecs) <- defs]
......@@ -359,27 +359,52 @@ where
= { fe
& fe_kind=if (isNothing $ lookup n macros) fe.fe_kind Macro
, fe_representation=lookup n macros <|> fe.fe_representation
, fe_documentation=if (isSingleFunction typespecs id)
(findDoc hideIsUsedReturn parseSingleFunctionDoc id st) fe.fe_documentation
}
in ( setLine dcl class_pos {zero & name=Just id_name}
, 'DB'.toClass
(map 'T'.toTypeVar class_args)
(flatten $ map 'T'.toTypeContext class_context)
(flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe) <- typespecs]
<$> (findDoc parseClassDoc id st))
(parseDoc typespecs id st)
[(f,updateRepresentation f et) \\ ({name=Just f}, et) <- typespecs]
)
\\ PD_Class {class_ident=id=:{id_name},class_pos,class_args,class_context} clsdefs <- defs
]
where
// When the class has one member with the same name as the class, use
// the class documentation as the function's documentation. This is the
// case for classes like `class zero a :: a`, which do not have a where
// clause and hence no other place for the function's documentation.
parseDoc :: [(LocationInModule, 'DB'.FunctionEntry)] Ident SymbolTable -> Maybe Documentation
parseDoc members id st
| isSingleFunction members id = flip addClassMemberDoc
(functionToClassMemberDoc <$> findDoc hideIsUsedReturn parseSingleFunctionDoc id st)
<$> findDoc hideFunctionOnClass parseClassDoc id st
| otherwise = flip (foldl addClassMemberDoc)
[functionToClassMemberDoc <$> fe.fe_documentation \\ (_,fe) <- members]
<$> findDoc hideIsUsedReturn parseClassDoc id st
// Remove generic type variables from FunctionDoc; @var is for the class type variables
parseSingleFunctionDoc = fmap (appFst (\(FunctionDoc d ps vs r t) -> FunctionDoc d ps [] r t)) o parseFunctionDoc
isSingleFunction :: [(LocationInModule, 'DB'.FunctionEntry)] Ident -> Bool
isSingleFunction members id = length members == 1
&& fromJust (fst $ hd members).name == id.id_name
// Hide warnings about @result and @param on single function classes
hideFunctionOnClass (IllegalField "param") = False
hideFunctionOnClass (IllegalField "result") = False
hideFunctionOnClass w = hideIsUsedReturn w
pd_types :: !Bool ![ParsedDefinition] SymbolTable -> [(LocationInModule, 'DB'.TypeDefEntry)]
pd_types dcl defs st
= [let name = 'T'.td_name td in
( setLine dcl ptd.td_pos {zero & name=Just name}
, 'DB'.toTypeDefEntry td $ findRhsDoc ptd =<<
(case findDoc (parsef ptd.td_rhs) ptd.td_ident st of
(case findDoc (const True) (parsef ptd.td_rhs) ptd.td_ident st of
Just d -> Just d
Nothing -> docParseResultToMaybe $ parsef ptd.td_rhs ""
Nothing -> docParseResultToMaybe (const True) $ parsef ptd.td_rhs ""
)
) \\ PD_Type ptd <- defs, td <- ['T'.toTypeDef ptd]]
where
......@@ -404,7 +429,7 @@ where
addFields [] doc
= Just doc
addFields [{ps_doc=Yes d}:fs] doc
= addFields fs doc >>= docParseResultToMaybe o parseFieldDoc d
= addFields fs doc >>= docParseResultToMaybe (const True) o parseFieldDoc d
addFields [_:fs] doc
= addFields fs doc
......@@ -412,7 +437,7 @@ where
addConses [] doc
= Just doc
addConses [{pc_doc=Yes d}:cs] doc
= addConses cs doc >>= docParseResultToMaybe o parseConstructorDoc d
= addConses cs doc >>= docParseResultToMaybe (const True) o parseConstructorDoc d
addConses [_:cs] doc
= addConses cs doc
......@@ -440,17 +465,22 @@ where
# (b1,b2,pm,ht,f,fs) = wantModule f s b1 i p b2 ht io fs
= ((b1,b2,pm,ht,f),fs)
docParseResultToMaybe :: (Either ParseError (Documentation, [ParseWarning]))
docParseResultToMaybe :: (ParseWarning -> Bool)
(Either ParseError (Documentation, [ParseWarning]))
-> Maybe Documentation
docParseResultToMaybe (Left e)
docParseResultToMaybe showw (Left e)
= traceParseError e Nothing
docParseResultToMaybe (Right (doc,ws))
= traceParseWarnings (filter (not o isUsedReturn) ws) (Just doc)
docParseResultToMaybe showw (Right (doc,ws))
= traceParseWarnings (filter showw ws) (Just doc)
hideIsUsedReturn :: ParseWarning -> Bool
hideIsUsedReturn w = not $ isUsedReturn w
findDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
findDoc :: (ParseWarning -> Bool)
(String -> Either ParseError (Documentation, [ParseWarning]))
Ident SymbolTable -> Maybe Documentation
findDoc parse {id_info} st = case sreadPtr id_info st of
{ste_doc=Yes doc} = docParseResultToMaybe $ parse doc
findDoc showw parse {id_info} st = case sreadPtr id_info st of
{ste_doc=Yes doc} = docParseResultToMaybe showw $ parse doc
_ = Nothing
isUsedReturn :: ParseWarning -> Bool
......
......@@ -89,7 +89,7 @@ different syntax elements, and what they should document.
| | Description | `@param` | `@result` | `@type` | `@var` | `@representation`
|--------------|-------------|----------|-----------|---------|--------|-------------------
| Class | ![][y] | | | | ![][y] |
| Class | ![][y] | ![][y]<sup>1</sup> | ![][y]<sup>1</sup> | | ![][y] |
| Class member | ![][y] | ![][y] | ![][y] | | |
| Constructor | ![][y] | | | | |
| Function | ![][y] | ![][y] | ![][y] | | |
......@@ -100,6 +100,9 @@ different syntax elements, and what they should document.
| Record field | ![][y] | | | | |
| Type | ![][y] | | | | ![][y] | ![][y], for type synonyms
<sup>Note 1: only for shorthand classes like `class zero a :: a`, where there
is no other place for the documentation of the class member.</sup>
| Field | Description
|-------------------|-------------
| `@param` | Parameters of a function(-like)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment