module Language.Syntactic.Interpretation.Render
( Render (..)
, printExpr
, ToTree (..)
, showAST
, drawAST
) where
import Data.Tree
import Language.Syntactic.Syntax
class Render expr
where
render :: expr a -> String
render = renderPart []
renderPart :: [String] -> expr a -> String
renderPart [] a = render a
renderPart args a = "(" ++ unwords (render a : args) ++ ")"
instance Render dom => Render (AST dom)
where
renderPart args (Sym a) = renderPart args a
renderPart args (f :$ a) = renderPart (render a : args) f
instance Render dom => Show (AST dom a)
where
show = render
instance (Render expr1, Render expr2) => Render (expr1 :+: expr2)
where
renderPart args (InjL a) = renderPart args a
renderPart args (InjR a) = renderPart args a
instance (Render expr1, Render expr2) => Show ((expr1 :+: expr2) a)
where
show = render
printExpr :: Render expr => expr a -> IO ()
printExpr = putStrLn . render
class Render expr => ToTree expr
where
toTreePart :: [Tree String] -> expr a -> Tree String
toTreePart args a = Node (render a) args
instance ToTree dom => ToTree (AST dom)
where
toTreePart args (Sym a) = toTreePart args a
toTreePart args (f :$ a) = toTreePart (toTree a : args) f
instance (ToTree expr1, ToTree expr2) => ToTree (expr1 :+: expr2)
where
toTreePart args (InjL a) = toTreePart args a
toTreePart args (InjR a) = toTreePart args a
toTree :: ToTree expr => expr a -> Tree String
toTree = toTreePart []
showAST :: ToTree dom => AST dom a -> String
showAST = drawTree . toTree
drawAST :: ToTree dom => AST dom a -> IO ()
drawAST = putStrLn . showAST