dropsolve 0.1.1 → 0.1.2

raw patch · 2 files changed

+38/−21 lines, 2 filesdep +containers

Dependencies added: containers

Files

• dropsolve.cabal +2/−2
• dropsolve.hs +36/−19

@@ -1,5 +1,5 @@ Name:          dropsolve-Version:       0.1.1+Version:       0.1.2 License:       BSD3 License-file:  LICENSE Author:        Daniel Trstenjak@@ -16,4 +16,4 @@  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 +  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, containers >= 0.4 && < 0.5

@@ -10,11 +10,14 @@ import System.Exit import Data.Time.Clock import Data.Time.Calendar-import Data.List (isInfixOf, isSuffixOf, isPrefixOf, concat)+import Data.List (isInfixOf, isSuffixOf, isPrefixOf, concat, foldr) import Data.Char (intToDigit, digitToInt, isDigit, toUpper)+import Data.Foldable (foldrM)+import qualified Data.Map as M import Text.Regex.Posix ((=~)) import Control.Monad (when, mapM_, filterM) import Control.Exception.Base (try)+import Foreign.Marshal.Error (void)  main = do    hSetBuffering stdout NoBuffering@@ -24,7 +27,7 @@ 	[]            -> printUsage >> printHelp         ("-h":[])     -> printUsage >> printHelp 	("--help":[]) -> printUsage >> printHelp-	(dropDir:[])  -> resolve dropDir+	(dropDir:[])  -> void $ resolve dropDir M.empty 	otherwise     -> error $ "Invalid Arguments\n" ++ usage  printUsage = putStrLn usage@@ -55,25 +58,33 @@    putStrLn $ "   (H)elp          => By pressing 'H' or 'h', this help is printed."    putStrLn $ "" -resolve file = do+type Resolved = M.Map String Int++resolve :: String -> Resolved -> IO Resolved+resolve file resolved = do    dirExists <- doesDirectoryExist file    if dirExists       then do 	 entries <- getDirContents file-	 mapM_ (\e -> resolve $ file </> e) entries+	 foldrM (\e r -> resolve (file </> e) r) resolved entries       else do 	 fileExists <- doesFileExist file-	 when (fileExists && hasConflict file) $-	    handleConflict file+	 if fileExists && hasConflict file+	    then do+	       let confInfo = conflictInfo file+		   key      = dir confInfo </> fileName confInfo+	       if key `M.member` resolved+		  then return resolved+		  else do+		     handleConflict confInfo+		     return $ M.insert key 1 resolved+	    else return resolved  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 +handleConflict confInfo = do+   confFiles <- findConflicting confInfo+   resolveConflict confInfo confFiles      where       findConflicting confInfo = do@@ -88,7 +99,7 @@       resolveConflict confInfo confFiles 	 | length confFiles == 0 = return () 	 | otherwise = do-	    let origFile = dir confInfo </> fileName confInfo+	    let origFile = dir confInfo </> fileName confInfo ++ suffix confInfo 	    putStrLn $ "\nConflicting file: " ++ origFile             putConfFiles confFiles 1 	    askUser confInfo confFiles@@ -129,7 +140,7 @@                (year, month, day) <- getCurrentDate 	       let idx        = num - 1                    file       = confFiles !! idx-		   origFile   = dir confInfo </> fileName confInfo+		   origFile   = dir confInfo </> fileName confInfo ++ suffix confInfo 		   origBackup = origFile ++ "_backup_" ++ show year ++ "-" ++ show month ++ "-" ++ show day 	       errorsToStderr $ do 		  copyFile origFile origBackup@@ -151,15 +162,16 @@    filePath :: String,    dir      :: String,    fileName :: String,+   suffix   :: 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+   let (_:dir:fileName:host:date:suffix:[]) = concat (filePath =~ regex :: [[String]])+       in ConflictInfo filePath dir fileName suffix host date    where-      regex = "(.*)" </> "(.*) \\((.*) conflicted copy (.*)\\).*"+      regex = "(.*)" </> "(.*) \\((.*) conflicted copy (.*)\\)(.*)"   getDirContents dir = do@@ -171,10 +183,15 @@  errorsToStderr :: IO () -> IO () errorsToStderr action =-   catch action (\e -> hPutStrLn stderr ("\ndropsolve: " ++ show e))+   catch action (\e -> do pn <- normalizedProgName+			  hPutStrLn stderr ("\n" ++ pn ++ ": " ++ show e)) +normalizedProgName = do+   pn <- getProgName+   return $ takeWhile (/= '.') pn -appDirectory   = getAppUserDataDirectory "dropsolve"++appDirectory   = normalizedProgName >>= \pn -> getAppUserDataDirectory pn trashDirectory = appDirectory >>= \d -> return $ d </> "trash"   defaultDiff = "gvimdiff -f"