cimple 0.0.25 → 0.0.26

raw patch · 21 files changed

+991/−688 lines, 21 filesdep +hashablePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable

API changes (from Hackage documentation)

Files

• cimple.cabal +5/−1
• src/Language/Cimple.hs +6/−0
• src/Language/Cimple/Ast.hs +44/−20
• src/Language/Cimple/CommentParser.y +89/−211
• src/Language/Cimple/DescribeAst.hs +1/−1
• src/Language/Cimple/Flatten.hs +14/−19
• src/Language/Cimple/IO.hs +2/−2
• src/Language/Cimple/Lexer.x +7/−15
• src/Language/Cimple/MapAst.hs +19/−35
• src/Language/Cimple/Parser.y +13/−7
• src/Language/Cimple/Pretty.hs +83/−257
• src/Language/Cimple/PrettyComment.hs +83/−0
• src/Language/Cimple/PrettyCommon.hs +135/−0
• src/Language/Cimple/Tokens.hs +5/−3
• src/Language/Cimple/TraverseAst.hs +21/−46
• src/Language/Cimple/TreeParser.y +46/−57
• test/Language/Cimple/CommentParserSpec.hs +359/−0
• test/Language/Cimple/DescribeAstSpec.hs +6/−3
• test/Language/Cimple/ParserSpec.hs +20/−1
• test/Language/Cimple/PrettySpec.hs +32/−9
• test/Language/CimpleSpec.hs +1/−1

@@ -1,5 +1,5 @@ name:          cimple-version:       0.0.25+version:       0.0.26 synopsis:      Simple C-like programming language homepage:      https://toktok.github.io/ license:       GPL-3@@ -43,6 +43,8 @@     Language.Cimple.Parser     Language.Cimple.ParseResult     Language.Cimple.PrettyColor+    Language.Cimple.PrettyComment+    Language.Cimple.PrettyCommon     Language.Cimple.SemCheck.Includes     Language.Cimple.Tokens     Language.Cimple.TranslationUnit@@ -57,6 +59,7 @@     , data-fix     , file-embed     , filepath+    , hashable     , monad-parallel     , mtl     , prettyprinter@@ -115,6 +118,7 @@   other-modules:     Language.CimpleSpec     Language.Cimple.AstSpec+    Language.Cimple.CommentParserSpec     Language.Cimple.DescribeAstSpec     Language.Cimple.ParserSpec     Language.Cimple.PrettySpec

@@ -3,10 +3,12 @@     , DefaultActions     , defaultActions     , removeSloc+    , getParamNameFromNode     ) where  import           Control.Monad.State.Strict  (State) import qualified Control.Monad.State.Strict  as State+import           Data.Fix                    (Fix (..)) import           Data.Text                   (Text)  import           Language.Cimple.Annot       as X@@ -26,3 +28,7 @@ removeSloc =     flip State.evalState () . mapAst defaultActions         { doLexeme = \_ (L _ c t) _ -> pure $ L (AlexPn 0 0 0) c t }++getParamNameFromNode :: Node (Lexeme Text) -> Maybe Text+getParamNameFromNode (Fix (VarDecl _ (L _ _ name) _)) = Just name+getParamNameFromNode _                                = Nothing

@@ -13,15 +13,22 @@     , CommentStyle (..)     , Comment     , CommentF (..)+    , Nullability (..)+    , getNodeId     ) where  import           Data.Aeson                   (FromJSON, FromJSON1, ToJSON,                                                ToJSON1)-import           Data.Fix                     (Fix)+import           Data.Fix                     (Fix (..)) import           Data.Functor.Classes         (Eq1, Ord1, Read1, Show1) import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))+import           Data.Hashable                (Hashable (..))+import           Data.Hashable.Lifted         (Hashable1) import           GHC.Generics                 (Generic, Generic1) +getNodeId :: Hashable a => Node a -> Int+getNodeId = hash+ data NodeF lexeme a     -- Preprocessor     = PreprocInclude lexeme@@ -73,6 +80,7 @@     | VarDeclStmt a (Maybe a)     | VarDecl a lexeme [a]     | DeclSpecArray (Maybe a)+    | ArrayDim Nullability a     -- Expressions     | InitialiserList [a]     | UnaryExpr UnaryOp a@@ -134,39 +142,34 @@  instance FromJSON lexeme => FromJSON1 (NodeF lexeme) instance ToJSON lexeme => ToJSON1 (NodeF lexeme)+instance Hashable lexeme => Hashable1 (NodeF lexeme)  data CommentF lexeme a     = DocComment [a]-    | DocWord lexeme-    | DocSentence [a] lexeme-    | DocNewline -    | DocAttention [a]-    | DocBrief [a]-    | DocDeprecated [a]+    | DocAttention+    | DocBrief+    | DocDeprecated     | DocExtends lexeme+    | DocFile     | DocImplements lexeme-    | DocParam (Maybe lexeme) lexeme [a]-    | DocReturn [a]-    | DocRetval lexeme [a]-    | DocSee lexeme [a]+    | DocNote+    | DocParam (Maybe lexeme) lexeme+    | DocReturn+    | DocRetval+    | DocSection lexeme+    | DocSecurityRank lexeme (Maybe lexeme) lexeme+    | DocSee lexeme+    | DocSubsection lexeme      | DocPrivate -    | DocParagraph [a]     | DocLine [a]     | DocCode lexeme [a] lexeme-    | DocList [a]-    | DocULItem [a] [a]-    | DocOLItem lexeme [a] -    | DocColon lexeme+    | DocWord lexeme     | DocRef lexeme     | DocP lexeme-    | DocLParen a-    | DocRParen a-    | DocAssignOp AssignOp a a-    | DocBinaryOp BinaryOp a a     deriving (Show, Read, Eq, Ord, Generic, Generic1, Functor, Foldable, Traversable)     deriving (Show1, Read1, Eq1, Ord1) via FunctorClassesDefault (CommentF lexeme) @@ -174,6 +177,7 @@  instance FromJSON lexeme => FromJSON1 (CommentF lexeme) instance ToJSON lexeme => ToJSON1 (CommentF lexeme)+instance Hashable lexeme => Hashable1 (CommentF lexeme)  data AssignOp     = AopEq@@ -243,6 +247,7 @@ data Scope     = Global     | Static+    | Local     deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)  instance FromJSON Scope@@ -258,3 +263,22 @@  instance FromJSON CommentStyle instance ToJSON CommentStyle++data Nullability+    = NullabilityUnspecified+    | Nullable+    | Nonnull+    deriving (Enum, Bounded, Ord, Show, Read, Eq, Generic)++instance FromJSON Nullability+instance ToJSON Nullability++instance (Hashable lexeme, Hashable a) => Hashable (NodeF lexeme a) where+instance (Hashable lexeme, Hashable a) => Hashable (CommentF lexeme a) where+instance Hashable AssignOp where+instance Hashable BinaryOp where+instance Hashable UnaryOp where+instance Hashable LiteralType where+instance Hashable Scope where+instance Hashable CommentStyle where+instance Hashable Nullability where

