[darcs-devel] Exporting env vars to the posthook

Nathaniel Gray n8gray at caltech.edu
Wed Aug 2 18:14:40 PDT 2006


Hmm, darcs send didn't, so I guess I'll try again by hand.  Attached is 
my first whack at a patch for exporting environment variables to 
posthook commands.  It works, but I'm not sure you'll like it yet. 
Aside from some aesthetic objections, the only serious problem I see is 
that changing the method used to execute the posthook from 
System.Cmd.system to System.Process.runProcess will break any posthook 
command that counts on being processed by the shell.  For example, this 
doesn't work anymore in your defaults file:
	apply posthook cat foo > bar

I don't know how system works on Windows so I'm not exactly sure how to 
work around this.

Another (related) weakness is that we now must tokenize the posthook 
command into command + arguments instead of just letting system do it 
for us.  I'm just using words for that, which means it's impossible to 
pass the posthook a string with spaces in it.

Despite this, I would like to find a way to get at least some of this 
merged sooner rather than later.  In particular, the first patch touches 
every command, changing their types and making them return empty 
environments.  I'd like to avoid having to maintain this for too long. 
I could perhaps split the patch up so that it just drops the environment 
and continues to use system for now.

Anyhow, thanks for reviewing this, and let me know if you have any 
questions, but please CC me.

Thanks,
-n8

-- 
 >>>-- Nathaniel Gray -- Caltech Computer Science ------>
 >>>-- Mojave Project -- http://mojave.cs.caltech.edu -->

-------------- next part --------------

New patches:

