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

CloogleDBFactory.icl

@@ -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]

Doc.dcl

@@ -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
  *

Doc.icl

@@ -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, [])

Search.icl

@@ -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

clean-platform @ f7c719a9

-Subproject commit 60a7504f9844795de6d1718465a82e5a264cfb72
+Subproject commit f7c719a94c7a3e27c9d6e4c5cc9518575b5956f4

libcloogle @ 8200544a

-Subproject commit b8bb9ccfd13e9032d48d421a6fc0c5f6492e0163
+Subproject commit 8200544a75c023e7f7c656bb90ab9bdf7a0b0813