Skip to content

Instantly share code, notes, and snippets.

@wenkokke
Last active April 1, 2017 18:15
Show Gist options
  • Save wenkokke/61cf8a970b99f0c92d4b to your computer and use it in GitHub Desktop.
Save wenkokke/61cf8a970b99f0c92d4b to your computer and use it in GitHub Desktop.
Pandoc filter which renders simple brace-delimited trees in codeblocks to LaTeX's Tikz-QTree...
#!/usr/bin/env runhaskell
-- cabal depedencies:
--
-- * containers
-- * pandoc-types
-- * uu-parsinglib
--
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Applicative
import Data.Char (isSpace)
import qualified Data.Map as M (singleton)
import Data.Monoid
import Data.Tree (Tree(..))
import Debug.Trace (trace)
import Text.Pandoc.JSON
import Text.Pandoc.Walk (walk)
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.BasicInstances
import Text.ParserCombinators.UU.Derived
import Text.ParserCombinators.UU.Utils
-- Syntax of trees is as follows:
--
-- Node ::= '[' Value (Node | Leaf)* ']'
-- Leaf ::= QuotedString | MathString | LabelString
-- QuotedString ::= '"' ... anything goes ... '"'
-- MathString ::= '$' ... anything goes ... '$'
-- LabelString ::= anything but a space ... ' '
--
-- * Parsing Tree format and outputting LaTeX's QTree format
renderTree' :: Block -> Block
renderTree' cb@(CodeBlock (_, classes, _) str)
| "tree" `elem` classes = RawBlock (Format "latex") (showQTree . parseTree $ str)
| otherwise = cb
renderTree' bl = bl
parseTree :: String -> Tree String
parseTree = runParser "tree" pNode
where
pNode :: Parser (Tree String)
pNode = pBrackets (Node <$> pValue <*> pMany pNode) <<|> (return <$> pValue)
pValue,pLabelString,pMathString :: Parser String
pValue = pQuotedString <<|> pMathString <<|> pLabelString
pMathString = (\str -> "$" ++ str ++ "$") <$> pParentheticalString '$'
pLabelString = lexeme $ pList (pPred (\c -> not (isSpace c || c == ']'))) <* (pAnySym " \r\n\t" <?> "Whitespace")
pPred p = pSatisfy p
(Insertion "Anything but whitespace" 'y' 5)
showQTree :: Tree String -> String
showQTree t = unlines
[ "\\begin{tikzpicture}"
, "\\Tree " ++ go t
, "\\end{tikzpicture}"
]
where
go (Node val []) = leaf val
go (Node lbl xs) = node lbl . unwords . map go $ xs
leaf val = "{" ++ val ++ "}"
node "" x = "[ " ++ x ++ " ]"
node lbl x = "[.{" ++ lbl ++ "} " ++ x ++ " ]"
-- * Adding LaTeX includes
unsafeUse :: String -> String
unsafeUse pkg =
"\\usepackage{" ++ pkg ++ "}%"
unsafeQTreeUse :: Block
unsafeQTreeUse =
RawBlock (Format "latex") . unlines $
[ unsafeUse "tikz"
, unsafeUse "tikz-qtree"
]
useQTree :: Meta -> Meta
useQTree meta = case lookupMeta "header-uses" meta of
Nothing -> mkMeta [unsafeQTreeUse]
Just (MetaBlocks blocks) -> mkMeta (unsafeQTreeUse : blocks)
Just _ -> trace "warning: tikz-qtree was not included" meta
where
mkMeta :: [Block] -> Meta
mkMeta = (<> meta) . Meta . M.singleton "header-includes" . MetaBlocks
-- * Filter definition
renderTree :: Pandoc -> Pandoc
renderTree (Pandoc meta blocks) = Pandoc (useQTree meta) (walk renderTree' blocks)
main :: IO ()
main = toJSONFilter renderTree
@tindzk
Copy link

tindzk commented Dec 17, 2014

Works great, thanks! For those, who are wondering how to use it, here's a small example:

```tree
["<Wurzel>"
    ["Laponia"
        ["Welterbe"
            ["schwedische"
                ["Das"]
            ]

            ["liegt"
                ["in"
                    ["Lappland"]
                ]
            ]
        ]
    ]

    ["."]
]
```

Also, the following might be needed at the beginning of your LaTeX template:

$for(header-includes)$
    $header-includes$
$endfor$

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment