cimple 0.0.2 → 0.0.3

raw patch · 11 files changed

+386/−68 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cimple.cabal +2/−1
• src/Language/Cimple/AST.hs +1/−0
• src/Language/Cimple/Diagnostics.hs +31/−8
• src/Language/Cimple/IO.hs +16/−6
• src/Language/Cimple/Lexer.x +1/−0
• src/Language/Cimple/Parser.y +33/−36
• src/Language/Cimple/Pretty.hs +1/−0
• src/Language/Cimple/SemCheck/Includes.hs +1/−1
• src/Language/Cimple/TraverseAst.hs +34/−15
• src/Language/Cimple/TreeParser.y +265/−0
• test/Language/CimpleSpec.hs +1/−1

@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.2+version:              0.0.3 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3@@ -40,6 +40,7 @@     , Language.Cimple.SemCheck.Includes     , Language.Cimple.Tokens     , Language.Cimple.TranslationUnit+    , Language.Cimple.TreeParser   build-depends:       base < 5     , aeson

@@ -72,6 +72,7 @@     | AssignExpr (Node lexeme) AssignOp (Node lexeme)     | ParenExpr (Node lexeme)     | CastExpr (Node lexeme) (Node lexeme)+    | CompoundExpr (Node lexeme) (Node lexeme)     | SizeofExpr (Node lexeme)     | SizeofType (Node lexeme)     | LiteralExpr LiteralType lexeme

@@ -1,21 +1,44 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData        #-} module Language.Cimple.Diagnostics   ( Diagnostics+  , HasDiagnostics (..)   , warn+  , sloc+  , at   ) where  import           Control.Monad.State.Lazy (State) import qualified Control.Monad.State.Lazy as State import           Data.Text                (Text) import qualified Data.Text                as Text-import           Language.Cimple.Lexer    (Lexeme (..), lexemeLine)+import           Language.Cimple.AST      (Node)+import           Language.Cimple.Lexer    (AlexPosn (..), Lexeme (..),+                                           lexemeLine)+import           Language.Cimple.Tokens   (LexemeClass (..)) -type Diagnostics a = State [Text] a+type DiagnosticsT diags a = State diags a+type Diagnostics a = DiagnosticsT [Text] a -warn :: FilePath -> Lexeme Text -> Text -> Diagnostics ()-warn file l w = do-    diags <- State.get-    State.put $ diag : diags-  where-    diag = Text.pack file <> ":" <> Text.pack (show (lexemeLine l)) <> ": " <> w++class HasDiagnostics a where+    addDiagnostic :: Text -> a -> a++instance HasDiagnostics [Text] where+    addDiagnostic = (:)+++warn :: HasDiagnostics diags => FilePath -> Lexeme Text -> Text -> DiagnosticsT diags ()+warn file l w = State.modify (addDiagnostic $ sloc file l <> ": " <> w)+++sloc :: FilePath -> Lexeme a -> Text+sloc file l = Text.pack file <> ":" <> Text.pack (show (lexemeLine l))+++at :: Node (Lexeme Text) -> Lexeme Text+at n =+    case foldMap (:[]) n of+        []  -> L (AlexPn 0 0 0) Error "unknown source location"+        l:_ -> l

