cimple 0.0.29 → 0.0.30

raw patch · 15 files changed

+877/−167 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cimple.cabal +4/−1
• src/Language/Cimple/Ast.hs +2/−2
• src/Language/Cimple/Diagnostics.hs +257/−8
• src/Language/Cimple/Lexer.x +45/−58
• src/Language/Cimple/MapAst.hs +2/−2
• src/Language/Cimple/Parser.y +9/−10
• src/Language/Cimple/Parser/Error/Pretty.hs +2/−0
• src/Language/Cimple/Pretty.hs +4/−4
• src/Language/Cimple/TraverseAst.hs +2/−1
• src/Language/Cimple/TreeParser.y +3/−3
• test/Language/Cimple/AstSpec.hs +4/−3
• test/Language/Cimple/DiagnosticsSpec.hs +400/−0
• test/Language/Cimple/ParserSpec.hs +68/−0
• test/Language/Cimple/PrettyCommentSpec.hs +74/−74
• test/Language/Cimple/PrettySpec.hs +1/−1

@@ -1,5 +1,5 @@ name:          cimple-version:       0.0.29+version:       0.0.30 synopsis:      Simple C-like programming language homepage:      https://toktok.github.io/ license:       GPL-3@@ -125,6 +125,7 @@     Language.Cimple.ParserSpec     Language.Cimple.PrettyCommentSpec     Language.Cimple.PrettySpec+    Language.Cimple.DiagnosticsSpec     Language.CimpleSpec    ghc-options:        -Wall -Wno-unused-imports@@ -133,9 +134,11 @@       QuickCheck     , base                 <5     , cimple+    , containers     , data-fix     , extra     , hspec+    , mtl     , prettyprinter     , prettyprinter-ansi-terminal     , text

@@ -106,7 +106,7 @@     | EnumDecl lexeme [a] lexeme     | Enumerator lexeme (Maybe a)     | AggregateDecl a-    | Typedef a lexeme+    | Typedef a lexeme [a]     | TypedefFunction a     | Struct lexeme [a]     | Union lexeme [a]@@ -205,7 +205,7 @@         EnumDecl l as l' -> EnumDecl (f l) (map g as) (f l')         Enumerator l ma -> Enumerator (f l) (fmap g ma)         AggregateDecl a -> AggregateDecl (g a)-        Typedef a l -> Typedef (g a) (f l)+        Typedef a l as -> Typedef (g a) (f l) (map g as)         TypedefFunction a -> TypedefFunction (g a)         Struct l as -> Struct (f l) (map g as)         Union l as -> Union (f l) (map g as)

