[darcs-devel] Exporting darcs -> git for easier repository history browsing eg using gitk

Marc Weber marco-oweber at gmx.de
Sat Nov 8 00:55:43 UTC 2008


Hi @ll,

darcs is known to be slow on some operations.
darcs changes --verbose | $PAGER is not as convinient as gitk (IMHO)..

That's why I've tried finding an easy and fast way to export darcs to any vcs.
The idea is simple: reuse darcs pull so that each time when you get updates the
other vcs is updated as well.
Using a script like this [2] and the extra flag below works fine  except preseving
date and author. I think it's the minimal solution for this purpose.
Maybe its worth enchancing this patch and add it to the darcs repository permanently?
All it does is adding the flag --post-patch-added-cmd and rearranging
the code in Pull.lhs so that sync_repo is called after applying each
patch only if --post-patch-added-cmd is given.
I still have to run the darcs test suite to see wether I've broken
anything. I just want to get your ideas as well now.

Asking in #git about how to commit while passing date and author 
vmiklos told me about various other solutions. I've tried to add them to the wiki:
http://wiki.darcs.net/DarcsWiki/FrontPage#preview
Maybe you want to correct / enhance the statements.

I'll have a look at git-darcs-import which seems to be an even
better solution to this problem.

Sincerly
Marc Weber

[2]
cat > git-commit << EOF
#!/bin/sh
cd ../clone
git add -A
echo "ignoring date \$3"
echo "ignoring author \$1"
# fixme date 
git commit -m "\$2 by \$1 at \$3" || { echo "nothing to comit ? tag ? :TODO "; }
EOF
chmod +x git-commit
$darcs pull ~/managed_repos/ghc_marc  --post-patch-added-cmd='./git-commit %a %m %d'


============= patch against recent darcs =============================
diff -rN -u old-darcs/foo/orig/file new-darcs/foo/orig/file
--- old-darcs/foo/orig/file     1970-01-01 00:00:00.000000000 +0000
+++ new-darcs/foo/orig/file     2008-11-08 00:36:36.000000000 +0000
@@ -0,0 +1 @@
+10
diff -rN -u old-darcs/GNUmakefile new-darcs/GNUmakefile
--- old-darcs/GNUmakefile       2008-11-08 00:36:36.000000000 +0000
+++ new-darcs/GNUmakefile       2008-11-08 00:36:36.000000000 +0000
@@ -4,6 +4,7 @@
 ## If we are not doing a dist, clean or config operation, include --
 ## and therefore (re)build -- the autoconf.mk and .depend makefile.
 ifeq (,$(filter slowdisttest dist% %clean config%,$(MAKECMDGOALS)))
+
 include autoconf.mk .depend .depend_p
 endif
 
@@ -436,7 +437,7 @@
        fi
 
 .depend:       autoconf.mk $(DARCS_FILES) $(UNIT_FILES)
-       $(ANNOUNCE_GHC) $(GHCFLAGS) -M -optdep-f -optdep$@ $(filter %.lhs %.hs,$^)
+       #$(ANNOUNCE_GHC) $(GHCFLAGS) -M -optdep-f -optdep$@ $(filter %.lhs %.hs,$^)
 .depend_p: .depend
        sed 's/\.\(hi\|o\)/.p_\1/g' $< >$@
 
diff -rN -u old-darcs/src/Darcs/Arguments.lhs new-darcs/src/Darcs/Arguments.lhs
--- old-darcs/src/Darcs/Arguments.lhs   2008-11-08 00:36:36.000000000 +0000
+++ new-darcs/src/Darcs/Arguments.lhs   2008-11-08 00:36:36.000000000 +0000
@@ -78,7 +78,8 @@
                          store_in_memory,
                          patch_select_flag,
                          network_options,
-                         allow_unrelated_repos
+                         allow_unrelated_repos,
+                         post_patch_added_cmd, maybe_post_patch_added_cmd
                       ) where
 import System.Console.GetOpt
 import System.Directory ( doesDirectoryExist )
@@ -153,6 +154,7 @@
 getContent (Cc s) = StringContent s
 getContent (Subject s) = StringContent s
 getContent (SendmailCmd s) = StringContent s
+getContent (PostPatchAddedCmd s) = StringContent s
 getContent (Author s) = StringContent s
 getContent (OnePatch s) = StringContent s
 getContent (SeveralPatch s) = StringContent s
@@ -477,7 +479,8 @@
   author, askdeps, lookforadds, ignoretimes, test, notest, help, force_replace,
   help_on_match, allow_unrelated_repos,
   match_one, match_range, match_several, fancy_move_add, sendmail_cmd,