@@ -7,17 +7,16 @@ import           Data.Fix                    (Fix (..)) import           Data.Text                   (Text) import qualified Data.Text                   as Text+import           Data.List                   (dropWhile) -import           Language.Cimple.Ast         (AssignOp (..), BinaryOp (..),-                                              Comment, CommentF (..))+import           Language.Cimple.Ast         (Comment, CommentF (..)) import           Language.Cimple.DescribeAst (describeLexeme, sloc)-import           Language.Cimple.Lexer       (Lexeme (..))+import           Language.Cimple.Lexer       (AlexPosn (..), Lexeme (..)) import           Language.Cimple.ParseResult (ParseResult) import           Language.Cimple.Tokens      (LexemeClass (..)) }  %name parseComment Comment- %expect 0  %error {parseError}@@ -25,240 +24,119 @@ %monad {ParseResult} %tokentype {Term} %token-    '@attention'		{ L _ CmtCommand "@attention"	}-    '@brief'			{ L _ CmtCommand "@brief"	}-    '@deprecated'		{ L _ CmtCommand "@deprecated"	}-    '@extends'			{ L _ CmtCommand "@extends"	}-    '@implements'		{ L _ CmtCommand "@implements"	}-    '@note'			{ L _ CmtCommand "@note"	}-    '@param'			{ L _ CmtCommand "@param"	}-    '@private'			{ L _ CmtCommand "@private"	}-    '@ref'			{ L _ CmtCommand "@ref"		}-    '@p'			{ L _ CmtCommand "@p"		}-    '@return'			{ L _ CmtCommand "@return"	}-    '@retval'			{ L _ CmtCommand "@retval"	}-    '@see'			{ L _ CmtCommand "@see"		}-    '@code'			{ L _ CmtCode	 "@code"	}-    '@endcode'			{ L _ CmtCode	 "@endcode"	}+    '@attention'		{ L _ CmtCommand "@attention"		}+    '@brief'			{ L _ CmtCommand "@brief"		}+    '@deprecated'		{ L _ CmtCommand "@deprecated"		}+    '@file'			{ L _ CmtCommand "@file"		}+    '@extends'			{ L _ CmtCommand "@extends"		}+    '@implements'		{ L _ CmtCommand "@implements"		}+    '@note'			{ L _ CmtCommand "@note"		}+    '@param'			{ L _ CmtCommand "@param"		}+    '@private'			{ L _ CmtCommand "@private"		}+    '@ref'			{ L _ CmtCommand "@ref"			}+    '@p'			{ L _ CmtCommand "@p"			}+    '@return'			{ L _ CmtCommand "@return"		}+    '@retval'			{ L _ CmtCommand "@retval"		}+    '@section'			{ L _ CmtCommand "@section"		}+    '@subsection'		{ L _ CmtCommand "@subsection"		}+    '@see'			{ L _ CmtCommand "@see"			}+    '@security_rank'		{ L _ CmtCommand "@security_rank"	}+    '@code'			{ L _ CmtCode	 "@code"		}+    '@endcode'			{ L _ CmtCode	 "@endcode"		} -    ' '				{ L _ CmtIndent		" "	}-    'INDENT1'			{ L _ CmtIndent		"   "	}-    'INDENT2'			{ L _ CmtIndent		"    " 	}-    'INDENT3'			{ L _ CmtIndent		"     "	}-    'INDENT'			{ L _ CmtIndent			_ }+    '/n'			{ L _ PpNewline				_ }+    '/**'			{ L _ CmtStartDoc			_ }+    '*/'			{ L _ CmtEnd				_ }+    ' '				{ L _ CmtSpace				_ } -    '('				{ L _ PctLParen			_ }-    ')'				{ L _ PctRParen			_ }-    ','				{ L _ PctComma			_ }-    ':'				{ L _ PctColon			_ }-    '/'				{ L _ PctSlash			_ }-    '='				{ L _ PctEq			_ }-    '=='			{ L _ PctEqEq			_ }-    '!='			{ L _ PctEMarkEq		_ }-    '>='			{ L _ PctGreaterEq		_ }-    ';'				{ L _ PctSemicolon		_ }-    '.'				{ L _ PctPeriod			_ }-    '...'			{ L _ PctEllipsis		_ }-    '?'				{ L _ PctQMark			_ }-    '!'				{ L _ PctEMark			_ }-    '-'				{ L _ PctMinus			_ }-    '+'				{ L _ PctPlus			_ }-    '\n'			{ L _ PpNewline			_ }-    '/**'			{ L _ CmtStartDoc		_ }-    '*/'			{ L _ CmtEnd			_ }-    LIT_INTEGER			{ L _ LitInteger		_ }-    LIT_STRING			{ L _ LitString			_ }-    CMT_ATTR			{ L _ CmtAttr			_ }-    CMT_CODE			{ L _ CmtCode			_ }-    CMT_WORD			{ L _ CmtWord			_ }-    CMT_REF			{ L _ CmtRef			_ }+    '('				{ L _ PctLParen				_ }+    ')'				{ L _ PctRParen				_ }+    ','				{ L _ PctComma				_ } -%right '='-%left '.' '?' ',' ';' '!'-%left '!=' '=='-%left '>='-%left '-' '+'-%left '/'-%left '(' ')'+    '[in]'			{ L _ CmtAttr				_ } +    TOKEN			{ L _ _					_ }++%nonassoc Command+%left TOKEN ' ' '(' ')' ','+ %%  Comment :: { NonTerm } Comment-:	'/**' '\n' Blocks '*/'					{ Fix $ DocComment $3 }-|	'/**' DocLine '*/'					{ Fix $ DocComment $2 }-|	'/**' Command(DocLine) '*/'				{ Fix $ DocComment [$2] }-|	'/**' Command(IndentedSentence) Blocks '*/'		{ Fix $ DocComment ($2 : $3) }--Blocks :: { [NonTerm] }-Blocks-:	BlockList						{ reverse $1 }--BlockList :: { [NonTerm] }-BlockList-:	Block							{ [$1] }-|	BlockList Block						{ $2 : $1 }--Block :: { NonTerm }-Block-:	'\n'							{ Fix DocNewline }-|	' ' Command(IndentedSentence)				{ $2 }-|	' ' Paragraph						{ Fix $ DocParagraph $2 }-|	' ' NumberedListItem					{ Fix $ DocList [$2] }-|	' ' BulletListItem					{ Fix $ DocList [$2] }--Paragraph :: { [NonTerm] }-Paragraph-:	Word(NonInt) Punctuation MaybeWords			{ Fix (DocSentence [$1] $2) : $3 }-|	Word(NonInt) MaybeWords					{ prepend $1 $2 }--Punctuation :: { Term }-Punctuation-:	'.'							{ $1 }-|	','							{ $1 }-|	';'							{ $1 }-|	'?'							{ $1 }--MaybeWords :: { [NonTerm] }-MaybeWords-:								{ [] }-|	IndentedSentence					{ $1 }--IndentedSentence :: { [NonTerm] }-IndentedSentence-:	DocLine '\n'						{ $1 }-|	DocLine '\n' 'INDENT1' IndentedSentence			{ $1 ++ $4 }--DocLine :: { [NonTerm] }-DocLine-:	Words							{ [Fix $ DocLine $1] }--Command(x)-:	'@attention' x						{ Fix $ DocAttention $2 }-|	'@brief' x						{ Fix $ DocBrief $2 }-|	'@param' CMT_WORD x					{ Fix $ DocParam Nothing $2 $3 }-|	'@param' CMT_ATTR CMT_WORD x				{ Fix $ DocParam (Just $2) $3 $4 }-|	'@retval' Atom x					{ Fix $ DocRetval $2 $3 }-|	'@return' x						{ Fix $ DocReturn $2 }-|	'@return' '\n' BulletListItemII				{ Fix $ DocReturn (Fix (DocLine []) : $3) }-|	'@see' CMT_WORD x					{ Fix $ DocSee $2 $3 }-|	'@deprecated' x						{ Fix $ DocDeprecated $2 }-|	'@implements' CMT_WORD					{ Fix $ DocImplements $2 }-|	'@extends' CMT_WORD					{ Fix $ DocExtends $2 }-|	'@private'						{ Fix DocPrivate }-|	Code							{ $1 }--Code :: { NonTerm }-Code-:	'@code' CodeWords '@endcode'				{ Fix $ DocCode $1 (reverse $2) $3 }--CodeWords :: { [NonTerm] }-CodeWords-:	CodeWord						{ [$1] }-|	CodeWords CodeWord					{ $2 : $1 }--CodeWord :: { NonTerm }-CodeWord-:	'\n'							{ Fix $ DocWord $1 }-|	' '							{ Fix $ DocWord $1 }-|	'INDENT1'						{ Fix $ DocWord $1 }-|	'INDENT2'						{ Fix $ DocWord $1 }-|	'INDENT3'						{ Fix $ DocWord $1 }-|	'INDENT'						{ Fix $ DocWord $1 }-|	CMT_CODE						{ Fix $ DocWord $1 }--BulletListItem :: { NonTerm }-BulletListItem-:	'-' Words '\n' BulletICont				{ Fix $ DocULItem $2 $4 }+:	'/**' Items '*/'				{ Fix $ DocComment [Fix (DocLine $2)] }+|	'/**' Items '/n' Lines '*/'			{ Fix $ DocComment (Fix (DocLine $2) : $4) } -BulletICont :: { [NonTerm] }-BulletICont-:								{ [] }-|	'INDENT1' DocLine '\n' BulletICont			{ $2 ++ $4 }-|	BulletListItemII					{ $1 }+Lines :: { [NonTerm] }+Lines+:							{ [] }+|	Line Lines					{ $1 : $2 } -BulletListItemII :: { [NonTerm] }-BulletListItemII-:	'INDENT1' '-' Words '\n' BulletIICont			{ Fix (DocULItem ($3 ++ snd $5) []) : fst $5 }+Line :: { NonTerm }+Line+:	Items '/n'					{ Fix $ DocLine $1 } -BulletIICont :: { ([NonTerm], [NonTerm]) }-BulletIICont-:								{ ([], []) }-|	BulletListItemII					{ ($1, []) }-|	'INDENT3' DocLine '\n' BulletIICont			{ ([], $2) <> $4 }+Items :: { [NonTerm] }+Items+:							{ [] }+|	Item Items					{ $1 : $2 } -NumberedListItem :: { NonTerm }-NumberedListItem-:	LIT_INTEGER '.' IndentedSentenceII			{ Fix (DocOLItem $1 $3) }+Item :: { NonTerm }+Item+:	TOKEN						{ Fix $ DocWord $1 }+|	' '						{ Fix $ DocWord $1 }+|	'('						{ Fix $ DocWord $1 }+|	')'						{ Fix $ DocWord $1 }+|	','						{ Fix $ DocWord $1 }+|	Command						{ $1 } -IndentedSentenceII :: { [NonTerm] }-IndentedSentenceII-:	DocLine '\n'						{ $1 }-|	DocLine '\n' 'INDENT2' IndentedSentenceII		{ $1 ++ $4 }+Command :: { NonTerm }+Command+:	'@attention'					{ Fix DocAttention }+|	'@brief'					{ Fix DocBrief }+|	'@deprecated'					{ Fix DocDeprecated }+|	'@file'						{ Fix DocFile }+|	'@extends' ' ' TOKEN				{ Fix $ DocExtends $3 }+|	'@implements' ' ' TOKEN				{ Fix $ DocImplements $3 }+|	'@note'						{ Fix DocNote }+|	'@param' '[in]' ' ' TOKEN			{ Fix $ DocParam (Just $2) $4 }+|	'@param' ' ' TOKEN				{ Fix $ DocParam Nothing $3 }+|	'@private'					{ Fix DocPrivate }+|	'@ref' ' ' TOKEN				{ Fix $ DocRef $3 }+|	'@p' ' ' TOKEN					{ Fix $ DocP $3 }+|	'@return'					{ Fix DocReturn }+|	'@retval'					{ Fix DocRetval }+|	'@section' ' ' TOKEN				{ Fix $ DocSection $3 }+|	'@subsection' ' ' TOKEN				{ Fix $ DocSubsection $3 }+|	'@see' ' ' TOKEN				{ Fix $ DocSee $3 }+|	'@security_rank' '(' TOKEN ',' ' ' TOKEN ')'	{ Fix $ DocSecurityRank $3 Nothing $6 }+|	'@security_rank' '(' TOKEN ',' ' ' TOKEN ',' ' ' TOKEN ')'	{ Fix $ DocSecurityRank $3 (Just $6) $9 }+|	'@code' Words '@endcode'			{ Fix $ DocCode $1 $2 $3 }  Words :: { [NonTerm] } Words-:	SentenceList(WordList)					{ $1 }--WordList :: { [NonTerm] }-WordList-:	Word(Atom)						{ [$1] }-|	WordList Word(Atom)					{ $2 : $1 }--SentenceList(x)-:	x							{ reverse $1 }-|	SentenceList(x) ';'					{ [Fix (DocSentence $1 $2)] }-|	SentenceList(x) ','					{ [Fix (DocSentence $1 $2)] }-|	SentenceList(x) '.'					{ [Fix (DocSentence $1 $2)] }-|	SentenceList(x) '?'					{ [Fix (DocSentence $1 $2)] }-|	SentenceList(x) '!'					{ [Fix (DocSentence $1 $2)] }-|	SentenceList(x) ';' SentenceList(x)			{ Fix (DocSentence $1 $2) : $3 }-|	SentenceList(x) ',' SentenceList(x)			{ Fix (DocSentence $1 $2) : $3 }-|	SentenceList(x) '.' SentenceList(x)			{ Fix (DocSentence $1 $2) : $3 }-|	SentenceList(x) '?' SentenceList(x)			{ Fix (DocSentence $1 $2) : $3 }-|	SentenceList(x) '!' SentenceList(x)			{ Fix (DocSentence $1 $2) : $3 }--Word(x)-:	x							{ Fix $ DocWord $1 }-|	x ':'							{ Fix $ DocColon $1 }-|	Word(x) '=' Word(Atom)					{ Fix $ DocAssignOp AopEq $1 $3 }-|	Word(x) '+' Word(Atom)					{ Fix $ DocBinaryOp BopPlus $1 $3 }-|	Word(x) '-' Word(Atom)					{ Fix $ DocBinaryOp BopMinus $1 $3 }-|	Word(x) '/' Word(Atom)					{ Fix $ DocBinaryOp BopDiv $1 $3 }-|	Word(x) '!=' Word(Atom)					{ Fix $ DocBinaryOp BopNe $1 $3 }-|	Word(x) '>=' Word(Atom)					{ Fix $ DocBinaryOp BopGe $1 $3 }-|	Word(x) '==' Word(Atom)					{ Fix $ DocBinaryOp BopEq $1 $3 }-|	'@ref' Atom						{ Fix $ DocRef $2 }-|	'@p' Atom						{ Fix $ DocP $2 }-|	'(' Word(Atom)						{ Fix $ DocLParen $2 }-|	Word(x) ')'						{ Fix $ DocRParen $1 }--Atom :: { Term }-Atom-:	NonInt							{ $1 }-|	LIT_INTEGER						{ $1 }+:							{ [] }+|	Word Words					{ $1 : $2 } -NonInt :: { Term }-NonInt-:	CMT_WORD						{ $1 }-|	CMT_CODE						{ $1 }-|	LIT_STRING						{ $1 }-|	'...'							{ $1 }+Word :: { NonTerm }+Word+:	TOKEN					{ Fix $ DocWord $1 }+|	' '					{ Fix $ DocWord $1 }+|	'('					{ Fix $ DocWord $1 }+|	')'					{ Fix $ DocWord $1 }+|	','					{ Fix $ DocWord $1 }+|	'/n'					{ Fix $ DocWord $1 }  { type Term = Lexeme Text type NonTerm = Comment Term -prepend :: NonTerm -> [NonTerm] -> [NonTerm]-prepend x [] = [x]-prepend x (Fix (DocLine xs):rest) = Fix (DocLine (x:xs)) : rest- failAt :: Lexeme Text -> String -> ParseResult a failAt n msg =     fail $ Text.unpack (sloc "" n) <> ": unexpected in comment: " <> describeLexeme n <> msg  parseError :: ([Lexeme Text], [String]) -> ParseResult a parseError ([], options)  = fail $ " end of comment; expected one of " <> show options-parseError (n:_, [])      = failAt n "; expected end of comment"+parseError (n:_, [])	  = failAt n "; expected end of comment" parseError (n:_, options) = failAt n $ "; expected one of " <> show options }

