cimple 0.0.4 → 0.0.5

raw patch · 8 files changed

+247/−180 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cimple.cabal +2/−2
• src/Language/Cimple.hs +18/−5
• src/Language/Cimple/AST.hs +74/−74
• src/Language/Cimple/IO.hs +24/−25
• src/Language/Cimple/SemCheck/Includes.hs +20/−19
• src/Language/Cimple/TraverseAst.hs +90/−47
• test/Language/CimpleSpec.hs +14/−2
• tools/dump-ast.hs +5/−6

@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.4+version:              0.0.5 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3@@ -31,7 +31,6 @@     , Language.Cimple.IO     , Language.Cimple.Pretty     , Language.Cimple.Program-    , Language.Cimple.TraverseAst   other-modules:       Language.Cimple.AST     , Language.Cimple.Graph@@ -40,6 +39,7 @@     , Language.Cimple.SemCheck.Includes     , Language.Cimple.Tokens     , Language.Cimple.TranslationUnit+    , Language.Cimple.TraverseAst     , Language.Cimple.TreeParser   build-depends:       base < 5

@@ -1,6 +1,19 @@-module Language.Cimple (module X) where+module Language.Cimple+    ( module X+    , AstActions+    , defaultActions+    ) where -import           Language.Cimple.AST    as X-import           Language.Cimple.Lexer  as X-import           Language.Cimple.Parser as X-import           Language.Cimple.Tokens as X+import           Control.Monad.State.Lazy    (State)+import           Data.Text                   (Text)++import           Language.Cimple.AST         as X+import           Language.Cimple.Lexer       as X+import           Language.Cimple.Parser      as X+import           Language.Cimple.Tokens      as X+import           Language.Cimple.TraverseAst as X++type AstActions a = X.IdentityActions (State a) () Text++defaultActions :: X.IdentityActions (State a) () Text+defaultActions = X.identityActions

