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