diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/confsolve.cabal b/confsolve.cabal new file mode 100644 --- /dev/null +++ b/confsolve.cabal @@ -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 diff --git a/confsolve.hs b/confsolve.hs new file mode 100644 --- /dev/null +++ b/confsolve.hs @@ -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 ++ "\""