@@ -116,7 +116,7 @@     d CmtCommand            = Just "doxygen command"     d CmtAttr               = Just "parameter attribute"     d CmtEndDocSection      = Just "doxygen end-of-section"-    d CmtIndent             = Just "indented comment"+    d CmtSpace              = Just "space in comment"     d CmtStart              = Just "start of comment"     d CmtStartCode          = Just "escaped comment"     d CmtStartBlock         = Just "block comment"

@@ -11,7 +11,7 @@ import           GHC.Generics import           Language.Cimple.Ast (AssignOp, BinaryOp, CommentF (..),                                       CommentStyle, LiteralType, NodeF (..),-                                      Scope, UnaryOp)+                                      Nullability, Scope, UnaryOp)  class Concats t a where     concats :: t -> [a]@@ -44,6 +44,7 @@ instance GenConcatsFlatten Scope        a where gconcatsFlatten = const [] instance GenConcatsFlatten CommentStyle a where gconcatsFlatten = const [] instance GenConcatsFlatten LiteralType  a where gconcatsFlatten = const []+instance GenConcatsFlatten Nullability  a where gconcatsFlatten = const []  instance GenConcatsFlatten b a => GenConcatsFlatten (Maybe b) a where     gconcatsFlatten = gconcatsFlatten . maybeToList@@ -56,32 +57,26 @@  instance GenConcatsFlatten (Fix (CommentF a)) a where     -- TODO(iphydf): Figure out how to write this using Generics.-    gconcatsFlatten (Fix DocNewline) = []+    gconcatsFlatten (Fix DocFile) = []     gconcatsFlatten (Fix DocPrivate) = []-    gconcatsFlatten (Fix (DocAssignOp _ l r)) = concatMap gconcatsFlatten [l, r]-    gconcatsFlatten (Fix (DocAttention x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocBinaryOp _ l r)) = concatMap gconcatsFlatten [l, r]-    gconcatsFlatten (Fix (DocBrief x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocColon x)) = gconcatsFlatten x+    gconcatsFlatten (Fix DocAttention) = []+    gconcatsFlatten (Fix (DocBrief)) = []     gconcatsFlatten (Fix (DocComment x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocDeprecated x)) = gconcatsFlatten x+    gconcatsFlatten (Fix (DocDeprecated)) = []     gconcatsFlatten (Fix (DocExtends x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocImplements x)) = gconcatsFlatten x+    gconcatsFlatten (Fix DocNote) = []     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-    gconcatsFlatten (Fix (DocParagraph x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocParam a p x)) = concat [gconcatsFlatten a, gconcatsFlatten p, gconcatsFlatten x]+    gconcatsFlatten (Fix (DocParam a p)) = concat [gconcatsFlatten a, gconcatsFlatten p]     gconcatsFlatten (Fix (DocP x)) = gconcatsFlatten x     gconcatsFlatten (Fix (DocRef x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocReturn x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocRetval r x)) = r : gconcatsFlatten x-    gconcatsFlatten (Fix (DocRParen x)) = gconcatsFlatten x-    gconcatsFlatten (Fix (DocSee r x)) = r : gconcatsFlatten x-    gconcatsFlatten (Fix (DocSentence x p)) = gconcatsFlatten x ++ [p]-    gconcatsFlatten (Fix (DocULItem i x)) = gconcatsFlatten i ++ gconcatsFlatten x+    gconcatsFlatten (Fix (DocReturn)) = []+    gconcatsFlatten (Fix (DocRetval)) = []+    gconcatsFlatten (Fix (DocSection s)) = [s]+    gconcatsFlatten (Fix (DocSee r)) = [r]+    gconcatsFlatten (Fix (DocSecurityRank s p r)) = s : maybeToList p ++ [r]+    gconcatsFlatten (Fix (DocSubsection s)) = [s]     gconcatsFlatten (Fix (DocWord x)) = [x]  instance GenConcatsFlatten t a => GenConcats (Rec0 t) a where

@@ -48,13 +48,13 @@ runText f = flip runAlex f . LBS.fromStrict . Text.encodeUtf8  parseExpr :: Text -> Either String TextNode-parseExpr = runText Parser.parseStmt+parseExpr = runText Parser.parseExpr  parseStmt :: Text -> Either String TextNode parseStmt = runText Parser.parseStmt  parseText :: Text -> Either String [TextNode]-parseText = fmap cacheText . runText Parser.parseTranslationUnit+parseText = fmap cacheText . runText Parser.parseTranslationUnit >=> ParseResult.toEither . TreeParser.parseTranslationUnit  parseBytes :: LBS.ByteString -> Either String [TextNode] parseBytes = flip runAlex Parser.parseTranslationUnit

