dropsolve (empty) → 0.1
raw patch · 4 files changed
+227/−0 lines, 4 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, haskell98, process, regex-posix, time
Files
- LICENSE +24/−0
- Setup.hs +2/−0
- dropsolve.cabal +19/−0
- dropsolve.hs +182/−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
+ dropsolve.cabal view
@@ -0,0 +1,19 @@+Name: dropsolve+Version: 0.1+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 dropbox conflicts.+Description: A command line tool for resolving dropbox conflicts.++source-repository head+ type: git+ location: https://github.com/dan-t/dropsolve++Executable dropsolve+ Main-is: dropsolve.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
+ dropsolve.hs view
@@ -0,0 +1,182 @@+{-# 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.Time.Clock+import Data.Time.Calendar+import Data.List (isInfixOf, isSuffixOf, concat)+import Data.Char (intToDigit, digitToInt, isDigit, toUpper)+import Text.Regex.Posix ((=~))+import Control.Monad (when, mapM_, filterM)+import Control.Exception.Base (try)++main = do+ hSetBuffering stdout NoBuffering+ hSetBuffering stdin NoBuffering+ args <- getArgs+ case args of+ [] -> printUsage >> printHelp+ ("-h":[]) -> printUsage >> printHelp+ ("--help":[]) -> printUsage >> printHelp+ (dropDir:[]) -> resolve dropDir+ otherwise -> error $ "Invalid Arguments\n" ++ usage++printUsage = putStrLn usage+usage = "\nUsage: dropsolve DROPBOXDIR"++printHelp = do+ trashDir <- trashDirectory+ putStrLn $ ""+ putStrLn $ "Runtime options:"+ putStrLn $ " Take File (NUM) => By pressing 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 $ " Move to (T)rash => By pressing 'T' or 't', all conflicting files are"+ putStrLn $ " moved into the trash directory (" ++ trashDir ++ ")."+ putStrLn $ ""+ putStrLn $ " Show (D)iff => By pressing 'D' or 'd', the difference between the first"+ putStrLn $ " and the second conflicting file is shown. The diff tool"+ putStrLn $ " can be specified by the user by setting the environment"+ putStrLn $ " variable 'DROPSOLVE_DIFF'. The default diff tool is 'gvimdiff -f'."+ putStrLn $ ""+ putStrLn $ " (S)kip => By pressing 'S' or 's', the current conflict is skipped"+ putStrLn $ " and the next one is shown."+ putStrLn $ ""+ putStrLn $ " (Q)uit => By pressing 'Q' or 'q', the application is quit."+ putStrLn $ ""+ putStrLn $ " (H)elp => By pressing 'H' or 'h', this help is printed."+ putStrLn $ ""++resolve file = do+ dirExists <- doesDirectoryExist file+ if dirExists+ then do+ entries <- getDirContents file+ mapM_ (\e -> resolve $ file </> e) entries+ else do+ fileExists <- doesFileExist file+ when (fileExists && hasConflict file) $+ handleConflict file++hasConflict file = "conflicted copy" `isInfixOf` file++handleConflict file = do+ exist <- doesFileExist file+ when exist $ do+ let confInfo = conflictInfo file+ confFiles <- findConflicting confInfo+ resolveConflict confInfo confFiles ++ where+ findConflicting confInfo = do+ let d = dir confInfo+ fn = fileName confInfo+ entries <- getDirContents d+ let confs = filter (isConfFile fn) entries+ mapM (\e -> return $ d </> e) confs+ where+ isConfFile file = \e -> file `isInfixOf` e && hasConflict e++ resolveConflict confInfo confFiles+ | length confFiles == 0 = return ()+ | otherwise = do+ let origFile = dir confInfo </> fileName confInfo+ putStrLn $ "\nConflicting file: " ++ origFile+ putConfFiles confFiles 1+ askUser confInfo confFiles++ putConfFiles (c:cs) num = do+ let confInfo = conflictInfo c+ h = host confInfo+ d = date confInfo+ digit = intToDigit num+ putStrLn $ " (" ++ [digit] ++ ") " ++ h ++ " from " ++ d+ putConfFiles cs (num + 1)+ putConfFiles [] _ = return ()++ askUser confInfo confFiles = do+ putStr "\nTake File (NUM) | Move to (T)rash | Show (D)iff | (S)kip | (Q)uit | (H)elp : " + char <- getChar+ let numConfs = length confFiles+ askAgain = askUser confInfo confFiles+ case toUpper char of+ c | c == 'D' && numConfs >= 2 -> showDiff (head confFiles) (confFiles !! 1) >> askAgain+ | c == 'T' -> mapM_ (\c -> moveToTrash c) confFiles + | c == 'S' -> return ()+ | c == 'Q' -> exitSuccess+ | c == 'H' -> printHelp >> askAgain+ | c == '?' -> printHelp >> askAgain+ | isDigit c && digitToInt c <= numConfs -> takeFile (digitToInt c) confInfo confFiles+ | otherwise -> askAgain+ where+ moveToTrash file = do+ trashDir <- trashDirectory+ createDirectoryIfMissing True trashDir+ let (dir, fileName) = splitFileName file+ copyFile file (trashDir </> fileName) + removeFile file++ takeFile num confInfo confFiles = do+ (year, month, day) <- getCurrentDate+ let idx = num - 1+ file = confFiles !! idx+ origFile = dir confInfo </> fileName confInfo+ origBackup = origFile ++ "_backup_" ++ show year ++ "-" ++ show month ++ "-" ++ show day+ copyFile origFile origBackup+ moveToTrash origBackup+ copyFile file origFile+ mapM_ (\c -> moveToTrash c) confFiles++ showDiff file1 file2 = do+ putStrLn ""+ diff <- getEnvOrDefault "DROPSOLVE_DIFF" defaultDiff+ handle <- runCommand $ diff ++ " " ++ quote file1 ++ " " ++ quote file2+ waitForProcess handle+ return ()++ quote string = "\"" ++ string ++ "\""++-- conflicting file info+data ConflictInfo = ConflictInfo {+ filePath :: String,+ dir :: String,+ fileName :: String,+ host :: String,+ date :: String }++conflictInfo :: FilePath -> ConflictInfo+conflictInfo filePath =+ let (_:dir:fileName:host:date:[]) = concat (filePath =~ regex :: [[String]])+ in ConflictInfo filePath dir fileName host date+ where+ regex = "(.*)" </> "(.*) \\((.*) conflicted copy (.*)\\).*"+++getDirContents dir = do+ entries <- getDirectoryContents dir+ filterM notDots entries+ where+ notDots entry = return . not $ "." `isSuffixOf` entry || ".." `isSuffixOf` entry+++appDirectory = getAppUserDataDirectory "dropsolve"+trashDirectory = appDirectory >>= \d -> return $ d </> "trash" ++defaultDiff = "gvimdiff -f"++getCurrentDate :: IO (Integer,Int,Int) -- :: (year,month,day)+getCurrentDate = getCurrentTime >>= return . toGregorian . utctDay++getEnvOrDefault envVar defaultValue = do+ result <- try $ getEnv envVar+ case result of+ Right value -> return value+ Left (_ :: IOError) -> return defaultValue