@@ -1,18 +1,144 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Strict            #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE Strict                 #-} module Language.Cimple.Diagnostics-  ( Diagnostics+  ( DiagnosticLevel (..)+  , DiagnosticSpan (..)+  , Diagnostic (..)+  , IsPosition (..)+  , HasDiagnosticInfo (..)+  , CimplePos (..)+  , DiagnosticsT+  , Diagnostics   , HasDiagnostics (..)+  , HasDiagnosticsRich (..)   , warn+  , warnRich   , sloc+  , lexemePos+  , nodePos+  , nodePosAndLen+  , renderPure+  , diagToText   ) where -import           Control.Monad.State.Strict  (State)-import qualified Control.Monad.State.Strict  as State-import           Data.Text                   (Text)-import           Language.Cimple.DescribeAst (HasLocation (..))+import           Control.Monad.State.Strict    (State)+import qualified Control.Monad.State.Strict    as State+import           Data.Fix                      (foldFix)+import           Data.Function                 (on)+import           Data.List                     (groupBy, sortBy)+import           Data.Map.Strict               (Map)+import qualified Data.Map.Strict               as Map+import           Data.Text                     (Text)+import qualified Data.Text                     as Text+import           Language.Cimple.Ast           (Node)+import           Language.Cimple.DescribeAst   (HasLocation (..))+import qualified Language.Cimple.Flatten       as Flatten+import           Language.Cimple.Lexer         (AlexPosn (..), Lexeme (..),+                                                lexemeText)+import           Prettyprinter                 (Doc, align, annotate, line,+                                                pretty, vsep, (<+>))+import qualified Prettyprinter                 as PP+import           Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold,+                                                color, colorDull)+import qualified Prettyprinter.Render.Text     as PP.Text +import qualified Data.ByteString               as BS+import qualified Data.Text.Encoding            as Text++data DiagnosticLevel = ErrorLevel | WarningLevel | NoteLevel | HelpLevel+    deriving (Show, Eq, Ord)++data DiagnosticSpan pos = DiagnosticSpan+    { spanPos    :: pos+    , spanLen    :: Int+    , spanLabels :: [Doc AnsiStyle]+    }++data Diagnostic pos = Diagnostic+    { diagPos    :: pos+    , diagLen    :: Int+    , diagLevel  :: DiagnosticLevel+    , diagMsg    :: Doc AnsiStyle+    , diagFlag   :: Maybe Text+    , diagSpans  :: [DiagnosticSpan pos]+    , diagFooter :: [(DiagnosticLevel, Doc AnsiStyle)]+    }++diagToText :: IsPosition pos => Diagnostic pos -> Text+diagToText d =+    let p = diagPos d+        msg = PP.Text.renderStrict (PP.layoutSmart PP.defaultLayoutOptions (PP.unAnnotate (diagMsg d)))+        flag = maybe "" (\f -> " [-W" <> f <> "]") (diagFlag d)+        footers = map formatFooter (diagFooter d)+        formatFooter (l, footer) =+            let pref = case l of+                    ErrorLevel   -> "error: "+                    WarningLevel -> "warning: "+                    NoteLevel    -> "note: "+                    HelpLevel    -> "help: "+            in pref <> PP.Text.renderStrict (PP.layoutSmart PP.defaultLayoutOptions (PP.unAnnotate footer))+        loc = Text.pack (posFile p) <> ":" <> Text.pack (show (posLine p)) <> ": "+        level = case diagLevel d of+            ErrorLevel   -> "error: "+            WarningLevel -> "warning: "+            NoteLevel    -> "note: "+            HelpLevel    -> "help: "+    in Text.intercalate "\n" ( (loc <> level <> msg <> flag) : map (loc <>) footers )+++class IsPosition p where+    posFile   :: p -> FilePath+    posLine   :: p -> Int+    posColumn :: p -> Int+    isRealPos :: p -> Bool+    isRealPos _ = True++class IsPosition pos => HasDiagnosticInfo at pos | at -> pos where+    getDiagnosticInfo :: FilePath -> at -> (pos, Int)++data CimplePos = CimplePos+    { cimpleFile   :: FilePath+    , cimpleLine   :: Int+    , cimpleColumn :: Int+    }+    deriving (Show, Eq)++instance IsPosition CimplePos where+    posFile = cimpleFile+    posLine = cimpleLine+    posColumn = cimpleColumn++instance HasDiagnosticInfo (Lexeme Text) CimplePos where+    getDiagnosticInfo file l = (lexemePos file l, Text.length (lexemeText l))++instance HasDiagnosticInfo (Node (Lexeme Text)) CimplePos where+    getDiagnosticInfo = nodePosAndLen++lexemePos :: FilePath -> Lexeme text -> CimplePos+lexemePos file (L (AlexPn _ l c) _ _) = CimplePos file l c++nodePos :: FilePath -> Node (Lexeme text) -> CimplePos+nodePos file n =+    case foldFix Flatten.lexemes n of+        []  -> CimplePos file 0 0+        l:_ -> lexemePos file l++nodePosAndLen :: FilePath -> Node (Lexeme Text) -> (CimplePos, Int)+nodePosAndLen file n =+    case foldFix Flatten.lexemes n of+        []  -> (CimplePos file 0 0, 0)+        ls@(l:_)  ->+            let L (AlexPn start _ _) _ _ = l+                L (AlexPn end _ _) _ s = last' ls+            in (lexemePos file l, end + Text.length s - start)+  where+    last' [x]    = x+    last' (_:xs) = last' xs+    last' []     = error "nodePosAndLen: empty list"+ type DiagnosticsT diags a = State diags a type Diagnostics a = DiagnosticsT [Text] a @@ -21,9 +147,132 @@     => FilePath -> at -> Text -> DiagnosticsT diags () warn file l w = State.modify (addDiagnostic $ sloc file l <> ": " <> w) +warnRich+    :: (HasDiagnosticsRich diags pos)+    => Diagnostic pos -> DiagnosticsT diags ()+warnRich = State.modify . addDiagnosticRich + class HasDiagnostics a where     addDiagnostic :: Text -> a -> a  instance HasDiagnostics [Text] where     addDiagnostic = (:)++class HasDiagnosticsRich a pos | a -> pos where+    addDiagnosticRich :: Diagnostic pos -> a -> a++instance HasDiagnosticsRich [Diagnostic pos] pos where+    addDiagnosticRich = (:)+++renderPure :: IsPosition pos => Map FilePath [Text] -> [Diagnostic pos] -> [Doc AnsiStyle]+renderPure cache = map (formatRichError cache)+  where+    formatRichError cache' (Diagnostic p len level msg flag spans footers) =+        vsep $+        [ let msgLines = map (pretty . Text.stripEnd) $ Text.lines (Text.pack (show (PP.unAnnotate msg)))+          in case msgLines of+            (l:ls) -> header <+> align (vsep ((case flag of+                Just f -> l <+> annotate (colorDull White) ("[-W" <> pretty f <> "]")+                Nothing -> l) : ls))+            []     -> case flag of+                Just f -> header <+> annotate (colorDull White) ("[-W" <> pretty f <> "]")+                Nothing -> header+        ] +++        [ annotate (colorDull White) (pretty (replicate (width - 1) ' ') <> "-->") <+> annotate (bold <> color White) (pretty (posFile p) <> ":" <> pretty (posLine p) <> ":" <> pretty (posColumn p))+        | isRealPos p ] +++        (if null snippet then [] else [annotate (colorDull White) (pretty (replicate width ' ') <> "|")] ++ snippet) +++        map formatFooter footers+      where+                header = case level of+                    ErrorLevel   -> annotate (color Red    <> bold) "error:"+                    WarningLevel -> annotate (color Yellow <> bold) "warning:"+                    NoteLevel    -> annotate (color Cyan   <> bold) "note:"+                    HelpLevel    -> annotate (color Green  <> bold) "help:"++                spansToShow =+                    let primary = DiagnosticSpan p len []+                        samePos s1 s2 = isRealPos s1 && isRealPos s2 && posFile s1 == posFile s2 && posLine s1 == posLine s2 && posColumn s1 == posColumn s2+                    in if isRealPos p && all (\s -> not (samePos (spanPos s) p)) spans+                       then primary : spans+                       else spans++                width =+                    let lineNums = [posLine (spanPos s) | s <- spansToShow, isRealPos (spanPos s)]+                        maxLine = if null lineNums then 0 else maximum lineNums+                    in max 4 (length (show maxLine))++                groupedSpans = groupBy ((==) `on` (posLine . spanPos)) $ sortBy (compare `on` (posLine . spanPos)) spansToShow+                snippet = concatMap renderGrouped groupedSpans++                formatFooter (l, d) =+                    let pref = case l of+                            ErrorLevel   -> annotate (color Red    <> bold) "    = error:"+                            WarningLevel -> annotate (color Yellow <> bold) "    = warning:"+                            NoteLevel    -> annotate (color Cyan   <> bold) "    = note:"+                            HelpLevel    -> annotate (color Green  <> bold) "    = help:"+                    in pref <+> align d++                renderGrouped ss@(DiagnosticSpan sp _ _ : _) =+                    let mFileLines = if isRealPos sp then Map.lookup (posFile sp) cache' else Nothing+                        row = posLine sp+                        rowStr = show row+                        gutterStr = replicate (max 0 (width - length rowStr)) ' ' ++ rowStr ++ "|"+                        gutter = pretty gutterStr+                        lineText = case mFileLines of+                                     Just fileLines | row > 0 && row <= length fileLines ->+                                         [gutter <+> pretty (expandTabs 8 (fileLines !! (row - 1)))]+                                     _ -> []+                        -- Group spans on the same line by position and merge labels+                        uniqueSpans = map mergeLabels . groupBy ((==) `on` posAndLen') . sortBy (compare `on` posAndLen') $ ss+                        posAndLen' (DiagnosticSpan s le _) = (posColumn s, le)+                        mergeLabels [] = error "mergeLabels: empty group"+                        mergeLabels (DiagnosticSpan s le labels : samePosSpans) =+                            let allLabels = labels ++ concatMap spanLabels samePosSpans+                            in DiagnosticSpan s le allLabels++                        sourceLine = case mFileLines of+                            Just fileLines | row > 0 && row <= length fileLines -> fileLines !! (row - 1)+                            _ -> ""+                    in lineText ++ concatMap (renderSp sourceLine) uniqueSpans+                renderGrouped [] = []++                renderSp sourceLine (DiagnosticSpan sp l labels) =+                    let col = posColumn sp+                        -- 'col' is 1-based byte offset.+                        -- We need to find how many characters are before this byte offset.+                        charCol = byteToCharOffset sourceLine (col - 1)+                        -- Extract the prefix up to that character offset.+                        prefix = Text.take charCol sourceLine+                        -- Calculate visual width of that prefix (handling tabs).+                        visualCol = Text.length (expandTabs 8 prefix)++                        -- Calculate visual width of the span.+                        spanText = Text.take (byteToCharOffset (Text.drop charCol sourceLine) l) (Text.drop charCol sourceLine)+                        visualLen = Text.length (expandTabs 8 spanText)++                        padding = replicate visualCol ' '+                        underline = annotate (color Red <> bold) (pretty padding <> pretty (replicate (max 1 visualLen) '^'))+                        labelDocs = map (\lab -> line <> pretty (replicate width ' ') <> "|" <+> pretty padding <> align lab) labels+                        fullLabel = if null labels+                                    then mempty+                                    else line <> pretty (replicate width ' ') <> "|" <+> pretty padding <> "|" <> mconcat labelDocs+                    in [ pretty (replicate width ' ') <> "|" <+> underline <> fullLabel ]++expandTabs :: Int -> Text -> Text+expandTabs tabWidth = Text.pack . go 0 . Text.unpack+  where+    go _ [] = []+    go col (c:cs)+      | c == '\t' =+          let spaces = tabWidth - (col `mod` tabWidth)+          in replicate spaces ' ' ++ go (col + spaces) cs+      | otherwise = c : go (col + 1) cs++byteToCharOffset :: Text -> Int -> Int+byteToCharOffset t byteOffset =+    let bs = Text.encodeUtf8 t+    in if byteOffset >= BS.length bs+       then Text.length t+       else Text.length (Text.decodeUtf8 (BS.take byteOffset bs))

