diff --git a/confsolve.cabal b/confsolve.cabal --- a/confsolve.cabal +++ b/confsolve.cabal @@ -1,5 +1,5 @@ Name: confsolve -Version: 0.2 +Version: 0.3.1 License: BSD3 License-file: LICENSE Author: Daniel Trstenjak @@ -7,8 +7,8 @@ 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. +Synopsis: A command line tool for resolving conflicts of file synchronizers. +Description: A command line tool for resolving conflicts of file synchronizers. source-repository head type: git @@ -16,4 +16,4 @@ 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 + Build-Depends: base >= 3 && < 5, time >= 1.2 && < 1.3, process >= 1.0 && < 1.1, haskell98 >= 1.1 && < 1.2, unordered-containers >= 0.2.1.0 && < 0.3, text >= 0.11.2.0 && < 0.12, attoparsec >= 0.10.1.1 && < 0.11, system-filepath >= 0.4.6 && < 0.5, system-fileio >= 0.3.7 && < 0.4, cmdargs >= 0.9.5 && < 1.0 diff --git a/confsolve.hs b/confsolve.hs --- a/confsolve.hs +++ b/confsolve.hs @@ -1,48 +1,42 @@ -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} 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 qualified Data.HashMap.Strict as HM +import qualified Filesystem as FS +import qualified Data.Text as T +import qualified Filesystem.Path.CurrentOS as FP +import Filesystem.Path.CurrentOS (()) +import Control.Monad (mapM_, when) +import Control.Applicative ((<$>)) import Foreign.Marshal.Error (void) import qualified FileConflict as FC -import qualified Dropbox as DB -import qualified Wuala as WU +import qualified Dropbox.Conflict as DB +import qualified Wuala.Conflict as WU import Utils +import ConfsolveArgs + 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!" + args <- confsolveArgs + let dir = FP.fromText $ T.pack (directory args) + when (dropbox args) $ + resolveConflicts DB.Parser dir -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 $ "" + when (wuala args) $ + resolveConflicts WU.Parser dir + printRuntineHelp = do - trashDir <- trashDirectory + trashDir <- show <$> trashDirectory putStrLn $ "" putStrLn $ "Runtime Options:" putStrLn $ " (T)ake File (NUM) => By pressing 't' and a digit, the conflicting file with the" @@ -70,73 +64,85 @@ putStrLn $ " (H)elp => By pressing 'h', this help is printed." putStrLn $ "" -type Resolved = HS.Set String +type Conflicts = HM.HashMap T.Text [FC.ConflictingFile] -resolve :: (FC.FileConflict a) => a -> String -> Resolved -> IO Resolved -resolve fileConflict file resolved = do - dirExists <- doesDirectoryExist file - if dirExists + +resolveConflicts :: FC.ConflictParser parser => parser -> FP.FilePath -> IO () +resolveConflicts parser filePath = do + conflicts <- collectConflicts parser filePath HM.empty + mapM_ (handleConflict . conflict) (HM.toList conflicts) + where + conflict (path, files) = FC.Conflict (FP.fromText path) files + + +collectConflicts :: FC.ConflictParser parser => parser -> FP.FilePath -> Conflicts -> IO Conflicts +collectConflicts parser filePath conflicts = do + isDir <- FS.isDirectory filePath + if isDir then do - entries <- getDirContents file - foldrM (\e r -> resolve fileConflict (file e) r) resolved entries + entries <- FS.listDirectory filePath + foldrM (\entry conflicts -> collectConflicts parser entry conflicts) conflicts 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 + isFile <- FS.isFile filePath + if isFile + then do + let bname = toText $ FP.basename filePath + case FC.parseConflict parser bname of + Just (realBaseName, details) -> do + return $ HM.insertWith (++) + (toText $ replaceBaseName filePath (FP.fromText realBaseName)) + [FC.ConflictingFile details filePath] + conflicts + Nothing -> return conflicts -handleConflict :: FC.ConflictInfo -> IO () -handleConflict confInfo = do - let origFP = FC.origFilePath confInfo - exists <- doesFileExist origFP + else return conflicts + + +handleConflict :: FC.Conflict -> IO () +handleConflict conflict = do + let origFP = FC.origFilePath conflict + exists <- FS.isFile origFP if not exists - then putStrLn $ "Found conflicts for the file '" ++ origFP ++ "', but the file itself is missing! Skipping it." + then putStrLn $ "Found conflicts for the file '" ++ show origFP ++ "', but the file itself is missing! Skipping it." else do - putConfInfo confInfo - askUser confInfo + putConflict conflict + askUser conflict -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) +putConflict :: FC.Conflict -> IO () +putConflict conflict = do + putStrLn $ "\nConflicting file: " ++ (show $ FC.origFilePath conflict) + void $ foldlM (\i c -> putConf i c >> (return $ i+1)) 1 (FC.conflictingFiles conflict) where putConf idx conf = - putStrLn $ " (" ++ [intToDigit idx] ++ ") " ++ FC.details conf + putStrLn $ " (" ++ [intToDigit idx] ++ ") " ++ (show $ 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: " +askUser conflict = 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 + let confs = FC.conflictingFiles conflict 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 + askAgain = askUser conflict case map toUpper line of - ('T':d:[]) | validD d -> takeFile (digitToInt d) confInfo + ('T':d:[]) | validD d -> takeFile (digitToInt d) conflict | otherwise -> invalidTake >> askAgain - ('M':[]) -> mapM_ (\c -> moveToTrash $ FC.filePath c) confs + ('M':[]) -> mapM_ (\c -> moveToTrash $ FC.filePath c) confs - ('D':[]) | numConfs == 1 -> do showDiff (FC.origFilePath confInfo) - (FC.filePath $ confs !! 0) - askAgain + ('D':[]) | numConfs == 1 -> do showDiff (FC.origFilePath conflict) + (FC.filePath $ confs !! 0) + askAgain | otherwise -> invalidInput >> askAgain - ('D':d:[]) | validD d -> do let i = (digitToInt d) - 1 - showDiff (FC.origFilePath confInfo) + ('D':d:[]) | validD d -> do let i = (digitToInt d) - 1 + showDiff (FC.origFilePath conflict) (FC.filePath $ confs !! i) askAgain @@ -144,7 +150,7 @@ ('D':d1:d2:[]) | validD d1 && validD d2 -> do let i1 = (digitToInt d1) - 1 i2 = (digitToInt d2) - 1 - showDiff (FC.filePath $ confs !! i1) + showDiff (FC.filePath $ confs !! i1) (FC.filePath $ confs !! i2) askAgain @@ -159,34 +165,34 @@ where validDigit min max d = isDigit d && let i = digitToInt d in i >= min && i <= max - moveToTrash file = - errorsToStderr $ do + moveToTrash filePath = + errorsToStderr $ do trashDir <- trashDirectory - createDirectoryIfMissing True trashDir - let (dir, fileName) = splitFileName file - copyFile file (trashDir fileName) - removeFile file + FS.createTree trashDir + let fileName = FP.filename filePath + FS.copyFile filePath (trashDir fileName) + FS.removeFile filePath - takeFile num confInfo = do + takeFile num conflict = 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 + let idx = num - 1 + confs = FC.conflictingFiles conflict + file = FC.filePath $ confs !! idx + origFile = FC.origFilePath conflict + backupSpec = T.pack $ "_backup_" ++ show year ++ "-" ++ show month ++ "-" ++ show day + backupBaseName = (toText $ FP.basename origFile) `T.append` backupSpec + backupFile = replaceBaseName origFile (FP.fromText backupBaseName) errorsToStderr $ do - copyFile origFile origBackup - moveToTrash origBackup - copyFile file origFile + FS.copyFile origFile backupFile + moveToTrash backupFile + FS.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 + handle <- runCommand $ diff ++ " " ++ (quote $ toString file1) ++ " " ++ (quote $ toString file2) waitForProcess handle return ()