@@ -6,6 +6,7 @@     , parseText     ) where +import           Control.Monad                   ((>=>)) import           Control.Monad.State.Lazy        (State, evalState, get, put) import qualified Data.ByteString                 as BS import           Data.Map.Strict                 (Map)@@ -15,10 +16,11 @@ import qualified Data.Text.Encoding              as Text import           Language.Cimple.AST             (Node (..)) import           Language.Cimple.Lexer           (Lexeme, runAlex)-import           Language.Cimple.Parser          (parseCimple)+import qualified Language.Cimple.Parser          as Parser import           Language.Cimple.Program         (Program) import qualified Language.Cimple.Program         as Program import           Language.Cimple.TranslationUnit (TranslationUnit)+import qualified Language.Cimple.TreeParser      as TreeParser  type CacheState a = State (Map String Text) a @@ -44,23 +46,31 @@     process <$> res   where     res :: Either String [Node (Lexeme String)]-    res = runAlex (Text.unpack contents) parseCimple+    res =+        runAlex (Text.unpack contents) Parser.parseTranslationUnit +parseTextStrict :: Text -> Either String [Node (Lexeme Text)]+parseTextStrict = parseText >=> TreeParser.toEither . TreeParser.parseTranslationUnit + parseFile :: FilePath -> IO (Either String (TranslationUnit Text)) parseFile source =-    addSource . parseText . Text.decodeUtf8 <$> BS.readFile source+    addSource . parseTextStrict . Text.decodeUtf8 <$> BS.readFile source   where     -- Add source filename to the error message, if any.-    addSource (Left err) = Left $ "In file \"" <> source <> "\": " <> err+    addSource (Left err) = Left $ source <> ":" <> err     -- If there's no error message, record the source filename in the returned     -- TranslationUnit.     addSource (Right ok) = Right (source, ok)  +parseFiles' :: [FilePath] -> IO (Either String [TranslationUnit Text])+parseFiles' sources = sequenceA <$> traverse parseFile sources++ parseFiles :: [FilePath] -> IO (Either String [TranslationUnit Text])-parseFiles sources = sequenceA <$> traverse parseFile sources+parseFiles sources = fmap Program.toList . (>>= Program.fromList) <$> parseFiles' sources   parseProgram :: [FilePath] -> IO (Either String (Program Text))-parseProgram sources = (>>= Program.fromList) <$> parseFiles sources+parseProgram sources = (>>= Program.fromList) <$> parseFiles' sources