@@ -27,6 +27,7 @@ import qualified Data.Text.Encoding     as Text import           GHC.Generics           (Generic) import           Language.Cimple.Tokens (LexemeClass (..))+import           Data.Hashable (Hashable(..)) }  %wrapper "monad-bytestring"@@ -262,9 +263,6 @@ <cmtSC>		"SPDX-License-Identifier:"		{ mkL CmtSpdxLicense } <cmtSC>		"GPL-3.0-or-later"			{ mkL CmtWord } <cmtSC>		"TODO("[^\)]+"):"			{ mkL CmtWord }-<cmtSC>		[Ee]".g."				{ mkL CmtWord }-<cmtSC>		"etc."					{ 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]+)+			{ mkL CmtWord } <cmtSC>		[A-Z][A-Za-z]+"::"[a-z_]+		{ mkL CmtWord }@@ -274,15 +272,13 @@ <cmtSC>		"@code"					{ mkL CmtCode `andBegin` codeSC } <cmtSC>		"<code>"				{ mkL CmtCode `andBegin` codeSC } <cmtSC>		"["[^\]]+"]"				{ mkL CmtAttr }-<cmtSC>		"@retval"				{ mkL CmtCommand `andBegin` retvalSC }-<cmtSC>		[@\\][a-z]+				{ mkL CmtCommand }+<cmtSC>		[@\\][a-z_]+				{ mkL CmtCommand } <cmtSC>		"*"[A-Za-z][A-Za-z0-9_']*"*"		{ mkL CmtWord } <cmtSC>		"#"[A-Za-z][A-Za-z0-9_]*		{ mkL CmtRef } <cmtSC>		"_"*[A-Za-z][A-Za-z0-9_']*		{ mkL CmtWord } <cmtSC>		"#"[0-9]+				{ mkL CmtWord } <cmtSC>		"http://"[^\ ]+				{ mkL CmtWord } <cmtSC>		[0-9]+"%"				{ mkL LitInteger }-<cmtSC>		"-1"					{ mkL LitInteger } <cmtSC>		"`"([^`]|"\`")+"`"			{ mkL CmtCode } <cmtSC>		"${"([^\}])+"}"				{ mkL CmtCode } <cmtSC>		"-"+					{ mkL CmtWord }@@ -290,18 +286,12 @@ <cmtSC>		"–"					{ mkL CmtWord } <cmtSC>		"*/"					{ mkL CmtEnd `andBegin` 0 } <cmtSC>		\n					{ mkL PpNewline `andBegin` cmtNewlineSC }-<cmtSC>		" "+					;--<retvalSC>	[^\ ]+					{ mkL CmtWord `andBegin` cmtSC }-<retvalSC>	" "+					;+<cmtSC>		" "+					{ mkL CmtSpace }  <cmtNewlineSC>	" "+"*"+"/"				{ mkL CmtEnd `andBegin` 0 }-<cmtNewlineSC>	" "+"*"					{ begin cmtStartSC }--<cmtStartSC>	" "+					{ mkL CmtIndent `andBegin` cmtSC }-<cmtStartSC>	\n					{ mkL PpNewline `andBegin` cmtNewlineSC }+<cmtNewlineSC>	" "+"*"					{ begin cmtSC } -<codeStartSC>	" "+					{ mkL CmtIndent `andBegin` codeSC }+<codeStartSC>	" "+					{ mkL CmtSpace `andBegin` codeSC } <codeStartSC>	\n					{ mkL PpNewline `andBegin` codeNewlineSC }  <codeNewlineSC>	" "+"*"					{ begin codeStartSC }@@ -319,12 +309,14 @@ deriving instance Generic AlexPosn instance FromJSON AlexPosn instance ToJSON AlexPosn+instance Hashable AlexPosn  data Lexeme text = L AlexPosn LexemeClass text     deriving (Eq, Show, Generic, Functor, Foldable, Traversable)  instance FromJSON text => FromJSON (Lexeme text) instance ToJSON text => ToJSON (Lexeme text)+instance Hashable text => Hashable (Lexeme text) where  mkL :: LexemeClass -> AlexInput -> Int64 -> Alex (Lexeme Text) mkL c (p, _, str, _) len = pure $ L p c (piece str)

@@ -113,58 +113,40 @@             Fix <$> (DocComment <$> recurse docs)         DocWord word ->             Fix <$> (DocWord <$> recurse word)-        DocSentence docs ending ->-            Fix <$> (DocSentence <$> recurse docs <*> recurse ending)-        DocNewline -> pure $ Fix DocNewline -        DocAttention docs ->-            Fix <$> (DocAttention <$> recurse docs)-        DocBrief docs ->-            Fix <$> (DocBrief <$> recurse docs)-        DocDeprecated docs ->-            Fix <$> (DocDeprecated <$> recurse docs)+        DocAttention -> pure $ Fix DocAttention+        DocBrief -> pure $ Fix DocBrief+        DocDeprecated -> pure $ Fix DocDeprecated+        DocFile -> pure $ Fix DocFile         DocExtends feat ->             Fix <$> (DocExtends <$> recurse feat)         DocImplements feat ->             Fix <$> (DocImplements <$> recurse feat)-        DocParam attr name docs ->-            Fix <$> (DocParam <$> recurse attr <*> recurse name <*> recurse docs)-        DocReturn docs ->-            Fix <$> (DocReturn <$> recurse docs)-        DocRetval expr docs ->-            Fix <$> (DocRetval <$> recurse expr <*> recurse docs)-        DocSee ref docs ->-            Fix <$> (DocSee <$> recurse ref <*> recurse docs)+        DocNote -> pure $ Fix DocNote+        DocParam attr name ->+            Fix <$> (DocParam <$> recurse attr <*> recurse name)+        DocReturn -> pure $ Fix DocReturn+        DocRetval -> pure $ Fix DocRetval+        DocSection sec ->+            Fix <$> (DocSection <$> recurse sec)+        DocSee ref ->+            Fix <$> (DocSee <$> recurse ref)+        DocSecurityRank kw param rank ->+            Fix <$> (DocSecurityRank <$> recurse kw <*> recurse param <*> recurse rank)+        DocSubsection subsec ->+            Fix <$> (DocSubsection <$> recurse subsec)          DocPrivate -> pure $ Fix DocPrivate -        DocParagraph docs ->-            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 ->-            Fix <$> (DocOLItem <$> recurse docs <*> recurse sublist)-        DocULItem docs sublist ->-            Fix <$> (DocULItem <$> recurse docs <*> recurse sublist) -        DocColon docs ->-            Fix <$> (DocColon <$> recurse docs)         DocRef doc ->             Fix <$> (DocRef <$> recurse doc)         DocP doc ->             Fix <$> (DocP <$> recurse doc)-        DocLParen docs ->-            Fix <$> (DocLParen <$> recurse docs)-        DocRParen docs ->-            Fix <$> (DocRParen <$> recurse docs)-        DocAssignOp op lhs rhs ->-            Fix <$> (DocAssignOp op <$> recurse lhs <*> recurse rhs)-        DocBinaryOp op lhs rhs ->-            Fix <$> (DocBinaryOp op <$> recurse lhs <*> recurse rhs)        where         recurse :: MapAst itext otext a => a -> f (Mapped itext otext a)@@ -273,6 +255,8 @@             Fix <$> (VarDecl <$> recurse ty <*> recurse name <*> recurse arrs)         DeclSpecArray size ->             Fix <$> (DeclSpecArray <$> recurse size)+        ArrayDim nullability size ->+            Fix <$> (ArrayDim nullability <$> recurse size)         InitialiserList values ->             Fix <$> (InitialiserList <$> recurse values)         UnaryExpr op expr ->

@@ -17,8 +17,8 @@ import           Language.Cimple.Ast         (AssignOp (..), BinaryOp (..),                                               CommentStyle (..),                                               LiteralType (..), Node,-                                              NodeF (..), Scope (..),-                                              UnaryOp (..))+                                              NodeF (..), Nullability (..),+                                              Scope (..), UnaryOp (..)) import           Language.Cimple.DescribeAst (parseError) import           Language.Cimple.Lexer       (Alex, AlexPosn (..), Lexeme (..),                                               alexError, alexMonadScan)@@ -141,7 +141,7 @@     '/** @{'			{ L _ CmtStartDocSection	_ }     '/** @} */'			{ L _ CmtEndDocSection		_ }     '/***'			{ L _ CmtStartBlock		_ }-    ' '				{ L _ CmtIndent			_ }+    ' '				{ L _ CmtSpace			_ }     '*/'			{ L _ CmtEnd			_ }     'Copyright'			{ L _ CmtSpdxCopyright		_ }     'License'			{ L _ CmtSpdxLicense		_ }@@ -179,7 +179,7 @@  LicenseDecl :: { NonTerm } LicenseDecl-:	'/*' 'License' CMT_WORD '\n' CopyrightDecls '*/'	{ Fix $ LicenseDecl $3 (reverse $5) }+:	'/*' ' ' 'License' ' ' CMT_WORD '\n' CopyrightDecls '*/'	{ Fix $ LicenseDecl $5 (reverse $7) }  CopyrightDecls :: { [NonTerm] } CopyrightDecls@@ -188,7 +188,7 @@  CopyrightDecl :: { NonTerm } CopyrightDecl-:	' ' 'Copyright' CopyrightDates CopyrightOwner '\n'	{ Fix $ CopyrightDecl (fst $3) (snd $3) $4 }+:	' ' 'Copyright' ' ' CopyrightDates ' ' CopyrightOwner '\n'	{ Fix $ CopyrightDecl (fst $4) (snd $4) $6 }  CopyrightDates :: { (Term, Maybe Term) } CopyrightDates@@ -242,7 +242,6 @@ CommentToken :	CommentWord						{ $1 } |	'\n'							{ $1 }-|	' '							{ $1 }  CommentWords :: { [Term] } CommentWords@@ -258,6 +257,7 @@ |	CMT_CODE						{ $1 } |	LIT_INTEGER						{ $1 } |	LIT_STRING						{ $1 }+|	' '							{ $1 } |	'.'							{ $1 } |	'...'							{ $1 } |	'?'							{ $1 }@@ -455,7 +455,7 @@ DeclSpecArray :: { NonTerm } DeclSpecArray :	'[' ']'							{ Fix $ DeclSpecArray Nothing }-|	'[' Qual Expr ']'					{ Fix $ DeclSpecArray (Just ($2 $3)) }+|	'[' Nullability Expr ']'				{ Fix $ DeclSpecArray (Just (Fix (ArrayDim $2 $3))) } |	'[' '/*!' Expr '*/' ']'					{ Fix $ DeclSpecArray (Just $3) }  InitialiserExpr :: { NonTerm }@@ -691,6 +691,12 @@ |	nonnull const						{ tyConst . tyNonnull } |	nullable const						{ tyConst . tyNullable } |	owner							{ tyOwner }++Nullability :: { Nullability }+Nullability+:								{ NullabilityUnspecified }+|	nullable						{ Nullable }+|	nonnull							{ Nonnull }  GlobalLeafType :: { NonTerm } GlobalLeafType

@@ -3,8 +3,10 @@ module Language.Cimple.Pretty     ( plain     , render+    , renderSmart     , ppTranslationUnit     , showNode+    , showNodePlain     ) where  import           Data.Fix                      (foldFix)@@ -16,121 +18,31 @@                                                 Comment, CommentF (..),                                                 CommentStyle (..), Lexeme (..),                                                 LexemeClass (..), Node,-                                                NodeF (..), Scope (..),-                                                UnaryOp (..), lexemeLine,-                                                lexemeText)+                                                NodeF (..), Nullability (..),+                                                Scope (..), UnaryOp (..),+                                                lexemeLine, lexemeText) import           Language.Cimple.PrettyColor   (black, blue, cyan, dullcyan,                                                 dullgreen, dullmagenta, dullred,                                                 dullyellow, underline)+import           Language.Cimple.PrettyComment (ppCommentInfo)+import           Language.Cimple.PrettyCommon import           Prettyprinter import           Prettyprinter.Render.Terminal (AnsiStyle)-import qualified Prettyprinter.Render.Terminal as Term  indentWidth :: Int indentWidth = 2 -kwBitwise       = dullgreen $ pretty "bitwise"-kwBreak         = dullred   $ pretty "break"-kwCase          = dullred   $ pretty "case"-kwConst         = dullgreen $ pretty "const"-kwContinue      = dullred   $ pretty "continue"-kwDefault       = dullred   $ pretty "default"-kwDo            = dullred   $ pretty "do"-kwElse          = dullred   $ pretty "else"-kwEnum          = dullgreen $ pretty "enum"-kwExtern        = dullgreen $ pretty "extern"-kwFor           = dullred   $ pretty "for"-kwForce         = dullgreen $ pretty "force"-kwGnuPrintf     = dullgreen $ pretty "GNU_PRINTF"-kwGoto          = dullred   $ pretty "goto"-kwIf            = dullred   $ pretty "if"-kwNonnull       = dullgreen $ pretty "_Nonnull"-kwNullable      = dullgreen $ pretty "_Nullable"-kwOwner         = dullgreen $ pretty "owner"-kwReturn        = dullred   $ pretty "return"-kwSizeof        = dullred   $ pretty "sizeof"-kwStaticAssert  = dullred   $ pretty "static_assert"-kwStatic        = dullgreen $ pretty "static"-kwStruct        = dullgreen $ pretty "struct"-kwSwitch        = dullred   $ pretty "switch"-kwTypedef       = dullgreen $ pretty "typedef"-kwUnion         = dullgreen $ pretty "union"-kwWhile         = dullred   $ pretty "while"--kwDocAttention  = dullcyan $ pretty "@attention"-kwDocBrief      = dullcyan $ pretty "@brief"-kwDocDeprecated = dullcyan $ pretty "@deprecated"-kwDocExtends    = dullcyan $ pretty "@extends"-kwDocImplements = dullcyan $ pretty "@implements"-kwDocParam      = dullcyan $ pretty "@param"-kwDocPrivate    = dullcyan $ pretty "@private"-kwDocRef        = dullcyan $ pretty "@ref"-kwDocReturn     = dullcyan $ pretty "@return"-kwDocRetval     = dullcyan $ pretty "@retval"-kwDocP          = dullcyan $ pretty "@p"-kwDocSee        = dullcyan $ pretty "@see"--cmtPrefix :: Doc AnsiStyle-cmtPrefix = dullyellow (pretty '*')--ppText :: Text -> Doc AnsiStyle-ppText = pretty . Text.unpack--ppLexeme :: Lexeme Text -> Doc AnsiStyle-ppLexeme = ppText . lexemeText--commaSep :: [Doc AnsiStyle] -> Doc AnsiStyle-commaSep = hsep . punctuate comma- ppScope :: Scope -> Doc AnsiStyle ppScope = \case     Global -> mempty     Static -> kwStatic <> space--ppAssignOp :: AssignOp -> Doc AnsiStyle-ppAssignOp = \case-    AopEq     -> equals-    AopMul    -> pretty "*="-    AopDiv    -> pretty "/="-    AopPlus   -> pretty "+="-    AopMinus  -> pretty "-="-    AopBitAnd -> pretty "&="-    AopBitOr  -> pretty "|="-    AopBitXor -> pretty "^="-    AopMod    -> pretty "%="-    AopLsh    -> pretty ">>="-    AopRsh    -> pretty "<<="--ppBinaryOp :: BinaryOp -> Doc AnsiStyle-ppBinaryOp = \case-    BopNe     -> pretty "!="-    BopEq     -> pretty "=="-    BopOr     -> pretty "||"-    BopBitXor -> pretty '^'-    BopBitOr  -> pretty '|'-    BopAnd    -> pretty "&&"-    BopBitAnd -> pretty '&'-    BopDiv    -> pretty '/'-    BopMul    -> pretty '*'-    BopMod    -> pretty '%'-    BopPlus   -> pretty '+'-    BopMinus  -> pretty '-'-    BopLt     -> pretty '<'-    BopLe     -> pretty "<="-    BopLsh    -> pretty "<<"-    BopGt     -> pretty '>'-    BopGe     -> pretty ">="-    BopRsh    -> pretty ">>"+    Local  -> mempty -ppUnaryOp :: UnaryOp -> Doc AnsiStyle-ppUnaryOp = \case-    UopNot     -> pretty '!'-    UopNeg     -> pretty '~'-    UopMinus   -> pretty '-'-    UopAddress -> pretty '&'-    UopDeref   -> pretty '*'-    UopIncr    -> pretty "++"-    UopDecr    -> pretty "--"+ppNullability :: Nullability -> Doc AnsiStyle+ppNullability = \case+    NullabilityUnspecified -> mempty+    Nullable               -> kwNullable+    Nonnull                -> kwNonnull  ppCommentStart :: CommentStyle -> Doc AnsiStyle ppCommentStart = dullyellow . \case@@ -140,7 +52,7 @@     Regular -> pretty "/*"     Ignore  -> pretty "//!TOKSTYLE-" -ppCommentBody :: [Lexeme Text] -> Doc AnsiStyle+ppCommentBody :: [Lexeme (Doc AnsiStyle)] -> Doc AnsiStyle 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@@ -155,7 +67,7 @@         _               -> False      spaceWords = \case-        (L c p s:ws) -> L c p (tSpace<>s):continue ws+        (L c p s:ws) -> L c p s:continue ws         []           -> []       where         continue [] = []@@ -165,22 +77,20 @@         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 (tSpace<>s<>tSpace), end]-        continue (L c PctLParen s:w:ws) = L c PctLParen (tSpace<>s):w:continue ws-        continue (L c p s:ws) = L c p (tSpace<>s):continue ws--        tSpace :: Text-        tSpace = Text.pack " "+        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  _) = mempty-ppWord (L _ CmtCommand t) = dullcyan   $ ppText t-ppWord (L _ _          t) = dullyellow $ ppText t+ppWord :: Lexeme (Doc AnsiStyle) -> Doc AnsiStyle+ppWord l@(L _ CmtSpace   _) = lexemeText l+ppWord l@(L _ CmtCommand _) = dullcyan   $ lexemeText l+ppWord l@(L _ _          _) = dullyellow $ lexemeText l -ppComment :: CommentStyle -> [Lexeme Text] -> Lexeme Text -> Doc AnsiStyle+ppComment :: CommentStyle -> [Lexeme (Doc AnsiStyle)] -> Lexeme (Doc AnsiStyle) -> Doc AnsiStyle ppComment Ignore cs _ =     ppCommentStart Ignore <> hcat (map ppWord cs) <> dullyellow (pretty "//!TOKSTYLE+" <> line)-ppComment style cs (L l c _) =-    nest 1 $ ppCommentStart style <> ppCommentBody (cs ++ [L l c (Text.pack "*/")])+ppComment style cs end =+    nest 1 $ ppCommentStart style <> ppCommentBody (cs ++ [end])  ppInitialiserList :: [Doc AnsiStyle] -> Doc AnsiStyle ppInitialiserList l = lbrace <+> commaSep l <+> rbrace@@ -189,8 +99,9 @@ ppParamList = parens . indent 0 . commaSep  ppFunctionPrototype-    :: Doc AnsiStyle-    -> Lexeme Text+    :: Pretty a+    => Doc AnsiStyle+    -> Lexeme a     -> [Doc AnsiStyle]     -> Doc AnsiStyle ppFunctionPrototype ty name params =@@ -239,11 +150,11 @@     -> Doc AnsiStyle ppSwitchStmt c body =     nest indentWidth (-        kwSwitch <+> parens c <+> lbrace <$$>+        kwSwitch <+> parens c <+> lbrace <> line <>         vcat body-    ) <$$> rbrace+    ) <> line <> rbrace -ppVLA :: Doc AnsiStyle -> Lexeme Text -> Doc AnsiStyle -> Doc AnsiStyle+ppVLA :: Pretty a => Doc AnsiStyle -> Lexeme a -> Doc AnsiStyle -> Doc AnsiStyle ppVLA ty n sz =     pretty "VLA("         <> ty@@ -256,9 +167,9 @@ ppCompoundStmt :: [Doc AnsiStyle] -> Doc AnsiStyle ppCompoundStmt body =     nest indentWidth (-        lbrace <$$>+        lbrace <> line <>         ppToplevel body-    ) <$$> rbrace+    ) <> line <> rbrace  ppTernaryExpr     :: Doc AnsiStyle@@ -268,13 +179,13 @@ ppTernaryExpr c t e =     c <+> pretty '?' <+> t <+> colon <+> e -ppLicenseDecl :: Lexeme Text -> [Doc AnsiStyle] -> Doc AnsiStyle+ppLicenseDecl :: Pretty a => Lexeme a -> [Doc AnsiStyle] -> Doc AnsiStyle ppLicenseDecl l cs =-    dullyellow $ ppCommentStart Regular <+> pretty "SPDX-License-Identifier: " <> ppLexeme l <$$>-    vcat (map dullyellow cs) <$$>+    dullyellow $ ppCommentStart Regular <+> pretty "SPDX-License-Identifier: " <> ppLexeme l <> line <>+    vcat (map dullyellow cs) <> line <>     dullyellow (pretty " */") -ppIntList :: [Lexeme Text] -> Doc AnsiStyle+ppIntList :: Pretty a => [Lexeme a] -> Doc AnsiStyle ppIntList = parens . commaSep . map (dullred . ppLexeme)  ppMacroBody :: Doc AnsiStyle -> Doc AnsiStyle@@ -287,104 +198,30 @@     . renderS     . plain -plain :: Doc ann -> Doc xxx-plain = unAnnotate--ppVerbatimComment :: Doc AnsiStyle -> Doc AnsiStyle-ppVerbatimComment =-    vcat-    . map dullyellow-    . zipWith (<>) (mempty : repeat (pretty " * "))-    . map pretty-    . List.splitOn "\n"-    . renderS-    . plain--ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle-ppCodeBody =-    vcat-    . zipWith (<>) (mempty : commentStart " *"  )-    . map pretty-    . List.splitOn "\n"-    . renderS-    . plain-    . hcat--commentStart :: String -> [Doc AnsiStyle]-commentStart = repeat . dullyellow . pretty--ppCommentInfo :: Comment (Lexeme Text) -> Doc AnsiStyle-ppCommentInfo = foldFix go-  where-  ppBody     = vcat . zipWith (<>) (        commentStart " * "  )-  ppIndented = vcat . zipWith (<>) (mempty : commentStart " *   ")-  ppRef      = underline . cyan . ppLexeme-  ppAttr     = maybe mempty (blue . ppLexeme)--  go :: CommentF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle-  go = dullyellow . \case-    DocComment docs ->-        pretty "/**" <$$>-        ppBody docs <$$>-        dullyellow (pretty " */")-    DocWord w -> ppLexeme w-    DocSentence docs ending -> fillSep docs <> ppLexeme ending-    DocNewline -> mempty--    DocParam attr name docs ->-        kwDocParam <> ppAttr attr <+> underline (cyan (ppLexeme name)) <+> ppIndented docs--    DocAttention docs   -> kwDocAttention  <+> ppIndented docs-    DocBrief docs       -> kwDocBrief      <+> ppIndented docs-    DocDeprecated docs  -> kwDocDeprecated <+> ppIndented docs-    DocReturn docs      -> kwDocReturn     <+> ppIndented docs-    DocRetval expr docs -> kwDocRetval     <+> dullred (ppLexeme expr) <+> ppIndented docs-    DocSee name docs    -> kwDocSee        <+> ppRef name <+> ppIndented docs-    DocRef name         -> kwDocRef        <+> ppRef name-    DocP name           -> kwDocP          <+> ppRef name-    DocExtends feat     -> kwDocExtends    <+> ppLexeme feat-    DocImplements feat  -> kwDocImplements <+> ppLexeme feat-    DocPrivate          -> kwDocPrivate--    DocParagraph docs -> ppIndented docs-    DocLine docs -> fillSep docs-    DocCode begin code end -> ppLexeme begin <> ppCodeBody code <> ppLexeme end-    DocList l -> ppVerbatimComment $ vcat l-    DocOLItem num docs -> ppLexeme num <> pretty '.' <+> nest 3 (fillSep docs)-    DocULItem docs sublist -> pretty '-' <+> nest 2 (vsep $ fillSep docs : sublist)--    DocLParen doc -> lparen <> doc-    DocRParen doc -> doc <> rparen-    DocColon doc -> ppLexeme doc <> pretty ':'-    DocBinaryOp BopMinus l r -> l <>  pretty '-'      <>  r-    DocBinaryOp BopDiv   l r -> l <>  pretty '/'      <>  r-    DocAssignOp op       l r -> l <+> ppAssignOp op <+> r-    DocBinaryOp op       l r -> l <+> ppBinaryOp op <+> r--ppNode :: Node (Lexeme Text) -> Doc AnsiStyle+ppNode :: Pretty a => Node (Lexeme a) -> Doc AnsiStyle ppNode = foldFix go   where-  go :: NodeF (Lexeme Text) (Doc AnsiStyle) -> Doc AnsiStyle+  go :: Pretty a => NodeF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle   go = \case     StaticAssert cond msg ->         kwStaticAssert <> parens (cond <> comma <+> dullred (ppLexeme msg)) <> semi      LicenseDecl l cs -> ppLicenseDecl l cs     CopyrightDecl from (Just to) owner ->-        pretty " * Copyright © " <> ppLexeme from <> pretty '-' <> ppLexeme to <>-        ppCommentBody owner+        pretty " * Copyright © " <> ppLexeme from <> pretty '-' <> ppLexeme to <+>+        ppCommentBody (fmap pretty <$> owner)     CopyrightDecl from Nothing owner ->-        pretty " * Copyright © " <> ppLexeme from <>-        ppCommentBody owner+        pretty " * Copyright © " <> ppLexeme from <+>+        ppCommentBody (fmap pretty <$> owner) -    Comment style _ cs end ->-        ppComment style cs end+    Comment style _ cs (L l c _) ->+        ppComment style (fmap pretty <$> cs) (L l c (pretty "*/"))     CommentSection start decls end ->-        start <$$> line <> ppToplevel decls <> line <$$> end+        start <> line <> line <> ppToplevel decls <> line <> line <> end     CommentSectionEnd cs ->         dullyellow $ ppLexeme cs     Commented c d ->-        c <$$> d+        c <> line <> d     CommentInfo docs ->         ppCommentInfo docs @@ -412,6 +249,7 @@     VarDecl ty name arrs      -> ty <+> ppLexeme name <> hcat arrs     DeclSpecArray Nothing     -> pretty "[]"     DeclSpecArray (Just dim)  -> brackets dim+    ArrayDim nullability size -> ppNullability nullability <+> size      TyBitwise     ty -> kwBitwise <+> ty     TyForce       ty -> kwForce <+> ty@@ -427,14 +265,14 @@     TyUnion       l  -> kwUnion <+> dullgreen (ppLexeme l)      ExternC decls ->-        dullmagenta (pretty "#ifdef __cplusplus") <$$>-        kwExtern <+> dullred (pretty "\"C\"") <+> lbrace <$$>-        dullmagenta (pretty "#endif") <$$>+        dullmagenta (pretty "#ifdef __cplusplus") <> line <>+        kwExtern <+> dullred (pretty "\"C\"") <+> lbrace <> line <>+        dullmagenta (pretty "#endif") <> line <>         line <>-        ppToplevel decls <$$>+        ppToplevel decls <> line <>         line <>-        dullmagenta (pretty "#ifdef __cplusplus") <$$>-        rbrace <+> pretty "/* extern \"C\" */" <$$>+        dullmagenta (pretty "#ifdef __cplusplus") <> line <>+        rbrace <+> pretty "/* extern \"C\" */" <> line <>         dullmagenta (pretty "#endif")      Group decls -> vcat decls@@ -446,7 +284,7 @@         kwDo <+> body <+> kwWhile <+> pretty "(0)"      PreprocScopedDefine def stmts undef ->-        def <$$> ppToplevel stmts <$$> undef+        def <> line <> ppToplevel stmts <> line <> undef      PreprocInclude hdr ->         dullmagenta $ pretty "#include" <+> ppLexeme hdr@@ -460,33 +298,33 @@         dullmagenta $ pretty "#undef" <+> ppLexeme name      PreprocIf cond decls elseBranch ->-        dullmagenta (pretty "#if" <+> cond) <$$>+        dullmagenta (pretty "#if" <+> cond) <> line <>         ppToplevel decls <>-        elseBranch <$$>+        elseBranch <> line <>         dullmagenta (pretty "#endif  /*" <+> cond <+> pretty "*/")     PreprocIfdef name decls elseBranch ->-        dullmagenta (pretty "#ifdef" <+> ppLexeme name) <$$>+        dullmagenta (pretty "#ifdef" <+> ppLexeme name) <> line <>         ppToplevel decls <>-        elseBranch <$$>+        elseBranch <> line <>         dullmagenta (pretty "#endif  /*" <+> ppLexeme name <+> pretty "*/")     PreprocIfndef name decls elseBranch ->-        dullmagenta (pretty "#ifndef" <+> ppLexeme name) <$$>+        dullmagenta (pretty "#ifndef" <+> ppLexeme name) <> line <>         ppToplevel decls <>-        elseBranch <$$>+        elseBranch <> line <>         dullmagenta (pretty "#endif  /*" <+> ppLexeme name <+> pretty "*/")     PreprocElse [] -> mempty     PreprocElse decls ->         line <>-        dullmagenta (pretty "#else") <$$>+        dullmagenta (pretty "#else") <> line <>         ppToplevel decls     PreprocElif cond decls elseBranch ->         hardline <>-        dullmagenta (pretty "#elif") <+> cond <$$>+        dullmagenta (pretty "#elif") <+> cond <> line <>         ppToplevel decls <>         elseBranch      AttrPrintf fmt ellipsis fun ->-        kwGnuPrintf <> ppIntList [fmt, ellipsis] <$$> fun+        kwGnuPrintf <> ppIntList [fmt, ellipsis] <> line <> fun     CallbackDecl ty name ->         ppLexeme ty <+> ppLexeme name     FunctionPrototype ty name params ->@@ -504,14 +342,14 @@     AggregateDecl struct -> struct <> semi     Struct name members ->         nest indentWidth (-            kwStruct <+> ppLexeme name <+> lbrace <$$>+            kwStruct <+> ppLexeme name <+> lbrace <> line <>             vcat members-        ) <$$> rbrace+        ) <> line <> rbrace     Union name members ->         nest indentWidth (-            kwUnion <+> ppLexeme name <+> lbrace <$$>+            kwUnion <+> ppLexeme name <+> lbrace <> line <>             vcat members-        ) <$$> rbrace+        ) <> line <> rbrace     Typedef ty tyname ->         kwTypedef <+> ty <+> dullgreen (ppLexeme tyname) <> semi     TypedefFunction proto ->@@ -529,28 +367,28 @@      EnumConsts Nothing enums ->         nest indentWidth (-            kwEnum <+> lbrace <$$>+            kwEnum <+> lbrace <> line <>             vcat enums-        ) <$$> pretty "};"+        ) <> line <> pretty "};"     EnumConsts (Just name) enums ->         nest indentWidth (-            kwEnum <+> ppLexeme name <+> lbrace <$$>+            kwEnum <+> ppLexeme name <+> lbrace <> line <>             vcat enums-        ) <$$> pretty "};"+        ) <> line <> pretty "};"     EnumDecl name enums ty ->         nest indentWidth (-            kwTypedef <+> kwEnum <+> dullgreen (ppLexeme name) <+> lbrace <$$>+            kwTypedef <+> kwEnum <+> dullgreen (ppLexeme name) <+> lbrace <> line <>             vcat enums-        ) <$$> rbrace <+> dullgreen (ppLexeme ty) <> semi+        ) <> line <> rbrace <+> dullgreen (ppLexeme ty) <> semi      NonNull [] [] f ->-        kwNonnull <> pretty "()" <$$> f+        kwNonnull <> pretty "()" <> line <> f     NonNull nonnull [] f ->-        kwNonnull <> ppIntList nonnull <$$> f+        kwNonnull <> ppIntList nonnull <> line <> f     NonNull [] nullable f ->-        kwNullable <> ppIntList nullable <$$> f+        kwNullable <> ppIntList nullable <> line <> f     NonNull nonnull nullable f ->-        kwNonnull <> ppIntList nonnull <+> kwNullable <> ppIntList nullable <$$> f+        kwNonnull <> ppIntList nonnull <+> kwNullable <> ppIntList nullable <> line <> f      NonNullParam p ->         kwNonnull <> pretty "()" <+> p@@ -567,7 +405,7 @@     IfStmt cond t e               -> ppIfStmt cond t e     ForStmt i c n body            -> ppForStmt i c n body     Default s                     -> kwDefault <> colon <+> s-    Label l s                     -> indent (-99) (line <> ppLexeme l <> colon) <$$> s+    Label l s                     -> indent (-99) (line <> ppLexeme l <> colon) <> line <> s     ExprStmt e                    -> e <> semi     Goto l                        -> kwGoto <+> ppLexeme l <> semi     Case e s                      -> kwCase <+> e <> colon <+> s@@ -580,23 +418,11 @@ ppToplevel :: [Doc AnsiStyle] -> Doc AnsiStyle ppToplevel = vcat . punctuate line -ppTranslationUnit :: [Node (Lexeme Text)] -> Doc AnsiStyle+ppTranslationUnit :: Pretty a => [Node (Lexeme a)] -> Doc AnsiStyle ppTranslationUnit decls = (ppToplevel . map ppNode $ decls) <> line -showNode  :: Node (Lexeme Text) -> Text+showNode  :: Pretty a => Node (Lexeme a) -> Text showNode = render . ppNode -renderSmart :: Float -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle-renderSmart ribbonFraction widthPerLine-    = layoutSmart LayoutOptions-        { layoutPageWidth = AvailablePerLine widthPerLine (realToFrac ribbonFraction) }--renderS :: Doc AnsiStyle -> String-renderS = Text.unpack . render--render :: Doc AnsiStyle -> Text-render = TL.toStrict . Term.renderLazy . renderSmart 1 120--infixr 5 <$$>-(<$$>) :: Doc a -> Doc a -> Doc a-x <$$> y = x <> line <> y+showNodePlain :: Pretty a => Node (Lexeme a) -> Text+showNodePlain = render . plain . ppNode

