{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StrictData            #-}
module Language.Cimple.TraverseAst
    ( TraverseAst (..)
    , AstActions (..)
    , defaultActions
    ) 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

data AstActions f attr text = AstActions
    { AstActions f attr text -> FilePath
currentFile :: FilePath
    , AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
doFiles     :: [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])] -> f [(FilePath, [Node attr (Lexeme text)])]
    , AstActions f attr text
-> (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)])
    , AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doNodes     :: FilePath -> [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]   -> f             [Node attr (Lexeme text)]
    , AstActions f attr text
-> 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))
    , AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doLexemes   :: FilePath ->            [Lexeme text]    -> f                        [Lexeme text]    -> f                        [Lexeme text]
    , AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexeme    :: FilePath ->             Lexeme text     -> f                        (Lexeme text)    -> f                        (Lexeme text)
    , AstActions f attr text -> FilePath -> text -> f text -> f text
doText      :: FilePath ->                    text     -> f                                text     -> f                                text
    }

instance TraverseAst attr text a => TraverseAst attr text (Maybe a) where
    traverseAst :: AstActions f attr text -> Maybe a -> f (Maybe a)
traverseAst AstActions f attr text
_          Maybe a
Nothing  = Maybe a -> f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    traverseAst AstActions f attr text
astActions (Just a
x) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> f a -> f (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AstActions f attr text -> a -> f a
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions a
x

defaultActions :: Applicative f => AstActions f attr text
defaultActions :: AstActions f attr text
defaultActions = AstActions :: forall (f :: * -> *) attr text.
FilePath
-> ([(FilePath, [Node attr (Lexeme text)])]
    -> f [(FilePath, [Node attr (Lexeme text)])]
    -> f [(FilePath, [Node attr (Lexeme text)])])
-> ((FilePath, [Node attr (Lexeme text)])
    -> f (FilePath, [Node attr (Lexeme text)])
    -> f (FilePath, [Node attr (Lexeme text)]))
-> (FilePath
    -> [Node attr (Lexeme text)]
    -> f [Node attr (Lexeme text)]
    -> f [Node attr (Lexeme text)])
-> (FilePath
    -> Node attr (Lexeme text)
    -> f (Node attr (Lexeme text))
    -> f (Node attr (Lexeme text)))
-> (FilePath
    -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
-> (FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text))
-> (FilePath -> text -> f text -> f text)
-> AstActions f attr text
AstActions
    { currentFile :: FilePath
currentFile = FilePath
"<stdin>"
    , doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
doFiles     = (f [(FilePath, [Node attr (Lexeme text)])]
 -> f [(FilePath, [Node attr (Lexeme text)])])
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
forall a b. a -> b -> a
const f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
forall a. a -> a
id
    , doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFile      = (f (FilePath, [Node attr (Lexeme text)])
 -> f (FilePath, [Node attr (Lexeme text)]))
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall a b. a -> b -> a
const f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall a. a -> a
id
    , doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doNodes     = ([Node attr (Lexeme text)]
 -> f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
forall a b. a -> b -> a
const (([Node attr (Lexeme text)]
  -> f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
 -> FilePath
 -> [Node attr (Lexeme text)]
 -> f [Node attr (Lexeme text)]
 -> f [Node attr (Lexeme text)])
-> ([Node attr (Lexeme text)]
    -> f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
forall a b. (a -> b) -> a -> b
$ (f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
forall a b. a -> b -> a
const f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. a -> a
id
    , doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNode      = (Node attr (Lexeme text)
 -> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text)))
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
forall a b. a -> b -> a
const ((Node attr (Lexeme text)
  -> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text)))
 -> FilePath
 -> Node attr (Lexeme text)
 -> f (Node attr (Lexeme text))
 -> f (Node attr (Lexeme text)))
-> (Node attr (Lexeme text)
    -> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text)))
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
forall a b. (a -> b) -> a -> b
$ (f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text)))
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
forall a b. a -> b -> a
const f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall a. a -> a
id
    , doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexeme    = (Lexeme text -> f (Lexeme text) -> f (Lexeme text))
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
forall a b. a -> b -> a
const ((Lexeme text -> f (Lexeme text) -> f (Lexeme text))
 -> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text))
