fix: Correct pretty-printing of code in comments.

BUILD.bazel

@@ -172,7 +172,7 @@ haskell_library(
     ),
     src_strip_prefix = "src",
     tags = ["no-cross"],
-    version = "0.0.19",
+    version = "0.0.20",
     visibility = ["//visibility:public"],
     deps = [
         ":ast",

cimple.cabal

@@ -1,5 +1,5 @@
 name:          cimple
-version:       0.0.19
+version:       0.0.20
 synopsis:      Simple C-like programming language
 homepage:      https://toktok.github.io/
 license:       GPL-3

src/Language/Cimple/Ast.hs

@@ -147,6 +147,7 @@ data CommentF lexeme a
 
     | DocParagraph [a]
     | DocLine [a]
+    | DocCode a [a] a
     | DocList [a]
     | DocULItem [a] [a]
     | DocOLItem lexeme [a]

src/Language/Cimple/CommentParser.y

@@ -146,7 +146,7 @@ Command(x)
 |	'@implements' CMT_WORD					{ Fix $ DocImplements $2 }
 |	'@extends' CMT_WORD					{ Fix $ DocExtends $2 }
 |	'@private'						{ Fix DocPrivate }
-|	'@code' Code '@endcode'					{ Fix $ DocLine $ Fix (DocWord $1) : (reverse $2) ++ [Fix (DocWord $3)] }
+|	'@code' Code '@endcode'					{ Fix $ DocCode (Fix (DocWord $1)) (reverse $2) (Fix (DocWord $3)) }
 
 Code :: { [NonTerm] }
 Code

src/Language/Cimple/Flatten.hs

@@ -68,6 +68,7 @@ instance GenConcatsFlatten (Fix (CommentF a)) a where
     gconcatsFlatten (Fix (DocExtends x)) = gconcatsFlatten x
     gconcatsFlatten (Fix (DocImplements x)) = gconcatsFlatten x
     gconcatsFlatten (Fix (DocLine x)) = gconcatsFlatten x
+    gconcatsFlatten (Fix (DocCode b x e)) = concat [gconcatsFlatten b, gconcatsFlatten x, gconcatsFlatten e]
     gconcatsFlatten (Fix (DocList x)) = gconcatsFlatten x
     gconcatsFlatten (Fix (DocLParen x)) = gconcatsFlatten x
     gconcatsFlatten (Fix (DocOLItem i x)) = i : gconcatsFlatten x

src/Language/Cimple/Lexer.x

@@ -254,14 +254,15 @@ tokens :-
 <cmtSC>		"SPDX-License-Identifier:"		{ mkL CmtSpdxLicense }
 <cmtSC>		"GPL-3.0-or-later"			{ mkL CmtWord }
 <cmtSC>		"TODO("[^\)]+"):"			{ mkL CmtWord }
-<cmtSC>		[A-Z][A-Za-z]+"::"[a-z_]+		{ mkL CmtWord }
-<cmtSC>		"E.g."					{ mkL CmtWord }
-<cmtSC>		"e.g."					{ mkL CmtWord }
+<cmtSC>		[Ee]".g."				{ mkL CmtWord }
 <cmtSC>		"etc."					{ mkL CmtWord }
-<cmtSC>		"I.e."					{ mkL CmtWord }
-<cmtSC>		"i.e."					{ mkL CmtWord }
+<cmtSC>		[Ii]".e."				{ mkL CmtWord }
 <cmtSC>		[0-2][0-9](":"[0-5][0-9]){2}"."[0-9]{3}	{ mkL CmtWord }
-<cmtSC>		"v"?[0-9]"."[0-9]"."[0-9]		{ mkL CmtWord }
+<cmtSC>		"v"?[0-9]+("."[0-9]+)+			{ mkL CmtWord }
+<cmtSC>		[A-Z][A-Za-z]+"::"[a-z_]+		{ mkL CmtWord }
+<cmtSC>		([a-z]+"/")+[A-Za-z]+("."[a-z_]+)+	{ mkL CmtWord }
+<cmtSC>		[a-z]+("."[a-z_]+)+			{ mkL CmtWord }
+<cmtSC>		[a-z]+("-"[a-z_]+)+			{ mkL CmtWord }
 <cmtSC>		"@code"					{ mkL CmtCode `andBegin` codeSC }
 <cmtSC>		"<code>"				{ mkL CmtCode `andBegin` codeSC }
 <cmtSC>		"["[^\]]+"]"				{ mkL CmtAttr }