[posthook-env: Empty environments
n8gray at caltech.edu**20060727064354
 
 Added support for passing environment variables to the posthook script.  Env
 vars are defined in DarcsCommands.lhs as part of the PostHookEnvironmentVariable
 data type.  
 
 Each command is meant to register its exported variables along with
 descriptive help strings in the command_posthook_env_vars field of the
 DarcsCommand record.  To pass some env vars, a command returns a list of
 (PostHookEnvironmentVariable, String) pairs, where the strings are the values.
 
 There is a runtime check to make sure all advertized env vars are supplied.
 
 At the moment the env vars are not listed in the help output or documentation, 
 but that should change.
] {
hunk ./Add.lhs 72
+                    command_posthook_env_vars = [],
hunk ./Add.lhs 100
-add_cmd :: [DarcsFlag] -> [String] -> IO ()
+add_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Add.lhs 121
+    return []
hunk ./AmendRecord.lhs 42
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./AmendRecord.lhs 91
+                            command_posthook_env_vars = [],
hunk ./AmendRecord.lhs 107
-amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
+amendrecord_cmd :: [DarcsFlag] -> [String]
+                    -> IO [(PostHookEnvironmentVariable,String)]
hunk ./AmendRecord.lhs 149
+    return []
hunk ./Annotate.lhs 25
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Annotate.lhs 82
+                         command_posthook_env_vars = [],
hunk ./Annotate.lhs 111
-annotate_cmd :: [DarcsFlag] -> [String] -> IO ()
+annotate_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Annotate.lhs 127
+  return []
hunk ./Annotate.lhs 183
+  return []
hunk ./Apply.lhs 28
-import DarcsCommands ( DarcsCommand(..) )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..) )
hunk ./Apply.lhs 101
+                      command_posthook_env_vars = [],
hunk ./Apply.lhs 120
-apply_cmd :: [DarcsFlag] -> [String] -> IO ()
+apply_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Changes.lhs 24
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Changes.lhs 75
+                        command_posthook_env_vars = [],
hunk ./Changes.lhs 91
-changes_cmd :: [DarcsFlag] -> [String] -> IO ()
-changes_cmd [Context ""] [] = do return ()
+changes_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
+changes_cmd [Context ""] [] = do return []
hunk ./Changes.lhs 96
+  return []
hunk ./Changes.lhs 116
+  return []
hunk ./Check.lhs 26
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Check.lhs 83
+                      command_posthook_env_vars = [],
hunk ./Check.lhs 96
-check_cmd :: [DarcsFlag] -> [String] -> IO ()
+check_cmd :: [DarcsFlag] -> [String] 
+             -> IO [(PostHookEnvironmentVariable,String)]
hunk ./DarcsCommands.lhs 21
+                                     command_posthook_env_vars,
hunk ./DarcsCommands.lhs 28
-                                     command_sub_commands ),
+                                     command_sub_commands),
+                       PostHookEnvironmentVariable( PatchCount ),
hunk ./DarcsCommands.lhs 48
+import IO ( hPutStr, stderr )
hunk ./DarcsCommands.lhs 146
+data PostHookEnvironmentVariable =
+    PatchCount
+    deriving ( Show, Ord, Eq )
hunk ./DarcsCommands.lhs 154
-                  command_command :: [DarcsFlag] -> [String] -> IO (),
+                  command_posthook_env_vars :: [(PostHookEnvironmentVariable,String)],
+                  command_command :: [DarcsFlag] -> [String] 
+                                  -> IO [(PostHookEnvironmentVariable,String)],
hunk ./DarcsCommands.lhs 327
-                    (command_command cmd) (FixFilePath fix_path : os) ex
+                    env <- (command_command cmd) (FixFilePath fix_path : os) ex
hunk ./DarcsCommands.lhs 329
-                       (\e -> case e of ExitException ExitSuccess -> return ()
+                       (\e -> case e of ExitException ExitSuccess -> return []
hunk ./DarcsCommands.lhs 331
-                    postHookExitCode <- run_posthook os here
+                    stringEnv <- validatePostHookEnv cmd env
+                    postHookExitCode <- run_posthook os here stringEnv
hunk ./DarcsCommands.lhs 336
+-- Verify that all advertized env. vars were returned and convert them to
+-- strings.
+validatePostHookEnv :: DarcsCommand -> [(PostHookEnvironmentVariable,String)] -> IO [(String,String)]
+validatePostHookEnv cmd env =
+    let expected = map fst (sort (command_posthook_env_vars cmd)) in
+    let got = sort (map fst env) in
+    do if expected == got 
+          then return ()
+          else hPutStr stderr $ "WARNING: The command "
+                       ++ (command_name cmd)
+                       ++ " claims to export environment variables:\n"
+                       ++ (concat (map (\x -> "\t" ++ (show x) ++ "\n") expected))
+                       ++ "\nBut only exported:\n"
+                       ++ (concat (map (\x -> "\t" ++ (show x) ++ "\n") got))
+                       ++ "\nThis is an internal error -- please report it!\n"
+       return $ map (\ (x,y) -> ((show x), y)) env
hunk ./DarcsCommands.lhs 408
-            (DarcsCommand _ _ _ _ _ _ _ _ _ _) -> 
+            (DarcsCommand _ _ _ _ _ _ _ _ _ _ _) -> 
hunk ./DiffCommand.lhs 27
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./DiffCommand.lhs 72
+                             command_posthook_env_vars = [],
hunk ./DiffCommand.lhs 170
-diff_cmd :: [DarcsFlag] -> [String] -> IO ()
+diff_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./DiffCommand.lhs 196
+    return []
hunk ./Dist.lhs 72
+                     command_posthook_env_vars = [],
hunk ./Dist.lhs 81
-dist_cmd :: [DarcsFlag] -> [String] -> IO ()
+dist_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Dist.lhs 102
+     return []
hunk ./Get.lhs 26
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Get.lhs 93
+                    command_posthook_env_vars = [],
hunk ./Get.lhs 109
-get_cmd :: [DarcsFlag] -> [String] -> IO ()
+get_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Get.lhs 190
+  return []
hunk ./Help.lhs 32
-import DarcsCommands ( CommandControl(Command_data), DarcsCommand(..), 
+import DarcsCommands ( PostHookEnvironmentVariable, CommandControl(Command_data), DarcsCommand(..), 
hunk ./Help.lhs 70
+                     command_posthook_env_vars = [],
hunk ./Help.lhs 79
-help_cmd :: [DarcsFlag] -> [String] -> IO ()
+help_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Init.lhs 22
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Init.lhs 60
+                         command_posthook_env_vars = [],
hunk ./Init.lhs 91
-initialize_cmd :: [DarcsFlag] -> [String] -> IO ()
+initialize_cmd :: [DarcsFlag] -> [String] 
+                    -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Init.lhs 103
+    return []
hunk ./Mv.lhs 22
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Mv.lhs 77
+                   command_posthook_env_vars = [],
hunk ./Mv.lhs 85
-mv_cmd :: [DarcsFlag] -> [String] -> IO ()
+mv_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Mv.lhs 102
+  return []
hunk ./Mv.lhs 112
+     return []
hunk ./Optimize.lhs 25
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Optimize.lhs 79
+                         command_posthook_env_vars = [],
hunk ./Optimize.lhs 95
-optimize_cmd :: [DarcsFlag] -> [String] -> IO ()
+optimize_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Optimize.lhs 107
+    return []
hunk ./Pull.lhs 26
-import DarcsCommands ( DarcsCommand(..), loggers )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), loggers )
hunk ./Pull.lhs 92
+                     command_posthook_env_vars = [],
hunk ./Pull.lhs 111
-pull_cmd :: [DarcsFlag] -> [String] -> IO ()
-
+pull_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Pull.lhs 185
+      return []
hunk ./Push.lhs 22
-import DarcsCommands ( DarcsCommand(..) )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..) )
hunk ./Push.lhs 67
+                     command_posthook_env_vars = [],
hunk ./Push.lhs 81
-push_cmd :: [DarcsFlag] -> [String] -> IO ()
+push_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Push.lhs 150
+ return []
hunk ./Put.lhs 8
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Put.lhs 51
+                    command_posthook_env_vars = [],
hunk ./Put.lhs 62
-put_cmd :: [DarcsFlag] -> [String] -> IO ()
+put_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Put.lhs 116
+  return []
hunk ./QueryManifest.lhs 23
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./QueryManifest.lhs 74
+  command_posthook_env_vars = [],
hunk ./QueryManifest.lhs 82
-manifest_cmd :: [DarcsFlag] -> [String] -> IO ()
+manifest_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./QueryManifest.lhs 87
+    return []
hunk ./Record.lhs 57
-import DarcsCommands ( DarcsCommand(..), nodefaults, loggers )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults, loggers )
hunk ./Record.lhs 89
+                       command_posthook_env_vars = [],
hunk ./Record.lhs 115
-record_cmd :: [DarcsFlag] -> [String] -> IO ()
+record_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Record.lhs 151
+    return []
hunk ./Remove.lhs 22
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Remove.lhs 65
+                       command_posthook_env_vars = [],
hunk ./Remove.lhs 75
-remove_cmd :: [DarcsFlag] -> [String] -> IO ()
+remove_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Remove.lhs 81
+    return []
hunk ./Repair.lhs 61
+                       command_posthook_env_vars = [],
hunk ./Repair.lhs 75
-repair_cmd :: [DarcsFlag] -> [String] -> IO ()
+repair_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Replace.lhs 115
+                        command_posthook_env_vars = [],
hunk ./Replace.lhs 126
-replace_cmd :: [DarcsFlag] -> [String] -> IO ()
+replace_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Replace.lhs 143
+  return []
hunk ./Resolve.lhs 23
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Resolve.lhs 59
+                        command_posthook_env_vars = [],
hunk ./Resolve.lhs 70
-resolve_cmd :: [DarcsFlag] -> [String] -> IO ()
+resolve_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Resolve.lhs 92
+  return []
hunk ./Revert.lhs 24
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Revert.lhs 70
+                       command_posthook_env_vars = [],
hunk ./Revert.lhs 84
-revert_cmd :: [DarcsFlag] -> [String] -> IO ()
+revert_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Revert.lhs 121
+  return []
hunk ./Rollback.lhs 21
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Rollback.lhs 65
+                         command_posthook_env_vars = [],
hunk ./Rollback.lhs 76
-rollback_cmd :: [DarcsFlag] -> [String] -> IO ()
+rollback_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Rollback.lhs 99
+  return []
hunk ./Send.lhs 24
-import DarcsCommands ( DarcsCommand(..) )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..) )
hunk ./Send.lhs 85
+                     command_posthook_env_vars = [],
hunk ./Send.lhs 103
-send_cmd :: [DarcsFlag] -> [String] -> IO ()
+send_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Send.lhs 117
+  return []
hunk ./SetPref.lhs 23
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./SetPref.lhs 88
+                        command_posthook_env_vars = [],
hunk ./SetPref.lhs 98
-setpref_cmd :: [DarcsFlag] -> [String] -> IO ()
+setpref_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./SetPref.lhs 115
+  return []
hunk ./Tag.lhs 59
+                    command_posthook_env_vars = [],
hunk ./Tag.lhs 71
-tag_cmd :: [DarcsFlag] -> [String] -> IO ()
+tag_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Tag.lhs 86
+       return []
hunk ./Test.lhs 20
+import System.Process( runProcess, waitForProcess )
+import System.Environment( getEnvironment )
hunk ./Test.lhs 107
-run_posthook :: [DarcsFlag] -> FilePath -> IO ExitCode
-run_posthook opts repodir
+run_posthook :: [DarcsFlag] -> FilePath -> [(String, String)] -> IO ExitCode
+run_posthook opts repodir env
hunk ./Test.lhs 110
-             | otherwise = withCurrentDirectory repodir $ get_posthook opts
+             | otherwise = withCurrentDirectory repodir $ get_posthook opts env
hunk ./Test.lhs 112
-get_posthook :: [DarcsFlag] -> IO ExitCode
-get_posthook opts =
+runWithEnv :: [(String, String)] -> String -> IO ExitCode
+runWithEnv env command =
+    let args = words command in
+    case args of
+        cmd:rest ->
+            do pHandle <- runProcess cmd rest Nothing (Just env) Nothing Nothing Nothing
+               exitCode <- waitForProcess pHandle
+               return exitCode
+        [] ->
+            fail $ "No posthook found in get_posthook!"
+
+get_posthook :: [DarcsFlag] -> [(String, String)] -> IO ExitCode
+get_posthook opts env =
hunk ./Test.lhs 133
-      case yorn of ('y':_) -> do ec <- system command
+      case yorn of ('y':_) -> do procEnv <- getEnvironment
+                                 ec <- runWithEnv (env ++ procEnv) command
hunk ./TrackDown.lhs 23
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./TrackDown.lhs 62
+                          command_posthook_env_vars = [],
hunk ./TrackDown.lhs 71
-trackdown_cmd :: [DarcsFlag] -> [String] -> IO ()
+trackdown_cmd :: [DarcsFlag] -> [String] 
+                    -> IO [(PostHookEnvironmentVariable,String)]
hunk ./TrackDown.lhs 90
+  return []
hunk ./Unrecord.lhs 24
-import DarcsCommands ( DarcsCommand(..), nodefaults, loggers )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults, loggers )
hunk ./Unrecord.lhs 135
+                         command_posthook_env_vars = [],
hunk ./Unrecord.lhs 147
-unrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
+unrecord_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Unrecord.lhs 181
+       return []
hunk ./Unrecord.lhs 275
+                       command_posthook_env_vars = [],
hunk ./Unrecord.lhs 286
-unpull_cmd :: [DarcsFlag] -> [String] -> IO ()
+unpull_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Unrecord.lhs 349
+                           command_posthook_env_vars = [],
hunk ./Unrecord.lhs 360
-obliterate_cmd :: [DarcsFlag] -> [String] -> IO ()
+obliterate_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Unrecord.lhs 365
-generic_unpull_cmd :: String -> [DarcsFlag] -> [String] -> IO ()
+generic_unpull_cmd :: String -> [DarcsFlag] -> [String] 
+                      -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Unrecord.lhs 400
+        return []
hunk ./Unrevert.lhs 23
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./Unrevert.lhs 79
+                         command_posthook_env_vars = [],
hunk ./Unrevert.lhs 90
-unrevert_cmd :: [DarcsFlag] -> [String] -> IO ()
+unrevert_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./Unrevert.lhs 116
+        return []
hunk ./WhatsNew.lhs 24
-import DarcsCommands ( DarcsCommand(..), nodefaults )
+import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..), nodefaults )
hunk ./WhatsNew.lhs 82
+                         command_posthook_env_vars = [],
hunk ./WhatsNew.lhs 97
-whatsnew_cmd :: [DarcsFlag] -> [String] -> IO ()
+whatsnew_cmd :: [DarcsFlag] -> [String] 
+                -> IO [(PostHookEnvironmentVariable,String)]
hunk ./WhatsNew.lhs 129
+               return []
hunk ./WhatsNew.lhs 163
+    return []
hunk ./darcs.lhs 686
-       command_command help [] []
+       do command_command help [] []
+          return ()
hunk ./darcs.lhs 689
-       command_command help [Verbose] [] 
+       do command_command help [Verbose] [] 
+          return ()
}