@@ -15,112 +15,112 @@ import           Data.Aeson   (FromJSON, ToJSON) import           GHC.Generics (Generic) -data Node a lexeme-    = Attr a+data Node attr lexeme+    = Attr attr (Node attr lexeme)     -- Preprocessor     | PreprocInclude lexeme     | PreprocDefine lexeme-    | PreprocDefineConst lexeme (Node a lexeme)-    | PreprocDefineMacro lexeme [Node a lexeme] (Node a lexeme)-    | PreprocIf (Node a lexeme) [Node a lexeme] (Node a lexeme)-    | PreprocIfdef lexeme [Node a lexeme] (Node a lexeme)-    | PreprocIfndef lexeme [Node a lexeme] (Node a lexeme)-    | PreprocElse [Node a lexeme]-    | PreprocElif (Node a lexeme) [Node a lexeme] (Node a lexeme)+    | PreprocDefineConst lexeme (Node attr lexeme)+    | PreprocDefineMacro lexeme [Node attr lexeme] (Node attr lexeme)+    | PreprocIf (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)+    | PreprocIfdef lexeme [Node attr lexeme] (Node attr lexeme)+    | PreprocIfndef lexeme [Node attr lexeme] (Node attr lexeme)+    | PreprocElse [Node attr lexeme]+    | PreprocElif (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)     | PreprocUndef lexeme     | PreprocDefined lexeme-    | PreprocScopedDefine (Node a lexeme) [Node a lexeme] (Node a lexeme)-    | MacroBodyStmt [Node a lexeme]-    | MacroBodyFunCall (Node a lexeme)+    | PreprocScopedDefine (Node attr lexeme) [Node attr lexeme] (Node attr lexeme)+    | MacroBodyStmt [Node attr lexeme]+    | MacroBodyFunCall (Node attr lexeme)     | MacroParam lexeme-    | StaticAssert (Node a lexeme) lexeme+    | StaticAssert (Node attr lexeme) lexeme     -- Comments-    | LicenseDecl lexeme [Node a lexeme]+    | LicenseDecl lexeme [Node attr lexeme]     | CopyrightDecl lexeme (Maybe lexeme) [lexeme]-    | Comment CommentStyle lexeme [Node a lexeme] lexeme+    | Comment CommentStyle lexeme [Node attr lexeme] lexeme     | CommentBlock lexeme     | CommentWord lexeme-    | Commented (Node a lexeme) (Node a lexeme)+    | Commented (Node attr lexeme) (Node attr lexeme)     -- Namespace-like blocks-    | ExternC [Node a lexeme]-    | Class Scope lexeme [Node a lexeme] [Node a lexeme]-    | Namespace Scope lexeme [Node a lexeme]+    | ExternC [Node attr lexeme]+    | Class Scope lexeme [Node attr lexeme] [Node attr lexeme]+    | Namespace Scope lexeme [Node attr lexeme]     -- Statements-    | CompoundStmt [Node a lexeme]+    | CompoundStmt [Node attr lexeme]     | Break     | Goto lexeme     | Continue-    | Return (Maybe (Node a lexeme))-    | SwitchStmt (Node a lexeme) [Node a lexeme]-    | IfStmt (Node a lexeme) [Node a lexeme] (Maybe (Node a lexeme))-    | ForStmt (Node a lexeme) (Node a lexeme) (Node a lexeme) [Node a lexeme]-    | WhileStmt (Node a lexeme) [Node a lexeme]-    | DoWhileStmt [Node a lexeme] (Node a lexeme)-    | Case (Node a lexeme) (Node a lexeme)-    | Default (Node a lexeme)-    | Label lexeme (Node a lexeme)+    | Return (Maybe (Node attr lexeme))+    | SwitchStmt (Node attr lexeme) [Node attr lexeme]+    | IfStmt (Node attr lexeme) [Node attr lexeme] (Maybe (Node attr lexeme))+    | ForStmt (Node attr lexeme) (Node attr lexeme) (Node attr lexeme) [Node attr lexeme]+    | WhileStmt (Node attr lexeme) [Node attr lexeme]+    | DoWhileStmt [Node attr lexeme] (Node attr lexeme)+    | Case (Node attr lexeme) (Node attr lexeme)+    | Default (Node attr lexeme)+    | Label lexeme (Node attr lexeme)     -- Variable declarations-    | VLA (Node a lexeme) lexeme (Node a lexeme)-    | VarDecl (Node a lexeme) (Node a lexeme)-    | Declarator (Node a lexeme) (Maybe (Node a lexeme))+    | VLA (Node attr lexeme) lexeme (Node attr lexeme)+    | VarDecl (Node attr lexeme) (Node attr lexeme)+    | Declarator (Node attr lexeme) (Maybe (Node attr lexeme))     | DeclSpecVar lexeme-    | DeclSpecArray (Node a lexeme) (Maybe (Node a lexeme))+    | DeclSpecArray (Node attr lexeme) (Maybe (Node attr lexeme))     -- Expressions-    | InitialiserList [Node a lexeme]-    | UnaryExpr UnaryOp (Node a lexeme)-    | BinaryExpr (Node a lexeme) BinaryOp (Node a lexeme)-    | TernaryExpr (Node a lexeme) (Node a lexeme) (Node a lexeme)-    | AssignExpr (Node a lexeme) AssignOp (Node a lexeme)-    | ParenExpr (Node a lexeme)-    | CastExpr (Node a lexeme) (Node a lexeme)-    | CompoundExpr (Node a lexeme) (Node a lexeme)-    | SizeofExpr (Node a lexeme)-    | SizeofType (Node a lexeme)+    | InitialiserList [Node attr lexeme]+    | UnaryExpr UnaryOp (Node attr lexeme)+    | BinaryExpr (Node attr lexeme) BinaryOp (Node attr lexeme)+    | TernaryExpr (Node attr lexeme) (Node attr lexeme) (Node attr lexeme)+    | AssignExpr (Node attr lexeme) AssignOp (Node attr lexeme)+    | ParenExpr (Node attr lexeme)+    | CastExpr (Node attr lexeme) (Node attr lexeme)+    | CompoundExpr (Node attr lexeme) (Node attr lexeme)+    | SizeofExpr (Node attr lexeme)+    | SizeofType (Node attr lexeme)     | LiteralExpr LiteralType lexeme     | VarExpr lexeme-    | MemberAccess (Node a lexeme) lexeme-    | PointerAccess (Node a lexeme) lexeme-    | ArrayAccess (Node a lexeme) (Node a lexeme)-    | FunctionCall (Node a lexeme) [Node a lexeme]-    | CommentExpr (Node a lexeme) (Node a lexeme)+    | MemberAccess (Node attr lexeme) lexeme+    | PointerAccess (Node attr lexeme) lexeme+    | ArrayAccess (Node attr lexeme) (Node attr lexeme)+    | FunctionCall (Node attr lexeme) [Node attr lexeme]+    | CommentExpr (Node attr lexeme) (Node attr lexeme)     -- Type definitions-    | EnumClass lexeme [Node a lexeme]-    | EnumConsts (Maybe lexeme) [Node a lexeme]-    | EnumDecl lexeme [Node a lexeme] lexeme-    | Enumerator lexeme (Maybe (Node a lexeme))-    | ClassForward lexeme [Node a lexeme]-    | Typedef (Node a lexeme) lexeme-    | TypedefFunction (Node a lexeme)-    | Struct lexeme [Node a lexeme]-    | Union lexeme [Node a lexeme]-    | MemberDecl (Node a lexeme) (Node a lexeme) (Maybe lexeme)-    | TyConst (Node a lexeme)-    | TyPointer (Node a lexeme)+    | EnumClass lexeme [Node attr lexeme]+    | EnumConsts (Maybe lexeme) [Node attr lexeme]+    | EnumDecl lexeme [Node attr lexeme] lexeme+    | Enumerator lexeme (Maybe (Node attr lexeme))+    | ClassForward lexeme [Node attr lexeme]+    | Typedef (Node attr lexeme) lexeme+    | TypedefFunction (Node attr lexeme)+    | Struct lexeme [Node attr lexeme]+    | Union lexeme [Node attr lexeme]+    | MemberDecl (Node attr lexeme) (Node attr lexeme) (Maybe lexeme)+    | TyConst (Node attr lexeme)+    | TyPointer (Node attr lexeme)     | TyStruct lexeme     | TyFunc lexeme     | TyStd lexeme     | TyVar lexeme     | TyUserDefined lexeme     -- Functions-    | FunctionDecl Scope (Node a lexeme) (Maybe (Node a lexeme))-    | FunctionDefn Scope (Node a lexeme) [Node a lexeme]-    | FunctionPrototype (Node a lexeme) lexeme [Node a lexeme]-    | FunctionParam (Node a lexeme) (Node a lexeme)-    | Event lexeme (Node a lexeme)-    | EventParams [Node a lexeme]-    | Property (Node a lexeme) (Node a lexeme) [Node a lexeme]-    | Accessor lexeme [Node a lexeme] (Maybe (Node a lexeme))-    | ErrorDecl lexeme [Node a lexeme]-    | ErrorList [Node a lexeme]+    | FunctionDecl Scope (Node attr lexeme) (Maybe (Node attr lexeme))+    | FunctionDefn Scope (Node attr lexeme) [Node attr lexeme]+    | FunctionPrototype (Node attr lexeme) lexeme [Node attr lexeme]+    | FunctionParam (Node attr lexeme) (Node attr lexeme)+    | Event lexeme (Node attr lexeme)+    | EventParams [Node attr lexeme]+    | Property (Node attr lexeme) (Node attr lexeme) [Node attr lexeme]+    | Accessor lexeme [Node attr lexeme] (Maybe (Node attr lexeme))+    | ErrorDecl lexeme [Node attr lexeme]+    | ErrorList [Node attr lexeme]     | ErrorFor lexeme     | Ellipsis     -- Constants-    | ConstDecl (Node a lexeme) lexeme-    | ConstDefn Scope (Node a lexeme) lexeme (Node a lexeme)+    | ConstDecl (Node attr lexeme) lexeme+    | ConstDefn Scope (Node attr lexeme) lexeme (Node attr lexeme)     deriving (Show, Eq, Generic, Functor, Foldable, Traversable) -instance (FromJSON a, FromJSON lexeme) => FromJSON (Node a lexeme)-instance (ToJSON a, ToJSON lexeme) => ToJSON (Node a lexeme)+instance (FromJSON attr, FromJSON lexeme) => FromJSON (Node attr lexeme)+instance (ToJSON attr, ToJSON lexeme) => ToJSON (Node attr lexeme)  data AssignOp     = AopEq