@@ -43,6 +43,28 @@  %wrapper "monadUserState-bytestring" +$digit          = [0-9]+$alpha          = [a-zA-Z]+$upper          = [A-Z]+$lower          = [a-z]++@alphanum       = $alpha | $digit+@alphanum_      = $alpha | $digit | \_++@ident_upper    = $upper ($upper | $digit | \_)*+@ident_lower    = $lower ($lower | $digit | \_)*++@upper_snake    = $upper ($upper | $digit)* \_ ($upper | $digit | \_)*+@lower_snake    = $lower ($lower | $digit)* \_ ($lower | $digit | \_)*+@pascal_case    = $upper @alphanum_* $lower @alphanum_*+@camel_case     = $lower @alphanum_* $upper @alphanum_*++@win_type_prefix = WSA (EVENT | DATA) | LP (STR | TSTR | SOCKADDR)+@win_type_suffix = $upper @alphanum* (INFO | DATA | PARAMS | HEADER | STRUCT | UNION | INTEGER | TIME | STATUS | EVENT)+@win_type_extra  = IP_ADAPTER_INFO | LARGE_INTEGER | ULARGE_INTEGER+@win_type_common = DWORD | WORD | BYTE | BOOL | SOCKET | INT | UINT | LONG | ULONG | SHORT | USHORT | CHAR | UCHAR | FILETIME | HANDLE | LONGLONG+@win_type        = @win_type_prefix | @win_type_suffix | @win_type_extra | @win_type_common | u_long | u_int | u_short | u_char+ tokens :-  -- Ignore attributes.@@ -50,20 +72,14 @@ <0>		"VLA"					{ mkL KwVla }  -- Winapi functions.-<0>		"FormatMessageA"			{ mkL IdVar }-<0>		"GetAdaptersInfo"			{ mkL IdVar }-<0>		"GetSystemTimeAsFileTime"		{ mkL IdVar }-<0>		"GetTickCount"				{ mkL IdVar }-<0>		"LocalFree"				{ mkL IdVar }-<0>		"QueryPerformanceCounter"		{ mkL IdVar }-<0>		"QueryPerformanceFrequency"		{ mkL IdVar }+<0>		"Device" @pascal_case			{ mkL IdVar }+<0>		"FormatMessage" [AW]?			{ mkL IdVar }+<0>		"Get" @pascal_case			{ mkL IdVar }+<0>		("Local"|"Heap") ("Alloc"|"Free")	{ mkL IdVar }+<0>		"Query" @pascal_case			{ mkL IdVar } <0>		"SecureZeroMemory"			{ mkL IdVar }-<0>		"WSAAddressToString"("A"?)		{ mkL IdVar }-<0>		"WSACleanup"				{ mkL IdVar }-<0>		"WSAGetLastError"			{ mkL IdVar }-<0>		"WSASetLastError"			{ mkL IdVar }-<0>		"WSAStartup"				{ mkL IdVar }-<0>		"WSAStringToAddress"("A"?)		{ mkL IdVar }+<0>		"Sleep"					{ mkL IdVar }+<0>		"WSA" @pascal_case			{ mkL IdVar }  -- Winapi struct members. <0>		"GatewayList"				{ mkL IdVar }@@ -75,17 +91,7 @@ <0>		"String"				{ mkL IdVar }  -- Windows typedefs.-<0>		"DWORD"					{ mkL IdStdType }-<0>		"FILETIME"				{ mkL IdStdType }-<0>		"INT"					{ mkL IdStdType }-<0>		"LPSOCKADDR"				{ mkL IdStdType }-<0>		"IP_ADAPTER_INFO"			{ mkL IdStdType }-<0>		"LPSTR"					{ mkL IdStdType }-<0>		"LPTSTR"				{ mkL IdStdType }-<0>		"u_long"				{ mkL IdStdType }-<0>		"LARGE_INTEGER"				{ mkL IdStdType }-<0>		"SOCKET"				{ mkL IdStdType }-<0>		"WSADATA"				{ mkL IdStdType }+<0,ppSC>	@win_type				{ mkL IdStdType }  -- System struct types. <0>		"addrinfo"				{ mkL IdSueType }@@ -99,34 +105,11 @@ <0>		"in_addr"				{ mkL IdSueType } <0>		"in6_addr"				{ mkL IdSueType } <0>		"ipv6_mreq"				{ mkL IdSueType }-<0>		"sockaddr"				{ mkL IdSueType }-<0>		"sockaddr_in"				{ mkL IdSueType }-<0>		"sockaddr_in6"				{ mkL IdSueType }-<0>		"sockaddr_storage"			{ mkL IdSueType }+<0>		"pollfd"				{ mkL IdSueType }+<0>		"sockaddr"("_in"|"_in6"|"_storage")?	{ mkL IdSueType } <0>		"timespec"				{ mkL IdSueType } <0>		"timeval"				{ mkL IdSueType } --- Msgpack struct types.-<0>		"msgpack_iovec"				{ mkL IdSueType }-<0>		"msgpack_object_array"			{ mkL IdSueType }-<0>		"msgpack_object_bin"			{ mkL IdSueType }-<0>		"msgpack_object_ext"			{ mkL IdSueType }-<0>		"msgpack_object_kv"			{ mkL IdSueType }-<0>		"msgpack_object_map"			{ mkL IdSueType }-<0>		"msgpack_object"			{ mkL IdSueType }-<0>		"msgpack_object_str"			{ mkL IdSueType }-<0>		"msgpack_object_type"			{ mkL IdSueType }-<0>		"msgpack_packer"			{ mkL IdSueType }-<0>		"msgpack_packer_write"			{ mkL IdFuncType }-<0>		"msgpack_sbuffer"			{ mkL IdSueType }-<0>		"msgpack_timestamp"			{ mkL IdSueType }-<0>		"msgpack_unpacked"			{ mkL IdSueType }-<0>		"msgpack_unpacker"			{ mkL IdSueType }-<0>		"msgpack_unpack_return"			{ mkL IdSueType }-<0>		"msgpack_vrefbuffer"			{ mkL IdSueType }-<0>		"msgpack_zbuffer"			{ mkL IdSueType }-<0>		"msgpack_zone"				{ mkL IdSueType }- -- Sodium types. <0>		"crypto_generichash_blake2b_state"	{ mkL IdSueType } @@ -207,6 +190,7 @@ <0,ppSC>	"long int"				{ mkL IdStdType } <0,ppSC>	"long signed int"			{ mkL IdStdType } <0,ppSC>	"long"					{ mkL IdStdType }+<0,ppSC>	"long long"				{ mkL IdStdType } <0,ppSC>	"signed int"				{ mkL IdStdType } <0,ppSC>	"unsigned int"				{ mkL IdStdType } <0,ppSC>	"unsigned long"				{ mkL IdStdType }@@ -217,15 +201,18 @@ <0,ppSC>	"true"					{ mkL LitTrue } <0,ppSC>	"__func__"				{ mkL IdVar } <0,ppSC>	"nullptr"				{ mkL IdConst }-<0,ppSC>	"__"[a-zA-Z]+"__"?			{ mkL IdConst }-<0,ppSC>	[A-Z][A-Z0-9_]{1,2}			{ mkL IdSueType }-<0,ppSC>	_*[A-Z][A-Z0-9_]*			{ mkL IdConst }-<0,ppSC>	[A-Z][A-Za-z0-9_]*[a-z][A-Za-z0-9_]*	{ mkL IdSueType }-<0,ppSC>	"cmp_"[a-z][a-z0-9_]*_[suet]		{ mkL IdSueType }-<0,ppSC>	[a-z][a-z0-9_]*_t			{ mkL IdStdType }-<0,ppSC>	[a-z][a-z0-9_]*_cb			{ mkL IdFuncType }-<0,ppSC>	"cmp_"("reader"|"writer"|"skipper")	{ mkL IdFuncType }-<0,ppSC>	[a-z][A-Za-z0-9_]*			{ mkL IdVar }+<0,ppSC>	"nullptr"				{ mkL IdConst }+<0,ppSC>	"__" @alphanum_+ "__"?			{ mkL IdConst }+<0,ppSC>	"_" @ident_upper			{ mkL IdConst }+<0,ppSC>	$upper ($upper | $digit | \_){1,2}	{ mkL IdSueType }+<0,ppSC>	@ident_upper				{ mkL IdConst }+<0,ppSC>	@pascal_case				{ mkL IdSueType }+<0,ppSC>	"cmp_" @ident_lower "_" [suet]		{ mkL IdSueType }+<0,ppSC>	@ident_lower "_t"			{ mkL IdStdType }+<0,ppSC>	@ident_lower "_cb"			{ mkL IdFuncType }+<0,ppSC>	"cmp_" ("reader"|"writer"|"skipper")	{ mkL IdFuncType }+<0,ppSC>	@camel_case				{ mkL IdVar }+<0,ppSC>	@ident_lower				{ mkL IdVar } <0,ppSC,cmtSC>	[0-9]+[LU]*				{ mkL LitInteger } <0,ppSC,cmtSC>	[0-9]+"."[0-9]+[Ff]?			{ mkL LitFloat } <0,ppSC>	0x[0-9a-fA-F]+[LU]*			{ mkL LitInteger }

