
Hi, I am trying to mimic mapM() at shell command line. I define the interface as "mapm cmd2 cmd1," so cmd2 will be run for each of the cmd1 results. "$_" can be used inside cmd2 to represent the current cmd1 result. For example, the command mapm 'cp -pr $_ destination_dir/$_' ls copies everything under the current directory to the destination directory. The code is as follows: -- module Main where import System.Environment ( getArgs ) import System.Exit import System.IO import System.Process import Text.Regex import Text.Regex.Posix main = do hs_argv <- getArgs if length hs_argv /= 2 then putStrLn "wrong arguments!" >> exitFailure else do let [cmd2, cmd1] = hs_argv (_, hOut, hErr, _) <- runInteractiveCommand cmd1 err <- hGetContents hErr hClose hErr if null err then do out <- hGetContents hOut mapM (f cmd2) (lines out) else putStr err >> exitFailure f :: String -> String -> IO ExitCode f cmd2 item = system cmd2' where cmd2' = if cmd2 =~ "\\$\\_"::Bool then subRegex (mkRegex "\\$\\_") cmd2 item else cmd2 -- It works, except one issue that is bothering me. If I issue mapm 'lt $_' ls, I get a bunch of /bin/sh: lt: command not found, while I expect it act the same as mapm 'ls -Alrt --color=auto $_' ls, because "lt" is aliased to "ls -Alrt --color=auto." Notice "/bin/sh" above. My shell is actually tcsh. All the aliases are in ~/.cshrc. I tried replacing "system cmd2'" with system ("source ~/.cshrc; " ++ cmd2') and system ("tcsh -c " ++ "'source ~/.cshrc; " ++ cmd2' ++ "'"), but they did not solve the problem. Can someone please help me? Thanks, Hong