Git のログを Graphviz の dot ファイルで出力する

git-graphviz.hs

module Main where

import Data.Maybe

import Control.Applicative
import Control.Monad
import Control.Arrow

import System.IO
import System.Process
import System.Environment

gengraph :: [String] -> Maybe (String, [(String, String)])
gengraph [] = Nothing
gengraph (x : xs) = Just (x, map (flip (,) x) xs)

main :: IO ()
main = do
    args <- getArgs
    case args of
        [] -> return ()
        f : _ -> do
            handle <- openFile f WriteMode
            (ns, es) <- second concat . unzip . catMaybes . map (gengraph . words) . lines <$>
                readProcess "git" ["log", "--format=format:%H %P"] ""
            hPutStr handle "digraph git {\n"
            forM ns $ \node ->
                hPutStr handle $ "commit" ++ node ++ " [label = \"" ++ node ++ "\"];\n"
            forM es $ \(from, to) ->
                hPutStr handle $ "commit" ++ from ++ " -> commit" ++ to ++ ";\n"
            hPutStr handle "}\n"
            hClose handle