[Document env. vars in help output
n8gray at caltech.edu**20060803000014] {
hunk ./DarcsCommands.lhs 405
+    ++ posthook_env_vars
hunk ./DarcsCommands.lhs 422
+          posthook_env_vars =
+            let env = command_posthook_env_vars cmd in
+            if length env == 0 then
+                ""
+            else
+                "\nPosthook Environment Variables:\n" ++
+                concatMap (\(var, descr) -> "\t" ++ (show var) ++ "\t\t" ++
+                                            descr ++ "\n") env
}

[Apply exports PatchCount to posthook
n8gray at caltech.edu**20060803000255
 
 Hooray!  It works!  There are, however, semantic issues yet to be worked out.
 There should probably be some kind of naming policy for env vars (e.g. a
 common "Darcs" prefix) and other kinds of info, like total number of patch
 merges attempted, may be desired.  I'm inclined to let this be demand-driven
 rather than trying to anticipate what the likely possibilities are up-front.
 
 Also, should the posthook even be run if *no* patches were applied?
 
] {
hunk ./Apply.lhs 28
-import DarcsCommands ( PostHookEnvironmentVariable, DarcsCommand(..) )
+import DarcsCommands ( PostHookEnvironmentVariable( PatchCount ), DarcsCommand(..) )
hunk ./Apply.lhs 95
+posthook_vars :: [(PostHookEnvironmentVariable,String)]
+posthook_vars = [(PatchCount, "The number of patches that were successfully applied")]
hunk ./Apply.lhs 103
-                      command_posthook_env_vars = [],
+                      command_posthook_env_vars = posthook_vars,
hunk ./Apply.lhs 122
-apply_cmd :: [DarcsFlag] -> [String] -> IO [(PostHookEnvironmentVariable,String)]
-apply_cmd opts [patchesfile] = withRepoLock opts $ \repository -> do
+-- If apply_cmd_core doesn't return an env it means that there were no patches
+-- applied.  Cook up an appropriate env and return it.
+apply_cmd :: [DarcsFlag] -> [String] 
+             -> IO [(PostHookEnvironmentVariable,String)]
+apply_cmd opts patchesfilelist =
+  do env <- apply_cmd_core opts patchesfilelist
+        `Control.Exception.catch`
+           (\e -> case e of 
+                ExitException ExitSuccess ->
+                    return [(PatchCount, "0")]
+                _ -> throwIO e)
+     return env
+
+apply_cmd_core :: [DarcsFlag] -> [String] 
+             -> IO [(PostHookEnvironmentVariable,String)]
+apply_cmd_core opts [patchesfile] = withRepoLock opts $ \repository -> do
hunk ./Apply.lhs 210
-    exitWith ExitSuccess
+    return [(PatchCount, show $ length to_be_applied)]
hunk ./Apply.lhs 230
-apply_cmd _ _ = impossible
+apply_cmd_core _ _ = impossible
}

