Verified Commit 238392d4 authored by Camil Staps's avatar Camil Staps 🙂

Add printDoc for clean-cloogle/cloogle.org#194

parent 7438d3c8
......@@ -256,6 +256,21 @@ derive docBlockToDoc String, [], Maybe, Type
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
/**
* Print a documentation block as a string. The magic happens in
* {{`docToDocBlock`}}.
*/
printDoc :: !d -> String | docToDocBlock{|*|} d
/**
* The magic for {{`printDoc`}}.
* @param If true, return a `Left`. If false, return a `Right`.
*/
generic docToDocBlock d :: Bool d -> Either [String] DocBlock
derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
/**
* Trace a list of ParseWarnings like StdDebug might do it
*/
......
......@@ -21,13 +21,15 @@ import Data.GenDefault
import Data.List
import Data.Maybe
import Data.Tuple
from Text import class Text(join,split,trim,rtrim),
from Text import <+,
class Text(join,split,trim,rtrim,replaceSubString,endsWith),
instance Text String, instance Text [Char]
import Text.Language
import Text.Parsers.Simple.ParserCombinators
from Clean.Types import :: Type, :: TypeRestriction
import qualified Clean.Types.Parse as T
from Clean.Types.Util import instance toString Type
gDefault{|Maybe|} _ = Nothing
......@@ -213,6 +215,59 @@ where
derive docBlockToDoc ModuleDoc, FunctionDoc, ClassMemberDoc, ConstructorDoc,
ClassDoc, TypeDoc
printDoc :: !d -> String | docToDocBlock{|*|} d
printDoc d = join "\n * "
[ "/**"
: (case desc of
Nothing -> []
Just d -> [replaceSubString "\n" "\n * " d] ++ (if (isEmpty fields) [] [""])) ++
["@" +++ f +++ " " +++ replaceSubString "\n" "\n * " v \\ (f,v) <- fields]
] +++
"\n */"
where
(Right fields`) = docToDocBlock{|*|} False d
fields = filter ((<>) "description" o fst) fields`
desc = lookup "description" fields`
generic docToDocBlock a :: Bool a -> Either [String] DocBlock
docToDocBlock{|String|} True s = Left [s]
docToDocBlock{|[]|} fx True xs = Left [x \\ Left xs` <- map (fx True) xs, x <- xs`]
docToDocBlock{|Maybe|} fx True mb = case mb of
Nothing -> Left []
Just x -> fx True x
docToDocBlock{|PAIR|} fx fy False (PAIR x y) = Right (xs ++ ys)
where
(Right xs) = fx False x
(Right ys) = fy False y
docToDocBlock{|FIELD of d|} fx False (FIELD x) = Right [(name,x) \\ x <- xs]
where
(Left xs) = fx True x
name = {if (c=='_') '-' c \\ c <-: name`}
name`
| endsWith "ies" d.gfd_name = d.gfd_name % (0,size d.gfd_name-4) +++ "y"
| endsWith "s" d.gfd_name = d.gfd_name % (0,size d.gfd_name-2)
| otherwise = d.gfd_name
docToDocBlock{|RECORD|} fx False (RECORD x) = fx False x
docToDocBlock{|ParamDoc|} True pd = case pd.ParamDoc.name of
Nothing -> case pd.ParamDoc.description of
Nothing -> Left []
Just d -> Left [d]
Just n -> case pd.ParamDoc.description of
Nothing -> Left [n]
Just d -> Left [n +++ ": " +++ d]
docToDocBlock{|MultiLineString|} True (MultiLine s) = Left [s]
docToDocBlock{|Type|} True t = Left [toString t]
docToDocBlock{|Property|} True (ForAll name args impl) = Left
[name +++ ": A." +++ join "; " [a +++ " :: " <+ t \\ (a,t) <- args] +++ ":\n" +++ impl]
docToDocBlock{|PropertyVarInstantiation|} True (PropertyVarInstantiation (a,t)) = Left [a +++ " = " <+ t]
docToDocBlock{|PropertyTestGenerator|} True (PropertyTestGenerator t impl) = Left [t <+ "\n" +++ impl]
derive docToDocBlock ModuleDoc, FunctionDoc, ClassMemberDoc, ClassDoc,
ConstructorDoc, TypeDoc
trimMultiLine :: ![String] -> String
trimMultiLine ss = join "\n" [s % (trimn, size s - 1) \\ s <- ss]
where
......
Subproject commit c5382195226ec6baa7887f953702c176cd185c40
Subproject commit 58a0a8b9224e54ba1830123d97734e446c07c503
......@@ -253,6 +253,7 @@ makeResult orgsearchtype allsyns usedsyns (entry, annots) db
, class_heading = foldl ((+) o (flip (+) " ")) name ce.ce_vars +
if (isEmpty ce.ce_context) "" " | " + concat (print False ce.ce_context)
, class_funs = [fromJust fe.fe_representation \\ {value=FunctionEntry fe} <- mems]
, class_fun_doc = Just [printDoc <$> fe.fe_documentation \\ {value=FunctionEntry fe} <- mems]
, class_instances = sortBy ((<) `on` fst)
[(map snd ie.ie_types, map locResult ie.ie_locations)
\\ {value=InstanceEntry ie} <- ies]
......
Subproject commit bab8830b6e0c45b2d5c13585f8b1179033ce1d62
Subproject commit 60c8eb36203bfbac0db3bcb4d0c4d2dbdfa771e9
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