diffdump (empty) → 0.7.5
raw patch · 5 files changed
+494/−0 lines, 5 filesdep +ansi-terminaldep +basedep +bytestringsetup-changed
Dependencies added: ansi-terminal, base, bytestring, cmdargs, directory, filemanip, filepath, parallel-io, process, process-extras, unix
Files
- DiffDump.hs +370/−0
- LICENSE +30/−0
- PatchDump.hs +54/−0
- Setup.hs +7/−0
- diffdump.cabal +33/−0
+ DiffDump.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++import System.Console.CmdArgs+ ( cmdArgs+ , args -- remaining arguments+ , opt -- optional+ , (&=)+ , def+ , typ+ , typFile+ , typDir+ , argPos+ , summary+ , help+ , name+ , Data+ , Typeable+ )+import System.FilePath+ ( (</>)+ , takeDirectory+ , dropTrailingPathSeparator+ )+import System.FilePath.Find -- From the 'filemanip' package+ ( find+ , extension+ , (==?)+ , (&&?)+ , (||?)+ , FilterPredicate+ , filePath+ , fileName+ )+import System.Process.ByteString+ ( readProcessWithExitCode+ )+import System.Directory+ ( createDirectoryIfMissing+ , createDirectory+ , doesFileExist+ , doesDirectoryExist+ , removeDirectoryRecursive+ , getTemporaryDirectory+ , getCurrentDirectory+ , setCurrentDirectory+ )+import System.Exit+ ( ExitCode(ExitSuccess)+ , exitFailure+ )+import System.IO+ ( stderr+ , hPutStrLn+ )+import System.IO.Unsafe+ ( unsafePerformIO+ )+import GHC.Conc+ ( getNumProcessors+ )+import Data.List+ ( stripPrefix+ )+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import Control.Monad+ ( filterM+ , when+ , unless+ )+import Control.Concurrent.ParallelIO.Local+ ( parallel_+ , withPool+ , Pool+ )+import Control.Exception+ ( finally+ , bracket+ , throwIO+ )+import System.IO.Error+ ( isAlreadyExistsError+ )+import System.Posix.IO+ ( stdOutput+ )+import System.Posix.Terminal+ ( queryTerminal+ )+import System.Console.ANSI+ ( SGR(SetColor, Reset)+ , ConsoleLayer(Foreground)+ , ColorIntensity(Dull)+ , Color(Red, Cyan, Green)+ , setSGR+ )+import Paths_diffdump+ ( version+ )+import Data.Version+ ( showVersion+ )+import System.IO.Error+ ( catchIOError -- Use this instead of 'catch' to support GHC 7.6.1 and 7.4.x+ )++data DiffDump = DiffDump {+ outfile :: FilePath+ , outdir :: DirPath+ , olddir :: DirPath+ , newdir :: DirPath+ , func :: FilePath+ , arg_list :: [String]+ , cmd :: FilePath+ , arg :: [String]+ , cmd1 :: FilePath+ , arg1 :: [String]+ , cmd2 :: FilePath+ , arg2 :: [String]+ , filetype :: String+ , fileext :: String+ , diff :: FilePath+ , diff_arg :: [String]+ , force :: Bool+ , ignore :: [String]+ , recursive :: Bool+ , unified :: Bool+ , color :: Bool+ , no_color :: Bool+ , verbose :: Bool+ , keep_files :: Bool+ , succeed_on_diff :: Bool+} deriving (Show, Data, Typeable)++type DirPath = FilePath++diffDumpOpts :: DirPath -> DiffDump+diffDumpOpts defOutdir = DiffDump {+ -----------------------------------------------------------------------+ -- name default type description --+ -----------------------------------------------------------------------+ olddir = def &= argPos 0 &= typ "OLD_DIR" &= opt ("-" :: FilePath)+ , newdir = def &= argPos 1 &= typ "NEW_DIR" &= opt ("" :: FilePath)+ , func = def &= argPos 2 &= typFile &= opt ("" :: FilePath)+ , arg_list = def &= args &= typ "ARG"+ , outfile = def &= name "o" &= typFile &= help "Output path."+ , outdir = defOutdir &= typDir &= help "Directory for tempory files."+ , diff = "diff" &= typFile &= help "Path to diff."+ , cmd = def &= typFile &= help "Command to run on both arguments."+ , arg = def &= typ "ARG" &= help "Argument to pass to both commands."+ , cmd1 = def &= typFile &= help "Command to run on first argument. Overrides --cmd"+ , cmd2 = def &= typFile &= help "Command to run on second argument. Overrides --cmd"+ , arg1 = def &= typ "ARG" &= help "Argument appended to first command."+ , arg2 = def &= typ "ARG" &= help "Argument appended to second command."+ , filetype = def &= help "Filter by files that include this string in the output of the 'file' command."+ , fileext = def &= help "Filter by files that have this file extension."+ , ignore = def &= typDir &= help "Ignore contents of the given directory."+ , diff_arg = def &= help "Pass <arg> on to diff."+ , force = def &= name "f" &= help "Run despite the output directories already existing."+ , recursive = def &= name "r" &= help "Recursively compare any subdirectories found."+ , unified = def &= name "u" &= help "Output 3 lines of unified context."+ , color = def &= help "Force colorized diff in terminal output."+ , no_color = def &= help "Do not colorize diff in terminal output."+ , verbose = def &= help "Verbose output."+ , keep_files = def &= help "Keep intermediary files."+ , succeed_on_diff = def &= help "Unlike diff, return zero exit code when there are differences."+ } &= summary ("diffdump " ++ showVersion version)++data DumpCfg = DumpCfg {+ dumpPath :: FilePath+ , dumpArgs :: [String]+ } deriving (Show, Eq)++data DiffCfg = DiffCfg {+ diffPath :: FilePath+ , diffArgs :: [String]+ } deriving (Show, Eq)++main :: IO ()+main = do+ tmpDir <- getTemporaryDirectory+ defaultOutputDir <- createUniqueDirectory 0 (tmpDir </> ".diffdump")++ as <- cmdArgs (diffDumpOpts defaultOutputDir)++ n <- getNumProcessors+ when (verbose as) $ do+ hPutStrLn stderr $ "diffdump: Utilizing " ++ show n ++ " CPU(s)."++ finally (withPool n (parallelMain as)) $+ removeDirectoryRecursive defaultOutputDir++parallelMain :: DiffDump -> Pool -> IO ()+parallelMain as threadPool = do+ let oldRoot = dropTrailingPathSeparator (olddir as)+ let newRoot = if null (newdir as) then oldRoot else dropTrailingPathSeparator (newdir as)+ let outputDir = dropTrailingPathSeparator (outdir as)++ let firstCfg = mkDumpCfg (cmd1 as) (func as ++ cmd as) (arg_list as ++ arg as ++ arg1 as)+ let secondCfg = mkDumpCfg (cmd2 as) (func as ++ cmd as) (arg_list as ++ arg as ++ arg2 as)++ let recArgs = if recursive as then ["-r"] else []+ let uniArgs = if unified as then ["-u"] else []+ let diffCfg = DiffCfg (diff as) (recArgs ++ uniArgs ++ diff_arg as)++ let aDir = outputDir </> "a"+ let bDir = outputDir </> "b"++ createTempDirectory (force as) aDir+ createTempDirectory (force as) bDir++ oldRootIsDir <- doesDirectoryExist oldRoot+ newRootIsDir <- doesDirectoryExist newRoot+ + let diffdump = do+ if not oldRootIsDir || not newRootIsDir+ then do+ when (recursive as) $ do+ if not oldRootIsDir+ then hPutStrLn stderr $ "diffdump: error: " ++ oldRoot ++ " is not a directory"+ else hPutStrLn stderr $ "diffdump: error: " ++ newRoot ++ " is not a directory"+ exitFailure+ + dumpObjFiles aDir bDir (firstCfg, secondCfg) oldRoot newRoot+ else do+ when (verbose as) $ do+ hPutStrLn stderr $ "diffdump: Scanning for files..."++ oldPaths <- getRelPaths (recursive as) (filetype as) (fileext as) (ignore as) oldRoot+ commonPaths <- filterM (doesFileExist . (newRoot </>)) oldPaths+ + when (verbose as) $ do+ hPutStrLn stderr $ "diffdump: Found " ++ show (length commonPaths) ++ " file pairs to compare."+ hPutStrLn stderr $ "diffdump: Generating dump files... "+ + let dumpOps = map (dumpObj aDir bDir (firstCfg, secondCfg) oldRoot newRoot) commonPaths+ parallel_ threadPool dumpOps++ when (verbose as) $ do+ hPutStrLn stderr $ "diffdump: Comparing files... "++ runDiff diffCfg outputDir "a" "b"++ diffMaybe <- finally diffdump $+ unless (keep_files as) $ do+ removeDirectoryRecursive aDir+ removeDirectoryRecursive bDir++ case diffMaybe of+ Nothing -> return ()+ Just s -> do+ isatty <- queryTerminal stdOutput+ let isColor = not (no_color as) && (color as || isatty)+ writeDiff isColor (unified as) (outfile as) s++ when (verbose as) $ do+ hPutStrLn stderr $ "diffdump: Done."+ + unless (succeed_on_diff as) exitFailure++mkDumpCfg :: String -> String -> [String] -> DumpCfg+mkDumpCfg "" "" = DumpCfg "cat" -- Default command, plus custom options+mkDumpCfg "" x = DumpCfg x -- --cmd as command, plus custom options+mkDumpCfg x _ = DumpCfg x -- Override all defaults++createTempDirectory :: Bool -> DirPath -> IO ()+createTempDirectory frce p = do+ pExists <- doesDirectoryExist p+ when (pExists && not frce) $ do+ hPutStrLn stderr $ "error: the temporary directory '" ++ p ++ "' already exists. Use '-f' to proceed anyway."+ exitFailure+ createDirectoryIfMissing True p++writeDiff :: Bool -> Bool -> FilePath -> B.ByteString -> IO ()+writeDiff True isUni "" = putColorizedDiff isUni+writeDiff False _isUni "" = B.putStr+writeDiff _color _isUni p = B.writeFile p++putColorizedDiff :: Bool -> B.ByteString -> IO ()+putColorizedDiff isUni s = do+ mapM_ (putColorizedLine isUni) (B8.lines s)+ setSGR [Reset] -- cleanup++putColorizedLine :: Bool -> B.ByteString -> IO ()+putColorizedLine True x = setSGR [getUnifiedColor (safeHead ' ' x)] >> B8.putStrLn x+putColorizedLine False x = setSGR [ getColor (safeHead ' ' x)] >> B8.putStrLn x++safeHead :: Char -> B.ByteString -> Char+safeHead x xs+ | B.null xs = x+ | otherwise = B8.head xs++getColor :: Char -> SGR+getColor '>' = SetColor Foreground Dull Green+getColor '<' = SetColor Foreground Dull Red+getColor _ = Reset++getUnifiedColor :: Char -> SGR+getUnifiedColor '@' = SetColor Foreground Dull Cyan+getUnifiedColor '+' = SetColor Foreground Dull Green+getUnifiedColor '-' = SetColor Foreground Dull Red+getUnifiedColor _ = Reset++dumpObj :: DirPath -> DirPath -> (DumpCfg, DumpCfg) -> DirPath -> DirPath -> FilePath -> IO ()+dumpObj aDir bDir (cfg1, cfg2) oldRoot newRoot p = do+ runDump cfg1 (aDir</>p) (oldRoot</>p) ""+ runDump cfg2 (bDir</>p) (newRoot</>p) ""++dumpObjFiles :: DirPath -> DirPath -> (DumpCfg, DumpCfg) -> FilePath -> FilePath -> IO ()+dumpObjFiles aDir bDir (cfg1, cfg2) oldPath newPath = do+ input <- if oldPath == "-" || newPath == "-" then B.getContents else return ""+ runDump cfg1 (aDir</>"dump.txt") oldPath input+ runDump cfg2 (bDir</>"dump.txt") newPath input++runDiff :: DiffCfg -> DirPath -> FilePath -> FilePath -> IO (Maybe B.ByteString)+runDiff cfg outputDir p1 p2 = do+ bracket getCurrentDirectory setCurrentDirectory $ const $ do+ setCurrentDirectory outputDir+ (exitCode, s, err) <- readProcessWithExitCode (diffPath cfg) (diffArgs cfg ++ [p1, p2]) ""+ B.hPutStr stderr err+ return $ case exitCode of+ ExitSuccess -> Nothing+ _ -> Just s++createUniqueDirectory :: Int -> FilePath -> IO FilePath+createUniqueDirectory n p = do+ (createDirectory tmp >> return tmp)+ `catchIOError` (\e -> if isAlreadyExistsError e+ then createUniqueDirectory (succ n) p+ else throwIO e)+ where+ tmp = p ++ show n++runDump :: DumpCfg -> FilePath -> FilePath -> B.ByteString -> IO ()+runDump cfg outPath p input = do+ let as = dumpArgs cfg ++ (if p == "-" then [] else [p])+ s <- readProcess (dumpPath cfg) as input+ createDirectoryIfMissing True (takeDirectory outPath)+ B.writeFile outPath s++readProcess :: FilePath -> [String] -> B.ByteString -> IO B.ByteString+readProcess nm as input = do+ (exitCode, s, err) <- readProcessWithExitCode nm as input+ case exitCode of+ ExitSuccess -> return s+ _ -> do+ hPutStrLn stderr $ "diffdump: error executing: " ++ unwords (nm : as)+ B8.hPutStrLn stderr err+ exitFailure++getRelPaths :: Bool -> String -> String -> [String] -> DirPath -> IO [FilePath]+getRelPaths isRecursive fileTy fileExt ignoreDirs p = do+ ps <- find ((return isRecursive &&? isGoodDir) ||? filePath ==? p) ((return (null fileExt) ||? extension ==? fileExt) &&? expectedFileType fileTy) p+ return $ map (stripRoot p) ps+ where+ isGoodDir = do+ nm <- fileName+ return $ nm `notElem` ignoreDirs++expectedFileType :: String -> FilterPredicate+expectedFileType "" = return True+expectedFileType s = do+ p <- filePath+ return $ B8.pack s `B8.isInfixOf` unsafePerformIO (readProcess "file" ["--brief", p] "")++stripRoot :: DirPath -> FilePath -> FilePath+stripRoot pre p = maybe p id (stripPrefix (pre ++ "/") p)+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2012 Greg Fitzgerald++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ PatchDump.hs view
@@ -0,0 +1,54 @@+import System.Process+import System.Environment+import System.Directory+import System.IO+import Control.Exception++main :: IO ()+main = do+ withTempFile "patchdump" patch++patch :: FilePath -> Handle -> IO ()+patch tmpFile hdl = do+ cnts <- getContents+ hPutStr hdl cnts+ hClose hdl++ args <- getArgs+ _ <- readProcess "patch" (args ++ [tmpFile]) ""+ cnts' <- readFile tmpFile+ putStr cnts'++{- Borrowed from Real World Haskell -}++{- This function takes two parameters: a filename pattern and another+ function. It will create a temporary file, and pass the name and Handle+ of that file to the given function.++ The temporary file is created with openTempFile. The directory is the one+ indicated by getTemporaryDirectory, or, if the system has no notion of+ a temporary directory, "." is used. The given pattern is passed to+ openTempFile.++ After the given function terminates, even if it terminates due to an+ exception, the Handle is closed and the file is deleted. -}+withTempFile :: String -> (FilePath -> Handle -> IO a) -> IO a+withTempFile pattern func =+ do -- The library ref says that getTemporaryDirectory may raise on+ -- exception on systems that have no notion of a temporary directory.+ -- So, we run getTemporaryDirectory under catch. catch takes+ -- two functions: one to run, and a different one to run if the+ -- first raised an exception. If getTemporaryDirectory raised an+ -- exception, just use "." (the current working directory).+ tempdir <- getTemporaryDirectory `onException` return "."+ (tempfile, temph) <- openTempFile tempdir pattern ++ -- Call (func tempfile temph) to perform the action on the temporary+ -- file. finally takes two actions. The first is the action to run.+ -- The second is an action to run after the first, regardless of+ -- whether the first action raised an exception. This way, we ensure+ -- the temporary file is always deleted. The return value from finally+ -- is the first action's return value.+ finally (func tempfile temph) + (do hClose temph+ removeFile tempfile)
+ Setup.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ diffdump.cabal view
@@ -0,0 +1,33 @@+Name: diffdump+Synopsis: Tools for diffing stdout+Description: Command-line tools for diffing and patching stdout+Version: 0.7.5+License: BSD3+License-file: LICENSE+Build-type: Simple+Maintainer: Greg Fitzgerald <garious@gmail.com>+Category: System+Cabal-version: >= 1.6++source-repository head+ Type: git+ Location: https://github.com/garious/DiffDump++Executable diffdump+ Main-is: DiffDump.hs+ Build-depends: base >= 4 && < 5+ , filemanip >= 0.3.6.2+ , ansi-terminal >= 0.5.5+ , parallel-io >= 0.3.2+ , cmdargs >= 0.10+ , bytestring >= 0.10.0.0+ , process-extras >= 0.2.0+ , directory >= 1.2.0.0+ , filepath >= 1.3.0.1+ , unix >= 2.6.0.0+ Ghc-options: -Wall -threaded++Executable patchdump+ Main-is: PatchDump.hs+ Build-depends: base+ , process >= 1.1.0.2