{-# 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

-- | The 'stringTree' algebra of a functor. The default instance creates a tree
-- with the same structure as the term.
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

-- | Convert a term to a 'Tree'
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

-- | Show a term using ASCII art
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

-- | Print a term using ASCII art
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

-- | Write a term to an HTML file with foldable nodes
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])