@@ -0,0 +1,83 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+module Language.Cimple.PrettyComment+    ( ppCommentInfo+    ) where++import           Data.Fix                      (foldFix)+import           Data.List                     (dropWhile)+import qualified Data.List.Split               as List+import           Data.Text                     (Text)+import           Language.Cimple               (AssignOp (..), BinaryOp (..),+                                                Comment, CommentF (..),+                                                CommentStyle (..), Lexeme (..),+                                                LexemeClass (..), Node,+                                                NodeF (..), Nullability (..),+                                                Scope (..), UnaryOp (..),+                                                lexemeLine, lexemeText)+import           Language.Cimple.PrettyColor   (black, blue, cyan, dullcyan,+                                                dullgreen, dullmagenta, dullred,+                                                dullyellow, underline)+import           Language.Cimple.PrettyCommon+import           Prettyprinter+import           Prettyprinter.Render.Terminal (AnsiStyle)++ppCodeBody :: [Doc AnsiStyle] -> Doc AnsiStyle+ppCodeBody =+    vcat+    . map (pretty . (" *" <>))+    . dropWhile null+    . List.splitOn "\n"+    . renderS+    . plain+    . hcat++ppCommentInfo :: Pretty a => Comment (Lexeme a) -> Doc AnsiStyle+ppCommentInfo = foldFix go+  where+  ppRef :: forall a. Pretty a => Lexeme a -> Doc AnsiStyle+  ppRef      = underline . cyan . ppLexeme+  ppAttr :: forall a. Pretty a => Maybe (Lexeme a) -> Doc AnsiStyle+  ppAttr     = maybe mempty (blue . ppLexeme)+  mapTail _ []     = []+  mapTail f (x:xs) = x:map f xs++  go :: Pretty a => CommentF (Lexeme a) (Doc AnsiStyle) -> Doc AnsiStyle+  go = \case+    DocComment docs ->+        dullyellow (pretty "/**") <>+        (if null docs then mempty else vcat (map align $ mapTail (pretty " *" <>) docs)) <>+        line <> dullyellow (pretty " */")++    DocWord w -> ppLexeme w++    DocParam attr name ->+        kwDocParam <> ppAttr attr <+> ppLexeme name++    DocSecurityRank kw mparam rank ->+        kwDocSecurityRank <> pretty '(' <> ppLexeme kw <>+        (case mparam of+            Nothing    -> mempty+            Just param -> pretty ", " <> ppLexeme param+        ) <>+        pretty ", " <> ppLexeme rank <> pretty ')'++    DocAttention      -> kwDocAttention+    DocBrief          -> kwDocBrief+    DocDeprecated     -> kwDocDeprecated+    DocFile           -> kwDocFile+    DocReturn         -> kwDocReturn+    DocRetval         -> kwDocRetval+    DocSee name       -> kwDocSee        <+> ppRef name+    DocRef name         -> kwDocRef        <+> ppRef name+    DocP name           -> kwDocP          <+> ppRef name+    DocExtends feat     -> kwDocExtends    <+> ppLexeme feat+    DocImplements feat  -> kwDocImplements <+> ppLexeme feat+    DocPrivate          -> kwDocPrivate+    DocNote             -> kwDocNote+    DocSection title -> kwDocSection <+> ppLexeme title+    DocSubsection title -> kwDocSubsection <+> ppLexeme title++    DocLine docs -> hcat docs+    DocCode _ code _ ->+        kwDocCode <> line <> ppCodeBody code <> kwDocEndCode