-  logfile, rmlogfile, leave_test_dir, from_opt, set_default, pristine_tree
+  logfile, rmlogfile, leave_test_dir, from_opt, set_default, pristine_tree,
+  post_patch_added_cmd
 
       :: DarcsOption
 
@@ -1335,6 +1338,14 @@
 switch given \verb!SENDMAIL! will be used if present.
 
 \begin{code}
+post_patch_added_cmd = DarcsArgOption [] ["post-patch-added-cmd"] PostPatchAddedCmd "COMMAND" "specify command to be run after applying a patch when running darcs pull."
+maybe_post_patch_added_cmd :: [DarcsFlag] -> Maybe String
+maybe_post_patch_added_cmd (PostPatchAddedCmd s:_) = Just s
+maybe_post_patch_added_cmd (_:flags) = maybe_post_patch_added_cmd flags
+maybe_post_patch_added_cmd [] = Nothing
+\end{code}
+
+\begin{code}
 sendmail_cmd = DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command"
 
 -- |'get_sendmail_cmd' takes a list of flags and returns the sendmail command
diff -rN -u old-darcs/src/Darcs/Commands/Pull.lhs new-darcs/src/Darcs/Commands/Pull.lhs
--- old-darcs/src/Darcs/Commands/Pull.lhs       2008-11-08 00:36:36.000000000 +0000
+++ new-darcs/src/Darcs/Commands/Pull.lhs       2008-11-08 00:36:36.000000000 +0000
@@ -38,7 +38,8 @@
                          test, dry_run,
                          set_default, summary, working_repo_dir, remote_repo,
                          set_scripts_executable, nolinks,
-                         network_options, umask_option, allow_unrelated_repos
+                         network_options, umask_option, allow_unrelated_repos,
+                         post_patch_added_cmd, maybe_post_patch_added_cmd
                       )
 import Darcs.Repository ( Repository, SealedPatchSet, identifyRepositoryFor, withGutsOf,
                           amInRepository, withRepoLock, ($-), tentativelyMergePatches,
@@ -47,7 +48,7 @@
 import Darcs.Hopefully ( info )
 import Darcs.Patch ( RepoPatch, description )
 import Darcs.Ordered ( (:>)(..), (:\/:)(..), RL(..), unsafeUnRL, concatRL,
-                             mapFL, nullFL, reverseRL, mapRL )
+                             mapFL, nullFL, reverseRL, mapRL, FL(..))
 import Darcs.Patch.Permutations ( partitionFL )
 import Darcs.SlurpDirectory ( wait_a_moment )
 import Darcs.Repository.Prefs ( add_to_preflist, defaultrepo, set_defaultrepo, get_preflist )
@@ -58,6 +59,10 @@
 import Darcs.Utils ( clarify_errors, formatPath )
 import Darcs.Sealed ( Sealed(..), seal )
 import Printer ( putDocLn, vcat, ($$), text )
+import Darcs.Patch.Info(pi_author, pi_date, pi_name)
+import CommandLine (parseCmd)
+import Exec(exec,Redirect(..))
+import System.Time (calendarTimeToString)
 #include "impossible.h"
 \end{code}
 \begin{code}
@@ -96,7 +101,8 @@
                                                  ignoretimes,
                                                  remote_repo,
                                                  set_scripts_executable,
