DarcsToGit: port-darcs-patch

File port-darcs-patch, 1.6 KB (added by batterseapower, 9 years ago)
Line 
1#!/usr/bin/env runhaskell
2
3import Data.List
4
5import System.Environment
6import System.Exit
7import System.Process
8import System.IO
9
10import Debug.Trace
11
12main = do
13    [patch_name, git_directory] <- getArgs
14    diff_with_header <- readProcess "darcs" ["diff", "-u", "--patch=" ++ patch_name] ""
15    -- Thu Mar 31 11:26:34 BST 2011  dimitris@microsoft.com
16    --   * Introducing a datatype for WorkLists that properly prioritizes equalities.
17    --   
18    --   ... more stuff
19    --   
20    -- diff ....
21   
22    let (_header:short_msg_line:long_msg_lines, _diff_header:diff) = span (not . ("diff " `isPrefixOf`)) (lines diff_with_header)
23        '*':' ':short_msg = dropWhile (/= '*') short_msg_line
24        long_msg = map (drop 2) long_msg_lines
25   
26    (h_in, h_out, h_err, ph) <- runInteractiveProcess "patch" ["-p1"] (Just git_directory) Nothing
27    hPutStr h_in (unlines diff)
28    hClose h_in
29    waitForProcessSuccess "patch" h_out h_err ph
30   
31    (_h_in, h_out, h_err, ph) <- runInteractiveProcess "git" ["add", "."] (Just git_directory) Nothing
32    waitForProcessSuccess "git add" h_out h_err ph
33   
34    (h_in, h_out, h_err, ph) <- runInteractiveProcess "git" ["commit", "-a", "--file=-"] (Just git_directory) Nothing
35    hPutStr h_in (unlines (short_msg:long_msg))
36    hClose h_in
37    waitForProcessSuccess "git commit" h_out h_err ph
38
39
40waitForProcessSuccess what h_out h_err ph = waitForProcess ph >>= \ec -> case ec of
41    ExitSuccess -> return ()
42    ExitFailure c -> do
43        out <- hGetContents h_out
44        err <- hGetContents h_err
45        hPutStrLn stderr $ unlines [what ++ " failed: " ++ show c, "", out, "", err]
46        exitWith (ExitFailure 1)