Transform Org mode document to DOT graphviz language

org2dot.hs

-- required packages: split orgmode-parse

import qualified Data.Text as T
import Data.OrgMode.Parse
import Data.OrgMode.Types (Document (..), Headline (..), Section (..), Properties (..))
import Data.Attoparsec.Text
import Data.Maybe
import qualified Data.HashMap.Lazy as M
import Data.List.Split

data Header = Header
    { name :: String
    , subheaders :: [Header]
    , depends :: [String]
    , blocks :: [String]
    }

main :: IO ()
main = do
    text <- fmap T.pack getContents
    let Right (Document _ headlines) = parseOnly (parseDocument []) text
    let headers = transformHeadlines headlines
    mapM_ putStrLn $ generateDot headers

generateDot :: [Header] -> [String]
generateDot hs = "digraph {" : (concatMap generateEdges hs ++ ["}"])

generateEdges :: Header -> [String]
generateEdges header = map (\(x, y) -> quote x ++ " -> " ++ quote y) pairs
                        ++ concatMap generateEdges (subheaders header)
    where
        pairs = concat
            [ zip (map name $ subheaders header) nameRepeated
            , zip (depends header) nameRepeated
            , zip nameRepeated (blocks header)
            ]
        nameRepeated = repeat $ name header

transformHeadlines :: [Headline] -> [Header]
transformHeadlines = map transformHeadline

transformHeadline :: Headline -> Header
transformHeadline headline = Header (T.unpack $ title headline) (transformHeadlines $ subHeadlines headline) deps blocks
    where
        deps = getPropertyList "depends"
        blocks = getPropertyList "blocks"
        getPropertyList :: String -> [String]
        getPropertyList propetryName = maybe [] (splitOn "," . T.unpack) $ M.lookup (T.pack propetryName) properties
        properties = unProperties $ sectionProperties $ section headline

quote :: String -> String
quote s = T.unpack $ T.concat [q, T.replace q qq t, q]
    where
        t = T.pack s
        q = T.pack "\""
        qq = T.pack "\\\""