@@ -20,42 +20,41 @@ import           Language.Cimple.Program         (Program) import qualified Language.Cimple.Program         as Program import           Language.Cimple.TranslationUnit (TranslationUnit)+import           Language.Cimple.TraverseAst     (TextActions, mapAst,+                                                  textActions) import qualified Language.Cimple.TreeParser      as TreeParser -type CacheState a = State (Map String Text) a--cacheText :: String -> CacheState Text-cacheText s = do-    m <- get-    case Map.lookup s m of-        Nothing -> do-            let text = Text.pack s-            put $ Map.insert s text m-            return text-        Just text ->-            return text-+type StringNode = Node () (Lexeme String)+type TextNode = Node () (Lexeme Text) -process :: [Node a (Lexeme String)] -> [Node a (Lexeme Text)]-process stringAst =-    evalState (mapM (mapM (mapM cacheText)) stringAst) Map.empty+toTextAst :: [StringNode] -> [TextNode]+toTextAst stringAst =+    evalState (mapAst cacheActions stringAst) Map.empty+  where+    cacheActions :: TextActions (State (Map String Text)) () String Text+    cacheActions = textActions $ \s -> do+        m <- get+        case Map.lookup s m of+            Nothing -> do+                let text = Text.pack s+                put $ Map.insert s text m+                return text+            Just text ->+                return text  -parseText :: Text -> Either String [Node () (Lexeme Text)]+parseText :: Text -> Either String [TextNode] parseText contents =-    process <$> res-  where-    res :: Either String [Node () (Lexeme String)]-    res =-        runAlex (Text.unpack contents) Parser.parseTranslationUnit+    toTextAst <$> runAlex (Text.unpack contents) Parser.parseTranslationUnit -parseTextStrict :: Text -> Either String [Node () (Lexeme Text)]-parseTextStrict = parseText >=> TreeParser.toEither . TreeParser.parseTranslationUnit+parseTextPedantic :: Text -> Either String [TextNode]+parseTextPedantic =+    parseText >=> TreeParser.toEither . TreeParser.parseTranslationUnit   parseFile :: FilePath -> IO (Either String (TranslationUnit Text)) parseFile source =-    addSource . parseTextStrict . Text.decodeUtf8 <$> BS.readFile source+    addSource . parseTextPedantic . Text.decodeUtf8 <$> BS.readFile source   where     -- Add source filename to the error message, if any.     addSource (Left err) = Left $ source <> ":" <> err

