src/git-darcs-import.hs

   1 -- |
   2 -- Program     : git-darcs-import
   3 -- Copyright   : (c) 2008 Bertram Felgenhauer
   4 -- License     : GPL2
   5 --
   6 -- Maintainer  : Bertram Felgenhauer <int-e@gmx.de>
   7 -- Stability   : experimental
   8 -- Portability : ghc
   9 --
  10 -- darcs to git conversion.
  11 --
  12 --    git-darcs-import src dst
  13 --
  14
  15 module Main (main) where
  16
  17 import System.Environment (getArgs)
  18 import System.Directory (canonicalizePath, doesDirectoryExist, createDirectory)
  19 import System.IO (hFlush, stdout)
  20 import Control.Monad (when, liftM, forM_)
  21 import Control.Monad.Trans (liftIO)
  22 import Data.Maybe (isJust)
  23 import System.Console.GetOpt
  24
  25 import Darcs.Repository (read_repo, withRepositoryDirectory, Repository)
  26 import Darcs.Patch.Core (Named (..))
  27 import Darcs.Patch.Info (make_filename, pi_tag)
  28 import Darcs.Patch.Set (PatchSet)
  29 import Darcs.Ordered (mapRL)
  30 import Darcs.Patch (RepoPatch)
  31 import Darcs.Hopefully (PatchInfoAnd, info, hopefully)
  32 import Git.Base (Git, getVerbose, modifyVerbose, failure)
  33 import Git.Fast (runGit, getInventory, applyAndCommit)
  34 import System.Posix.Signals (installHandler, sigPIPE, Handler (..))
  35 import qualified Data.ByteString.Char8 as BC
  36
  37 options :: [OptDescr (Git ())]
  38 options = [
  39     Option "v" ["verbose"]
  40            (NoArg (modifyVerbose succ))
  41            "Be more verbose. This option can be given multiple times."
  42     ]
  43
  44 main :: IO ()
  45 main = do
  46     installHandler sigPIPE (CatchOnce $ putStrLn "\nCaught SIGPIPE!") Nothing
  47     args <- getArgs
  48     case getOpt Permute options args of
  49         (opts, [src, dst], []) -> convert opts src dst
  50         (opts, [src], []) -> convert opts src "."
  51         (_, _, []) -> putStrLn usage
  52         (_, _, es) -> mapM_ print es
  53
  54 usage :: String
  55 usage = usageInfo "git-darcs-import [-v] <source> [<destination>]" options
  56
  57 -- convert a darcs repository to a git repository, or catch up on new patches
  58 convert :: [Git ()] -> FilePath -> FilePath -> IO ()
  59 convert opts src dst0 = do
  60     dst <- canonicalizePath dst0
  61     dstEx <- doesDirectoryExist dst
  62     when (not dstEx) $ createDirectory dst
  63     withRepositoryDirectory [] src (work0 dst)
  64   where
  65     toList :: PatchSet p -> [PatchInfoAnd p]
  66     toList = concatMap (mapRL id) . mapRL id
  67
  68     work0 :: RepoPatch p => FilePath -> Repository p -> IO ()
  69     work0 dst repo = do
  70         ps <- read_repo repo
  71         runGit (sequence opts) dst (work (toList ps))
  72         putStrLn "\ngit-darcs-import done."
  73
  74     -- the worker for convert
  75     work :: RepoPatch p => [PatchInfoAnd p] -> Git ()
  76     work ps = do
  77         inv <- liftM reverse getInventory
  78         let inv' = map (BC.unpack . fst) inv
  79         case match ps inv' of
  80             Nothing -> failure "Destination is not a prefix of source."
  81             Just ps' -> forM_ ps' $ \(i, p@(NamedP pip _ _)) -> do
  82                 v <- getVerbose
  83                 liftIO $ do
  84                     putStr $ "\r" ++ show i ++ ". " ++ make_filename pip
  85                           ++ if v > 0 then "\n" else " "
  86                     hFlush stdout
  87                 applyAndCommit p
  88
  89     -- match the patches from the source repository (ps) with the patches in
  90     -- the destination (qs). for now we assume that the latter is a prefix of
  91     -- the first.
  92     match :: [PatchInfoAnd p] -> [String]
  93           -> Maybe [(Int, Named p)]
  94     -- case 1) empty destination
  95     match ps [] = Just $ reverse (zip [1..] (map hopefully ps))
  96     -- case 2) q is the last patch applied to the destination
  97     match ps (q:qs) = match' qs q ps [] 1
  98
  99     -- find q in ps
 100     match' :: [String]               -- other patches in destination
 101            -> String                 -- last patch in destination
 102            -> [PatchInfoAnd p]       -- patches to check
 103            -> [(Int, Named p)]       -- tentative work queue
 104            -> Int                    -- patch number
 105            -> Maybe [(Int, Named p)] -- maybe result work queue
 106     match' _  _ [] _  _ = Nothing
 107     match' qs q (p:ps) xs i
 108         | patchId p == q && samePatches ps qs = Just xs
 109         | patchId p == q                      = Nothing
 110         | otherwise = match' qs q ps ((i, hopefully p) : xs) $! i+1
 111
 112     patchId :: PatchInfoAnd p -> String
 113     patchId p = make_filename (info p)
 114
 115     -- check whether the given lists are the same; we stop the scan after
 116     -- the first tag for better performance
 117     samePatches :: [PatchInfoAnd p] -> [String] -> Bool
 118     samePatches (a:as) (b:bs) = patchId a == b && isTag a || samePatches as bs
 119     samePatches [] [] = True
 120     samePatches _  _  = False
 121
 122     isTag :: PatchInfoAnd p -> Bool
 123     isTag = isJust . pi_tag . info