confsolve 0.5.1 → 0.5.2
raw patch · 7 files changed
+236/−215 lines, 7 files
Files
- ConfsolveArgs.hs +14/−4
- Dropbox/Conflict.hs +7/−11
- FileConflict.hs +2/−2
- Main.hs +201/−0
- Wuala/Conflict.hs +7/−11
- confsolve.cabal +5/−3
- confsolve.hs +0/−184
ConfsolveArgs.hs view
@@ -1,8 +1,13 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, CPP #-} module ConfsolveArgs where import System.Console.CmdArgs +#ifdef CABAL+import Data.Version (showVersion)+import Paths_confsolve (version)+#endif+ data Confsolve = Confsolve { dropbox :: Bool, wuala :: Bool,@@ -14,13 +19,18 @@ wuala = def &= help "Resolve Wuala file conflicts", directory = def &= args &= typ "DIRECTORY" }- &= summary summaryInfo+ &= summary "" &= help "A command line tool for resolving conflicts of file synchronizers." &= helpArg [explicit, name "help", name "h"] &= versionArg [explicit, name "version", name "v", summary versionInfo ] -versionInfo = "confsolve version 0.4.1"-summaryInfo = ""+versionInfo :: String+versionInfo =+#ifdef CABAL+ "confsolve version " ++ showVersion version+#else+ "confsolve version unknown (not built with cabal)"+#endif confsolveArgs :: IO Confsolve confsolveArgs = cmdArgs confsolve
Dropbox/Conflict.hs view
@@ -3,16 +3,12 @@ module Dropbox.Conflict where import FileConflict import qualified Dropbox.FileNameParser as P-import qualified Data.Text as T--data Parser = Parser--(<++>) = T.append+import Data.Monoid ((<>)) -instance ConflictParser Parser where- parseConflict _ baseName =- case P.parse baseName of- Just (P.FileInfo realBaseName host date) ->- Just (realBaseName, "Version " <++> date <++> " from " <++> host)+parse :: ConflictParser+parse baseName =+ case P.parse baseName of+ Just (P.FileInfo realBaseName host date) ->+ Just (realBaseName, "Version " <> date <> " from " <> host) - Nothing -> Nothing+ Nothing -> Nothing
FileConflict.hs view
@@ -14,8 +14,8 @@ -- conflicting file details displayed to the user type Details = T.Text -class ConflictParser a where- parseConflict :: a -> BaseName -> Maybe (RealBaseName, Details)+-- the conflict file parser+type ConflictParser = BaseName -> Maybe (RealBaseName, Details) -- the details and filePath of a conflicting file data ConflictingFile = ConflictingFile {
+ Main.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}++import System.IO+import System.IO.Error (IOErrorType)+import System.Environment+import System.Process+import System.Exit+import Data.Foldable (foldrM, foldlM)+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, void)+import Control.Applicative ((<$>))+import qualified FileConflict as FC+import qualified Dropbox.Conflict as DB+import qualified Wuala.Conflict as WU+import Utils+import ConfsolveArgs+import ParseInput+++main :: IO ()+main = do+ hSetBuffering stdout NoBuffering+ hSetBuffering stdin NoBuffering+ args <- confsolveArgs+ let dir = FP.fromText $ T.pack (directory args)+ when (dropbox args) $+ resolveConflicts DB.parse dir++ when (wuala args) $+ resolveConflicts WU.parse dir+++printRuntineHelp :: IO ()+printRuntineHelp = do+ trashDir <- show <$> trashDirectory+ putStrLn $ ""+ putStrLn $ "Runtime Options:"+ putStrLn $ " (T)ake File (NUM) => By pressing 't' and a number (e.g 't1'), the conflicting file with the"+ putStrLn $ " number 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 number (e.g 'd1'), 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 numbers (e.g 'd1 2'), 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 Conflicts = HM.HashMap T.Text [FC.ConflictingFile]+++resolveConflicts :: FC.ConflictParser -> FP.FilePath -> IO ()+resolveConflicts parse filePath = do+ conflicts <- collectConflicts parse filePath HM.empty+ mapM_ (handleConflict . conflict) (HM.toList conflicts)+ where+ conflict (path, files) = FC.Conflict (FP.fromText path) files+++collectConflicts :: FC.ConflictParser -> FP.FilePath -> Conflicts -> IO Conflicts+collectConflicts parse filePath conflicts = do+ isDir <- FS.isDirectory filePath+ if isDir+ then do+ entries <- FS.listDirectory filePath+ foldrM (\entry conflicts -> collectConflicts parse entry conflicts) conflicts entries+ else do+ isFile <- FS.isFile filePath+ if isFile+ then do+ let bname = toText $ FP.basename filePath+ case parse bname of+ Just (realBaseName, details) -> do+ return $ HM.insertWith (++)+ (toText $ replaceBaseName filePath (FP.fromText realBaseName))+ [FC.ConflictingFile details filePath]+ conflicts++ Nothing -> return conflicts++ 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 '" ++ show origFP ++ "', but the file itself is missing! Skipping it."+ else do+ putConflict conflict+ askUserTillHandled conflict+ where+ askUserTillHandled confict = do+ reply <- askUser confict+ askAgain <- maybe (putStrLn "Invalid input! See Help" >> return True)+ (handleUserReply confict)+ reply+ when askAgain $ do+ putConflict confict+ askUserTillHandled confict+++type AskAgain = Bool+handleUserReply :: FC.Conflict -> UserReply -> IO AskAgain+handleUserReply conflict reply =+ case reply of+ TakeFile num -> do+ takeFile num conflict+ dontAskAgain++ MoveToTrash -> do+ mapM_ (\c -> moveToTrash $ FC.filePath c) confs+ dontAskAgain++ ShowDiff -> do+ showDiff (FC.origFilePath conflict) (FC.filePath $ confs !! 0)+ askAgain++ ShowDiffWith num -> do+ showDiff (FC.origFilePath conflict) (FC.filePath $ confs !! (num - 1))+ askAgain++ ShowDiffBetween num1 num2 -> do+ showDiff (FC.filePath $ confs !! (num1 - 1)) (FC.filePath $ confs !! (num2 - 1))+ askAgain++ Skip -> dontAskAgain+ Quit -> exitSuccess+ Help -> printRuntineHelp >> askAgain+ where+ confs = FC.conflictingFiles conflict+ askAgain = return True+ dontAskAgain = return False++ moveToTrash filePath =+ errorsToStderr $ do+ trashDir <- trashDirectory+ FS.createTree trashDir+ let fileName = FP.filename filePath+ FS.copyFile filePath (trashDir </> fileName)+ FS.removeFile filePath++ takeFile num conflict = do+ (year, month, day) <- getCurrentDate+ 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+ 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 $ toString file1) ++ " " ++ (quote $ toString file2)+ waitForProcess handle+ return ()++ quote string = "\"" ++ string ++ "\""+++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 fileNum conf =+ putStrLn $ " (" ++ show fileNum ++ ") " ++ (show $ FC.details conf)+++askUser :: FC.Conflict -> IO (Maybe UserReply)+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+ return $ parseInput line (length . FC.conflictingFiles $ conflict)
Wuala/Conflict.hs view
@@ -3,16 +3,12 @@ module Wuala.Conflict where import FileConflict import qualified Wuala.FileNameParser as P-import qualified Data.Text as T--data Parser = Parser--(<++>) = T.append+import Data.Monoid ((<>)) -instance ConflictParser Parser where- parseConflict _ baseName =- case P.parse baseName of- Just (P.FileInfo realBaseName version host) ->- Just (realBaseName, "Version " <++> version <++> " from " <++> host)+parse :: ConflictParser+parse baseName =+ case P.parse baseName of+ Just (P.FileInfo realBaseName version host) ->+ Just (realBaseName, "Version " <> version <> " from " <> host) - Nothing -> Nothing+ Nothing -> Nothing
confsolve.cabal view
@@ -1,5 +1,5 @@ name: confsolve-version: 0.5.1+version: 0.5.2 cabal-version: >=1.6 build-type: Simple license: BSD3@@ -11,7 +11,7 @@ running Dropbox or Wuala. category: Utils author: Daniel Trstenjak-tested-with: GHC ==7.6.2+tested-with: GHC ==7.6.2, GHC ==7.6.3 source-repository head type: git@@ -28,9 +28,11 @@ system-filepath >=0.4.8 && <0.5, system-fileio >=0.3.13 && <0.4, cmdargs >=0.10.7 && <0.11- main-is: confsolve.hs+ main-is: Main.hs buildable: True+ cpp-options: -DCABAL other-modules:+ Paths_confsolve FileConflict ParseInput Dropbox.Conflict
− confsolve.hs
@@ -1,184 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}--import System.IO-import System.IO.Error (IOErrorType)-import System.Environment-import System.Process-import System.Exit-import Data.Foldable (foldrM, foldlM)-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, void)-import Control.Applicative ((<$>))-import qualified FileConflict as FC-import qualified Dropbox.Conflict as DB-import qualified Wuala.Conflict as WU-import Utils-import ConfsolveArgs-import ParseInput---main = do- hSetBuffering stdout NoBuffering- hSetBuffering stdin NoBuffering- args <- confsolveArgs- let dir = FP.fromText $ T.pack (directory args)- when (dropbox args) $- resolveConflicts DB.Parser dir-- when (wuala args) $- resolveConflicts WU.Parser dir---printRuntineHelp = do- trashDir <- show <$> trashDirectory- putStrLn $ ""- putStrLn $ "Runtime Options:"- putStrLn $ " (T)ake File (NUM) => By pressing 't' and a number (e.g 't1'), the conflicting file with the"- putStrLn $ " number 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 number (e.g 'd1'), 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 numbers (e.g 'd1 2'), 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 Conflicts = HM.HashMap T.Text [FC.ConflictingFile]---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 <- FS.listDirectory filePath- foldrM (\entry conflicts -> collectConflicts parser entry conflicts) conflicts entries- else do- 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-- 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 '" ++ show origFP ++ "', but the file itself is missing! Skipping it."- else do- putConflict conflict- askUser conflict---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 fileNum conf =- putStrLn $ " (" ++ show fileNum ++ ") " ++ (show $ FC.details conf)---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.conflictingFiles conflict- numConfs = length confs- askAgain = putConflict conflict >> askUser conflict-- case parseInput line numConfs of- Just (TakeFile num) ->- takeFile num conflict-- Just MoveToTrash ->- mapM_ (\c -> moveToTrash $ FC.filePath c) confs-- Just ShowDiff -> do- showDiff (FC.origFilePath conflict) (FC.filePath $ confs !! 0)- askAgain-- Just (ShowDiffWith num) -> do - showDiff (FC.origFilePath conflict) (FC.filePath $ confs !! (num - 1))- askAgain-- Just (ShowDiffBetween num1 num2) -> do- showDiff (FC.filePath $ confs !! (num1 - 1)) (FC.filePath $ confs !! (num2 - 1))- askAgain-- Just Skip -> return ()- Just Quit -> exitSuccess- Just Help -> printRuntineHelp >> askAgain-- _ -> putStrLn $ "Invalid input! See Help"-- where- moveToTrash filePath =- errorsToStderr $ do- trashDir <- trashDirectory- FS.createTree trashDir- let fileName = FP.filename filePath- FS.copyFile filePath (trashDir </> fileName)- FS.removeFile filePath-- takeFile num conflict = do- (year, month, day) <- getCurrentDate- 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- 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 $ toString file1) ++ " " ++ (quote $ toString file2)- waitForProcess handle- return ()-- quote string = "\"" ++ string ++ "\""