@@ -12,8 +12,8 @@ import           Language.Cimple.Lexer           (Lexeme (..)) import           Language.Cimple.Tokens          (LexemeClass (..)) import           Language.Cimple.TranslationUnit (TranslationUnit)-import           Language.Cimple.TraverseAst     (AstActions (..),-                                                  defaultActions, traverseAst)+import           Language.Cimple.TraverseAst     (IdentityActions, doNode,+                                                  identityActions, traverseAst) import           System.FilePath                 (joinPath, splitPath,                                                   takeDirectory) @@ -36,24 +36,25 @@     go d f         = joinPath (d ++ f)  +normaliseIncludes' :: FilePath -> IdentityActions (State [FilePath]) () Text+normaliseIncludes' dir = identityActions+    { doNode = \_ node act ->+        case node of+            PreprocInclude (L spos LitString include) -> do+                let includePath = relativeTo dir $ tread include+                State.modify (includePath :)+                return $ PreprocInclude (L spos LitString (tshow includePath))++            _ -> act+    }++  where+    tshow = Text.pack . show+    tread = read . Text.unpack++ normaliseIncludes :: TranslationUnit Text -> (TranslationUnit Text, [FilePath]) normaliseIncludes (file, ast) =     ((file, ast'), includes)   where-    (ast', includes) = State.runState (traverseAst (go (takeDirectory file)) ast) []--    go :: FilePath -> AstActions (State [FilePath]) () Text-    go dir = defaultActions-        { doNode = \_ node act ->-            case node of-                PreprocInclude (L spos LitString include) -> do-                    let includePath = relativeTo dir $ tread include-                    State.modify (includePath :)-                    return $ PreprocInclude (L spos LitString (tshow includePath))--                _ -> act-        }--      where-        tshow = Text.pack . show-        tread = read . Text.unpack+    (ast', includes) = State.runState (traverseAst (normaliseIncludes' (takeDirectory file)) ast) []