@@ -297,8 +297,8 @@             Fix <$> (Enumerator <$> recurse name <*> recurse value)         AggregateDecl struct ->             Fix <$> (AggregateDecl <$> recurse struct)-        Typedef ty name ->-            Fix <$> (Typedef <$> recurse ty <*> recurse name)+        Typedef ty name arrs ->+            Fix <$> (Typedef <$> recurse ty <*> recurse name <*> recurse arrs)         TypedefFunction ty ->             Fix <$> (TypedefFunction <$> recurse ty)         Struct name members ->

@@ -26,8 +26,7 @@ import           Language.Cimple.Tokens      (LexemeClass (..)) } --- Conflict between (static) FunctionDecl and (static) ConstDecl.-%expect 2+%expect 0  %name parseTranslationUnit TranslationUnit %name parseExpr Expr@@ -290,8 +289,8 @@ |	IgnoreBody IGN_BODY					{ $2 : $1 }  PreprocIfdef(decls)-:	'#ifdef' ID_CONST decls PreprocElse(decls) Endif	{ Fix $ PreprocIfdef $2 (reverse $3) $4 }-|	'#ifndef' ID_CONST decls PreprocElse(decls) Endif	{ Fix $ PreprocIfndef $2 (reverse $3) $4 }+:	'#ifdef' ID_CONST decls PreprocElif(decls) Endif	{ Fix $ PreprocIfdef $2 (reverse $3) $4 }+|	'#ifndef' ID_CONST decls PreprocElif(decls) Endif	{ Fix $ PreprocIfndef $2 (reverse $3) $4 }  PreprocIf(decls) :	'#if' PreprocConstExpr '\n' decls PreprocElif(decls) Endif	{ Fix $ PreprocIf $2 (reverse $4) $5 }@@ -661,7 +660,7 @@ AggregateDecl :: { NonTerm } AggregateDecl :	AggregateType ';'					{ Fix $ AggregateDecl $1 }-|	typedef AggregateType ID_SUE_TYPE ';'			{ Fix $ Typedef $2 $3 }+|	typedef AggregateType ID_SUE_TYPE ';'			{ Fix $ Typedef $2 $3 [] }  AggregateType :: { NonTerm } AggregateType@@ -686,9 +685,9 @@  TypedefDecl :: { NonTerm } TypedefDecl-:	typedef QualType(GlobalLeafType) ID_SUE_TYPE ';'	{ Fix $ Typedef $2 $3 }+:	typedef QualType(GlobalLeafType) ID_SUE_TYPE DeclSpecArrays ';'	{ Fix $ Typedef $2 $3 $4 } |	typedef FunctionPrototype(ID_FUNC_TYPE) ';'		{ Fix $ TypedefFunction $2 }-|	struct ID_SUE_TYPE ';'					{ Fix $ Typedef (Fix (TyStruct $2)) $2 }+|	struct ID_SUE_TYPE ';'					{ Fix $ Typedef (Fix (TyStruct $2)) $2 [] }  QualType(leafType) :	bitwise ID_STD_TYPE					{ Fix (TyBitwise (Fix (TyStd $2))) }@@ -784,9 +783,9 @@  ConstDecl :: { NonTerm } ConstDecl-:	extern const GlobalLeafType ID_VAR ';'			{ Fix $ ConstDecl $3 $4 }-|	const GlobalLeafType ID_VAR '=' InitialiserExpr ';'	{ Fix $ ConstDefn Global $2 $3 $5 }-|	static const GlobalLeafType ID_VAR '=' InitialiserExpr ';'	{ Fix $ ConstDefn Static $3 $4 $6 }+:	extern QualType(GlobalLeafType) ID_VAR ';'			{ Fix $ ConstDecl $2 $3 }+|	QualType(GlobalLeafType) ID_VAR '=' InitialiserExpr ';'	{ Fix $ ConstDefn Global $1 $2 $4 }+|	static QualType(GlobalLeafType) ID_VAR '=' InitialiserExpr ';'	{ Fix $ ConstDefn Static $2 $3 $5 }  { type Term = Lexeme Text

@@ -167,6 +167,7 @@     | ["ID_CONST", "sizeof", "LIT_CHAR", "LIT_FALSE", "LIT_INTEGER"] `isPrefixOf` options = "constant expression"     | ["ID_CONST", "ID_SUE_TYPE", "'/*'" ] `isPrefixOf` options = "enumerator, type name, or comment"     | wants ["'defined'"] = "preprocessor constant expression"+    | wants ["ID_CONST", "sizeof", "LIT_CHAR", "LIT_FLOAT", "LIT_FALSE", "LIT_TRUE", "LIT_INTEGER", "LIT_STRING", "'('", "'\\n'"] = "macro body"     | wants ["'&'", "'&&'", "'*'", "'=='", "';'"] = "operator or end of statement"     | wants ["'&'", "'&&'", "'*'", "'^'", "'!='"] = "operator"     | wants ["ID_CONST", "ID_VAR", "LIT_CHAR", "'*'", "'('"] = "expression"@@ -175,6 +176,7 @@     | ["'&='", "'->'", "'*='"] `isPrefixOf` options = "assignment or member/array access"     | wants ["'='", "'*='", "'/='", "'+='", "'-='"] = "assignment operator"     | wants ["CMT_WORD"] = "comment contents"+    | wants ["','", "'}'", "'/*'"] = "',' or closing brace (or a comment)"      | length options == 2 = commaOr options     | otherwise           = "one of " <> commaOr options

@@ -351,15 +351,15 @@             kwUnion <+> ppLexeme name <+> lbrace <> line <>             vcat members         ) <> line <> rbrace-    Typedef ty tyname ->-        kwTypedef <+> ty <+> dullgreen (ppLexeme tyname) <> semi+    Typedef ty tyname arrs ->+        kwTypedef <+> ty <+> dullgreen (ppLexeme tyname) <> hcat arrs <> semi     TypedefFunction proto ->         kwTypedef <+> proto <> semi      ConstDecl ty name ->-        kwExtern <+> kwConst <+> ty <+> ppLexeme name <> semi+        kwExtern <+> ty <+> ppLexeme name <> semi     ConstDefn scope ty name value ->-        ppScope scope <> kwConst <+>+        ppScope scope <>         ty <+> ppLexeme name <+> equals <+> value <> semi      Enumerator name  Nothing -> ppLexeme name <> comma