@@ -276,6 +277,7 @@ tokens :-
 <cmtSC>		"-1"					{ mkL LitInteger }
 <cmtSC>		"`"([^`]|"\`")+"`"			{ mkL CmtCode }
 <cmtSC>		"${"([^\}])+"}"				{ mkL CmtCode }
+<cmtSC>		"-"+					{ mkL CmtWord }
 <cmtSC>		"–"					{ mkL CmtWord }
 <cmtSC>		"*/"					{ mkL CmtEnd `andBegin` 0 }
 <cmtSC>		\n					{ mkL PpNewline `andBegin` cmtNewlineSC }

src/Language/Cimple/MapAst.hs

@@ -142,6 +142,8 @@ instance MapAst itext otext (Comment (Lexeme itext)) where
             Fix <$> (DocParagraph <$> recurse docs)
         DocLine docs ->
             Fix <$> (DocLine <$> recurse docs)
+        DocCode begin docs end ->
+            Fix <$> (DocCode <$> recurse begin <*> recurse docs <*> recurse end)
         DocList docs ->
             Fix <$> (DocList <$> recurse docs)
         DocOLItem docs sublist ->

src/Language/Cimple/Pretty.hs

@@ -22,16 +22,16 @@
                                                UnaryOp (..), lexemeLine,
                                                lexemeText)
 import           Prelude                      hiding ((<$>))
 import           Text.PrettyPrint.ANSI.Leijen
 
 indentWidth :: Int
 indentWidth = 2
 
 kwBreak         = dullred   $ text "break"
 kwCase          = dullred   $ text "case"
 kwConst         = dullgreen $ text "const"
 kwContinue      = dullred   $ text "continue"
 kwDefault       = dullred   $ text "default"
 kwDo            = dullred   $ text "do"
 kwElse          = dullred   $ text "else"
 kwEnum          = dullgreen $ text "enum"
@@ -136,7 +136,7 @@
     Ignore  -> text "//!TOKSTYLE-"
 
 ppCommentBody :: [Lexeme Text] -> Doc
-ppCommentBody body = vsep . prefixStars . map (hsep . map ppWord) . groupLines $ body
+ppCommentBody body = vsep . prefixStars . map (hcat . map ppWord . spaceWords) . groupLines $ body
   where
     -- If the "*/" is on a separate line, don't add an additional "*" before
     -- it. If "*/" is on the same line, then do add a "*" prefix on the last line.
@@ -149,6 +149,21 @@
         L _ PpNewline _ -> True
         _               -> False
 
+    spaceWords = \case
+        (L c p s:ws) -> L c p (" "<>s):continue ws
+        [] -> []
+      where
+        continue [] = []
+        continue (w@(L _ CmtEnd _):ws) = w:continue ws
+        continue (w@(L _ PctComma _):ws) = w:continue ws
+        continue (w@(L _ PctPeriod _):ws) = w:continue ws
+        continue (w@(L _ PctEMark _):ws) = w:continue ws
+        continue (w@(L _ PctQMark _):ws) = w:continue ws
+        continue (w@(L _ PctRParen _):ws) = w:continue ws
+        continue [w@(L c p s), end@(L _ CmtEnd _)] | lexemeLine w == lexemeLine end = [L c p (" "<>s<>" "), end]
+        continue (L c PctLParen s:w:ws) = (L c PctLParen (" "<>s)):w:continue ws
+        continue (L c p s:ws) = (L c p (" "<>s)):continue ws
+
 ppWord (L _ CmtIndent  _) = empty
 ppWord (L _ CmtCommand t) = dullcyan   $ ppText t
 ppWord (L _ _          t) = dullyellow $ ppText t
@@ -157,7 +172,7 @@
 ppComment Ignore cs _ =
     ppCommentStart Ignore <> hcat (map ppWord cs) <> dullyellow (text "//!TOKSTYLE+" <> line)
 ppComment style cs (L l c _) =