@@ -7,34 +7,54 @@ {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StrictData            #-} module Language.Cimple.TraverseAst-    ( TraverseAst (..)-    , AstActions (..)-    , defaultActions+    ( mapAst, traverseAst++    , doFiles, doFile+    , doNodes, doNode+    , doLexemes, doLexeme+    , doText+    , doAttr++    , astActions+    , AttrActions, attrActions+    , TextActions, textActions+    , IdentityActions, identityActions     ) where  import           Language.Cimple.AST   (Node (..)) import           Language.Cimple.Lexer (Lexeme (..)) -class TraverseAst attr text a where-    traverseAst :: Applicative f => AstActions f attr text -> a -> f a+class TraverseAst iattr oattr itext otext a b where+    mapAst :: Applicative f => AstActions f iattr oattr itext otext -> a -> f b -data AstActions f attr text = AstActions+traverseAst+    :: (TraverseAst iattr oattr itext otext a a, Applicative f)+    => AstActions f iattr oattr itext otext -> a -> f a+traverseAst = mapAst++data AstActions f iattr oattr itext otext = AstActions     { currentFile :: FilePath-    , doFiles     :: [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])]-    , doFile      ::  (FilePath, [Node attr (Lexeme text)])  -> f  (FilePath, [Node attr (Lexeme text)])  -> f  (FilePath, [Node attr (Lexeme text)])-    , doNodes     :: FilePath -> [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]-    , doNode      :: FilePath ->  Node attr (Lexeme text)    -> f             (Node attr (Lexeme text))   -> f             (Node attr (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+    , doFiles     :: [(FilePath, [Node iattr (Lexeme itext)])] -> f [(FilePath, [Node oattr (Lexeme otext)])] -> f [(FilePath, [Node oattr (Lexeme otext)])]+    , doFile      ::  (FilePath, [Node iattr (Lexeme itext)])  -> f  (FilePath, [Node oattr (Lexeme otext)])  -> f  (FilePath, [Node oattr (Lexeme otext)])+    , doNodes     :: FilePath -> [Node iattr (Lexeme itext)]   -> f             [Node oattr (Lexeme otext)]   -> f             [Node oattr (Lexeme otext)]+    , doNode      :: FilePath ->  Node iattr (Lexeme itext)    -> f             (Node oattr (Lexeme otext))   -> f             (Node oattr (Lexeme otext))+    , doLexemes   :: FilePath ->             [Lexeme itext]    -> f                         [Lexeme otext]    -> f                         [Lexeme otext]+    , doLexeme    :: FilePath ->              Lexeme itext     -> f                         (Lexeme otext)    -> f                         (Lexeme otext)+    , doText      :: FilePath ->                     itext                                                    -> f                                 otext+    , doAttr      :: FilePath ->       iattr                                                                  -> f                   oattr     } -instance TraverseAst attr text a => TraverseAst attr text (Maybe a) where-    traverseAst _          Nothing  = pure Nothing-    traverseAst astActions (Just x) = Just <$> traverseAst astActions x+instance TraverseAst iattr oattr itext otext        a         b+      => TraverseAst iattr oattr itext otext (Maybe a) (Maybe b) where+    mapAst _       Nothing  = pure Nothing+    mapAst actions (Just x) = Just <$> mapAst actions x -defaultActions :: Applicative f => AstActions f attr text-defaultActions = AstActions+astActions+    :: Applicative f+    => (iattr -> f oattr)+    -> (itext -> f otext)+    -> AstActions f iattr oattr itext otext+astActions fa ft = AstActions     { currentFile = "<stdin>"     , doFiles     = const id     , doFile      = const id@@ -42,31 +62,51 @@     , doNode      = const $ const id     , doLexeme    = const $ const id     , doLexemes   = const $ const id-    , doText      = const $ const id+    , doText      = const ft+    , doAttr      = const fa     } -instance TraverseAst attr text text where-    traverseAst AstActions{..} = doText currentFile <*> pure+type AttrActions f iattr oattr text = AstActions f iattr oattr text text+attrActions :: Applicative f => (iattr -> f oattr) -> AttrActions f iattr oattr text+attrActions = flip astActions pure -instance TraverseAst attr text (Lexeme text) where-    traverseAst :: forall f . Applicative f-                => AstActions f attr text -> Lexeme text -> f (Lexeme text)-    traverseAst astActions@AstActions{..} = doLexeme currentFile <*>+type TextActions f attr itext otext = AstActions f attr attr itext otext+textActions :: Applicative f => (itext -> f otext) -> TextActions f attr itext otext+textActions = astActions pure++type IdentityActions f attr text = AstActions f attr attr text text+identityActions :: Applicative f => AstActions f attr attr text text+identityActions = astActions pure pure+++instance TraverseAst iattr oattr itext otext itext otext where+    mapAst AstActions{..} = doText currentFile++instance TraverseAst iattr oattr itext otext iattr oattr where+    mapAst AstActions{..} = doAttr currentFile++instance TraverseAst iattr oattr itext otext (Lexeme itext)+                                             (Lexeme otext) where+    mapAst :: forall f . Applicative f+           => AstActions f iattr oattr itext otext -> Lexeme itext -> f (Lexeme otext)+    mapAst actions@AstActions{..} = doLexeme currentFile <*>         \(L p c s) -> L p c <$> recurse s       where-        recurse :: TraverseAst attr text a => a -> f a-        recurse = traverseAst astActions+        recurse :: TraverseAst iattr oattr itext otext a b => a -> f b+        recurse = mapAst actions -instance TraverseAst attr text [Lexeme text] where-    traverseAst astActions@AstActions{..} = doLexemes currentFile <*>-        traverse (traverseAst astActions)+instance TraverseAst iattr oattr itext otext [Lexeme itext]+                                             [Lexeme otext] where+    mapAst actions@AstActions{..} = doLexemes currentFile <*>+        traverse (mapAst actions) -instance TraverseAst attr text (Node attr (Lexeme text)) where-    traverseAst :: forall f . Applicative f-                => AstActions f attr text -> Node attr (Lexeme text) -> f (Node attr (Lexeme text))-    traverseAst astActions@AstActions{..} = doNode currentFile <*> \case-        attr@Attr{} ->-            pure attr+instance TraverseAst iattr oattr itext otext (Node iattr (Lexeme itext))+                                             (Node oattr (Lexeme otext)) where+    mapAst :: forall f . Applicative f+           => AstActions f iattr oattr itext otext -> Node iattr (Lexeme itext) -> f (Node oattr (Lexeme otext))+    mapAst actions@AstActions{..} = doNode currentFile <*> \case+        Attr attr node ->+            Attr <$> recurse attr <*> recurse node         PreprocInclude path ->             PreprocInclude <$> recurse path         PreprocDefine name ->@@ -251,17 +291,20 @@             ConstDefn scope <$> recurse ty <*> recurse name <*> recurse value        where-        recurse :: TraverseAst attr text a => a -> f a-        recurse = traverseAst astActions+        recurse :: TraverseAst iattr oattr itext otext a b => a -> f b+        recurse = mapAst actions -instance TraverseAst attr text [Node attr (Lexeme text)] where-    traverseAst astActions@AstActions{..} = doNodes currentFile <*>-        traverse (traverseAst astActions)+instance TraverseAst iattr oattr itext otext [Node iattr (Lexeme itext)]+                                             [Node oattr (Lexeme otext)] where+    mapAst actions@AstActions{..} = doNodes currentFile <*>+        traverse (mapAst actions) -instance TraverseAst attr text (FilePath, [Node attr (Lexeme text)]) where-    traverseAst astActions@AstActions{doFile} tu@(currentFile, _) = doFile <*>-        traverse (traverseAst astActions{currentFile}) $ tu+instance TraverseAst iattr oattr itext otext (FilePath, [Node iattr (Lexeme itext)])+                                             (FilePath, [Node oattr (Lexeme otext)]) where+    mapAst actions@AstActions{doFile} tu@(currentFile, _) = doFile <*>+        traverse (mapAst actions{currentFile}) $ tu -instance TraverseAst attr text [(FilePath, [Node attr (Lexeme text)])] where-    traverseAst astActions@AstActions{..} = doFiles <*>-        traverse (traverseAst astActions)+instance TraverseAst iattr oattr itext otext [(FilePath, [Node iattr (Lexeme itext)])]+                                             [(FilePath, [Node oattr (Lexeme otext)])] where+    mapAst actions@AstActions{..} = doFiles <*>+        traverse (mapAst actions)

@@ -1,16 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} module Language.CimpleSpec where +import           Data.Text          (Text)+import qualified Data.Text          as Text import           Test.Hspec         (Spec, describe, it, shouldBe)  import           Language.Cimple    (AlexPosn (..), CommentStyle (..),                                      Lexeme (..), LexemeClass (..),-                                     LiteralType (..), Node (..), Scope (..))+                                     LiteralType (..), Node (..), Scope (..),+                                     TextActions, mapAst, textActions) import           Language.Cimple.IO (parseText)   spec :: Spec-spec =+spec = do+    describe "TraverseAst" $ do+        it "should map the same way as mapM" $ do+            let Right ast = parseText "int a(void) { return 3; }"+            let actions :: TextActions Maybe () Text String+                actions = textActions (Just . Text.unpack)+            mapM (mapM (mapM (Just . Text.unpack))) ast+                `shouldBe`+                mapAst actions ast+     describe "C parsing" $ do         it "should parse a simple function" $ do             let ast = parseText "int a(void) { return 3; }"

@@ -1,10 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Main (main) where -import           Language.Cimple.IO      (parseProgram)-import qualified Language.Cimple.Program as Program-import           System.Environment      (getArgs)-import           Text.Groom              (groom)+import           Language.Cimple.IO (parseFiles)+import           System.Environment (getArgs)+import           Text.Groom         (groom)   main :: IO ()@@ -13,9 +12,9 @@   case args of     [] -> fail "Usage: dump-ast [FILE]..."     srcs ->-      parseProgram srcs+      parseFiles srcs       >>= getRight-      >>= mapM_ (putStrLn . groom) . Program.toList+      >>= mapM_ (putStrLn . groom)   where     getRight (Left err) = fail err     getRight (Right ok) = return ok