{-# LANGUAGE OverloadedStrings, CPP #-}
#if __GLASGOW_HASKELL__ >= 801
{-# OPTIONS_GHC -Wno-orphans #-}
#else
{-# OPTIONS_GHC -fno-warn-orphans #-}
#endif

-- | Tree interface using the @qtree@ package.
--   An example of usage is provided in the /examples/ directory of
--   the source distribution.
module Text.LaTeX.Packages.Trees.Qtree (
    -- * Tree re-export
    module Text.LaTeX.Packages.Trees
    -- * Qtree package
  , qtree
    -- * Tree to LaTeX rendering
  , tree
  , rendertree
  ) where

import Text.LaTeX.Base
import Text.LaTeX.Base.Class
import Text.LaTeX.Packages.Trees
--
import Data.List (intersperse)

-- | The 'qtree' package.
qtree :: PackageName
qtree :: PackageName
qtree = PackageName
"qtree"

tree_ :: LaTeXC l => (a -> l) -> Tree a -> l
tree_ :: forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree_ a -> l
f (Leaf a
x) = forall l. LaTeXC l => l -> l
braces forall a b. (a -> b) -> a -> b
$ a -> l
f a
x
tree_ a -> l
f (Node Maybe a
mx [Tree a]
ts) =
  forall a. Monoid a => [a] -> a
mconcat [ l
"["
          , forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((l
"." forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. LaTeXC l => l -> l
braces forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> l
f) Maybe a
mx
          , l
" "
          , forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse l
" " forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree_ a -> l
f) [Tree a]
ts
          , l
" ]"
            ]

-- | Given a function to @LaTeX@ values, you can create a @LaTeX@ tree from a
--   Haskell tree. The function specifies how to render the node values.
tree :: LaTeXC l => (a -> l) -> Tree a -> l
tree :: forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree a -> l
f Tree a
t = forall l. LaTeXC l => PackageName -> l
commS PackageName
"Tree" forall a. Semigroup a => a -> a -> a
<> l
" " forall a. Semigroup a => a -> a -> a
<> forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree_ a -> l
f Tree a
t

-- | Instance defined in "Text.LaTeX.Packages.Trees.Qtree".
instance Texy a => Texy (Tree a) where
 texy :: forall l. LaTeXC l => Tree a -> l
texy = forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree forall t l. (Texy t, LaTeXC l) => t -> l
texy

-- | This function works as 'tree', but use 'render' as rendering function.
rendertree :: (Render a, LaTeXC l) => Tree a -> l
rendertree :: forall a l. (Render a, LaTeXC l) => Tree a -> l
rendertree = forall l a. LaTeXC l => (a -> l) -> Tree a -> l
tree (forall l. LaTeXC l => Text -> l
raw forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
protectText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Render a => a -> Text
render)