@@ -377,9 +377,10 @@         AggregateDecl struct -> do             _ <- recurse struct             pure ()-        Typedef ty name -> do+        Typedef ty name arrs -> do             _ <- recurse ty             _ <- recurse name+            _ <- recurse arrs             pure ()         TypedefFunction ty ->             recurse ty

@@ -105,7 +105,7 @@     enumerator		{ Fix (Enumerator{}) }     aggregateDecl	{ Fix (AggregateDecl{}) }     typedefFunction	{ Fix (TypedefFunction{}) }-    typedefStruct	{ Fix (Typedef (Fix Struct{}) _) }+    typedefStruct	{ Fix (Typedef (Fix Struct{}) _ _) }     typedef		{ Fix (Typedef{}) }     struct		{ Fix (Struct{}) }     union		{ Fix (Union{}) }@@ -253,9 +253,9 @@ processAggregate (Fix (AggregateDecl agg)) = do     processedAgg <- processAggregate agg     return $ Fix (AggregateDecl processedAgg)-processAggregate (Fix (Typedef agg name)) = do+processAggregate (Fix (Typedef agg name arrs)) = do     processedAgg <- processAggregate agg-    return $ Fix (Typedef processedAgg name)+    return $ Fix (Typedef processedAgg name arrs) processAggregate n = return n -- Return other types unchanged  recurse :: ([NonTerm] -> ParseResult [NonTerm]) -> NonTerm -> ParseResult NonTerm

@@ -29,7 +29,8 @@                 Fix (Compose (Annot () (                     ConstDefn Global                         (Fix (Compose (Annot () (-                            TyStd (L (AlexPn 6 1 7) IdStdType "int")))))+                            TyConst (Fix (Compose (Annot () (+                                TyStd (L (AlexPn 6 1 7) IdStdType "int")))))))))                         (L (AlexPn 10 1 11) IdVar "a")                         (Fix (Compose (Annot () (                             LiteralExpr Int (L (AlexPn 14 1 15) LitInteger "3"))))))))@@ -38,7 +39,7 @@              addAnnot ast `shouldSatisfy` \case                 (removeAnnot -> Fix (ConstDefn Global-                    (Fix (TyStd (L (AlexPn 6 1 7) IdStdType "int")))+                    (Fix (TyConst (Fix (TyStd (L (AlexPn 6 1 7) IdStdType "int")))))                     (L (AlexPn 10 1 11) IdVar "a")                     (Fix (LiteralExpr Int (L (AlexPn 14 1 15) LitInteger "3"))))) -> True                 _ -> False@@ -126,7 +127,7 @@             test (EnumDecl "l" ["as"] "l'") (EnumDecl "l-l" ["a-as"] "l-l'")             test (Enumerator "l" (Just "ma")) (Enumerator "l-l" (Just "a-ma"))             test (AggregateDecl "a") (AggregateDecl "a-a")-            test (Typedef "a" "l") (Typedef "a-a" "l-l")+            test (Typedef "a" "l" ["as"]) (Typedef "a-a" "l-l" ["a-as"])             test (TypedefFunction "a") (TypedefFunction "a-a")             test (Struct "l" ["as"]) (Struct "l-l" ["a-as"])             test (Union "l" ["as"]) (Union "l-l" ["a-as"])

