-- Copyright 2008 Ian Lynagh. -- Uses the darcs source, so GPL. import qualified Camp.Diff import Camp.InRepoFileName as InRepoFileName import qualified Camp.Patch.MegaPatch import qualified Camp.Patch.Apply import qualified Camp.Patch.Primitive import qualified Camp.Patch.Sequence import qualified Camp.Record import qualified Camp.Repository import Darcs.Flags import Darcs.Hopefully import Darcs.Ordered import Darcs.Patch import Darcs.Patch.Core import Darcs.Patch.FileName import Darcs.Patch.Info import Darcs.Patch.Prim import Darcs.Patch.Set import Darcs.Repository.DarcsRepo import Darcs.Sealed import Control.Exception import Control.Monad.State import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BSC import Data.List import System.Directory import System.Environment import System.FilePath import System.IO import System.Time import Unsafe.Coerce flags :: [DarcsFlag] flags = [] main :: IO () main = do hSetBuffering stdout NoBuffering [repo] <- getArgs createDirectory "darcs" createDirectory "camp" inCamp $ do r <- Camp.Repository.createRepo Camp.Repository.initialiseRepo r putStrLn "Counting patches" ps1 <- read_repo flags repo let MkCounts primpatches patches = unseal (countPatchSet (MkCounts 0 0)) ps1 evaluate primpatches evaluate patches putStrLn "Converting patches" ps2 <- read_repo flags repo unseal (flip evalStateT (primpatches, patches, 0, 0) . handlePatchSet) ps2 checkConsistent "darcs" "camp" putStrLn "" putStrLn "Done!" ----- data MkCounts = MkCounts !Int !Int countPatchSet :: MkCounts -> PatchSet Patch -> MkCounts countPatchSet counts NilRL = counts countPatchSet counts (x :<: xs) = countPatchSet (countRL counts x) xs countRL :: MkCounts -> RL (PatchInfoAnd Patch) -> MkCounts countRL counts NilRL = counts countRL (MkCounts npp np) (p :<: ps) = case hopefully p of NamedP _ _ patch -> countRL (countPatch (MkCounts npp (np + 1)) patch) ps countPatch :: MkCounts -> Patch -> MkCounts countPatch (MkCounts npp np) (PP _) = MkCounts (npp + 1) np countPatch counts (ComP NilFL) = counts countPatch counts (ComP (p :>: ps)) = countPatch (countPatch counts p) (ComP ps) countPatch counts (Merger eff _ _ _) = countPatch counts eff countPatch counts (Regrem effi _ _ _) = countPatch counts effi ----- type Counts = (Int, -- total primpatches Int, -- total patches Int, -- prim patches so far Int) -- patches so far type M = StateT Counts IO handlePatchSet :: PatchSet Patch -> M () handlePatchSet NilRL = return () handlePatchSet (x :<: xs) = do handlePatchSet xs handleRL x handleRL :: RL (PatchInfoAnd Patch) -> M () handleRL NilRL = return () handleRL (p :<: ps) = do handleRL ps case hopefully p of NamedP pinfo _ patch -> do nextPatch prims <- handlePatch patch liftIO $ inCamp $ do r <- Camp.Repository.getRepo -- XXX Should make our own name really n <- Camp.Repository.genName r let shortDesc = BSC.pack $ just_name pinfo longDesc = BSC.pack $ unlines $ pi_log pinfo author = BSC.pack $ just_author pinfo date = toClockTime $ pi_date pinfo mi = Camp.Patch.MegaPatch.MetaInfo shortDesc longDesc author date Camp.Record.recordMegaPatch r n mi prims handlePatch :: Patch -> M (Camp.Patch.Sequence.Seq Camp.Patch.Primitive.Primitive from to) handlePatch (PP prim) = handlePrim prim handlePatch (ComP NilFL) = return nil handlePatch (ComP (p :>: ps)) = do s1 <- handlePatch p s2 <- handlePatch (ComP ps) return (s1 `Camp.Patch.Sequence.appendSeq` s2) handlePatch (Merger eff _ _ _) = handlePatch eff handlePatch (Regrem effi _ _ _) = handlePatch (invert effi) inDir :: FilePath -> IO a -> IO a inDir d io = do curDir <- getCurrentDirectory setCurrentDirectory d r <- io setCurrentDirectory curDir return r inDarcs :: IO a -> IO a inDarcs = inDir "darcs" inCamp :: IO a -> IO a inCamp = inDir "camp" checkConsistent :: FilePath -> FilePath -> IO () checkConsistent x y = do xs <- getDirectoryContents x ys <- getDirectoryContents y let xs' = filter (`notElem` [".", ".."]) $ sort xs ys' = filter (`notElem` [".", "..", "_camp"]) $ sort ys unless (xs' == ys') $ error ("Inconsistent: " ++ show x) mapM_ f xs' where f z = do isD <- doesDirectoryExist (x z) if isD then checkConsistent (x z) (y z) else filesSame (x z) (y z) filesSame a b = do a' <- BS.readFile a b' <- BS.readFile b unless (a' == b') $ error ("Inconsistent: " ++ show a) handlePrim :: Prim -> M (Camp.Patch.Sequence.Seq Camp.Patch.Primitive.Primitive from to) handlePrim p = do _pp <- nextPrimPatch liftIO $ do inDarcs $ apply flags p campPrims <- handlePrim' p inCamp $ Camp.Patch.Apply.applyFully campPrims -- when (pp `mod` 1000 == 0) $ -- checkConsistent "darcs" "camp" return campPrims nextPrimPatch :: M Int nextPrimPatch = do (totalPrimPatches, totalPatches, primPatchesSoFar, patchesSoFar) <- get let primPatchesSoFar' = primPatchesSoFar + 1 liftIO $ putStr ("\r" ++ show patchesSoFar ++ "/" ++ show totalPatches ++ " " ++ show primPatchesSoFar' ++ "/" ++ show totalPrimPatches) put (totalPrimPatches, totalPatches, primPatchesSoFar', patchesSoFar) return primPatchesSoFar' nextPatch :: M () nextPatch = do (totalPrimPatches, totalPatches, primPatchesSoFar, patchesSoFar) <- get let patchesSoFar' = patchesSoFar + 1 liftIO $ putStr ("\r" ++ show patchesSoFar' ++ "/" ++ show totalPatches ++ " " ++ show primPatchesSoFar ++ "/" ++ show totalPrimPatches) put (totalPrimPatches, totalPatches, primPatchesSoFar, patchesSoFar') -- XXX Should check and normalise filepaths handlePrim' :: forall from to . Prim -> IO (Camp.Patch.Sequence.Seq Camp.Patch.Primitive.Primitive from to) handlePrim' (Move from to) = do let from' = InRepoFileName.fromString $ fn2fp from to' = InRepoFileName.fromString $ fn2fp to isDir <- doesDirectoryExist ("camp" InRepoFileName.toFilePath from') if isDir then return (singleton (Camp.Patch.Primitive.MvDir from' to')) else return (singleton (Camp.Patch.Primitive.MvFile from' to')) handlePrim' (DP fn RmDir) = do let fn' = InRepoFileName.fromString $ fn2fp fn return (singleton (Camp.Patch.Primitive.RmDir fn')) handlePrim' (DP fn AddDir) = do let fn' = InRepoFileName.fromString $ fn2fp fn return (singleton (Camp.Patch.Primitive.AddDir fn')) handlePrim' (FP fn RmFile) = do let fn' = InRepoFileName.fromString $ fn2fp fn return (singleton (Camp.Patch.Primitive.RmFile fn')) handlePrim' (FP fn AddFile) = do let fn' = InRepoFileName.fromString $ fn2fp fn return (singleton (Camp.Patch.Primitive.AddFile fn')) handlePrim' (FP fn (Hunk {})) = do let fp = fn2fp fn -- This can actually return multiple hunks, e.g. with -- "" -> "a\n\nb\n" -- the empty line in the original file can map to the -- second line of the new file inDarcs $ Camp.Diff.diffFile (".." "camp" fp) fp handlePrim' (FP fn (TokReplace {})) = do let fp = fn2fp fn inDarcs $ Camp.Diff.diffFile (".." "camp" fp) fp handlePrim' (FP fn (Binary old new)) = do let fn' = InRepoFileName.fromString $ fn2fp fn return (singleton (Camp.Patch.Primitive.Binary fn' (BSC.fromChunks [old]) (BSC.fromChunks [new]) )) handlePrim' (Split {}) = error "XXX Split patches aren't handled" handlePrim' (Identity {}) = error "XXX Identity patches aren't handled" handlePrim' (ChangePref {}) = return nil nil :: Camp.Patch.Sequence.Seq Camp.Patch.Primitive.Primitive from to nil = unsafeCoerce Camp.Patch.Sequence.Nil singleton :: Camp.Patch.Primitive.Primitive from to -> Camp.Patch.Sequence.Seq Camp.Patch.Primitive.Primitive from to singleton p = Camp.Patch.Sequence.Cons p Camp.Patch.Sequence.Nil