-> (Lexeme text -> f (Lexeme text) -> f (Lexeme text))
-> FilePath
-> Lexeme text
-> f (Lexeme text)
-> f (Lexeme text)
forall a b. (a -> b) -> a -> b
$ (f (Lexeme text) -> f (Lexeme text))
-> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
forall a b. a -> b -> a
const f (Lexeme text) -> f (Lexeme text)
forall a. a -> a
id
    , doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doLexemes   = ([Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
forall a b. a -> b -> a
const (([Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
 -> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
-> ([Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
-> FilePath
-> [Lexeme text]
-> f [Lexeme text]
-> f [Lexeme text]
forall a b. (a -> b) -> a -> b
$ (f [Lexeme text] -> f [Lexeme text])
-> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
forall a b. a -> b -> a
const f [Lexeme text] -> f [Lexeme text]
forall a. a -> a
id
    , doText :: FilePath -> text -> f text -> f text
doText      = (text -> f text -> f text) -> FilePath -> text -> f text -> f text
forall a b. a -> b -> a
const ((text -> f text -> f text)
 -> FilePath -> text -> f text -> f text)
-> (text -> f text -> f text)
-> FilePath
-> text
-> f text
-> f text
forall a b. (a -> b) -> a -> b
$ (f text -> f text) -> text -> f text -> f text
forall a b. a -> b -> a
const f text -> f text
forall a. a -> a
id
    }

instance TraverseAst attr text text where
    traverseAst :: AstActions f attr text -> text -> f text
traverseAst AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = FilePath -> text -> f text -> f text
doText FilePath
currentFile (text -> f text -> f text) -> (text -> f text) -> text -> f text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> text -> f text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance TraverseAst attr text (Lexeme text) where
    traverseAst :: forall f . Applicative f
                => AstActions f attr text -> Lexeme text -> f (Lexeme text)
    traverseAst :: AstActions f attr text -> Lexeme text -> f (Lexeme text)
traverseAst astActions :: AstActions f attr text
astActions@AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexeme FilePath
currentFile (Lexeme text -> f (Lexeme text) -> f (Lexeme text))
-> (Lexeme text -> f (Lexeme text))
-> Lexeme text
-> f (Lexeme text)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        \(L AlexPosn
p LexemeClass
c text
s) -> AlexPosn -> LexemeClass -> text -> Lexeme text
forall text. AlexPosn -> LexemeClass -> text -> Lexeme text
L AlexPosn
p LexemeClass
c (text -> Lexeme text) -> f text -> f (Lexeme text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> text -> f text
forall a. TraverseAst attr text a => a -> f a
recurse text
s
      where
        recurse :: TraverseAst attr text a => a -> f a
        recurse :: a -> f a
recurse = AstActions f attr text -> a -> f a
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions

instance TraverseAst attr text [Lexeme text] where
    traverseAst :: AstActions f attr text -> [Lexeme text] -> f [Lexeme text]
traverseAst astActions :: AstActions f attr text
astActions@AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doLexemes FilePath
currentFile ([Lexeme text] -> f [Lexeme text] -> f [Lexeme text])
-> ([Lexeme text] -> f [Lexeme text])
-> [Lexeme text]
-> f [Lexeme text]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Lexeme text -> f (Lexeme text))
-> [Lexeme text] -> f [Lexeme text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (AstActions f attr text -> Lexeme text -> f (Lexeme text)
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions)

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 f attr text
-> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
traverseAst astActions :: AstActions f attr text
astActions@AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNode FilePath
currentFile (Node attr (Lexeme text)
 -> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text)))
-> (Node attr (Lexeme text) -> f (Node attr (Lexeme text)))
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> \case
        attr :: Node attr (Lexeme text)
attr@Attr{} ->
            Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node attr (Lexeme text)
attr
        PreprocInclude Lexeme text
path ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
PreprocInclude (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
path
        PreprocDefine Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
PreprocDefine (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        PreprocDefineConst Lexeme text
name Node attr (Lexeme text)
value ->
            Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme -> Node a lexeme
PreprocDefineConst (Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
value
        PreprocDefineMacro Lexeme text
name [Node attr (Lexeme text)]
params Node attr (Lexeme text)
body ->
            Lexeme text
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocDefineMacro (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
params f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
body
        PreprocIf Node attr (Lexeme text)
cond [Node attr (Lexeme text)]
thenDecls Node attr (Lexeme text)
elseBranch ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocIf (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
thenDecls f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
elseBranch
        PreprocIfdef Lexeme text
name [Node attr (Lexeme text)]
thenDecls Node attr (Lexeme text)
elseBranch ->
            Lexeme text
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocIfdef (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
thenDecls f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
elseBranch
        PreprocIfndef Lexeme text
name [Node attr (Lexeme text)]
thenDecls Node attr (Lexeme text)
elseBranch ->
            Lexeme text
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocIfndef (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
thenDecls f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
elseBranch
        PreprocElse [Node attr (Lexeme text)]
decls ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
PreprocElse ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
decls
        PreprocElif Node attr (Lexeme text)
cond [Node attr (Lexeme text)]
decls Node attr (Lexeme text)
elseBranch ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocElif (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
decls f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
elseBranch
        PreprocUndef Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
PreprocUndef (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        PreprocDefined Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
PreprocDefined (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        PreprocScopedDefine Node attr (Lexeme text)
define [Node attr (Lexeme text)]
stmts Node attr (Lexeme text)
undef ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> [Node a lexeme] -> Node a lexeme -> Node a lexeme
PreprocScopedDefine (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)]
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
define f ([Node attr (Lexeme text)]
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
undef
        MacroBodyStmt [Node attr (Lexeme text)]
stmts ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
MacroBodyStmt ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts
        MacroBodyFunCall Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
MacroBodyFunCall (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        MacroParam Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
MacroParam (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        StaticAssert Node attr (Lexeme text)
cond Lexeme text
msg ->
            Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> lexeme -> Node a lexeme
StaticAssert (Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
msg
        LicenseDecl Lexeme text
license [Node attr (Lexeme text)]
copyrights ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
LicenseDecl (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
license f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
copyrights
        CopyrightDecl Lexeme text
from Maybe (Lexeme text)
to [Lexeme text]
owner ->
            Lexeme text
-> Maybe (Lexeme text) -> [Lexeme text] -> Node attr (Lexeme text)
forall a lexeme.
lexeme -> Maybe lexeme -> [lexeme] -> Node a lexeme
CopyrightDecl (Lexeme text
 -> Maybe (Lexeme text) -> [Lexeme text] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Maybe (Lexeme text)
      -> [Lexeme text] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
from f (Maybe (Lexeme text) -> [Lexeme text] -> Node attr (Lexeme text))
-> f (Maybe (Lexeme text))
-> f ([Lexeme text] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Lexeme text) -> f (Maybe (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Lexeme text)
to f ([Lexeme text] -> Node attr (Lexeme text))
-> f [Lexeme text] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Lexeme text] -> f [Lexeme text]
forall a. TraverseAst attr text a => a -> f a
recurse [Lexeme text]
owner
        Comment CommentStyle
doc Lexeme text
start [Node attr (Lexeme text)]
contents Lexeme text
end ->
            CommentStyle
-> Lexeme text
-> [Node attr (Lexeme text)]
-> Lexeme text
-> Node attr (Lexeme text)
forall a lexeme.
CommentStyle
-> lexeme -> [Node a lexeme] -> lexeme -> Node a lexeme
Comment CommentStyle
doc (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Lexeme text
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
start f ([Node attr (Lexeme text)]
   -> Lexeme text -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
contents f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
end
        CommentBlock Lexeme text
comment ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
CommentBlock (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
comment
        CommentWord Lexeme text
word ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
CommentWord (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
word
        Commented Node attr (Lexeme text)
comment Node attr (Lexeme text)
node ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
Commented (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
comment f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
node
        ExternC [Node attr (Lexeme text)]
decls ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
ExternC ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
decls
        CompoundStmt [Node attr (Lexeme text)]
stmts ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
CompoundStmt ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts
        Node attr (Lexeme text)
Break ->
            Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node attr (Lexeme text)
forall a lexeme. Node a lexeme
Break
        Goto Lexeme text
label ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
Goto (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
label
        Node attr (Lexeme text)
Continue ->
            Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node attr (Lexeme text)
forall a lexeme. Node a lexeme
Continue
        Return Maybe (Node attr (Lexeme text))
value ->
            Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text)
forall a lexeme. Maybe (Node a lexeme) -> Node a lexeme
Return (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
value
        SwitchStmt Node attr (Lexeme text)
value [Node attr (Lexeme text)]
cases ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> [Node a lexeme] -> Node a lexeme
SwitchStmt (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
value f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
cases
        IfStmt Node attr (Lexeme text)
cond [Node attr (Lexeme text)]
thenStmts Maybe (Node attr (Lexeme text))
elseStmt ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Maybe (Node attr (Lexeme text))
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme
-> [Node a lexeme] -> Maybe (Node a lexeme) -> Node a lexeme
IfStmt (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Maybe (Node attr (Lexeme text))
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)]
      -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f ([Node attr (Lexeme text)]
   -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
thenStmts f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
elseStmt
        ForStmt Node attr (Lexeme text)
initStmt Node attr (Lexeme text)
cond Node attr (Lexeme text)
next [Node attr (Lexeme text)]
stmts ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme
-> Node a lexeme
-> Node a lexeme
-> [Node a lexeme]
-> Node a lexeme
ForStmt (Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text)
      -> Node attr (Lexeme text)
      -> [Node attr (Lexeme text)]
      -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
initStmt f (Node attr (Lexeme text)
   -> Node attr (Lexeme text)
   -> [Node attr (Lexeme text)]
   -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text)
      -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f (Node attr (Lexeme text)
   -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
next f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts
        WhileStmt Node attr (Lexeme text)
cond [Node attr (Lexeme text)]
stmts ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> [Node a lexeme] -> Node a lexeme
WhileStmt (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts
        DoWhileStmt [Node attr (Lexeme text)]
stmts Node attr (Lexeme text)
cond ->
            [Node attr (Lexeme text)]
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme -> Node a lexeme
DoWhileStmt ([Node attr (Lexeme text)]
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
stmts f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond
        Case Node attr (Lexeme text)
value Node attr (Lexeme text)
stmt ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
Case (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
value f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
stmt
        Default Node attr (Lexeme text)
stmt ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
Default (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
stmt
        Label Lexeme text
label Node attr (Lexeme text)
stmt ->
            Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme -> Node a lexeme
Label (Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
label f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
stmt
        VLA Node attr (Lexeme text)
ty Lexeme text
name Node attr (Lexeme text)
size ->
            Node attr (Lexeme text)
-> Lexeme text
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> lexeme -> Node a lexeme -> Node a lexeme
VLA (Node attr (Lexeme text)
 -> Lexeme text
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Lexeme text
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
size
        VarDecl Node attr (Lexeme text)
ty Node attr (Lexeme text)
decl ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
VarDecl (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
decl
        Declarator Node attr (Lexeme text)
spec Maybe (Node attr (Lexeme text))
value ->
            Node attr (Lexeme text)
-> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> Maybe (Node a lexeme) -> Node a lexeme
Declarator (Node attr (Lexeme text)
 -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
spec f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
value
        DeclSpecVar Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
DeclSpecVar (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        DeclSpecArray Node attr (Lexeme text)
spec Maybe (Node attr (Lexeme text))
size ->
            Node attr (Lexeme text)
-> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> Maybe (Node a lexeme) -> Node a lexeme
DeclSpecArray (Node attr (Lexeme text)
 -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
spec f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
size
        InitialiserList [Node attr (Lexeme text)]
values ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
InitialiserList ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
values
        UnaryExpr UnaryOp
op Node attr (Lexeme text)
expr ->
            UnaryOp -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. UnaryOp -> Node a lexeme -> Node a lexeme
UnaryExpr UnaryOp
op (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        BinaryExpr Node attr (Lexeme text)
lhs BinaryOp
op Node attr (Lexeme text)
rhs ->
            Node attr (Lexeme text)
-> BinaryOp -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> BinaryOp -> Node a lexeme -> Node a lexeme
BinaryExpr (Node attr (Lexeme text)
 -> BinaryOp -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (BinaryOp
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
lhs f (BinaryOp -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f BinaryOp
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinaryOp -> f BinaryOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryOp
op f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
rhs
        TernaryExpr Node attr (Lexeme text)
cond Node attr (Lexeme text)
thenExpr Node attr (Lexeme text)
elseExpr ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> Node a lexeme -> Node a lexeme -> Node a lexeme
TernaryExpr (Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text)
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
cond f (Node attr (Lexeme text)
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
thenExpr f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
elseExpr
        AssignExpr Node attr (Lexeme text)
lhs AssignOp
op Node attr (Lexeme text)
rhs ->
            Node attr (Lexeme text)
-> AssignOp -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> AssignOp -> Node a lexeme -> Node a lexeme
AssignExpr (Node attr (Lexeme text)
 -> AssignOp -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (AssignOp
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
lhs f (AssignOp -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f AssignOp
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AssignOp -> f AssignOp
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssignOp
op f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
rhs
        ParenExpr Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
ParenExpr (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        CastExpr Node attr (Lexeme text)
ty Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
CastExpr (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        CompoundExpr Node attr (Lexeme text)
ty Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
CompoundExpr (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        SizeofExpr Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
SizeofExpr (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        SizeofType Node attr (Lexeme text)
ty ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
SizeofType (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty
        LiteralExpr LiteralType
ty Lexeme text
value ->
            LiteralType -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. LiteralType -> lexeme -> Node a lexeme
LiteralExpr LiteralType
ty (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
value
        VarExpr Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
VarExpr (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        MemberAccess Node attr (Lexeme text)
name Lexeme text
field ->
            Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> lexeme -> Node a lexeme
MemberAccess (Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
name f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
field
        PointerAccess Node attr (Lexeme text)
name Lexeme text
field ->
            Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> lexeme -> Node a lexeme
PointerAccess (Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
name f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
field
        ArrayAccess Node attr (Lexeme text)
arr Node attr (Lexeme text)
idx ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
ArrayAccess (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
arr f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
idx
        FunctionCall Node attr (Lexeme text)
callee [Node attr (Lexeme text)]
args ->
            Node attr (Lexeme text)
-> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> [Node a lexeme] -> Node a lexeme
FunctionCall (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
callee f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
args
        CommentExpr Node attr (Lexeme text)
comment Node attr (Lexeme text)
expr ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
CommentExpr (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
comment f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
expr
        EnumClass Lexeme text
name [Node attr (Lexeme text)]
members ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
EnumClass (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        EnumConsts Maybe (Lexeme text)
name [Node attr (Lexeme text)]
members ->
            Maybe (Lexeme text)
-> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. Maybe lexeme -> [Node a lexeme] -> Node a lexeme
EnumConsts (Maybe (Lexeme text)
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Maybe (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Lexeme text) -> f (Maybe (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Lexeme text)
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        EnumDecl Lexeme text
name [Node attr (Lexeme text)]
members Lexeme text
tyName ->
            Lexeme text
-> [Node attr (Lexeme text)]
-> Lexeme text
-> Node attr (Lexeme text)
forall a lexeme.
lexeme -> [Node a lexeme] -> lexeme -> Node a lexeme
EnumDecl (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Lexeme text
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> Lexeme text -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
tyName
        Enumerator Lexeme text
name Maybe (Node attr (Lexeme text))
value ->
            Lexeme text
-> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Maybe (Node a lexeme) -> Node a lexeme
Enumerator (Lexeme text
 -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
value
        Typedef Node attr (Lexeme text)
ty Lexeme text
name ->
            Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> lexeme -> Node a lexeme
Typedef (Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        TypedefFunction Node attr (Lexeme text)
ty ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
TypedefFunction (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty
        Namespace Scope
scope Lexeme text
name [Node attr (Lexeme text)]
members ->
            Scope
-> Lexeme text
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Scope -> lexeme -> [Node a lexeme] -> Node a lexeme
Namespace Scope
scope (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        Class Scope
scope Lexeme text
name [Node attr (Lexeme text)]
tyvars [Node attr (Lexeme text)]
members ->
            Scope
-> Lexeme text
-> [Node attr (Lexeme text)]
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Scope
-> lexeme -> [Node a lexeme] -> [Node a lexeme] -> Node a lexeme
Class Scope
scope (Lexeme text
 -> [Node attr (Lexeme text)]
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
tyvars f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        ClassForward Lexeme text
name [Node attr (Lexeme text)]
tyvars ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
ClassForward (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
tyvars
        Struct Lexeme text
name [Node attr (Lexeme text)]
members ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
Struct (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        Union Lexeme text
name [Node attr (Lexeme text)]
members ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
Union (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
members
        MemberDecl Node attr (Lexeme text)
ty Node attr (Lexeme text)
decl Maybe (Lexeme text)
width ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> Maybe (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> Node a lexeme -> Maybe lexeme -> Node a lexeme
MemberDecl (Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> Maybe (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text)
      -> Maybe (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text)
   -> Maybe (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Maybe (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
decl f (Maybe (Lexeme text) -> Node attr (Lexeme text))
-> f (Maybe (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Lexeme text) -> f (Maybe (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Lexeme text)
width
        TyConst Node attr (Lexeme text)
ty ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
TyConst (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty
        TyPointer Node attr (Lexeme text)
ty ->
            Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme
TyPointer (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty
        TyStruct Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
TyStruct (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        TyFunc Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
TyFunc (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        TyVar Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
TyVar (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        TyStd Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
TyStd (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        TyUserDefined Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
TyUserDefined (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        FunctionDecl Scope
scope Node attr (Lexeme text)
proto Maybe (Node attr (Lexeme text))
errors ->
            Scope
-> Node attr (Lexeme text)
-> Maybe (Node attr (Lexeme text))
-> Node attr (Lexeme text)
forall a lexeme.
Scope -> Node a lexeme -> Maybe (Node a lexeme) -> Node a lexeme
FunctionDecl Scope
scope (Node attr (Lexeme text)
 -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
proto f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
errors
        FunctionDefn Scope
scope Node attr (Lexeme text)
proto [Node attr (Lexeme text)]
body ->
            Scope
-> Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Scope -> Node a lexeme -> [Node a lexeme] -> Node a lexeme
FunctionDefn Scope
scope (Node attr (Lexeme text)
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
proto f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
body
        FunctionPrototype Node attr (Lexeme text)
ty Lexeme text
name [Node attr (Lexeme text)]
params ->
            Node attr (Lexeme text)
-> Lexeme text
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> lexeme -> [Node a lexeme] -> Node a lexeme
FunctionPrototype (Node attr (Lexeme text)
 -> Lexeme text
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text
      -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Lexeme text
   -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
params
        FunctionParam Node attr (Lexeme text)
ty Node attr (Lexeme text)
decl ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> Node a lexeme -> Node a lexeme
FunctionParam (Node attr (Lexeme text)
 -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
decl
        Event Lexeme text
name Node attr (Lexeme text)
params ->
            Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme -> Node a lexeme
Event (Lexeme text -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
params
        EventParams [Node attr (Lexeme text)]
params ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
EventParams ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
params
        Property Node attr (Lexeme text)
ty Node attr (Lexeme text)
decl [Node attr (Lexeme text)]
accessors ->
            Node attr (Lexeme text)
-> Node attr (Lexeme text)
-> [Node attr (Lexeme text)]
-> Node attr (Lexeme text)
forall a lexeme.
Node a lexeme -> Node a lexeme -> [Node a lexeme] -> Node a lexeme
Property (Node attr (Lexeme text)
 -> Node attr (Lexeme text)
 -> [Node attr (Lexeme text)]
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text)
      -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Node attr (Lexeme text)
   -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
decl f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
accessors
        Accessor Lexeme text
name [Node attr (Lexeme text)]
params Maybe (Node attr (Lexeme text))
errors ->
            Lexeme text
-> [Node attr (Lexeme text)]
-> Maybe (Node attr (Lexeme text))
-> Node attr (Lexeme text)
forall a lexeme.
lexeme -> [Node a lexeme] -> Maybe (Node a lexeme) -> Node a lexeme
Accessor (Lexeme text
 -> [Node attr (Lexeme text)]
 -> Maybe (Node attr (Lexeme text))
 -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)]
      -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)]
   -> Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)]
-> f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
params f (Maybe (Node attr (Lexeme text)) -> Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
-> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Node attr (Lexeme text))
-> f (Maybe (Node attr (Lexeme text)))
forall a. TraverseAst attr text a => a -> f a
recurse Maybe (Node attr (Lexeme text))
errors
        ErrorDecl Lexeme text
name [Node attr (Lexeme text)]
errors ->
            Lexeme text -> [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. lexeme -> [Node a lexeme] -> Node a lexeme
ErrorDecl (Lexeme text
 -> [Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
errors
        ErrorList [Node attr (Lexeme text)]
errors ->
            [Node attr (Lexeme text)] -> Node attr (Lexeme text)
forall a lexeme. [Node a lexeme] -> Node a lexeme
ErrorList ([Node attr (Lexeme text)] -> Node attr (Lexeme text))
-> f [Node attr (Lexeme text)] -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall a. TraverseAst attr text a => a -> f a
recurse [Node attr (Lexeme text)]
errors
        ErrorFor Lexeme text
name ->
            Lexeme text -> Node attr (Lexeme text)
forall a lexeme. lexeme -> Node a lexeme
ErrorFor (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        Node attr (Lexeme text)
Ellipsis ->
            Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node attr (Lexeme text)
forall a lexeme. Node a lexeme
Ellipsis
        ConstDecl Node attr (Lexeme text)
ty Lexeme text
name ->
            Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text)
forall a lexeme. Node a lexeme -> lexeme -> Node a lexeme
ConstDecl (Node attr (Lexeme text) -> Lexeme text -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Lexeme text -> Node attr (Lexeme text))
-> f (Lexeme text) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name
        ConstDefn Scope
scope Node attr (Lexeme text)
ty Lexeme text
name Node attr (Lexeme text)
value ->
            Scope
-> Node attr (Lexeme text)
-> Lexeme text
-> Node attr (Lexeme text)
-> Node attr (Lexeme text)
forall a lexeme.
Scope -> Node a lexeme -> lexeme -> Node a lexeme -> Node a lexeme
ConstDefn Scope
scope (Node attr (Lexeme text)
 -> Lexeme text
 -> Node attr (Lexeme text)
 -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
-> f (Lexeme text
      -> Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
ty f (Lexeme text
   -> Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Lexeme text)
-> f (Node attr (Lexeme text) -> Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Lexeme text -> f (Lexeme text)
forall a. TraverseAst attr text a => a -> f a
recurse Lexeme text
name f (Node attr (Lexeme text) -> Node attr (Lexeme text))
-> f (Node attr (Lexeme text)) -> f (Node attr (Lexeme text))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall a. TraverseAst attr text a => a -> f a
recurse Node attr (Lexeme text)
value

      where
        recurse :: TraverseAst attr text a => a -> f a
        recurse :: a -> f a
recurse = AstActions f attr text -> a -> f a
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions

instance TraverseAst attr text [Node attr (Lexeme text)] where
    traverseAst :: AstActions f attr text
-> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
traverseAst astActions :: AstActions f attr text
astActions@AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doNodes FilePath
currentFile ([Node attr (Lexeme text)]
 -> f [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> ([Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (Node attr (Lexeme text) -> f (Node attr (Lexeme text)))
-> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (AstActions f attr text
-> Node attr (Lexeme text) -> f (Node attr (Lexeme text))
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions)

instance TraverseAst attr text (FilePath, [Node attr (Lexeme text)]) where
    traverseAst :: AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
traverseAst astActions :: AstActions f attr text
astActions@AstActions{(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)])
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFile} tu :: (FilePath, [Node attr (Lexeme text)])
tu@(FilePath
currentFile, [Node attr (Lexeme text)]
_) = (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)]))
-> ((FilePath, [Node attr (Lexeme text)])
    -> f (FilePath, [Node attr (Lexeme text)]))
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        ([Node attr (Lexeme text)] -> f [Node attr (Lexeme text)])
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (AstActions f attr text
-> [Node attr (Lexeme text)] -> f [Node attr (Lexeme text)]
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions{FilePath
currentFile :: FilePath
currentFile :: FilePath
currentFile}) ((FilePath, [Node attr (Lexeme text)])
 -> f (FilePath, [Node attr (Lexeme text)]))
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall a b. (a -> b) -> a -> b
$ (FilePath, [Node attr (Lexeme text)])
tu

instance TraverseAst attr text [(FilePath, [Node attr (Lexeme text)])] where
    traverseAst :: AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
traverseAst astActions :: AstActions f attr text
astActions@AstActions{FilePath
FilePath -> text -> f text -> f text
FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
[(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
(FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doText :: FilePath -> text -> f text -> f text
doLexeme :: FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: FilePath
doText :: forall (f :: * -> *) attr text.
AstActions f attr text -> FilePath -> text -> f text -> f text
doLexeme :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> Lexeme text -> f (Lexeme text) -> f (Lexeme text)
doLexemes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath -> [Lexeme text] -> f [Lexeme text] -> f [Lexeme text]
doNode :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> Node attr (Lexeme text)
-> f (Node attr (Lexeme text))
-> f (Node attr (Lexeme text))
doNodes :: forall (f :: * -> *) attr text.
AstActions f attr text
-> FilePath
-> [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
-> f [Node attr (Lexeme text)]
doFile :: forall (f :: * -> *) attr text.
AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
doFiles :: forall (f :: * -> *) attr text.
AstActions f attr text
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
currentFile :: forall (f :: * -> *) attr text. AstActions f attr text -> FilePath
..} = [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
doFiles ([(FilePath, [Node attr (Lexeme text)])]
 -> f [(FilePath, [Node attr (Lexeme text)])]
 -> f [(FilePath, [Node attr (Lexeme text)])])
-> ([(FilePath, [Node attr (Lexeme text)])]
    -> f [(FilePath, [Node attr (Lexeme text)])])
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        ((FilePath, [Node attr (Lexeme text)])
 -> f (FilePath, [Node attr (Lexeme text)]))
-> [(FilePath, [Node attr (Lexeme text)])]
-> f [(FilePath, [Node attr (Lexeme text)])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (AstActions f attr text
-> (FilePath, [Node attr (Lexeme text)])
-> f (FilePath, [Node attr (Lexeme text)])
forall attr text a (f :: * -> *).
(TraverseAst attr text a, Applicative f) =>
AstActions f attr text -> a -> f a
traverseAst AstActions f attr text
astActions)