@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# LANGUAGE LambdaCase #-}+module Language.Cimple.PrettyCommon where++import           Data.Text                     (Text)+import qualified Data.Text                     as Text+import qualified Data.Text.Lazy                as TL+import           Language.Cimple               (AssignOp (..), BinaryOp (..),+                                                Comment, CommentF (..),+                                                CommentStyle (..), Lexeme (..),+                                                LexemeClass (..), Node,+                                                NodeF (..), Nullability (..),+                                                Scope (..), UnaryOp (..),+                                                lexemeLine, lexemeText)+import           Language.Cimple.PrettyColor   (dullcyan, dullgreen, dullred,+                                                dullyellow)+import           Prettyprinter+import           Prettyprinter.Render.Terminal (AnsiStyle)+import qualified Prettyprinter.Render.Terminal as Term++kwBitwise         = dullgreen $ pretty "bitwise"+kwBreak           = dullred   $ pretty "break"+kwCase            = dullred   $ pretty "case"+kwConst           = dullgreen $ pretty "const"+kwContinue        = dullred   $ pretty "continue"+kwDefault         = dullred   $ pretty "default"+kwDo              = dullred   $ pretty "do"+kwElse            = dullred   $ pretty "else"+kwEnum            = dullgreen $ pretty "enum"+kwExtern          = dullgreen $ pretty "extern"+kwFor             = dullred   $ pretty "for"+kwForce           = dullgreen $ pretty "force"+kwGnuPrintf       = dullgreen $ pretty "GNU_PRINTF"+kwGoto            = dullred   $ pretty "goto"+kwIf              = dullred   $ pretty "if"+kwNonnull         = dullgreen $ pretty "_Nonnull"+kwNullable        = dullgreen $ pretty "_Nullable"+kwOwner           = dullgreen $ pretty "owner"+kwReturn          = dullred   $ pretty "return"+kwSizeof          = dullred   $ pretty "sizeof"+kwStaticAssert    = dullred   $ pretty "static_assert"+kwStatic          = dullgreen $ pretty "static"+kwStruct          = dullgreen $ pretty "struct"+kwSwitch          = dullred   $ pretty "switch"+kwTypedef         = dullgreen $ pretty "typedef"+kwUnion           = dullgreen $ pretty "union"+kwWhile           = dullred   $ pretty "while"++kwDocAttention    = dullcyan $ pretty "@attention"+kwDocBrief        = dullcyan $ pretty "@brief"+kwDocDeprecated   = dullcyan $ pretty "@deprecated"+kwDocFile         = dullcyan $ pretty "@file"+kwDocExtends      = dullcyan $ pretty "@extends"+kwDocImplements   = dullcyan $ pretty "@implements"+kwDocParam        = dullcyan $ pretty "@param"+kwDocPrivate      = dullcyan $ pretty "@private"+kwDocRef          = dullcyan $ pretty "@ref"+kwDocReturn       = dullcyan $ pretty "@return"+kwDocRetval       = dullcyan $ pretty "@retval"+kwDocP            = dullcyan $ pretty "@p"+kwDocSee          = dullcyan $ pretty "@see"+kwDocSecurityRank = dullcyan $ pretty "@security_rank"+kwDocNote         = dullcyan $ pretty "@note"+kwDocSection      = dullcyan $ pretty "@section"+kwDocSubsection   = dullcyan $ pretty "@subsection"+kwDocCode         = dullcyan $ pretty "@code"+kwDocEndCode      = dullcyan $ pretty "@endcode"++ppAssignOp :: AssignOp -> Doc AnsiStyle+ppAssignOp = \case+    AopEq     -> equals+    AopMul    -> pretty "*="+    AopDiv    -> pretty "/="+    AopPlus   -> pretty "+="+    AopMinus  -> pretty "-="+    AopBitAnd -> pretty "&="+    AopBitOr  -> pretty "|="+    AopBitXor -> pretty "^="+    AopMod    -> pretty "%="+    AopLsh    -> pretty ">>="+    AopRsh    -> pretty "<<="++ppBinaryOp :: BinaryOp -> Doc AnsiStyle+ppBinaryOp = \case+    BopNe     -> pretty "!="+    BopEq     -> pretty "=="+    BopOr     -> pretty "||"+    BopBitXor -> pretty '^'+    BopBitOr  -> pretty '|'+    BopAnd    -> pretty "&&"+    BopBitAnd -> pretty '&'+    BopDiv    -> pretty '/'+    BopMul    -> pretty '*'+    BopMod    -> pretty '%'+    BopPlus   -> pretty '+'+    BopMinus  -> pretty '-'+    BopLt     -> pretty '<'+    BopLe     -> pretty "<="+    BopLsh    -> pretty "<<"+    BopGt     -> pretty '>'+    BopGe     -> pretty ">="+    BopRsh    -> pretty ">>"++ppUnaryOp :: UnaryOp -> Doc AnsiStyle+ppUnaryOp = \case+    UopNot     -> pretty '!'+    UopNeg     -> pretty '~'+    UopMinus   -> pretty '-'+    UopAddress -> pretty '&'+    UopDeref   -> pretty '*'+    UopIncr    -> pretty "++"+    UopDecr    -> pretty "--"++cmtPrefix :: Doc AnsiStyle+cmtPrefix = dullyellow (pretty '*')++ppLexeme :: Pretty a => Lexeme a -> Doc AnsiStyle+ppLexeme = pretty . lexemeText++commaSep :: [Doc AnsiStyle] -> Doc AnsiStyle+commaSep = hsep . punctuate comma++plain :: Doc ann -> Doc xxx+plain = unAnnotate++renderSmart :: Float -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle+renderSmart ribbonFraction widthPerLine+    = layoutSmart LayoutOptions+        { layoutPageWidth = AvailablePerLine widthPerLine (realToFrac ribbonFraction) }++renderS :: Doc AnsiStyle -> String+renderS = Text.unpack . render++render :: Doc AnsiStyle -> Text+render = TL.toStrict . Term.renderLazy . renderSmart 1 120

