module Text.EBNF.SyntaxTree where
import Text.EBNF.Helper
import Text.Parsec.Pos
import Data.List as List
import Data.Tuple
import Data.Ord
import Data.Maybe
import Data.Aeson.Types
import Data.Text (pack)
import qualified Data.Foldable as Fold
type Identifier = String
type Content = String
data SyntaxTree = SyntaxTree {
identifier :: !Identifier,
content :: !Content,
position :: !SourcePos,
children :: ![SyntaxTree]
} deriving (Show, Eq)
flattenSyntaxTree :: SyntaxTree -> [SyntaxTree]
flattenSyntaxTree st = st:flattened
where
flattened = concat . map flattenSyntaxTree . children $ st
findST :: (SyntaxTree -> Bool) -> SyntaxTree -> Maybe SyntaxTree
findST p st | p st = Just st
| isJust ch = fromJust ch
| otherwise = Nothing
where
ch = find (\a -> isJust a) . map (findST p) $ children st
instance Ord SyntaxTree where
compare (SyntaxTree _ _ pos _) (SyntaxTree _ _ pos' _) = compare pos pos'
instance ToJSON SyntaxTree where
toJSON (SyntaxTree i c p ch) = (object [(pack "identifier") .= i,
(pack "content") .= c,
(pack "position") .= (toJSON p),
(pack "children") .= (map (toJSON) ch)])
instance ToJSON SourcePos where
toJSON pos = (object [(pack "name") .= (sourceName pos),
(pack "line") .= (sourceLine pos),
(pack "col") .= (sourceColumn pos)])
replaceIdentifier :: Identifier -> SyntaxTree -> SyntaxTree
replaceIdentifier i st = (SyntaxTree
(i)
(content st)
(position st)
(children st))
replaceContent :: Content -> SyntaxTree -> SyntaxTree
replaceContent c st = (SyntaxTree
(identifier st)
(c)
(position st)
(children st))
replacePosition :: SourcePos -> SyntaxTree -> SyntaxTree
replacePosition p st = (SyntaxTree
(identifier st)
(content st)
(p)
(children st))
replaceChildren :: [SyntaxTree] -> SyntaxTree -> SyntaxTree
replaceChildren ch st = (SyntaxTree
(identifier st)
(content st)
(position st)
(ch))
insert :: SyntaxTree -> SyntaxTree -> SyntaxTree
insert st st' = SyntaxTree (identifier st)
(content st)
(position st)
(insertWhere (\a -> a > st') st' (children st))
remove :: SyntaxTree -> SyntaxTree -> SyntaxTree
remove st st' = SyntaxTree (identifier st)
(content st)
(position st)
(filter (\a -> a /= st') (children st))
collapse :: (SyntaxTree -> Bool) -> SyntaxTree -> SyntaxTree
collapse predicate (SyntaxTree i c p ch) =
(SyntaxTree i c' p ch')
where
ch' = map (collapse predicate) ch
c' = concat (map content ch')
prune :: (SyntaxTree -> Bool) -> SyntaxTree -> SyntaxTree
prune predicate (SyntaxTree i c p ch) =
SyntaxTree i c p (map (prune predicate) (filter (not . predicate) ch))
pruneUnderscored :: SyntaxTree -> SyntaxTree
pruneUnderscored st = prune (\a -> ((head (identifier a)) == '_')) st
isTerminal :: SyntaxTree -> Bool
isTerminal (SyntaxTree _ _ _ []) = True
isTerminal (SyntaxTree _ _ _ _) = False
nulltree = SyntaxTree "" "" (newPos "" 0 0) []