Context:

[Minor tweaks to list_authors.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060720180602] 
[add some changelog entries
Tommy Pettersson <ptp at lysator.liu.se>**20060718152611] 
[add some changelog entries
Tommy Pettersson <ptp at lysator.liu.se>**20060616150558] 
[Added elc and pyc to binaries.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060713184214] 
[Run ssh/scp/sftp quietly.
Eric Kow <eric.kow at gmail.com>**20060707025245
 
 This is useful for silencing Putty, and could also be for OpenSSH should
 we decide to stop redirecting to /dev/null.
 
] 
[Refactor calls to ssh/scp/sftp.
Eric Kow <eric.kow at gmail.com>**20060706202509
 
] 
[Added up links in web interface.
Peter Stuifzand <peter at stuifzand.com>**20060610082238
 Added a link to the 'projects' part of the cgi repository interface, so that
 you go back to the project list.
] 
[Merge makefile targets test_perl and test_shell into test_scripts.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060607223134
 This should keep parallel make from breaking.
] 
[bump version to 1.0.8pre1
Tommy Pettersson <ptp at lysator.liu.se>**20060522122655] 
[Add a test suite for calling external programs.
Eric Kow <eric.kow at gmail.com>**20060521045407
 
 For now this only includes a test for ssh (issue171).
 
] 
[Add warning to Eric's SSHControlMaster rework.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060528194136] 
[Only launch SSH control master on demand (fixes issue171)
Eric Kow <eric.kow at gmail.com>**20060528093000
 
 A secondary benefit is that this encapsulates the use of the control
 master functionality and consequently simplifies calling ssh.  There is
 no need to deal with the details of launching or exiting the control
 master.
 
] 
[Fail with a sensible message when there is no default repository to pull from.
lele at nautilus.homeip.net**20060515135042] 
[Extend test suite for patch matching.
Eric Kow <eric.kow at gmail.com>**20060513192501
 
] 
[Implement help --match (issue91).
Eric Kow <eric.kow at gmail.com>**20060513185610
 
 Also, refactor matching code in a way that encourages developers
 to document for help --match any new matchers they create.
 
] 
[Replace dateparser.sh with more general match.pl for testing --match.
Eric Kow <eric.kow at gmail.com>**20060513104942
 
] 
[Add tests for pristine error and quiet mode when removing a directory.
Eric Kow <eric.kow at gmail.com>**20060513100021] 
[Suppress non-empty dir warning if Quiet.
Eric Kow <eric.kow at gmail.com>**20060513053456] 
[Replace test rmdir.sh with rmdir.pl.
Eric Kow <eric.kow at gmail.com>**20060513043823] 
[Add forgotten file umask.h.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060423174844] 
[Add --umask to all commands that write to the current repository.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060407195655] 
[Add option --umask.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060407194552] 
[Actually switch umasks in withRepoLock.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060407194202] 
[Implement withUMask.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060407193312] 
[Add umask.c.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060407193255] 
[Propagate opts to withRepoLock.
Juliusz Chroboczek <jch at pps.jussieu.fr>**20060325190622] 
[Test pull.pl, CREATE_DIR_ERROR: removed TODO now that directory name is printed in error message
Marnix Klooster <marnix.klooster at gmail.com>**20060304164033
 Also removes a superfluous (and erroneous) chdir statement, which tried to
 change to non-existing directory templ (last character was ell instead of one).
 
 Also improves the description of this test.
] 
[TAG 1.0.7
Tommy Pettersson <ptp at lysator.liu.se>**20060513171438] 
Patch bundle hash:
b072df57e73e51c1c8ce85af8ca0df4319f2f381


More information about the darcs-devel mailing list