Verified Commit 7a9bba20 authored by Camil Staps's avatar Camil Staps 🚀

Add type_doc to macros for clean-cloogle/cloogle.org#115

parent dbef6e96
......@@ -64,7 +64,7 @@ from Doc import :: Documentation(FunctionDoc), :: ResultDoc, :: VarDoc,
parseFunctionDoc, parseConstructorDoc, parseADTypeDoc, parseRecordTypeDoc,
parseSynonymTypeDoc, parseAbstractTypeDoc, parseFieldDoc, parseClassDoc,
parseModuleDoc, traceParseError, traceParseWarnings, getTypeRhsDoc,
functionToClassMemberDoc, addClassMemberDoc
getTypeDoc, functionToClassMemberDoc, addClassMemberDoc
:: TemporaryDB
= { temp_functions :: ![[(!'DB'.Location, !'DB'.FunctionEntry)]]
......@@ -171,11 +171,13 @@ where
-> [('DB'.Location, 'DB'.FunctionEntry)]
pd_macros lib mod dcl st
= [( 'DB'.Location lib mod (toLine pos) Nothing id.id_name
, { zero
, let doc = findDoc parseFunctionDoc id st in
{ zero
& fe_kind=Macro
, fe_type=getTypeDoc =<< doc
, fe_representation=Just $ priostring id +++ cpp pd
, fe_priority=findPrio id >>= 'T'.toMaybePriority
, fe_documentation=findDoc parseFunctionDoc id st
, fe_documentation=doc
}
) \\ pd=:(PD_Function pos id isinfix args rhs FK_Macro) <- dcl]
where
......@@ -423,7 +425,7 @@ record_functions (loc, etd)
& fe_kind=RecordField
, fe_type=Just t
, fe_representation=Just $ concat [".", f, " :: ":print False t]
, fe_documentation=(\d -> FunctionDoc (Just d) [] [] Nothing) <$> doc
, fe_documentation=(\d -> FunctionDoc (Just d) [] [] Nothing Nothing) <$> doc
})
\\ (f,t) <- 'T'.recordsToFunctions ('DB'.getTypeDef etd)
& doc <- field_doc]
......
......@@ -7,13 +7,15 @@ definition module Doc
from Data.Either import :: Either
from Data.Maybe import :: Maybe
from TypeDef import :: Type
/**
* Documentation on a Clean syntax element
*/
:: Documentation
= ModuleDoc (Maybe Description)
//* Documentation for a module
| FunctionDoc (Maybe Description) [ParamDoc] [VarDoc] (Maybe ResultDoc)
| FunctionDoc (Maybe Description) [ParamDoc] [VarDoc] (Maybe ResultDoc) (Maybe Type)
//* Documentation for a function, generic or macro
| ClassDoc (Maybe Description) [VarDoc] [Maybe ClassMemberDoc]
//* Documentation for a class
......@@ -76,10 +78,11 @@ from Data.Maybe import :: Maybe
* best-effort result nevertheless
*/
:: ParseWarning
= UnknownField String //* Unknown @-field
| IllegalField String //* This @-field is not allowed in this docblock
| NoDescription //* The main description is missing
| UsedReturn //* Used @return instead of @result
= UnknownField String //* Unknown @-field
| IllegalField String //* This @-field is not allowed in this docblock
| NoDescription //* The main description is missing
| UsedReturn //* Used @return instead of @result
| UnparsableType String //* Could not parse a @type field as a type
/**
* Get the main description from a documentation
......@@ -110,6 +113,13 @@ getVarDocs :: Documentation -> [VarDoc]
*/
getResultDoc :: Documentation -> Maybe String
/**
* Get the type of a FunctionDoc (should only be used for macros)
*
* @result The Type or Nothing
*/
getTypeDoc :: Documentation -> Maybe Type
/**
* Get the documentation on the right-hand side of a TypeDoc
*
......
......@@ -15,11 +15,15 @@ import Data.List
import Data.Maybe
import Data.Tuple
from TypeDef import :: Type
import qualified TypeParse as T
:: DocField
= Param String
| Var String
| Result String
| Representation String
| Type String
:: FieldUpdateFunction :==
DocField Documentation -> Either ParseError (Documentation, [ParseWarning])
......@@ -29,28 +33,33 @@ fieldName (Param _) = "param"
fieldName (Var _) = "var"
fieldName (Result _) = "result"
fieldName (Representation _) = "representation"
fieldName (Type _) = "type"
getDocDescription :: Documentation -> Maybe Description
getDocDescription (ModuleDoc d) = d
getDocDescription (FunctionDoc d _ _ _) = d
getDocDescription (ClassDoc d _ _) = d
getDocDescription (TypeDoc d _ _) = d
getDocDescription (ConstructorDoc d _) = d
getDocDescription (ModuleDoc d) = d
getDocDescription (FunctionDoc d _ _ _ _) = d
getDocDescription (ClassDoc d _ _) = d
getDocDescription (TypeDoc d _ _) = d
getDocDescription (ConstructorDoc d _) = d
getParamDocs :: Documentation -> [ParamDoc]
getParamDocs (FunctionDoc _ ps _ _) = ps
getParamDocs (ConstructorDoc _ ps) = ps
getParamDocs _ = []
getParamDocs (FunctionDoc _ ps _ _ _) = ps
getParamDocs (ConstructorDoc _ ps) = ps
getParamDocs _ = []
getVarDocs :: Documentation -> [VarDoc]
getVarDocs (FunctionDoc _ _ vs _) = vs
getVarDocs (ClassDoc _ vs _) = vs
getVarDocs (TypeDoc _ vs _) = vs
getVarDocs _ = []
getVarDocs (FunctionDoc _ _ vs _ _) = vs
getVarDocs (ClassDoc _ vs _) = vs
getVarDocs (TypeDoc _ vs _) = vs
getVarDocs _ = []
getResultDoc :: Documentation -> Maybe String
getResultDoc (FunctionDoc _ _ _ r) = r
getResultDoc _ = Nothing
getResultDoc (FunctionDoc _ _ _ r _) = r
getResultDoc _ = Nothing
getTypeDoc :: Documentation -> Maybe Type
getTypeDoc (FunctionDoc _ _ _ _ t) = t
getTypeDoc _ = Nothing
getTypeRhsDoc :: Documentation -> Maybe TypeRhsDoc
getTypeRhsDoc (TypeDoc _ _ rhs) = rhs
......@@ -72,7 +81,7 @@ getRepresentationDoc doc = case getTypeRhsDoc doc of
_ = Nothing
functionToClassMemberDoc :: Documentation -> ClassMemberDoc
functionToClassMemberDoc (FunctionDoc d ps _ r) = ClassMemberDoc d ps r
functionToClassMemberDoc (FunctionDoc d ps _ r _) = ClassMemberDoc d ps r
addClassMemberDoc :: Documentation (Maybe ClassMemberDoc) -> Documentation
addClassMemberDoc (ClassDoc d vs ms) m = ClassDoc d vs (ms ++ [m])
......@@ -81,7 +90,7 @@ parseModuleDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseModuleDoc = parseDocBlock $ ModuleDoc Nothing
parseFunctionDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseFunctionDoc = parseDocBlock $ FunctionDoc Nothing [] [] Nothing
parseFunctionDoc = parseDocBlock $ FunctionDoc Nothing [] [] Nothing Nothing
parseClassDoc :: (String -> Either ParseError (Documentation, [ParseWarning]))
parseClassDoc = parseDocBlock $ ClassDoc Nothing [] []
......@@ -116,7 +125,7 @@ parseFieldDoc _ _
updateDesc :: [[Char]] Documentation -> Documentation
updateDesc desc doc = case doc of
FunctionDoc _ ps vs r = FunctionDoc desc` ps vs r
FunctionDoc _ ps vs r t = FunctionDoc desc` ps vs r t
ModuleDoc _ = ModuleDoc desc`
ClassDoc _ vs cms = ClassDoc desc` vs cms
TypeDoc _ vs rhs = TypeDoc desc` vs rhs
......@@ -158,14 +167,19 @@ where
= upd (Var $ prepField desc) doc
parseFs ['representation'] desc doc
= upd (Representation $ prepField desc) doc
parseFs ['type'] desc doc
= upd (Type $ prepField desc) doc
parseFs field _ doc
= Right (doc, [UnknownField $ toString ['@':field]])
upd :: DocField Documentation
-> Either ParseError (Documentation, [ParseWarning])
upd (Param d) (FunctionDoc t ps vs r) = Right (FunctionDoc t [d:ps] vs r, [])
upd (Result d) (FunctionDoc t ps vs _) = Right (FunctionDoc t ps vs (Just d), [])
upd (Var d) (FunctionDoc t ps vs r) = Right (FunctionDoc t ps [d:vs] r, [])
upd (Param d) (FunctionDoc desc ps vs r t) = Right (FunctionDoc desc [d:ps] vs r t, [])
upd (Result d) (FunctionDoc desc ps vs _ t) = Right (FunctionDoc desc ps vs (Just d) t, [])
upd (Var d) (FunctionDoc desc ps vs r t) = Right (FunctionDoc desc ps [d:vs] r t, [])
upd (Type d) f=:(FunctionDoc desc ps vs r _) = case 'T'.parseType $ fromString d of
Just t -> Right (FunctionDoc desc ps vs r (Just t), [])
Nothing -> Right (f, [UnparsableType d])
upd (Param d) (ConstructorDoc t ps) = Right (ConstructorDoc t [d:ps], [])
upd (Var d) (ClassDoc t vs ms) = Right (ClassDoc t [d:vs] ms, [])
upd (Var d) (TypeDoc t vs rhs) = Right (TypeDoc t [d:vs] rhs, [])
......
......@@ -229,6 +229,7 @@ makeFunctionResult orgsearch orgsearchtype usedsynonyms mbCls (fl, fe) db
, param_doc = getParamDocs <$> fe.fe_documentation
, generic_var_doc = getVarDocs <$> fe.fe_documentation
, result_doc = getResultDoc =<< fe.fe_documentation
, type_doc = concat <$> print False <$> (getTypeDoc =<< fe.fe_documentation)
}
)
where
......
Subproject commit 60a7504f9844795de6d1718465a82e5a264cfb72
Subproject commit f7c719a94c7a3e27c9d6e4c5cc9518575b5956f4
Subproject commit b8bb9ccfd13e9032d48d421a6fc0c5f6492e0163
Subproject commit 8200544a75c023e7f7c656bb90ab9bdf7a0b0813
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