@@ -0,0 +1,400 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+module Language.Cimple.DiagnosticsSpec where++import qualified Control.Monad.State.Strict  as State+import           Data.Fix                    (Fix (..))+import           Data.Map.Strict             (Map)+import qualified Data.Map.Strict             as Map+import           Data.Text                   (Text)+import qualified Data.Text                   as Text+import           GHC.Stack                   (HasCallStack)+import           Language.Cimple             (AlexPosn (..), BinaryOp (..),+                                              Lexeme (..), LexemeClass (..),+                                              NodeF (..))+import           Language.Cimple.Diagnostics+import           Prettyprinter               (Doc, LayoutOptions (..),+                                              PageWidth (..),+                                              defaultLayoutOptions,+                                              layoutPretty, vsep)+import           Prettyprinter.Render.Text   (renderStrict)+import           Test.Hspec++spec :: Spec+spec = do+    describe "nodePosAndLen" $ do+        it "calculates position and length of a simple node" $ do+            let lexeme = L (AlexPn 10 2 5) IdVar "var"+            let node = Fix (VarExpr lexeme)+            let (pos, len) = nodePosAndLen "test.c" node+            pos `shouldBe` CimplePos "test.c" 2 5+            len `shouldBe` 3++        it "calculates position and length of a complex node" $ do+            let l1 = L (AlexPn 10 2 5) IdVar "x"+            -- l2 (operator) is skipped in flattening if not in the node structure as a child+            let l3 = L (AlexPn 30 2 25) IdVar "y"+            -- FunctionCall contains the function name and args, so it covers l1 to l3+            let node = Fix (FunctionCall (Fix (VarExpr l1)) [Fix (VarExpr l3)])+            let (pos, len) = nodePosAndLen "test.c" node+            pos `shouldBe` CimplePos "test.c" 2 5+            -- Length is from start of l1 (10) to end of l3 (30 + 1). 31 - 10 = 21.+            len `shouldBe` 21++    describe "Diagnostics State" $ do+        it "warn collects diagnostics" $ do+            let lexeme = L (AlexPn 0 1 1) IdVar ("foo" :: Text)+            let action = warn "test.c" lexeme "warning message"+            let diags = State.execState action [] :: [Text]+            diags `shouldBe` ["test.c:1: warning message"]++        it "warnRich collects rich diagnostics" $ do+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 5+                    , diagLevel = WarningLevel+                    , diagMsg = "warning message"+                    , diagFlag = Just "some-flag"+                    , diagSpans = []+                    , diagFooter = []+                    }+            let action = warnRich diag+            let diags = State.execState action []+            case diags of+                [d] -> do+                    diagLevel d `shouldBe` WarningLevel+                    diagFlag d `shouldBe` Just "some-flag"+                _ -> expectationFailure "Expected exactly one diagnostic"++    describe "renderPure" $ do+        it "renders different levels" $ do+            let mkDiag lvl msg = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 1+                    , diagLevel = lvl+                    , diagMsg = msg+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo mempty [mkDiag WarningLevel "warn"]+                [ "warning: warn"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]+            shouldRenderTo mempty [mkDiag NoteLevel "note"]+                [ "note: note"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]+            shouldRenderTo mempty [mkDiag HelpLevel "help"]+                [ "help: help"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]++        it "renders flags" $ do+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 1+                    , diagLevel = WarningLevel+                    , diagMsg = "some warning"+                    , diagFlag = Just "my-check"+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo mempty [diag]+                [ "warning: some warning [-Wmy-check]"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]++        it "renders multiline messages" $ do+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 1+                    , diagLevel = ErrorLevel+                    , diagMsg = "line 1\nline 2"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo mempty [diag]+                [ "error: line 1"+                , "       line 2"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]++        it "renders line numbers > 1000 correctly" $ do+            let dummyLines = replicate 999 "..." ++ ["target line"]+            let cache = Map.fromList [("test.c", dummyLines)]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1000 1+                    , diagLen = 6+                    , diagLevel = ErrorLevel+                    , diagMsg = "msg"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: msg"+                , "   --> test.c:1000:1"+                , "    |"+                , "1000| target line"+                , "    | ^^^^^^"+                ]++        it "renders line numbers > 10000 correctly" $ do+            let dummyLines = replicate 9999 "..." ++ ["target line"]+            let cache = Map.fromList [("test.c", dummyLines)]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 10000 1+                    , diagLen = 6+                    , diagLevel = ErrorLevel+                    , diagMsg = "msg"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: msg"+                , "    --> test.c:10000:1"+                , "     |"+                , "10000| target line"+                , "     | ^^^^^^"+                ]++        it "renders a simple error without source context" $ do+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 5+                    , diagLevel = ErrorLevel+                    , diagMsg = "something went wrong"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo mempty [diag]+                [ "error: something went wrong"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                ]++        it "renders an error with source context" $ do+            let source = "int x = ;"+            let cache = Map.fromList [("test.c", [source])]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 9+                    , diagLen = 1+                    , diagLevel = ErrorLevel+                    , diagMsg = "expected expression"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: expected expression"+                , "   --> test.c:1:9"+                , "    |"+                , "   1| int x = ;"+                , "    |         ^"+                ]++        it "renders an error with multiple spans" $ do+            let source = "int x = y + z;"+            let cache = Map.fromList [("test.c", [source])]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 9+                    , diagLen = 1+                    , diagLevel = ErrorLevel+                    , diagMsg = "type mismatch"+                    , diagFlag = Nothing+                    , diagSpans =+                        [ DiagnosticSpan (CimplePos "test.c" 1 9) 1 ["this is int"]+                        , DiagnosticSpan (CimplePos "test.c" 1 13) 1 ["this is float"]+                        ]+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: type mismatch"+                , "   --> test.c:1:9"+                , "    |"+                , "   1| int x = y + z;"+                , "    |         ^"+                , "    |         |"+                , "    |         this is int"+                , "    |             ^"+                , "    |             |"+                , "    |             this is float"+                ]++        it "renders footers" $ do+             let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 1+                    , diagLen = 1+                    , diagLevel = ErrorLevel+                    , diagMsg = "bad thing"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = [(NoteLevel, "did you mean something else?")]+                    }+             shouldRenderTo mempty [diag]+                [ "error: bad thing"+                , "   --> test.c:1:1"+                , "    |"+                , "    | ^"+                , "    = note: did you mean something else?"+                ]++        it "renders multiple spans on different lines" $ do+            let source = ["int x = 1;", "int y = 2;", "x + y;"]+            let cache = Map.fromList [("test.c", source)]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 3 1+                    , diagLen = 5+                    , diagLevel = ErrorLevel+                    , diagMsg = "error here"+                    , diagFlag = Nothing+                    , diagSpans =+                        [ DiagnosticSpan (CimplePos "test.c" 1 5) 1 ["decl 1"]+                        , DiagnosticSpan (CimplePos "test.c" 2 5) 1 ["decl 2"]+                        , DiagnosticSpan (CimplePos "test.c" 3 1) 5 ["usage"]+                        ]+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: error here"+                , "   --> test.c:3:1"+                , "    |"+                , "   1| int x = 1;"+                , "    |     ^"+                , "    |     |"+                , "    |     decl 1"+                , "   2| int y = 2;"+                , "    |     ^"+                , "    |     |"+                , "    |     decl 2"+                , "   3| x + y;"+                , "    | ^^^^^"+                , "    | |"+                , "    | usage"+                ]++        it "includes implicit primary span if not present in spans" $ do+            let source = "int x;"+            let cache = Map.fromList [("test.c", [source])]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 5+                    , diagLen = 1+                    , diagLevel = ErrorLevel+                    , diagMsg = "error"+                    , diagFlag = Nothing+                    , diagSpans =+                        [ DiagnosticSpan (CimplePos "test.c" 1 1) 3 ["type"]+                        ]+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: error"+                , "   --> test.c:1:5"+                , "    |"+                , "   1| int x;"+                , "    | ^^^"+                , "    | |"+                , "    | type"+                , "    |     ^"+                ]++    describe "diagToText" $ do+        it "converts diagnostic to simple text format" $ do+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 10 5+                    , diagLen = 3+                    , diagLevel = WarningLevel+                    , diagMsg = "something fishy"+                    , diagFlag = Just "checks"+                    , diagSpans = []+                    , diagFooter = [(NoteLevel, "check it out")]+                    }+            let text = diagToText diag+            text `shouldBe` "test.c:10: warning: something fishy [-Wchecks]\ntest.c:10: note: check it out"++    describe "tab expansion" $ do+        it "expands tabs in source line for alignment" $ do+            -- Source: "abc\tvar"+            -- 'a' at 1, 'b' at 2, 'c' at 3.+            -- '\t' at 4. Moves cursor to next multiple of 8 + 1 => 9.+            -- "var" starts at byte 5.+            -- Visual position of "var" is 9.+            let source = "abc\tvar"+            let cache = Map.fromList [("test.c", [source])]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 5+                    , diagLen = 3+                    , diagLevel = ErrorLevel+                    , diagMsg = "found var"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            -- Expectation:+            -- Source line should have tab expanded to 5 spaces (3 chars + 5 spaces = 8).+            -- "abc     var"+            --  123456789+            --          ^+            shouldRenderTo cache [diag]+                [ "error: found var"+                , "   --> test.c:1:5"+                , "    |"+                , "   1| abc     var"+                , "    |         ^^^"+                ]++        it "handles multi-byte characters correctly" $ do+            -- Source: "/* é */ int x;"+            -- 'é' is 2 bytes (C3 A9).+            -- "/* " is 3 bytes.+            -- "é" is 2 bytes.+            -- " */ " is 4 bytes.+            -- Total bytes before 'int': 3 + 2 + 4 = 9 bytes.+            -- 'int' starts at byte 10.+            -- Visual: "/* é */ int x;"+            -- "/* " (3 cols)+            -- "é" (1 col)+            -- " */ " (4 cols)+            -- Total visual cols: 3 + 1 + 4 = 8 cols.+            -- 'int' starts at visual col 9.+            let source = "/* é */ int x;"+            let cache = Map.fromList [("test.c", [source])]+            let diag = Diagnostic+                    { diagPos = CimplePos "test.c" 1 10+                    , diagLen = 3+                    , diagLevel = ErrorLevel+                    , diagMsg = "found int"+                    , diagFlag = Nothing+                    , diagSpans = []+                    , diagFooter = []+                    }+            shouldRenderTo cache [diag]+                [ "error: found int"+                , "   --> test.c:1:10"+                , "    |"+                , "   1| /* é */ int x;"+                , "    |         ^^^"+                ]++shouldRenderTo :: HasCallStack => Map FilePath [Text] -> [Diagnostic CimplePos] -> [Text] -> Expectation+shouldRenderTo cache diags expected =+    let docs = renderPure cache diags+        opts = defaultLayoutOptions { layoutPageWidth = Unbounded }+        rendered = renderStrict $ layoutPretty opts (vsep docs)+        actualLines = map Text.stripEnd $ Text.lines rendered+    in actualLines `shouldBe` expected

