{-# 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