{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Comp.Render where
import Data.Comp
import Data.Comp.Derive
import Data.Comp.Show ()
import Data.Foldable (toList)
import Data.Tree (Tree (..))
import Data.Tree.View
class (Functor f, Foldable f, ShowConstr f) => Render f where
stringTreeAlg :: Alg f (Tree String)
stringTreeAlg f (Tree String)
f = forall a. a -> [Tree a] -> Tree a
Node (forall (f :: * -> *) a. ShowConstr f => f a -> String
showConstr f (Tree String)
f) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Tree String)
f
stringTree :: Render f => Term f -> Tree String
stringTree :: forall (f :: * -> *). Render f => Term f -> Tree String
stringTree = forall (f :: * -> *) a. Functor f => Alg f a -> Term f -> a
cata forall (f :: * -> *). Render f => Alg f (Tree String)
stringTreeAlg
showTerm :: Render f => Term f -> String
showTerm :: forall (f :: * -> *). Render f => Term f -> String
showTerm = Tree String -> String
showTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Render f => Term f -> Tree String
stringTree
drawTerm :: Render f => Term f -> IO ()
drawTerm :: forall (f :: * -> *). Render f => Term f -> IO ()
drawTerm = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Render f => Term f -> String
showTerm
writeHtmlTerm :: Render f => FilePath -> Term f -> IO ()
writeHtmlTerm :: forall (f :: * -> *). Render f => String -> Term f -> IO ()
writeHtmlTerm String
file
= Maybe String -> String -> Tree NodeInfo -> IO ()
writeHtmlTree forall a. Maybe a
Nothing String
file
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
n -> Behavior -> String -> String -> NodeInfo
NodeInfo Behavior
InitiallyExpanded String
n String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *). Render f => Term f -> Tree String
stringTree
$(derive [liftSum] [''Render])