@@ -34,6 +34,10 @@             let ast = parseText "int a(void) { return 3; }"             ast `shouldSatisfy` isRight1 +        it "should parse a const function declaration" $ do+            let ast = parseText "const int f(void);"+            ast `shouldSatisfy` isRight1+         it "should parse dereferencing a function pointer" $ do             let ast = parseText "void f() { struct My_Struct s_var = *get_s(1); }"             ast `shouldSatisfy` isRight1@@ -66,6 +70,70 @@                     , "  int y;"                     , "};"                     ]+            ast `shouldSatisfy` isRight1++        it "should parse a typedef with an array" $ do+            let ast = parseText "typedef uint8_t Public_Key[32];"+            ast `shouldSatisfy` isRight1++        it "should parse #ifdef/#elif" $ do+            let ast = parseText $ Text.unlines+                    [ "struct Foo {"+                    , "  int x;"+                    , "#ifdef HAVE_FOO_BAR"+                    , "  int foo_bar;"+                    , "#elif defined(HAVE_BAR_FOO)"+                    , "  int bar_foo;"+                    , "#endif /* HAVE_FOO_BAR */"+                    , "  int y;"+                    , "};"+                    ]+            ast `shouldSatisfy` isRight1++        it "should parse #ifndef/#elif" $ do+            let ast = parseText $ Text.unlines+                    [ "struct Foo {"+                    , "  int x;"+                    , "#ifndef HAVE_FOO_BAR"+                    , "  int foo_bar;"+                    , "#elif defined(HAVE_BAR_FOO)"+                    , "  int bar_foo;"+                    , "#endif /* HAVE_FOO_BAR */"+                    , "  int y;"+                    , "};"+                    ]+            ast `shouldSatisfy` isRight1++        it "should parse LOGGER_INFO as a constant" $ do+            let ast = parseText "void f() { int x = LOGGER_INFO; }"+            ast `shouldSatisfy` isRight1++        it "should parse IP_ADAPTER_INFO as a type" $ do+            let ast = parseText "void f() { IP_ADAPTER_INFO *x; }"+            ast `shouldSatisfy` isRight1++        it "should parse LARGE_INTEGER as a type" $ do+            let ast = parseText "void f() { LARGE_INTEGER x; }"+            ast `shouldSatisfy` isRight1++        it "should parse POLLIN as a constant" $ do+            let ast = parseText "void f() { int x = POLLIN; }"+            ast `shouldSatisfy` isRight1++        it "should parse WSAEWOULDBLOCK as a constant" $ do+            let ast = parseText "void f() { int x = WSAEWOULDBLOCK; }"+            ast `shouldSatisfy` isRight1++        it "should parse WSADATA as a type" $ do+            let ast = parseText "void f() { WSADATA wsaData; }"+            ast `shouldSatisfy` isRight1++        it "should parse DHT as a type" $ do+            let ast = parseText "void f() { DHT *dht; }"+            ast `shouldSatisfy` isRight1++        it "should parse _WIN32 as a constant" $ do+            let ast = parseText "void f() { int x = _WIN32; }"             ast `shouldSatisfy` isRight1          it "should parse a comment" $ do

