diff --git a/HSH.cabal b/HSH.cabal --- a/HSH.cabal +++ b/HSH.cabal @@ -1,10 +1,10 @@ Name: HSH -Version: 1.2.4 +Version: 1.2.5 License: LGPL Maintainer: John Goerzen Author: John Goerzen Stability: Beta -Copyright: Copyright (c) 2006-2007 John Goerzen +Copyright: Copyright (c) 2006-2008 John Goerzen license-file: COPYRIGHT extra-source-files: COPYING homepage: http://software.complete.org/hsh @@ -16,13 +16,12 @@ Exposed-Modules: HSH, HSH.Command, HSH.ShellEquivs Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances -Build-Depends: base, unix, mtl, regex-compat, MissingH>=0.18.3, hslogger, filepath, regex-base, regex-posix -GHC-Options: -O2 +Build-Depends: base, unix, mtl, regex-compat, MissingH>=1.0.0, hslogger, filepath, regex-base, regex-posix, directory +GHC-Options: -O2 -threaded -Wall Category: System Executable: runtests -Buildable: False +Buildable: False Main-Is: runtests.hs -HS-Source-Dir: testsrc -Extensions: ExistentialQuantification, OverlappingInstances, - UndecidableInstances +HS-Source-Dirs: testsrc +Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances diff --git a/HSH/Command.hs b/HSH/Command.hs --- a/HSH/Command.hs +++ b/HSH/Command.hs @@ -1,14 +1,16 @@ +{-# OPTIONS_GHC -XFlexibleInstances -XTypeSynonymInstances #-} + {- Commands for HSH -Copyright (C) 2004-2007 John Goerzen +Copyright (C) 2004-2008 John Goerzen Please see the COPYRIGHT file -} {- | Module : HSH.Command - Copyright : Copyright (C) 2006-2007 John Goerzen + Copyright : Copyright (C) 2006-2008 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen + Maintainer : John Goerzen Stability : provisional Portability: portable @@ -27,9 +29,8 @@ catchEC, ) where -import System.Cmd.Utils hiding (pipeBoth) -import System.IO.HVIO -import System.IO.Utils +-- import System.IO.HVIO +-- import System.IO.Utils import System.IO import System.Exit import System.Posix.Types @@ -44,8 +45,9 @@ import System.Posix.Env import Text.Regex.Posix import Control.Monad(when) -import Data.String(rstrip) +import Data.String.Utils(rstrip) +d, dr :: String -> IO () d = debugM "HSH.Command" dr = debugM "HSH.Command.Run" @@ -54,7 +56,7 @@ {- | A shell command is something we can invoke, pipe to, pipe from, or pipe in both directions. All commands that can be run as shell -commands must define these methods. +commands must define these methods. Minimum implementation is 'fdInvoke'. -} @@ -71,7 +73,7 @@ show _ = "(String -> String)" instance Show (String -> IO String) where show _ = "(String -> IO String)" - + instance ShellCommand (String -> IO String) where fdInvoke func fstdin fstdout childclosefds childfunc = do -- d $ "SIOSF: Before fork" @@ -141,7 +143,7 @@ first String is the command to run, and the list of Strings represents the arguments to the program, if any. -} instance ShellCommand (String, [String]) where - fdInvoke pc@(cmd, args) fstdin fstdout childclosefds childfunc = + fdInvoke pc@(cmd, args) fstdin fstdout childclosefds childfunc = do d $ "S Before fork for " ++ show pc p <- try (forkProcess childstuff) pid <- case p of @@ -149,11 +151,11 @@ Left x -> fail $ "Error in fork: " ++ show x d $ "SP New pid " ++ show pid ++ " for " ++ show pc return $ seq pid pid - return [(show (cmd, args), + return [(show (cmd, args), getProcessStatus True False pid >>= (return . forceMaybe))] - - where + + where childstuff = do d $ "SC preparing to redir" d $ "SC input is on " ++ show fstdin d $ "SC output is on " ++ show fstdout @@ -167,14 +169,15 @@ {- | An instance of 'ShellCommand' for an external command. The String is split using words to the command to run, and the arguments, if any. -} instance ShellCommand String where - fdInvoke cmdline ifd ofd closefd forkfunc = + fdInvoke cmdline ifd ofd closefd forkfunc = do esh <- getEnv "SHELL" let sh = case esh of Nothing -> "/bin/sh" Just x -> x fdInvoke (sh, ["-c", cmdline]) ifd ofd closefd forkfunc -redir fromfd tofd +redir :: Fd -> Fd -> IO () +redir fromfd tofd | fromfd == tofd = do d $ "ignoring identical redir " ++ show fromfd return () | otherwise = do d $ "running dupTo " ++ show (fromfd, tofd) @@ -185,18 +188,18 @@ -> [Fd] -- ^ List of Fds to not touch, ever -> IO () closefds inpclosefds noclosefds = - do d $ "closefds " ++ show closefds ++ " " ++ show noclosefds - mapM_ closeit . filter (\x -> not (x `elem` noclosefds)) $ closefds + do d $ "closefds " ++ show uclosefds ++ " " ++ show noclosefds + mapM_ closeit . filter (\x -> not (x `elem` noclosefds)) $ uclosefds where closeit fd = do d $ "Closing fd " ++ show fd closeFd fd - closefds = uniq inpclosefds + uclosefds = uniq inpclosefds data (ShellCommand a, ShellCommand b) => PipeCommand a b = PipeCommand a b deriving Show {- | An instance of 'ShellCommand' represeting a pipeline. -} instance (ShellCommand a, ShellCommand b) => ShellCommand (PipeCommand a b) where - fdInvoke pc@(PipeCommand cmd1 cmd2) fstdin fstdout childclosefds forkfunc = + fdInvoke pc@(PipeCommand cmd1 cmd2) fstdin fstdout childclosefds forkfunc = do d $ "*** Handling pipe: " ++ show pc (reader, writer) <- createPipe let allfdstoclose = reader : writer : fstdin : fstdout : childclosefds @@ -205,25 +208,21 @@ res2 <- fdInvoke cmd2 reader fstdout allfdstoclose forkfunc d $ "pipe fdInvoke: Parent closing " ++ show [reader, writer] mapM_ closeFd [reader, writer] - + d $ "*** Done handling pipe " ++ show pc return $ res1 ++ res2 {- | Pipe the output of the first command into the input of the second. -} (-|-) :: (ShellCommand a, ShellCommand b) => a -> b -> PipeCommand a b -(-|-) = PipeCommand - -{- | Function to use when there is nothing for the parent to do -} -nullParentFunc :: IO () -nullParentFunc = return () +(-|-) = PipeCommand {- | Function to use when there is nothing for the child to do -} nullChildFunc :: IO () nullChildFunc = return () -{- | Different ways to get data from 'run'. +{- | Different ways to get data from 'run'. - * IO () runs, throws an exception on error, and sends stdout to stdout + * IO () runs, throws an exception on error, and sends stdout to stdout * IO String runs, throws an exception on error, reads stdout into a buffer, and returns it as a string. @@ -231,7 +230,7 @@ * IO [String] is same as IO String, but returns the results as lines * IO ProcessStatus runs and returns a ProcessStatus with the exit - information. stdout is sent to stdout. Exceptions are not thrown. + information. stdout is sent to stdout. Exceptions are not thrown. * IO (String, ProcessStatus) is like IO ProcessStatus, but also includes a description of the last command in the pipe to have @@ -240,7 +239,7 @@ * IO Int returns the exit code from a program directly. If a signal caused the command to be reaped, returns 128 + SIGNUM. - * IO Bool returns True if the program exited normally (exit code 0, + * IO Bool returns True if the program exited normally (exit code 0, not stopped by a signal) and False otherwise. -} @@ -267,7 +266,7 @@ Exited (ExitFailure x) -> return x Terminated x -> return (128 + (fromIntegral x)) Stopped x -> return (128 + (fromIntegral x)) - + instance RunResult (IO Bool) where run cmd = do rc <- run cmd return ((rc::Int) == 0) @@ -299,13 +298,13 @@ {- | Evaluates the result codes and returns an overall status -} processResults :: [InvokeResult] -> IO (String, ProcessStatus) -processResults r = +processResults r = do rc <- mapM procresult r case catMaybes rc of [] -> return (fst (last r), Exited (ExitSuccess)) x -> return (last x) where procresult :: InvokeResult -> IO (Maybe (String, ProcessStatus)) - procresult (cmd, action) = + procresult (cmd, action) = do rc <- action return $ case rc of Exited (ExitSuccess) -> Nothing @@ -316,13 +315,13 @@ checkResults (cmd, ps) = case ps of Exited (ExitSuccess) -> return () - Exited (ExitFailure x) -> + Exited (ExitFailure x) -> fail $ cmd ++ ": exited with code " ++ show x - Terminated sig -> + Terminated sig -> fail $ cmd ++ ": terminated by signal " ++ show sig Stopped sig -> fail $ cmd ++ ": stopped by signal " ++ show sig - + {- | Handle an exception derived from a program exiting abnormally -} tryEC :: IO a -> IO (Either ProcessStatus a) tryEC action = @@ -337,7 +336,7 @@ Right result -> return (Right result) where pat = ": exited with code [0-9]+$|: terminated by signal ([0-9]+)$|: stopped by signal [0-9]+" proc :: String -> ProcessStatus - proc e + proc e | e =~ "^: exited" = Exited (ExitFailure (str2ec e)) | e =~ "^: terminated by signal" = Terminated (str2ec e) | e =~ "^: stopped by signal" = Stopped (str2ec e) @@ -355,7 +354,7 @@ {- | A convenience function. Refers only to the version of 'run' that returns @IO ()@. This prevents you from having to cast to it -all the time when you do not care about the result of 'run'. +all the time when you do not care about the result of 'run'. The implementation is simply: @@ -368,7 +367,7 @@ {- | Another convenience function. This returns the first line of the output, with any trailing newlines or whitespace stripped off. No leading whitespace is stripped. This function will raise an exception if there is not at least -one line of output. Mnemonic: runSL means \"run single line\". +one line of output. Mnemonic: runSL means \"run single line\". This command exists separately from 'run' because there is already a 'run' instance that returns a String, though that instance returns the diff --git a/HSH/ShellEquivs.hs b/HSH/ShellEquivs.hs --- a/HSH/ShellEquivs.hs +++ b/HSH/ShellEquivs.hs @@ -1,18 +1,18 @@ {- Shell Equivalents -Copyright (C) 2004-2007 John Goerzen +Copyright (C) 2004-2008 John Goerzen Please see the COPYRIGHT file -} {- | Module : HSH.ShellEquivs - Copyright : Copyright (C) 2007 John Goerzen + Copyright : Copyright (C) 2008 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen + Maintainer : John Goerzen Stability : provisional Portability: portable -Copyright (c) 2006-2007 John Goerzen, jgoerzen\@complete.org +Copyright (c) 2006-2008 John Goerzen, jgoerzen\@complete.org This module provides shell-like commands. Most, but not all, are designed to be used directly as part of a HSH pipeline. All may be used outside @@ -25,10 +25,12 @@ appendTo, basename, bracketCD, - dirname, catFrom, catTo, cd, + cut, + cutR, + dirname, echo, exit, glob, @@ -36,40 +38,77 @@ grepV, egrep, egrepV, + joinLines, + lower, + upper, mkdir, + numberLines, pwd, readlink, readlinkabs, + rev, + revW, + space, + unspace, + tac, tee, + tr, + trd, + wcW, wcL, + uniq, ) where -import HSH.Command -import Data.List -import Text.Regex -import Control.Monad -import Control.Exception(evaluate) +import Data.List (genericLength, intersperse, isInfixOf, nub) +import Data.Char (toLower, toUpper) +import Text.Regex (matchRegex, mkRegex) +import Text.Printf (printf) +import Control.Monad (foldM) import System.Directory hiding (createDirectory) -import System.Posix.Files -import System.Posix.User -import System.Posix.Directory -import System.Posix.Types -import System.IO.Error -import System.Path +-- import System.FilePath (splitPath) +import System.Posix.Files (getFileStatus, isSymbolicLink, readSymbolicLink) +import System.Posix.User (getEffectiveUserName, getUserEntryForName, homeDirectory) +import System.Posix.Directory (createDirectory) +import System.Posix.Types (FileMode()) +import System.Path (absNormPath, bracketCWD) import System.Exit -import qualified System.Path.Glob as Glob +import qualified System.Path.Glob as Glob (glob) -{- | Load the specified files and display them, one at a time. +{- | Return the absolute path of the arg. Raises an error if the +computation is impossible. -} +abspath :: FilePath -> IO FilePath +abspath inp = + do p <- pwd + case absNormPath p inp of + Nothing -> fail $ "Cannot make " ++ show inp ++ " absolute within " ++ + show p + Just x -> return x -The special file @-@ means to display the input. +{- | The filename part of a path -} +basename :: FilePath -> FilePath +basename = snd . splitpath -If it is not given, no input is read. +{- | The directory part of a path -} +dirname :: FilePath -> FilePath +dirname = fst . splitpath +{- | Changes the current working directory to the given path, executes +the given I\/O action, then changes back to the original directory, +even if the I\/O action raised an exception. + +This is an alias for the MissingH function System.Path.bracketCWD. -} +bracketCD :: FilePath -> IO a -> IO a +bracketCD = bracketCWD + +{- | Load the specified files and display them, one at a time. + +The special file @-@ means to display the input. If it is not given, +no input is read. + Unlike the shell cat, @-@ may be given twice. However, if it is, you -will be forcing Haskell to buffer the input. +will be forcing Haskell to buffer the input. -Note: buffering behavior here is untested. --} +Note: buffering behavior here is untested. -} catFrom :: [FilePath] -> String -> IO String catFrom fplist inp = do r <- foldM foldfunc "" fplist @@ -80,7 +119,7 @@ fn -> do c <- readFile fn return (accum ++ c) -{- | Takes input, writes it to the specified file, and does not pass it on. +{- | Takes input, writes it to the specified file, and does not pass it on. See also 'tee'. -} catTo :: FilePath -> String -> IO String catTo fp inp = @@ -93,30 +132,42 @@ do appendFile fp inp return "" -{- | Takes a string and sends it on as standard output. +{- | An alias for System.Directory.setCurrentDirectory. -The input to this function is never read. -} -echo :: String -> String -> String -echo inp _ = inp +Want to change to a user\'s home directory? Try this: -{- | Takes input, writes it to all the specified files, and passes it on. +> glob "~jgoerzen" >>= cd . head -This function buffers the input. +See also 'bracketCD'. +-} +cd :: FilePath -> IO () +cd = setCurrentDirectory -See also 'catFrom'. -} -tee :: [FilePath] -> String -> IO String -tee [] inp = return inp -tee (x:xs) inp = do writeFile x inp - tee xs inp +{- | Split a list by a given character and select the nth list. -{- | Search for the string in the lines. Return those that match. -} -grep :: String -> [String] -> [String] -grep needle = filter (isInfixOf needle) +> cut ' ' 2 "foo bar baz quux" -> "bar" +-} +cut :: Integer -> Char -> String -> String +cut pos = cutR [pos] -{- | Search for the string in the lines. Return those that do NOT match. -} -grepV :: String -> [String] -> [String] -grepV needle = filter (not . isInfixOf needle) +{- | Split a list by a given character and select ranges of the resultant lists. +> cutR [2..4] ' ' "foo bar baz quux foobar" -> "baz quux foobar" +> cutR [1..1000] ' ' "foo bar baz quux foobar" -> "bar baz quux foobar" +> cutR [-1000..1000] ' ' "foo bar baz quux foobar" -> "foo bar baz quux foobar" + + Note that too large and too small indices are essentially ignored. +-} +cutR :: [Integer] -> Char -> String -> String +cutR nums delim z = drop 1 $ concat [delim:x | (x, y) <- zip string [0..], elem y nums] + where string = split delim z + +{- | Takes a string and sends it on as standard output. + +The input to this function is never read. -} +echo :: String -> String -> String +echo inp _ = inp + {- | Search for the regexp in the lines. Return those that match. -} egrep :: String -> [String] -> [String] egrep pat = filter (ismatch regex) @@ -133,40 +184,75 @@ Nothing -> False Just _ -> True -{- | Count number of lines. wc -l -} -wcL :: [String] -> [String] -wcL inp = [show $ genericLength inp] +{- | Exits with the specified error code. 0 indicates no error. -} +exit :: Int -> IO a +exit code + | code == 0 = exitWith ExitSuccess + | otherwise = exitWith (ExitFailure code) -{- | An alias for System.Directory.getCurrentDirectory -} -pwd :: IO FilePath -pwd = getCurrentDirectory +{- | Takes a pattern. Returns a list of names that match that pattern. +Handles: -{- | An alias for System.Directory.setCurrentDirectory. +>~username at beginning of file to expand to user's home dir +>? matches exactly one character +>* matches zero or more characters +>[list] matches any character in list +>[!list] matches any character not in list -Want to change to a user\'s home directory? Try this: +The result of a tilde expansion on a nonexistant username is to do no +tilde expansion. -> glob "~jgoerzen" >>= cd . head +The tilde with no username equates to the current user. -See also 'bracketCD'. +Non-tilde expansion is done by the MissingH module System.Path.Glob. -} +glob :: FilePath -> IO [FilePath] +glob inp@('~':remainder) = + catch expanduser (\_ -> Glob.glob inp) + where (username, rest) = span (/= '/') remainder + expanduser = + do lookupuser <- + if username /= "" + then return username + else getEffectiveUserName + ue <- getUserEntryForName lookupuser + Glob.glob (homeDirectory ue ++ rest) +glob x = Glob.glob x +{- | Search for the string in the lines. Return those that match. +Same as: + +> grep needle = filter (isInfixOf needle) -} -cd :: FilePath -> IO () -cd = setCurrentDirectory +grep :: String -> [String] -> [String] +grep = filter . isInfixOf -{- | Return the absolute path of the arg. Raises an error if the -computation is impossible. -} -abspath :: FilePath -> IO FilePath -abspath inp = - do p <- pwd - case absNormPath p inp of - Nothing -> fail $ "Cannot make " ++ show inp ++ " absolute within " ++ - show p - Just x -> return x +{- | Search for the string in the lines. Return those that do NOT match. -} +grepV :: String -> [String] -> [String] +grepV needle = filter (not . isInfixOf needle) +-- | Join lines of a file +joinLines :: [String] -> [String] +joinLines = return . concat + +{- | Creates the given directory. A value of 0o755 for mode would be typical. + +An alias for System.Posix.Directory.createDirectory. -} +mkdir :: FilePath -> FileMode -> IO () +mkdir = createDirectory + +{- | Number each line of a file -} +numberLines :: [String] -> [String] +numberLines = zipWith (printf "%3d %s") [(1::Int)..] + +{- | An alias for System.Directory.getCurrentDirectory. -} +pwd :: IO FilePath +pwd = getCurrentDirectory + {- | Return the destination that the given symlink points to. + An alias for System.Posix.Files.readSymbolicLink -} readlink :: FilePath -> IO FilePath -readlink fp = +readlink fp = do issym <- (getFileStatus fp >>= return . isSymbolicLink) if issym then readSymbolicLink fp @@ -174,9 +260,9 @@ {- | As 'readlink', but turns the result into an absolute path. -} readlinkabs :: FilePath -> IO FilePath -readlinkabs inp = - do do issym <- (getFileStatus inp >>= return . isSymbolicLink) - if issym +readlinkabs inp = + do issym <- (getFileStatus inp >>= return . isSymbolicLink) + if issym then do rl <- readlink inp case absNormPath (dirname inp) rl of Nothing -> fail $ "Cannot make " ++ show rl ++ " absolute within " ++ @@ -184,69 +270,86 @@ Just x -> return x else abspath inp -splitpath "" = (".", ".") -splitpath "/" = ("/", "/") -splitpath p - | last p == '/' = splitpath (init p) - | not ('/' `elem` p) = (".", p) - | head p == '/' && length (filter (== '/') p) == 1 = ("/", tail p) - | otherwise = (\(base, dir) -> (reverse (tail dir), reverse base)) - (break (== '/') (reverse p)) +{- | Reverse characters on each line (rev) -} +rev, revW :: [String] -> [String] +rev = map reverse -{- | The filename part of a path -} -basename :: FilePath -> FilePath -basename = snd . splitpath +{- | Reverse words on each line -} +revW = map (unwords . reverse . words) -{- | The directory part of a path -} -dirname :: FilePath -> FilePath -dirname = fst . splitpath +{- | Reverse lines in a String (like Unix tac). -{- | Exits with the specified error code. 0 indicates no error. -} -exit :: Int -> IO a -exit code - | code == 0 = exitWith ExitSuccess - | otherwise = exitWith (ExitFailure code) +Implemented as: -{- | Takes a pattern. Returns a list of names that match that pattern. -Handles: +> tac = reverse ->~username at beginning of file to expand to user's home dir ->? matches exactly one character ->* matches zero or more characters ->[list] matches any character in list ->[!list] matches any character not in list +See 'uniq'. -} +tac :: [String] -> [String] +tac = reverse -The result of a tilde expansion on a nonexistant username is to do no -tilde expansion. +{- | Takes input, writes it to all the specified files, and passes it on. +This function buffers the input. -The tilde with no username equates to the current user. +See also 'catFrom'. -} +tee :: [FilePath] -> String -> IO String +tee [] inp = return inp +tee (x:xs) inp = writeFile x inp >> tee xs inp -Non-tilde expansion is done by the MissingH module System.Path.Glob. --} -glob :: FilePath -> IO [FilePath] -glob inp@('~':remainder) = - catch expanduser (\_ -> Glob.glob inp) - where (username, rest) = span (/= '/') remainder - expanduser = - do lookupuser <- - if username /= "" - then return username - else getEffectiveUserName - ue <- getUserEntryForName lookupuser - Glob.glob (homeDirectory ue ++ rest) -glob x = Glob.glob x +{- | Translate a character x to y, like: -{- | Changes the current working directory to the given path, executes -the given I\/O action, then changes back to the original directory, -even if the I\/O action raised an exception. +>tr 'e' 'f' -This is an alias for the MissingH function System.Path.bracketCWD. --} -bracketCD :: FilePath -> IO a -> IO a -bracketCD = bracketCWD +Or, in sed, -{- | Creates the given directory. A value of 0o755 for mode would be typical. -An alias for System.Posix.Directory.createDirectory --} -mkdir :: FilePath -> FileMode -> IO () -mkdir = createDirectory +>y// + -} +tr :: Char -> Char -> String -> String +tr a b = map (\x -> if x == a then b else x) + +{- | Delete specified character in a string. -} +trd :: Char -> String -> String +trd = filter . (/=) + +{- | Remove duplicate lines from a file (like Unix uniq). + +Takes a String representing a file or output and plugs it through lines and then nub to uniqify on a line basis. -} +uniq :: String -> String +uniq = unlines . nub . lines + +{- | Double space a file -} +space, unspace :: [String] -> [String] +space = intersperse "" + +{- | Inverse of double space; drop empty lines -} +unspace = filter (not . null) + +{- | Convert a string to all upper or lower case -} +lower, upper :: String -> String +lower = map toLower +upper = map toUpper + +{- | Count number of lines. wc -l -} +wcL, wcW :: [String] -> [String] +wcL inp = [show (genericLength inp :: Integer)] + +{- | Count number of words in a file (like wc -w) -} +wcW inp = [show ((genericLength $ words $ unlines inp) :: Integer)] + +{- Utility function. +> split ' ' "foo bar baz" -> ["foo","bar","baz"] -} +split :: Char -> String -> [String] +split c s = case rest of + [] -> [chunk] + _:rst -> chunk : split c rst + where (chunk, rest) = break (==c) s + +-- TODO: Perhaps simplify to make use of split +splitpath :: String -> (String, String) +splitpath "" = (".", ".") +splitpath "/" = ("/", "/") +splitpath p + | last p == '/' = splitpath (init p) + | not ('/' `elem` p) = (".", p) + | head p == '/' && length (filter (== '/') p) == 1 = ("/", tail p) + | otherwise = (\(base, dir) -> (reverse (tail dir), reverse base)) + (break (== '/') (reverse p)) diff --git a/testsrc/runtests.hs b/testsrc/runtests.hs deleted file mode 100644 --- a/testsrc/runtests.hs +++ /dev/null @@ -1,13 +0,0 @@ -{- -Copyright (C) 2004-2007 John Goerzen -Please see the COPYRIGHT file --} - -module Main where - -import Test.HUnit -import Tests -import TestUtils - -main = runTestTT tests -