-    nest 1 $ ppCommentStart style <+> ppCommentBody (cs ++ [L l c "*/"])
+    nest 1 $ ppCommentStart style <> ppCommentBody (cs ++ [L l c "*/"])
 
 ppInitialiserList :: [Doc] -> Doc
 ppInitialiserList l = lbrace <+> commaSep l <+> rbrace
@@ -274,10 +289,22 @@
     . renderS
     . plain
 
+ppCodeBody :: [Doc] -> Doc
+ppCodeBody =
+    vcat
+    . zipWith (<>) (empty : commentStart " *"  )
+    . map text
+    . List.splitOn "\n"
+    . renderS
+    . plain
+    . hcat
+
+commentStart :: String -> [Doc]
+commentStart = repeat . dullyellow . text
+
 ppCommentInfo :: Comment (Lexeme Text) -> Doc
 ppCommentInfo = foldFix go
   where
-  commentStart t = repeat (dullyellow (text t))
   ppBody     = vcat . zipWith (<>) (        commentStart " * "  )
   ppIndented = vcat . zipWith (<>) (empty : commentStart " *   ")
   ppRef      = underline . cyan . ppLexeme
@@ -310,6 +337,7 @@
 
     DocParagraph docs -> ppIndented docs
     DocLine docs -> fillSep docs
+    DocCode begin code end -> begin <> ppCodeBody code <> end
     DocList l -> ppVerbatimComment $ vcat l
     DocOLItem num docs -> ppLexeme num <> char '.' <+> nest 3 (fillSep docs)
     DocULItem docs sublist -> char '-' <+> nest 2 (vsep $ fillSep docs : sublist)
@@ -332,10 +360,10 @@
 
     LicenseDecl l cs -> ppLicenseDecl l cs
     CopyrightDecl from (Just to) owner ->
-        text " * Copyright © " <> ppLexeme from <> char '-' <> ppLexeme to <+>
+        text " * Copyright © " <> ppLexeme from <> char '-' <> ppLexeme to <>
         ppCommentBody owner
     CopyrightDecl from Nothing owner ->
-        text " * Copyright © " <> ppLexeme from <+>
+        text " * Copyright © " <> ppLexeme from <>
         ppCommentBody owner
 
     Comment style _ cs end ->

src/Language/Cimple/TraverseAst.hs

@@ -134,6 +134,11 @@ instance TraverseAst text (Comment (Lexeme text)) where
             recurse docs
         DocLine docs ->
             recurse docs
+        DocCode begin docs end -> do
+            _ <- recurse begin
+            _ <- recurse docs
+            _ <- recurse end
+            pure ()
         DocList docs ->
             recurse docs
         DocOLItem docs sublist -> do

test/Language/Cimple/PrettySpec.hs

@@ -69,7 +69,7 @@ spec = do
 
         it "respects newlines at end of comments" $ do
             compact "/* foo bar */" `shouldBe` "/* foo bar */\n"
-            compact "/* foo bar\n */" `shouldBe` "/* foo bar\n*/\n"
+            compact "/* foo bar\n */" `shouldBe` "/* foo bar\n */\n"
 
         it "respects comment styles" $ do
             compact "/* foo bar */" `shouldBe` "/* foo bar */\n"
@@ -79,11 +79,11 @@ spec = do
 
         it "supports punctuation in comments" $ do
             compact "/* foo.bar,baz-blep */"
-                `shouldBe` "/* foo . bar , baz - blep */\n"
-            compact "/* foo? */" `shouldBe` "/* foo ? */\n"
+                `shouldBe` "/* foo.bar, baz-blep */\n"
+            compact "/* foo? */" `shouldBe` "/* foo?*/\n"
             compact "/* 123 - 456 */" `shouldBe` "/* 123 - 456 */\n"
             compact "/* - 3 */" `shouldBe` "/* - 3 */\n"
-            compact "/* a-b */" `shouldBe` "/* a - b */\n"
+            compact "/* a-b */" `shouldBe` "/* a-b*/\n"
 
         it "formats pointer types with east-const" $ do
             compact "void foo(const int *a);"