confluence_table_to_dot.hs

{-# LANGUAGE BlockArguments #-}

module Main where

import Data.Char
import Data.List.Split

import qualified Data.Set

main :: IO ()
main = interact confluenceTableToDot

confluenceTableToDot :: String -> String
confluenceTableToDot
  = unlines
  . do \x  -> ["digraph {",""] ++ x ++ ["","}"]
  . do \x  -> ["# Nodes:"] ++ concatMap fst x ++ ["", "# Edges:"] ++ concatMap snd x
  . do \ls ->  map (dottify (extractIDs ls)) ls
  . groupify

extractIDs :: [[String]] -> Data.Set.Set String
extractIDs = Data.Set.fromList . filter (not . null) . map extractID

extractID :: [String] -> String
extractID []        = ""
extractID (l : _ls) = mkID l

-- All IDs -> Row Items -> (Nodes, Edges)
dottify :: Data.Set.Set String -> [String] -> ([String], [String])
dottify _ids []  = ([], [])
dottify _ids [x] = ([createNode x], [])
dottify  ids l@(x : _xs) = ([createNode x], createEdge ids l)

createNode :: String -> String
createNode x = mkID x ++ " [ label=\"" ++ mkLabel x ++ "\" ]" ++ ";"

createEdge :: Data.Set.Set String -> [String] -> [String]
createEdge  ids l@(x : _x : _xs)
  | Data.Set.member (mkID (last l)) ids
                = [ mkID x ++ " -> " ++ mkID (last l) ++ ";" ]
createEdge  _ _ = []

mkID :: String -> String
mkID s = "id_" ++  filter isAlphaNum s

mkLabel :: String -> String
mkLabel = filter (/= '\"')

groupify :: String -> [[String]]
groupify
  = strip
  . map strip
  . map (concatMap (splitOn "\t"))
  . reverse
  . map reverse
  . parse []
  . lines

parse :: [[String]] -> [String] -> [[String]]
parse acc [] = acc
parse acc (l@(x : _xs) : ls)
  | null l              = parse acc ls
  | all isSpace l       = parse acc ls
  | not (isSpace x)     = parse ([l] : acc) ls
parse [] _ls            = error "shouldn't hit this"
parse (a : as) (l : ls) = parse ((l : a) : as) ls

strip :: [[a]] -> [[a]]
strip = filter (not . null)