confsolve (empty) → 0.2
raw patch · 4 files changed
+238/−0 lines, 4 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, hashmap, haskell98, process, regex-posix, time
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- confsolve.cabal +19/−0
- confsolve.hs +193/−0
+ LICENSE view
@@ -0,0 +1,24 @@+Copyright (c) 2011, Daniel Trstenjak+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * 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.+ * Neither the name of the <organization> nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "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 DANIEL TRSTENJAK 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ confsolve.cabal view
@@ -0,0 +1,19 @@+Name: confsolve+Version: 0.2+License: BSD3+License-file: LICENSE+Author: Daniel Trstenjak+Maintainer: daniel.trstenjak@gmail.com+Build-Type: Simple+Category: Utils+Cabal-Version: >=1.6+Synopsis: A command line tool for resolving conflicts of file synchronizers. Currently supported are Dropbox and Wuala.+Description: A command line tool for resolving conflicts of file synchronizers. Currently supported are Dropbox and Wuala.++source-repository head+ type: git+ location: https://github.com/dan-t/confsolve++Executable confsolve+ Main-is: confsolve.hs+ Build-Depends: base >= 3 && < 5, regex-posix >= 0.94 && < 0.95, time >= 1.2 && < 1.3, process >= 1.0 && < 1.1, filepath >= 1.2 && < 1.3, directory >= 1.1 && < 1.2, haskell98 >= 1.1 && < 1.2, hashmap >= 1.2.0.1 && < 1.3
+ confsolve.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE ScopedTypeVariables #-}++import System (getArgs)+import System.Directory+import System.IO+import System.IO.Error (IOErrorType)+import System.FilePath+import System.Environment+import System.Process+import System.Exit+import Data.List (isInfixOf, isSuffixOf, isPrefixOf, concat, foldr)+import Data.Char (intToDigit, digitToInt, isDigit, toUpper)+import Data.Foldable (foldrM, foldlM)+import qualified Data.HashSet as HS+import Control.Monad (mapM_)+import Foreign.Marshal.Error (void)+import qualified FileConflict as FC+import qualified Dropbox as DB+import qualified Wuala as WU+import Utils++main = do+ hSetBuffering stdout NoBuffering+ hSetBuffering stdin NoBuffering+ args <- getArgs+ case args of+ [] -> printHelp+ ("-h":[]) -> printHelp >> printRuntineHelp+ ("--help":[]) -> printHelp >> printRuntineHelp+ ("-d":dir:[]) -> void $ resolve DB.DropboxConflict dir HS.empty+ ("-w":dir:[]) -> void $ resolve WU.WualaConflict dir HS.empty+ otherwise -> error $ "Invalid Arguments!"++printHelp = do+ putStrLn $ ""+ putStrLn $ "Usage: confsolve OPTION DIRECTORY"+ putStrLn $ ""+ putStrLn $ "Options:"+ putStrLn $ " -d resolve Dropbox file conflicts"+ putStrLn $ " -w resolve Wuala file conflicts"+ putStrLn $ " -h print this help message"+ putStrLn $ ""++printRuntineHelp = do+ trashDir <- trashDirectory+ putStrLn $ ""+ putStrLn $ "Runtime Options:"+ putStrLn $ " (T)ake File (NUM) => By pressing 't' and a digit, the conflicting file with the"+ putStrLn $ " digit NUM is used as the new version. A copy of the"+ putStrLn $ " current file and the other conflicting files is put"+ putStrLn $ " into the trash directory '" ++ trashDir ++ "'."+ putStrLn $ ""+ putStrLn $ " (M)ove to Trash => By pressing 'm', all conflicting files are"+ putStrLn $ " moved into the trash directory '" ++ trashDir ++ "'."+ putStrLn $ ""+ putStrLn $ " Show (D)iff (NUM) => By pressing 'd' and a digit, the difference between the"+ putStrLn $ " current file and the conflicting file NUM is shown."+ putStrLn $ " If there's only one conflicting file, then only pressing"+ putStrLn $ " 'd' is sufficient."+ putStrLn $ " By pressing 'd' and two digits, the difference between"+ putStrLn $ " the two conflicting files is shown."+ putStrLn $ " The diff tool can be specified by the user by setting the environment"+ putStrLn $ " variable 'CONFSOLVE_DIFF'. The default diff tool is 'gvimdiff -f'."+ putStrLn $ ""+ putStrLn $ " (S)kip => By pressing 's', the current conflict is skipped"+ putStrLn $ " and the next one is shown."+ putStrLn $ ""+ putStrLn $ " (Q)uit => By pressing 'q', the application is quit."+ putStrLn $ ""+ putStrLn $ " (H)elp => By pressing 'h', this help is printed."+ putStrLn $ ""++type Resolved = HS.Set String++resolve :: (FC.FileConflict a) => a -> String -> Resolved -> IO Resolved+resolve fileConflict file resolved = do+ dirExists <- doesDirectoryExist file+ if dirExists+ then do+ entries <- getDirContents file+ foldrM (\e r -> resolve fileConflict (file </> e) r) resolved entries+ else do+ fileExists <- doesFileExist file+ let isntResolved = not $ file `HS.member` resolved+ if fileExists && isntResolved+ then do+ maybeConfInfo <- FC.find fileConflict file+ case maybeConfInfo of+ Nothing -> return resolved+ Just confInfo -> do+ handleConflict confInfo+ return $ foldr (\c r -> HS.insert (FC.filePath c) r) resolved (FC.conflicts confInfo)+ else return resolved+++handleConflict :: FC.ConflictInfo -> IO ()+handleConflict confInfo = do+ let origFP = FC.origFilePath confInfo+ exists <- doesFileExist origFP+ if not exists+ then putStrLn $ "Found conflicts for the file '" ++ origFP ++ "', but the file itself is missing! Skipping it."+ else do+ putConfInfo confInfo+ askUser confInfo+++putConfInfo :: FC.ConflictInfo -> IO ()+putConfInfo confInfo = do+ putStrLn $ "\nConflicting file: " ++ FC.origFilePath confInfo+ void $ foldlM (\i c -> putConf i c >> (return $ i+1)) 1 (FC.conflicts confInfo)+ where+ putConf idx conf =+ putStrLn $ " (" ++ [intToDigit idx] ++ ") " ++ FC.details conf+++askUser confInfo = do+ putStr "\n(T)ake File (NUM) | (M)ove to Trash | Show (D)iff (NUM [NUM]) | (S)kip | (Q)uit | (H)elp: " + line <- getLine+ let confs = FC.conflicts confInfo+ numConfs = length confs+ validD = validDigit 1 numConfs+ invalidTake = putStrLn $ "Invalid input! Use e.g: 't1'"+ invalidDiff = putStrLn $ "Invalid input! Use e.g: 'd1' or 'd12'"+ invalidInput = putStrLn $ "Invalid input! See Help"+ askAgain = askUser confInfo+ case map toUpper line of+ ('T':d:[]) | validD d -> takeFile (digitToInt d) confInfo+ | otherwise -> invalidTake >> askAgain++ ('M':[]) -> mapM_ (\c -> moveToTrash $ FC.filePath c) confs ++ ('D':[]) | numConfs == 1 -> do showDiff (FC.origFilePath confInfo) + (FC.filePath $ confs !! 0) + askAgain ++ | otherwise -> invalidInput >> askAgain++ ('D':d:[]) | validD d -> do let i = (digitToInt d) - 1 + showDiff (FC.origFilePath confInfo) + (FC.filePath $ confs !! i)+ askAgain++ | otherwise -> invalidDiff >> askAgain++ ('D':d1:d2:[]) | validD d1 && validD d2 -> do let i1 = (digitToInt d1) - 1+ i2 = (digitToInt d2) - 1+ showDiff (FC.filePath $ confs !! i1) + (FC.filePath $ confs !! i2)+ askAgain++ | otherwise -> invalidDiff >> askAgain++ ('S':[]) -> return ()+ ('Q':[]) -> exitSuccess+ ('H':[]) -> printRuntineHelp >> askAgain+ ('?':[]) -> printRuntineHelp >> askAgain+ otherwise -> invalidInput >> askAgain++ where+ validDigit min max d = isDigit d && let i = digitToInt d in i >= min && i <= max++ moveToTrash file =+ errorsToStderr $ do + trashDir <- trashDirectory+ createDirectoryIfMissing True trashDir+ let (dir, fileName) = splitFileName file+ copyFile file (trashDir </> fileName) + removeFile file++ takeFile num confInfo = do+ (year, month, day) <- getCurrentDate+ let idx = num - 1+ confs = FC.conflicts confInfo+ file = FC.filePath $ confs !! idx+ origFile = FC.origFilePath confInfo+ origBackup = FC.dir confInfo </> FC.fileName confInfo + ++ "_backup_" ++ show year ++ "-" ++ show month+ ++ "-" ++ show day ++ FC.suffix confInfo++ errorsToStderr $ do+ copyFile origFile origBackup+ moveToTrash origBackup+ copyFile file origFile+ mapM_ (\c -> moveToTrash (FC.filePath c)) confs++ showDiff file1 file2 = do+ putStrLn ""+ diff <- getEnvOrDefault "CONFSOLVE_DIFF" defaultDiff+ handle <- runCommand $ diff ++ " " ++ quote file1 ++ " " ++ quote file2+ waitForProcess handle+ return ()++ quote string = "\"" ++ string ++ "\""