@@ -4,8 +4,9 @@     ( LexemeClass (..)     ) where -import           Data.Aeson   (FromJSON, ToJSON)-import           GHC.Generics (Generic)+import           Data.Aeson    (FromJSON, ToJSON)+import           Data.Hashable (Hashable)+import           GHC.Generics  (Generic)  data LexemeClass     = IdConst@@ -109,7 +110,7 @@     | CmtCommand     | CmtAttr     | CmtEndDocSection-    | CmtIndent+    | CmtSpace     | CmtStart     | CmtStartCode     | CmtStartBlock@@ -131,3 +132,4 @@  instance FromJSON LexemeClass instance ToJSON LexemeClass+instance Hashable LexemeClass

@@ -96,42 +96,39 @@             recurse docs         DocWord word ->             recurse word-        DocSentence docs ending -> do-            _ <- recurse docs-            _ <- recurse ending-            pure ()-        DocNewline -> pure () -        DocAttention docs ->-            recurse docs-        DocBrief docs ->-            recurse docs-        DocDeprecated docs ->-            recurse docs+        DocAttention -> pure ()+        DocBrief -> pure ()+        DocDeprecated -> pure ()+        DocFile -> pure ()         DocExtends feat ->             recurse feat         DocImplements feat ->             recurse feat-        DocParam attr name docs -> do+        DocNote -> pure ()+        DocParam attr name -> do             _ <- recurse attr             _ <- recurse name-            _ <- recurse docs             pure ()-        DocReturn docs ->-            recurse docs-        DocRetval expr docs -> do-            _ <- recurse expr-            _ <- recurse docs+        DocReturn -> pure ()+        DocRetval -> pure ()+        DocSection sec -> do+            _ <- recurse sec             pure ()-        DocSee ref docs -> do+        DocSee ref -> do             _ <- recurse ref-            _ <- recurse docs             pure ()+        DocSecurityRank kw mparam rank -> do+            _ <- recurse kw+            _ <- recurse mparam+            _ <- recurse rank+            pure ()+        DocSubsection subsec -> do+            _ <- recurse subsec+            pure ()          DocPrivate -> pure () -        DocParagraph docs ->-            recurse docs         DocLine docs ->             recurse docs         DocCode begin docs end -> do@@ -139,35 +136,11 @@             _ <- recurse docs             _ <- recurse end             pure ()-        DocList docs ->-            recurse docs-        DocOLItem docs sublist -> do-            _ <- recurse docs-            _ <- recurse sublist-            pure ()-        DocULItem docs sublist -> do-            _ <- recurse docs-            _ <- recurse sublist-            pure () -        DocColon docs ->-            recurse docs         DocRef doc ->             recurse doc         DocP doc ->             recurse doc-        DocLParen docs ->-            recurse docs-        DocRParen docs ->-            recurse docs-        DocAssignOp _ lhs rhs -> do-            _ <- recurse lhs-            _ <- recurse rhs-            pure ()-        DocBinaryOp _ lhs rhs -> do-            _ <- recurse lhs-            _ <- recurse rhs-            pure ()        where         recurse :: TraverseAst text a => a -> f ()@@ -332,6 +305,8 @@             _ <- recurse arrs             pure ()         DeclSpecArray size ->+            recurse size+        ArrayDim _ size ->             recurse size         InitialiserList values ->             recurse values

@@ -18,7 +18,7 @@  %name parseTranslationUnit TranslationUnit %name parseDecls Decls-%name parseHeaderBody HeaderBody+%name parseMemberDecls MemberDecls  %error {parseError} %errorhandlertype explist@@ -104,8 +104,9 @@     enumDecl		{ Fix (EnumDecl{}) }     enumerator		{ Fix (Enumerator{}) }     aggregateDecl	{ Fix (AggregateDecl{}) }-    typedef		{ Fix (Typedef{}) }     typedefFunction	{ Fix (TypedefFunction{}) }+    typedefStruct	{ Fix (Typedef (Fix Struct{}) _) }+    typedef		{ Fix (Typedef{}) }     struct		{ Fix (Struct{}) }     union		{ Fix (Union{}) }     memberDecl		{ Fix (MemberDecl{}) }@@ -130,59 +131,12 @@  TranslationUnit :: { [NonTerm] } TranslationUnit-:	licenseDecl docComment Header				{ [$1, Fix $ Commented $2 $3] }-|	licenseDecl docComment Source				{ $1 : mapHead (Fix . Commented $2) $3 }-|	licenseDecl            Header				{ [$1, $2] }-|	licenseDecl            Source				{ $1 : $2 }--Header :: { NonTerm }-Header-:	preprocIfndef ModeLine					{% recurse parseHeaderBody $1 }--ModeLine :: { Maybe NonTerm }-ModeLine-:								{ Nothing }-|	comment							{ Just $1 }--HeaderBody :: { [NonTerm] }-HeaderBody-:	preprocDefine Includes Decls				{ $1 : $2 ++ $3 }--Source :: { [NonTerm] }-Source-:	Features localInclude Includes Decls			{ maybeToList $1 ++ [$2] ++ $3 ++ $4 }--Features :: { Maybe NonTerm }-Features-:								{ Nothing }-|	NonEmptyList(IfDefine)					{ Just $ Fix $ Group $1 }--IfDefine :: { NonTerm }-IfDefine-:	ifndefDefine						{ $1 }-|	ifdefDefine						{ $1 }-|	ifDefine						{ $1 }--Includes :: { [NonTerm] }-Includes-:								{ [] }-|	NonEmptyList(SysInclude)				{ [Fix $ Group $1] }-|	NonEmptyList(LocalInclude)				{ [Fix $ Group $1] }-|	NonEmptyList(SysInclude) NonEmptyList(LocalInclude)	{ [Fix $ Group $1, Fix $ Group $2] }--LocalInclude :: { NonTerm }-LocalInclude-:	localInclude						{ $1 }-|	localIncludeBlock					{ $1 }--SysInclude :: { NonTerm }-SysInclude-:	sysInclude						{ $1 }-|	sysIncludeBlock						{ $1 }+:	licenseDecl Decls					{ $1 : $2 }+|	            Decls					{ $1 }  Decls :: { [NonTerm] } Decls-:	List(Decl)						{ $1 }+:	NonEmptyList(Decl)					{ $1 }  Decl :: { NonTerm } Decl@@ -197,8 +151,10 @@ |	functionDefn						{ $1 } |	nonNull							{ $1 } |	attrPrintf						{ $1 }-|	aggregateDecl						{ $1 }-|	struct							{ $1 }+|	aggregateDecl						{% processAggregate $1 }+|	struct							{% processAggregate $1 }+|	union							{% processAggregate $1 }+|	typedefStruct						{% processAggregate $1 } |	typedef							{ $1 } |	constDecl						{ $1 } |	constDefn						{ $1 }@@ -213,8 +169,27 @@ |	preprocIfndef						{% recurse parseDecls $1 } |	staticAssert						{ $1 } |	typedefFunction						{ $1 }-|	IfDefine						{ $1 }+|	ifndefDefine						{ $1 }+|	ifdefDefine						{ $1 }+|	ifDefine						{ $1 }+|	localInclude						{ $1 }+|	localIncludeBlock					{ $1 }+|	sysInclude						{ $1 }+|	sysIncludeBlock						{ $1 } +MemberDecls :: { [NonTerm] }+MemberDecls+:	NonEmptyList(MemberDecl)				{ $1 }++MemberDecl :: { NonTerm }+MemberDecl+:	comment							{ $1 }+|	memberDecl						{ $1 }+|	docComment memberDecl					{% fmap (\c -> Fix $ Commented c $2) $ parseDocComment $1 }+|	preprocIfdef						{% recurse parseMemberDecls $1 }+|	preprocIfndef						{% recurse parseMemberDecls $1 }+|	preprocIf						{% recurse parseMemberDecls $1 }+ List(x) :								{ [] } |	NonEmptyList(x)						{ $1 }@@ -230,7 +205,6 @@ type TextLexeme = Lexeme Text type NonTerm = Node TextLexeme - mapHead :: (a -> a) -> [a] -> [a] mapHead _ [] = [] mapHead f (x:xs) = f x : xs@@ -267,12 +241,27 @@ hasInclude style (Fix (PreprocElse ed))           = any (hasInclude style) ed hasInclude _ _                                    = False +-- This helper function unpacks a struct/union, processes its members,+-- and then packs it back up.+processAggregate :: NonTerm -> ParseResult NonTerm+processAggregate (Fix (Struct name members)) = do+    processedMembers <- parseMemberDecls members+    return $ Fix (Struct name processedMembers)+processAggregate (Fix (Union name members)) = do+    processedMembers <- parseMemberDecls members+    return $ Fix (Union name processedMembers)+processAggregate (Fix (AggregateDecl agg)) = do+    processedAgg <- processAggregate agg+    return $ Fix (AggregateDecl processedAgg)+processAggregate (Fix (Typedef agg name)) = do+    processedAgg <- processAggregate agg+    return $ Fix (Typedef processedAgg name)+processAggregate n = return n -- Return other types unchanged  recurse :: ([NonTerm] -> ParseResult [NonTerm]) -> NonTerm -> ParseResult NonTerm recurse f (Fix (ExternC ds))          = Fix <$> (ExternC <$> f ds) recurse f (Fix (PreprocIf     c t e)) = Fix <$> (PreprocIf     c <$> f t <*> recurse f e) recurse f (Fix (PreprocIfdef  c t e)) = Fix <$> (PreprocIfdef  c <$> f t <*> recurse f e)-recurse f (Fix (PreprocIfndef c t e)) = Fix <$> (PreprocIfndef c <$> f t <*> recurse f e) recurse f (Fix (PreprocIfndef c t e)) = Fix <$> (PreprocIfndef c <$> f t <*> recurse f e) recurse f (Fix (PreprocElif   c t e)) = Fix <$> (PreprocElif   c <$> f t <*> recurse f e) recurse f (Fix (PreprocElse      [])) = Fix <$> pure (PreprocElse [])