-                                                 umask_option] ++
+                                                 umask_option,
+                                                 post_patch_added_cmd] ++
                                                 network_options,
                      command_basic_options = [match_several,
                                               all_interactive,
@@ -115,6 +121,7 @@
   let (logMessage, _, logDocLn) = loggers opts
       putInfo = if (Quiet `elem` opts || XMLOutput `elem` opts) then \_ -> return () else logDocLn
       putVerbose = if Verbose `elem` opts then putDocLn else \_ -> return ()
+
   in withRepoLock opts $- \repository -> do
   here <- getCurrentDirectory
   repodirs <- (nub . filter (/= here)) `fmap` mapM (fixUrl opts) unfixedrepodirs
@@ -146,33 +153,52 @@
                            definePatches ps
                            exitWith ExitSuccess
      s <- slurp_recorded repository
-     with_selected_changes "pull" opts s ps $
-      \ (to_be_pulled:>_) -> do
-      print_dry_run_message_and_exit "pull" opts to_be_pulled
-      definePatches to_be_pulled
-      when (nullFL to_be_pulled) $ do
-          logMessage "You don't want to pull any patches, and that's fine with me!"
-          exitWith ExitSuccess
-      check_paths opts to_be_pulled
-      putVerbose $ text "Getting and merging the following patches:"
-      putVerbose $ vcat $ mapFL description to_be_pulled
-      let merge_opts | NoAllowConflicts `elem` opts = opts
-                     | AllowConflicts   `elem` opts = opts
-                     | otherwise                    = MarkConflicts : opts
-      Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
-                   (reverseRL $ head $ unsafeUnRL us') to_be_pulled
-      withGutsOf repository $ do finalizeRepositoryChanges repository
-                                 -- so work will be more recent than rec:
-                                 revertable $ do wait_a_moment
-                                                 applyToWorking repository opts pw
-      sync_repo repository
-      putInfo $ text "Finished pulling and applying."
-          where revertable x = x `clarify_errors` unlines
-                  ["Error applying patch to the working directory.","",
-                   "This may have left your working directory an inconsistent",
-                   "but recoverable state. If you had no un-recorded changes",
-                   "by using 'darcs revert' you should be able to make your",
-                   "working directory consistent again."]
+     let applyPatches _ (NilFL :> _) = do
+                  logMessage "You don't want to pull any patches, and that's fine with me!"
+                  exitWith ExitSuccess
+         applyPatches mbCmd (patches:>_) = do
+             doApply mbCmd patches
+             putInfo $ text "Finished pulling and applying."
+         -- doApply :: (Maybe String) -> FL (PatchInfoAnd p) -> IO ()
+         doApply Nothing = doApplyPatches
+         doApply (Just cmd) = -- for each patch:  apply patch, sync, run hook
+             sequence_ . mapFL (\p -> doApplyPatches (p :>: NilFL) >>  runHook cmd p )
+         runHook cmd p = do
+             let pi' = info p
+             case parseCmd [('m', pi_name pi'),('a', pi_author pi'), ('d', calendarTimeToString (pi_date pi'))] cmd of
+                Right ((prog:args), _) -> do 
+                    ec <- exec prog args (Null, AsIs, AsIs)
+                    case ec of
+                      ExitSuccess -> return ()
+                      ExitFailure es -> fail $ "post-patch-added-cmd command failed with exit status " ++ show es
+                Right _ -> fail "no prog found in post-patch-added-cmd"
+                Left pe -> fail $ "failed parsing post-patch-added-cmd command " ++ cmd ++ " error : " ++ show pe
+         -- doApplyPatches :: FL (PatchInfoAnd p) -> IO ()
+         doApplyPatches to_be_pulled = do
+           print_dry_run_message_and_exit "pull" opts to_be_pulled
+           definePatches to_be_pulled
+           check_paths opts to_be_pulled
+           putVerbose $ text "Getting and merging the following patches:"
+           putVerbose $ vcat $ mapFL description to_be_pulled
+           let merge_opts | NoAllowConflicts `elem` opts = opts
+                          | AllowConflicts   `elem` opts = opts
+                          | otherwise                    = MarkConflicts : opts
+           Sealed pw <- tentativelyMergePatches repository "pull" merge_opts
+                        (reverseRL $ head $ unsafeUnRL us') to_be_pulled
+           withGutsOf repository $ do finalizeRepositoryChanges repository
+                                      -- so work will be more recent than rec:
+                                      revertable $ do wait_a_moment
+                                                      print $ "flags withGutsOf: " ++ (show opts)
+                                                      applyToWorking repository opts pw
+           sync_repo repository
+                where revertable x = x `clarify_errors` unlines
+                        ["Error applying patch to the working directory.","",
+                         "This may have left your working directory an inconsistent",
+                         "but recoverable state. If you had no un-recorded changes",
+                         "by using 'darcs revert' you should be able to make your",
+                         "working directory consistent again."]
+     with_selected_changes "pull" opts s ps $ applyPatches (maybe_post_patch_added_cmd opts)
+
 pull_cmd _ [] = fail "No default repository to pull from, please specify one"
 \end{code}
 
diff -rN -u old-darcs/src/Darcs/Flags.lhs new-darcs/src/Darcs/Flags.lhs
--- old-darcs/src/Darcs/Flags.lhs       2008-11-08 00:36:36.000000000 +0000
+++ new-darcs/src/Darcs/Flags.lhs       2008-11-08 00:36:36.000000000 +0000
@@ -88,6 +88,7 @@
                | NoCache
                | AllowUnrelatedRepos
                | NullFlag
+               | PostPatchAddedCmd String
                  deriving ( Eq, Show )
 
 data Compression = NoCompression | GzipCompression




More information about the darcs-devel mailing list