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

WIP on comments

parent 3ebf02c1
Pipeline #39466 failed with stage
in 1 minute and 11 seconds
......@@ -270,12 +270,14 @@ collectComments comments pm
# (_,_,coll) = collect comments Nothing pm.mod_defs coll
= coll
import Debug.Trace
collect :: ![CleanComment] !(Maybe CleanComment) ![a] !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments) | pos, singleLineAbove, commentIndex, children a
collect cc prev [] coll = (cc, prev, coll)
collect [] (Just prev) [pd:pds] coll = ([], Nothing, putCC pd prev coll)
collect [] Nothing _ coll = ([], Nothing, coll)
collect [{content}:cs] prev pds coll | not (startsWith "*" content) = collect cs prev pds coll
collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll = case c canBelongTo pd of
collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll =
let (_,_,b) = trace_stdout (c.line,commentIndex pd,c canBelongTo pd) in case b of
Nothing -> collect allcmnts prev pds coll
Just True -> case prev of
Just prev | not (singleLineAbove pd) && not c.multiline
......@@ -288,8 +290,12 @@ collect allcmnts=:[c:cs] prev allpds=:[pd:pds] coll = case c canBelongTo pd of
# coll = case prev of
Nothing -> coll
Just cmnt -> putCC pd cmnt coll
# (allcmnts,prev,coll) = recurse allcmnts Nothing (children pd) coll
-> collect allcmnts prev pds coll
-> case trace_stdout (pd before c) of
Just False
# (allcmnts,prev,coll) = recurse allcmnts Nothing (children pd) coll
-> collect allcmnts prev pds coll
_
-> collect allcmnts prev pds coll
where
// Compiler cannot figure out the overloading if we call collect from collect directly
recurse :: ![CleanComment] !(Maybe CleanComment) !Children !CollectedComments -> (![CleanComment], !Maybe CleanComment, !CollectedComments)
......@@ -331,6 +337,21 @@ where
= a==b || a+1==b
= a==b
(before) elem {line,column,multiline} = case trace_stdout elem_line of
Nothing
-> Nothing
Just elem_line
| multiline
-> Just (line <= elem_line)
| singleLineAbove elem
-> Just (line <= elem_line)
-> Just (line < elem_line)
where
elem_line = case pos elem of
Just (FunPos _ ln _) -> Just ln
Just (LinePos _ ln) -> Just ln
_ -> Nothing
// If true, single-line documentation should be given above the element.
class singleLineAbove a :: !a -> Bool
instance singleLineAbove ParsedDefinition where singleLineAbove _ = True
......
......@@ -8,6 +8,8 @@ definition module commentstest
import syntax
import Clean.Parse.Comments
:: NT =: NT Int //* Should be ignored (see clean-test-properties#11)
//* A documentation entry
:: Entry =
{ kind :: !String //* the kind of thing that is documented
......
......@@ -32,6 +32,7 @@ Start w
expected :: [Entry]
expected =
[ {kind="module", name="commentstest", value=Just "*\n * This module is used to test the Clean documentation parser in Clean.Parse.Comments.\n * The documentation here is written obscurely on purpose!\n "}
, {kind="type", name="NT", value=Nothing}
, {kind="type", name="Entry", value=Just "* A documentation entry\n"}
, {kind="selector", name="kind", value=Just "* the kind of thing that is documented\n"}
, {kind="selector", name="name", value=Just "* the name of the documented thing\n"}
......
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