@@ -0,0 +1,359 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.Cimple.CommentParserSpec where++import           Data.Text          (Text)+import qualified Data.Text          as Text+import           Test.Hspec         (Spec, describe, it, shouldSatisfy)++import           Language.Cimple    (Lexeme, Node)+import           Language.Cimple.IO (parseText)+++isRight1 :: Either a [b] -> Bool+isRight1 (Right [_]) = True+isRight1 _           = False+++parseLines :: [Text] -> Either String [Node (Lexeme Text)]+parseLines = parseText . Text.unlines+++spec :: Spec+spec = do+    describe "Doxygen comment parsing" $ do+        it "should parse a doc comment" $+            parseLines+                [ "/**"+                , " * @brief hello world."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a doc comment with a number at the end" $+            parseLines+                [ "/**"+                , " * @brief hello world."+                , " *"+                , " * There's more to say about today."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a @param" $+            parseLines+                [ "/**"+                , " * @param p1 hello world."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a @param with [in] attribute" $+            parseLines+                [ "/**"+                , " * @param[in] p1 hello world."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a @return" $+            parseLines+                [ "/**"+                , " * @return hello world."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a @retval" $+            parseLines+                [ "/**"+                , " * @retval 0 Success."+                , " * @retval 1 Failure."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a bullet list" $+            parseLines+                [ "/**"+                , " * - item 1"+                , " * - item 2"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a nested bullet list" $+            parseLines+                [ "/**"+                , " * - item 1"+                , " *   - nested item 1"+                , " * - item 2"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a numbered list" $+            parseLines+                [ "/**"+                , " * 1. item 1"+                , " * 2. item 2"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a numbered list with continuation" $+            parseLines+                [ "/**"+                , " * 1. item 1"+                , " *    continued."+                , " * 2. item 2"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a code block" $+            parseLines+                [ "/**"+                , " * @code"+                , " * int x = 5;"+                , " * @endcode"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @deprecated" $+            parseLines+                [ "/**"+                , " * @deprecated Use new_function instead."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @see" $+            parseLines+                [ "/**"+                , " * @see other_function for more details."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @attention" $+            parseLines+                [ "/**"+                , " * @attention This is important."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @note" $+            parseLines+                [ "/**"+                , " * @note This is a note."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @private" $+            parseLines+                [ "/**"+                , " * @private"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @extends" $+            parseLines+                [ "/**"+                , " * @extends BaseClass"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @implements" $+            parseLines+                [ "/**"+                , " * @implements Interface"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @security_rank" $+            parseLines+                [ "/**"+                , " * @security_rank(sink, data, 1)"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse a complex comment" $+            parseLines+                [ "/**"+                , " * @brief A brief description."+                , " *"+                , " * A more detailed description."+                , " * - list item 1"+                , " * - list item 2"+                , " * @param p1 Description for p1."+                , " * @return Description for return."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with operators" $+            parseLines+                [ "/**"+                , " * check if x == 5"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @ref" $+            parseLines+                [ "/**"+                , " * see @ref my_ref"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @p" $+            parseLines+                [ "/**"+                , " * @p my_p"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @file" $+            parseLines+                [ "/**"+                , " * @file"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @section" $+            parseLines+                [ "/**"+                , " * @section sec_id sec_title"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse @subsection" $+            parseLines+                [ "/**"+                , " * @subsection subsec_id subsec_title"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with colon" $+            parseLines+                [ "/**"+                , " * Note:"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with parens" $+            parseLines+                [ "/**"+                , " * (Note)"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with parens including long sentences going to the next line" $+            parseLines+                [ "/**"+                , " * This is a comment (and there is more"+                , " * to say about this)."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with operators" $+            parseLines+                [ "/**"+                , " * a + b = c"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse words with assignment" $+            parseLines+                [ "/**"+                , " * x = 5"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should parse sentences with various punctuation" $+            parseLines+                [ "/**"+                , " * Is this a question?"+                , " * This is exciting!"+                , " * This is a clause;"+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should allow numbers in the text" $+            parseLines+                [ "/**"+                , " * I have 3 things on my mind."+                , " */"+                , "const int abc = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should allow numbers at the start of the text" $+            parseLines+                [ "/**"+                , " * I have 3 things on my mind. You have"+                , " * 20 things on your mind. We are not the same."+                , " */"+                , "const int my_mind = 3;"+                ]+            `shouldSatisfy` isRight1++        it "should allow numbers at the end of the sentence at the start of a line" $+            parseLines+                [ "/**"+                , " * I have 3 things on my mind. The number of things on your mind is"+                , " * 20."+                , " */"+                , "const int my_mind = 3;"+                ]+            `shouldSatisfy` isRight1

@@ -5,6 +5,8 @@ import           Test.Hspec          (Spec, describe, it, shouldBe,                                       shouldNotContain) +import           Control.Monad       (unless)+import           Data.List           (isInfixOf) import qualified Data.List.Extra     as List import           Data.Text           (Text) import qualified Data.Text           as Text@@ -40,9 +42,10 @@                 "expected constant or literal"          it "has suggestions for any sequence of tokens in top level" $ do-            property $ \tokens ->-                expected parseText (Text.intercalate " " (map sampleToken tokens)) `shouldNotContain`-                    "expected one of"+            property $ \tokens -> do+                let msg = expected parseText (Text.intercalate " " (map sampleToken tokens))+                unless ("\"ifndefDefine\"" `isInfixOf` msg) $+                    msg `shouldNotContain` "expected one of"          it "has suggestions for any sequence of tokens in expressions" $ do             property $ \tokens ->

@@ -2,11 +2,14 @@ module Language.Cimple.ParserSpec where  import           Data.Fix           (Fix (..))+import           Data.Text          (Text)+import qualified Data.Text          as Text import           Test.Hspec         (Spec, describe, it, shouldBe,                                      shouldSatisfy)  import           Language.Cimple    (AlexPosn (..), Lexeme (..),-                                     LexemeClass (..), NodeF (..), Scope (..))+                                     LexemeClass (..), Node, NodeF (..),+                                     Scope (..)) import           Language.Cimple.IO (parseText)  @@ -15,6 +18,10 @@ isRight1 _           = False  +parseLines :: [Text] -> Either String [Node (Lexeme Text)]+parseLines = parseText . Text.unlines++ spec :: Spec spec = do     describe "C parsing" $ do@@ -32,6 +39,18 @@          it "should parse a struct with bit fields" $ do             let ast = parseText "typedef struct Foo { int x : 123; } Foo;"+            ast `shouldSatisfy` isRight1++        it "should parse a struct with preprocessor conditionals" $ do+            let ast = parseText $ Text.unlines+                    [ "struct Foo {"+                    , "  int x;"+                    , "#ifndef HAVE_FOO_BAR"+                    , "  int foo_bar;"+                    , "#endif /* HAVE_FOO_BAR */"+                    , "  int y;"+                    , "};"+                    ]             ast `shouldSatisfy` isRight1          it "should parse a comment" $ do

@@ -46,6 +46,27 @@  spec :: Spec spec = do+    -- implementation: Pretty.hs (ppComment).+    describe "Regular comment pretty-printing" $ do+        it "should pretty-print a doc comment" $+            pretty (unlines+                [ "/*"+                , " * @brief hello world."+                , " *"+                , " * This is cool stuff."+                , " */"+                , "const int abc = 3;"+                ])+            `shouldBe` unlines+                [ "/*"+                , " * @brief hello world."+                , " *"+                , " * This is cool stuff."+                , " */"+                , ""+                , "const int abc = 3;"+                ]+     describe "showNode" $ do         it "prints code with syntax highlighting" $ do             let pp = showNode $ head $ mustParse "int a(void) { return 3; }"@@ -112,21 +133,23 @@          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"-            compact "/** foo bar */ int a(void);" `shouldBe` "/** foo bar */\n\nint a(void);\n"             compact "/*** foo bar */" `shouldBe` "/*** foo bar */\n"             compact "/**** foo bar */" `shouldBe` "/*** foo bar */\n" +--      it "properly formats doxygen comments" $ do+--          compact "/** foo bar */ int a(void);" `shouldBe` "/** foo bar */\n\nint a(void);\n"+         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);"@@ -149,7 +172,7 @@                 `shouldBe` "void foo(int a, char const* msg, ...);\n"          it "supports C preprocessor directives" $ do-            compact "#define XYZZY 123\n"-                `shouldBe` "#define XYZZY 123\n"-            compact "#include <tox/tox.h>\n"-                `shouldBe` "#include <tox/tox.h>\n"+            compact "#ifndef XYZZY\n#define XYZZY 123\n#endif /* XYZZY */\n"+                `shouldBe` "#ifndef XYZZY\n#define XYZZY 123\n#endif  /* XYZZY */\n"+            compact "#include \"tox.h\"\n"+                `shouldBe` "#include \"tox.h\"\n"

@@ -120,7 +120,7 @@     CmtCommand            -> "@param"     CmtAttr               -> "[out]"     CmtEndDocSection      -> "/** @} */"-    CmtIndent             -> "*"+    CmtSpace              -> " "     CmtStart              -> "/*"     CmtStartCode          -> "/*!"     CmtStartBlock         -> "/***"