@@ -233,6 +233,7 @@ <cmtSC>		"http://"[^ ]+				{ mkL CmtWord } <cmtSC>		[0-9]+"%"				{ mkL LitInteger } <cmtSC>		"`"([^`]|"\`")+"`"			{ mkL CmtCode }+<cmtSC>		"${"([^\}])+"}"				{ mkL CmtCode } <cmtSC>		"–"					{ mkL CmtWord } <cmtSC>		"*/"					{ mkL CmtEnd `andBegin` 0 } <cmtSC>		\n					{ mkL PpNewline `andBegin` cmtNewlineSC }

@@ -4,15 +4,16 @@ import           Language.Cimple.AST    (AssignOp (..), BinaryOp (..),                                          CommentStyle (..), LiteralType (..),                                          Node (..), Scope (..), UnaryOp (..))-import           Language.Cimple.Lexer  (Alex, AlexPosn, Lexeme (..), alexError,-                                         alexMonadScan)+import           Language.Cimple.Lexer  (Alex, AlexPosn (..), Lexeme (..),+                                         alexError, alexMonadScan) import           Language.Cimple.Tokens (LexemeClass (..)) }  -- Conflict between (static) FunctionDecl and (static) ConstDecl. %expect 2 -%name parseCimple+%name parseTranslationUnit TranslationUnit+ %error {parseError} %errorhandlertype explist %lexer {lexwrap} {L _ Eof _}@@ -182,30 +183,22 @@  ToplevelDecl :: { StringNode } ToplevelDecl-:	PreprocIfdef(ToplevelDecls)				{ $1 }-|	PreprocIf(ToplevelDecls)				{ $1 }-|	PreprocInclude						{ $1 }-|	PreprocUndef						{ $1 }-|	ExternC							{ $1 }+:	AggregateDecl						{ $1 } |	Comment							{ $1 }-|	Namespace						{ $1 }-|	Event							{ $1 }-|	ErrorDecl						{ $1 }-|	StaticAssert						{ $1 }-|	Commented(CommentableDecl)				{ $1 }--CommentableDecl :: { StringNode }-CommentableDecl-:	TypedefDecl						{ $1 }-|	AggregateDecl						{ $1 }+|	ConstDecl						{ $1 } |	EnumDecl						{ $1 }+|	ErrorDecl						{ $1 }+|	Event							{ $1 }+|	ExternC							{ $1 } |	FunctionDecl						{ $1 }-|	ConstDecl						{ $1 }+|	Namespace						{ $1 } |	PreprocDefine						{ $1 }--DocComment :: { StringNode }-DocComment-:	'/**' CommentTokens '*/'				{ Comment Doxygen $1 (reverse $2) $3 }+|	PreprocIfdef(ToplevelDecls)				{ $1 }+|	PreprocIf(ToplevelDecls)				{ $1 }+|	PreprocInclude						{ $1 }+|	PreprocUndef						{ $1 }+|	StaticAssert						{ $1 }+|	TypedefDecl						{ $1 }  StaticAssert :: { StringNode } StaticAssert@@ -228,8 +221,8 @@  Event :: { StringNode } Event-:	event IdVar       '{' Commented(EventType) '}'		{ Event $2 $4 }-|	event IdVar const '{' Commented(EventType) '}'		{ Event $2 $5 }+:	event IdVar       '{' Comment EventType '}'		{ Event $2 (Commented $4 $5) }+|	event IdVar const '{' Comment EventType '}'		{ Event $2 (Commented $5 $6) }  EventType :: { StringNode } EventType@@ -246,6 +239,7 @@ Comment :: { StringNode } Comment :	'/*' CommentTokens '*/'					{ Comment Regular $1 (reverse $2) $3 }+|	'/**' CommentTokens '*/'				{ Comment Doxygen $1 (reverse $2) $3 } |	'/***' CommentTokens '*/'				{ Comment Block $1 (reverse $2) $3 } |	'/**/'							{ CommentBlock $1 } @@ -532,8 +526,14 @@ :	LhsExpr							{ $1 } |	ExprStmt						{ $1 } |	FunctionCall						{ $1 }+|	CompoundExpr						{ $1 } |	PureExpr(Expr)						{ $1 } +-- Allow `(Type){0}` to set struct values to all-zero.+CompoundExpr :: { StringNode }+CompoundExpr+:	'(' QualType ')' '{' Expr '}'				{ CompoundExpr $2 $5 }+ AssignExpr :: { StringNode } AssignExpr :	LhsExpr AssignOperator Expr				{ AssignExpr $1 $2 $3 }@@ -579,7 +579,7 @@ EnumDecl :: { StringNode } EnumDecl :	enum class ID_SUE_TYPE EnumeratorList			{ EnumClass $3 $4 }-|	enum       ID_SUE_TYPE EnumeratorList			{ EnumConsts (Just $2) $3 }+|	enum       ID_SUE_TYPE EnumeratorList ';'		{ EnumConsts (Just $2) $3 } |	enum                   EnumeratorList ';'		{ EnumConsts Nothing $2 } |	typedef enum ID_SUE_TYPE EnumeratorList ID_SUE_TYPE ';'	{ EnumDecl $3 $4 $5 } |	bitmask ID_SUE_TYPE EnumeratorList			{ EnumDecl $2 $3 $2 }@@ -590,12 +590,8 @@  Enumerators :: { [StringNode] } Enumerators-:	Commented(Enumerator)					{ [$1] }-|	Enumerators Commented(Enumerator)			{ $2 : $1 }--Commented(x)-:	x							{ $1 }-|	DocComment x						{ Commented $1 $2 }+:	Enumerator						{ [$1] }+|	Enumerators Enumerator					{ $2 : $1 }  Enumerator :: { StringNode } Enumerator@@ -627,8 +623,8 @@  MemberDecls :: { [StringNode] } MemberDecls-:	Commented(MemberDecl)					{ [$1] }-|	MemberDecls Commented(MemberDecl)			{ $2 : $1 }+:	MemberDecl						{ [$1] }+|	MemberDecls MemberDecl					{ $2 : $1 }  MemberDecl :: { StringNode } MemberDecl@@ -727,8 +723,9 @@ type StringNode = Node StringLexeme  parseError :: Show text => (Lexeme text, [String]) -> Alex a-parseError (token, options) =-    alexError $ "Parse error near token: " <> show token <> "; expected one of " <> show options+parseError (L (AlexPn _ line col) c t, options) =+    alexError $ show line <> ":" <> show col <> ": Parse error near " <> show c <> ": "+        <> show t <> "; expected one of " <> show options  lexwrap :: (Lexeme String -> Alex a) -> Alex a lexwrap = (alexMonadScan >>=)

@@ -340,6 +340,7 @@     FunctionCall c  a -> ppFunctionCall c a     ArrayAccess  e  i -> ppExpr e <> char '[' <> ppExpr i <> char ']'     CastExpr     ty e -> char '(' <> ppType ty <> char ')' <> ppExpr e+    CompoundExpr ty e -> char '(' <> ppType ty <> char ')' <+> char '{' <> ppExpr e <> char '}'     PreprocDefined  n -> text "defined(" <> ppLexeme n <> char ')'     InitialiserList l -> ppInitialiserList l     PointerAccess e m -> ppExpr e <> text "->" <> ppLexeme m

@@ -44,7 +44,7 @@      go :: FilePath -> AstActions (State [FilePath]) Text     go dir = defaultActions-        { doNode = \node act ->+        { doNode = \_ node act ->             case node of                 PreprocInclude (L spos LitString include) -> do                     let includePath = relativeTo dir $ tread include

@@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE InstanceSigs        #-} {-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StrictData          #-} module Language.Cimple.TraverseAst@@ -17,11 +18,14 @@     traverseAst :: Applicative f => AstActions f Text -> a -> f a  data AstActions f text = AstActions-    { doNodes   :: [Node (Lexeme text)] -> f [Node (Lexeme text)] -> f [Node (Lexeme text)]-    , doNode    ::  Node (Lexeme text)  -> f (Node (Lexeme text)) -> f (Node (Lexeme text))-    , doLexemes ::       [Lexeme text]  -> f       [Lexeme text]  -> f       [Lexeme text]-    , doLexeme  ::        Lexeme text   -> f       (Lexeme text)  -> f       (Lexeme text)-    , doText    ::               text   -> f               text   -> f               text+    { currentFile :: FilePath+    , doUnits     :: [(FilePath, [Node (Lexeme text)])] -> f [(FilePath, [Node (Lexeme text)])] -> f [(FilePath, [Node (Lexeme text)])]+    , doUnit      ::  (FilePath, [Node (Lexeme text)])  -> f  (FilePath, [Node (Lexeme text)])  -> f  (FilePath, [Node (Lexeme text)])+    , doNodes     :: FilePath -> [Node (Lexeme text)]   -> f             [Node (Lexeme text)]   -> f             [Node (Lexeme text)]+    , doNode      :: FilePath ->  Node (Lexeme text)    -> f             (Node (Lexeme text))   -> f             (Node (Lexeme text))+    , doLexemes   :: FilePath ->       [Lexeme text]    -> f                   [Lexeme text]    -> f                   [Lexeme text]+    , doLexeme    :: FilePath ->        Lexeme text     -> f                   (Lexeme text)    -> f                   (Lexeme text)+    , doText      :: FilePath ->               text     -> f                           text     -> f                           text     }  instance TraverseAst a => TraverseAst (Maybe a) where@@ -30,35 +34,38 @@  defaultActions :: Applicative f => AstActions f lexeme defaultActions = AstActions-    { doNodes   = const id-    , doNode    = const id-    , doLexeme  = const id-    , doLexemes = const id-    , doText    = const id+    { currentFile = "<stdin>"+    , doUnits     = const id+    , doUnit      = const id+    , doNodes     = const $ const id+    , doNode      = const $ const id+    , doLexeme    = const $ const id+    , doLexemes   = const $ const id+    , doText      = const $ const id     }  instance TraverseAst Text where     traverseAst :: forall f . Applicative f                 => AstActions f Text -> Text -> f Text-    traverseAst astActions = doText astActions <*> pure+    traverseAst astActions@AstActions{currentFile} = doText astActions currentFile <*> pure  instance TraverseAst (Lexeme Text) where     traverseAst :: forall f . Applicative f                 => AstActions f Text -> Lexeme Text -> f (Lexeme Text)-    traverseAst astActions = doLexeme astActions <*> \case+    traverseAst astActions@AstActions{currentFile} = doLexeme astActions currentFile <*> \case         L p c s -> L p c <$> recurse s       where         recurse :: TraverseAst a => a -> f a         recurse = traverseAst astActions  instance TraverseAst [Lexeme Text] where-    traverseAst astActions = doLexemes astActions <*>+    traverseAst astActions@AstActions{currentFile} = doLexemes astActions currentFile <*>         traverse (traverseAst astActions)  instance TraverseAst (Node (Lexeme Text)) where     traverseAst :: forall f . Applicative f                 => AstActions f Text -> Node (Lexeme Text) -> f (Node (Lexeme Text))-    traverseAst astActions = doNode astActions <*> \case+    traverseAst astActions@AstActions{currentFile} = doNode astActions currentFile <*> \case         PreprocInclude path ->             PreprocInclude <$> recurse path         PreprocDefine name ->@@ -155,6 +162,8 @@             ParenExpr <$> recurse expr         CastExpr ty expr ->             CastExpr <$> recurse ty <*> recurse expr+        CompoundExpr ty expr ->+            CompoundExpr <$> recurse ty <*> recurse expr         SizeofExpr expr ->             SizeofExpr <$> recurse expr         SizeofType ty ->@@ -245,5 +254,15 @@         recurse = traverseAst astActions  instance TraverseAst [Node (Lexeme Text)] where-    traverseAst astActions = doNodes astActions <*>+    traverseAst astActions@AstActions{currentFile} = doNodes astActions currentFile <*>+        traverse (traverseAst astActions)++instance TraverseAst (FilePath, [Node (Lexeme Text)]) where+    traverseAst astActions tu@(currentFile, _) = doUnit astActions' <*>+        traverse (traverseAst astActions') $ tu+      where+        astActions' = astActions{currentFile}++instance TraverseAst [(FilePath, [Node (Lexeme Text)])] where+    traverseAst astActions = doUnits astActions <*>         traverse (traverseAst astActions)

@@ -0,0 +1,265 @@+{+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Language.Cimple.TreeParser where++import           Data.Text             (Text)+import           Language.Cimple.AST   (CommentStyle (..), Node (..))+import           Language.Cimple.Lexer (Lexeme)+}++%name parseTranslationUnit TranslationUnit+%name parseDecls Decls+%name parseHeaderBody HeaderBody++%error {parseError}+%errorhandlertype explist+%monad {TreeParser}+%tokentype {TextNode}+%token+    ifndefDefine	{ PreprocIfndef _ body (PreprocElse []) | isDefine body }+    ifdefDefine		{ PreprocIfdef _ body (PreprocElse []) | isDefine body }+    ifDefine		{ PreprocIf _ body (PreprocElse []) | isDefine body }++    ifndefInclude	{ PreprocIfndef{} | isPreproc tk && hasInclude tk }+    ifdefInclude	{ PreprocIfdef{} | isPreproc tk && hasInclude tk }+    ifInclude		{ PreprocIf{} | isPreproc tk && hasInclude tk }++    docComment		{ Comment Doxygen _ _ _ }++    -- Preprocessor+    preprocInclude	{ PreprocInclude{} }+    preprocDefine	{ PreprocDefine{} }+    preprocDefineConst	{ PreprocDefineConst{} }+    preprocDefineMacro	{ PreprocDefineMacro{} }+    preprocIf		{ PreprocIf{} }+    preprocIfdef	{ PreprocIfdef{} }+    preprocIfndef	{ PreprocIfndef{} }+    preprocElse		{ PreprocElse{} }+    preprocElif		{ PreprocElif{} }+    preprocUndef	{ PreprocUndef{} }+    preprocDefined	{ PreprocDefined{} }+    preprocScopedDefine	{ PreprocScopedDefine{} }+    macroBodyStmt	{ MacroBodyStmt{} }+    macroBodyFunCall	{ MacroBodyFunCall{} }+    macroParam		{ MacroParam{} }+    staticAssert	{ StaticAssert{} }+    -- Comments+    licenseDecl		{ LicenseDecl{} }+    copyrightDecl	{ CopyrightDecl{} }+    comment		{ Comment{} }+    commentBlock	{ CommentBlock{} }+    commentWord		{ CommentWord{} }+    commented		{ Commented{} }+    -- Namespace-like blocks+    externC		{ ExternC{} }+    class		{ Class{} }+    namespace		{ Namespace{} }+    -- Statements+    compoundStmt	{ CompoundStmt{} }+    break		{ Break }+    goto		{ Goto{} }+    continue		{ Continue }+    return		{ Return{} }+    switchStmt		{ SwitchStmt{} }+    ifStmt		{ IfStmt{} }+    forStmt		{ ForStmt{} }+    whileStmt		{ WhileStmt{} }+    doWhileStmt		{ DoWhileStmt{} }+    case		{ Case{} }+    default		{ Default{} }+    label		{ Label{} }+    -- Variable declarations+    vLA			{ VLA{} }+    varDecl		{ VarDecl{} }+    declarator		{ Declarator{} }+    declSpecVar		{ DeclSpecVar{} }+    declSpecArray	{ DeclSpecArray{} }+    -- Expressions+    initialiserList	{ InitialiserList{} }+    unaryExpr		{ UnaryExpr{} }+    binaryExpr		{ BinaryExpr{} }+    ternaryExpr		{ TernaryExpr{} }+    assignExpr		{ AssignExpr{} }+    parenExpr		{ ParenExpr{} }+    castExpr		{ CastExpr{} }+    compoundExpr	{ CompoundExpr{} }+    sizeofExpr		{ SizeofExpr{} }+    sizeofType		{ SizeofType{} }+    literalExpr		{ LiteralExpr{} }+    varExpr		{ VarExpr{} }+    memberAccess	{ MemberAccess{} }+    pointerAccess	{ PointerAccess{} }+    arrayAccess		{ ArrayAccess{} }+    functionCall	{ FunctionCall{} }+    commentExpr		{ CommentExpr{} }+    -- Type definitions+    enumClass		{ EnumClass{} }+    enumConsts		{ EnumConsts{} }+    enumDecl		{ EnumDecl{} }+    enumerator		{ Enumerator{} }+    classForward	{ ClassForward{} }+    typedef		{ Typedef{} }+    typedefFunction	{ TypedefFunction{} }+    struct		{ Struct{} }+    union		{ Union{} }+    memberDecl		{ MemberDecl{} }+    tyConst		{ TyConst{} }+    tyPointer		{ TyPointer{} }+    tyStruct		{ TyStruct{} }+    tyFunc		{ TyFunc{} }+    tyStd		{ TyStd{} }+    tyVar		{ TyVar{} }+    tyUserDefined	{ TyUserDefined{} }+    -- Functions+    functionDecl	{ FunctionDecl{} }+    functionDefn	{ FunctionDefn{} }+    functionPrototype	{ FunctionPrototype{} }+    functionParam	{ FunctionParam{} }+    event		{ Event{} }+    eventParams		{ EventParams{} }+    property		{ Property{} }+    accessor		{ Accessor{} }+    errorDecl		{ ErrorDecl{} }+    errorList		{ ErrorList{} }+    errorFor		{ ErrorFor{} }+    ellipsis		{ Ellipsis }+    -- Constants+    constDecl		{ ConstDecl{} }+    constDefn		{ ConstDefn{} }++%%++TranslationUnit :: { [TextNode] }+TranslationUnit+:	licenseDecl FileComment Header				{ [$1, $2, $3] }+|	licenseDecl FileComment Source				{ $1 : $2 : $3 }+|	licenseDecl             Header				{ [$1, $2] }+|	licenseDecl             Source				{ $1 : $2 }++FileComment :: { TextNode }+FileComment+:	comment							{ $1 }+|	docComment						{ $1 }++Header :: { TextNode }+Header+:	preprocIfndef						{% recurse parseHeaderBody $1 }++HeaderBody :: { [TextNode] }+HeaderBody+:	preprocDefine Includes Decls				{ $1 : reverse $2 ++ reverse $3 }++Source :: { [TextNode] }+Source+:	Features preprocInclude Includes Decls			{ $1 ++ [$2] ++ reverse $3 ++ reverse $4 }++Features :: { [TextNode] }+Features+:								{ [] }+|	Features IfDefine					{ $2 : $1 }++IfDefine :: { TextNode }+IfDefine+:	ifndefDefine						{ $1 }+|	ifdefDefine						{ $1 }+|	ifDefine						{ $1 }++Includes :: { [TextNode] }+Includes+:								{ [] }+|	Includes Include					{ $2 : $1 }++Include :: { TextNode }+Include+:	preprocInclude						{ $1 }+|	ifndefInclude						{ $1 }+|	ifdefInclude						{ $1 }+|	ifInclude						{ $1 }++Decls :: { [TextNode] }+Decls+:								{ [] }+|	Decls Decl						{ $2 : $1 }++Decl :: { TextNode }+Decl+:	comment							{ $1 }+|	CommentableDecl						{ $1 }+|	docComment CommentableDecl				{ Commented $1 $2 }++CommentableDecl :: { TextNode }+CommentableDecl+:	functionDecl						{ $1 }+|	functionDefn						{ $1 }+|	struct							{ $1 }+|	typedef							{ $1 }+|	constDecl						{ $1 }+|	constDefn						{ $1 }+|	enumConsts						{ $1 }+|	enumDecl						{ $1 }+|	externC							{% recurse parseDecls $1 }+|	preprocDefine						{ $1 }+|	preprocDefineConst					{ $1 }+|	preprocDefineMacro					{ $1 }+|	preprocIf						{% recurse parseDecls $1 }+|	preprocIfdef						{% recurse parseDecls $1 }+|	preprocIfndef						{% recurse parseDecls $1 }+|	staticAssert						{ $1 }+|	typedefFunction						{ $1 }+|	IfDefine						{ $1 }++{+type TextLexeme = Lexeme Text+type TextNode = Node TextLexeme++newtype TreeParser a = TreeParser { toEither :: Either String a }+    deriving (Functor, Applicative, Monad)++instance MonadFail TreeParser where+    fail = TreeParser . Left+++isDefine :: [TextNode] -> Bool+isDefine (PreprocUndef{}:d)     = isDefine d+isDefine [PreprocDefine{}]      = True+isDefine [PreprocDefineConst{}] = True+isDefine _                      = False++isPreproc :: TextNode -> Bool+isPreproc PreprocInclude{}        = True+isPreproc PreprocUndef{}          = True+isPreproc PreprocDefine{}         = True+isPreproc PreprocDefineConst{}    = True+isPreproc (PreprocIf _ td ed)     = all isPreproc td && isPreproc ed+isPreproc (PreprocIfdef _ td ed)  = all isPreproc td && isPreproc ed+isPreproc (PreprocIfndef _ td ed) = all isPreproc td && isPreproc ed+isPreproc (PreprocElse ed)        = all isPreproc ed+isPreproc _                       = False++hasInclude :: TextNode -> Bool+hasInclude PreprocInclude{}        = True+hasInclude (PreprocIf _ td ed)     = any hasInclude td || hasInclude ed+hasInclude (PreprocIfdef _ td ed)  = any hasInclude td || hasInclude ed+hasInclude (PreprocIfndef _ td ed) = any hasInclude td || hasInclude ed+hasInclude (PreprocElse ed)        = any hasInclude ed+hasInclude _                       = False+++recurse :: ([TextNode] -> TreeParser [TextNode]) -> TextNode -> TreeParser TextNode+recurse f (ExternC ds)          = ExternC <$> f ds+recurse f (PreprocIf c t e)     = PreprocIf c <$> f t <*> recurse f e+recurse f (PreprocIfdef c t e)  = PreprocIfdef c <$> f t <*> recurse f e+recurse f (PreprocIfndef c t e) = PreprocIfndef c <$> f t <*> recurse f e+recurse f (PreprocIfndef c t e) = PreprocIfndef c <$> f t <*> recurse f e+recurse f (PreprocElif c t e)   = PreprocElif c <$> f t <*> recurse f e+recurse f (PreprocElse [])      = return $ PreprocElse []+recurse f (PreprocElse e)       = PreprocElse <$> f e+recurse _ ns                    = fail $ show ns+++parseError :: ([TextNode], [String]) -> TreeParser a+parseError ([], options) =+    fail $ "end of file; expected one of " <> show options+parseError (n:_, options) =+    fail $ show n <> "; expected one of " <> show options+}

@@ -93,4 +93,4 @@         it "does not support multiple declarators per declaration" $ do             let ast = parseText "int main() { int a, b; }"             ast `shouldBe` Left-                "Parse error near token: L (AlexPn 18 1 19) PctComma \",\"; expected one of [\"';'\"]"+                "1:19: Parse error near PctComma: \",\"; expected one of [\"';'\"]"