@@ -45,13 +45,13 @@                 [ "/**"                 , " * @brief hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @brief hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a doc comment with a paragraph" $@@ -61,7 +61,7 @@                 , " *"                 , " * There's more to say about today."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -69,7 +69,7 @@                 , " *"                 , " * There's more to say about today."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a @param" $@@ -77,13 +77,13 @@                 [ "/**"                 , " * @param p1 hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @param p1 hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a @param with [in] attribute" $@@ -91,13 +91,13 @@                 [ "/**"                 , " * @param[in] p1 hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @param[in] p1 hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a @return" $@@ -105,13 +105,13 @@                 [ "/**"                 , " * @return hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @return hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a @retval" $@@ -120,14 +120,14 @@                 , " * @retval 0 Success."                 , " * @retval 1 Failure."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @retval 0 Success."                 , " * @retval 1 Failure."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a bullet list" $@@ -136,14 +136,14 @@                 , " * - item 1"                 , " * - item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * - item 1"                 , " * - item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a nested bullet list" $@@ -153,7 +153,7 @@                 , " *   - nested item 1"                 , " * - item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -161,7 +161,7 @@                 , " *   - nested item 1"                 , " * - item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a numbered list" $@@ -170,14 +170,14 @@                 , " * 1. item 1"                 , " * 2. item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * 1. item 1"                 , " * 2. item 2"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a code block" $@@ -188,7 +188,7 @@                 , " *     y = 3;"                 , " * @endcode"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -197,7 +197,7 @@                 , " *     y = 3;"                 , " * @endcode"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @deprecated" $@@ -205,13 +205,13 @@                 [ "/**"                 , " * @deprecated Use new_function instead."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @deprecated Use new_function instead."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @see" $@@ -219,13 +219,13 @@                 [ "/**"                 , " * @see other_function for more details."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @see other_function for more details."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @attention" $@@ -233,13 +233,13 @@                 [ "/**"                 , " * @attention This is important."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @attention This is important."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @note" $@@ -247,13 +247,13 @@                 [ "/**"                 , " * @note This is a note."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @note This is a note."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @private" $@@ -261,13 +261,13 @@                 [ "/**"                 , " * @private"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @private"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @extends" $@@ -275,13 +275,13 @@                 [ "/**"                 , " * @extends BaseClass"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @extends BaseClass"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @implements" $@@ -289,13 +289,13 @@                 [ "/**"                 , " * @implements Interface"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @implements Interface"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @security_rank" $@@ -303,13 +303,13 @@                 [ "/**"                 , " * @security_rank(sink, data, 1)"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @security_rank(sink, data, 1)"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print a complex comment" $@@ -324,7 +324,7 @@                 , " * @param p1 Description for p1."                 , " * @return Description for return."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -337,7 +337,7 @@                 , " * @param p1 Description for p1."                 , " * @return Description for return."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with operators" $@@ -345,13 +345,13 @@                 [ "/**"                 , " * check if x == 5"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * check if x == 5"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @ref" $@@ -359,13 +359,13 @@                 [ "/**"                 , " * see @ref my_ref"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * see @ref my_ref"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @p" $@@ -373,13 +373,13 @@                 [ "/**"                 , " * @p my_p"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @p my_p"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @file" $@@ -387,13 +387,13 @@                 [ "/**"                 , " * @file"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @file"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @section" $@@ -401,13 +401,13 @@                 [ "/**"                 , " * @section sec_id sec_title"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @section sec_id sec_title"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print @subsection" $@@ -415,13 +415,13 @@                 [ "/**"                 , " * @subsection subsec_id subsec_title"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * @subsection subsec_id subsec_title"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with colon" $@@ -429,13 +429,13 @@                 [ "/**"                 , " * Note:"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * Note:"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with parens" $@@ -443,13 +443,13 @@                 [ "/**"                 , " * (Note)"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * (Note)"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with parens including long sentences going to the next line" $@@ -458,14 +458,14 @@                 , " * This is a comment (and there is more"                 , " * to say about this)."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * This is a comment (and there is more"                 , " * to say about this)."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with operators" $@@ -473,13 +473,13 @@                 [ "/**"                 , " * a + b = c"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * a + b = c"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print words with assignment" $@@ -487,13 +487,13 @@                 [ "/**"                 , " * x = 5"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * x = 5"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should pretty-print sentences with various punctuation" $@@ -503,7 +503,7 @@                 , " * This is exciting!"                 , " * This is a clause;"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -511,7 +511,7 @@                 , " * This is exciting!"                 , " * This is a clause;"                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should allow numbers in the text" $@@ -519,13 +519,13 @@                 [ "/**"                 , " * I have 3 things on my mind."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * I have 3 things on my mind."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]          it "should allow numbers at the start of the text" $@@ -534,14 +534,14 @@                 , " * I have 3 things on my mind. You have"                 , " * 20 things on your mind. We are not the same."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * I have 3 things on my mind. You have"                 , " * 20 things on your mind. We are not the same."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ]          it "should allow numbers at the end of the sentence at the start of a line" $@@ -550,14 +550,14 @@                 , " * I have 3 things on my mind. The number of things on your mind is"                 , " * 20."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ])             `shouldBe` unlines                 [ "/**"                 , " * I have 3 things on my mind. The number of things on your mind is"                 , " * 20."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ]          it "should treat numbers like words and be able to continue normally" $@@ -567,7 +567,7 @@                 , " * 1, maybe more or less, and we can talk a lot about"                 , " * 2022. This is the next sentence."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -575,7 +575,7 @@                 , " * 1, maybe more or less, and we can talk a lot about"                 , " * 2022. This is the next sentence."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ]          it "should print numbered lists as is" $@@ -588,7 +588,7 @@                 , " *"                 , " * Here is some more text not part of the list items."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ])             `shouldBe` unlines                 [ "/**"@@ -599,7 +599,7 @@                 , " *"                 , " * Here is some more text not part of the list items."                 , " */"-                , "const int my_mind = 3;"+                , "int const my_mind = 3;"                 ]          it "should pretty-print a doc comment with content on the first line" $@@ -607,11 +607,11 @@                 [ "/** @file test.c"                 , " * @brief hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ])             `shouldBe` unlines                 [ "/** @file test.c"                 , " * @brief hello world."                 , " */"-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]

@@ -64,7 +64,7 @@                 , " * This is cool stuff."                 , " */"                 , ""-                , "const int abc = 3;"+                , "int const abc = 3;"                 ]      describe "showNode" $ do