confsolve 0.3.6 → 0.3.7

raw patch · 9 files changed

+286/−1 lines, 9 files

Files

ConfsolveArgs.hs +26/−0
Dropbox/Conflict.hs +18/−0
Dropbox/FileNameParser.hs +29/−0
FileConflict.hs +29/−0
ParseInput.hs +54/−0
Utils.hs +73/−0
Wuala/Conflict.hs +18/−0
Wuala/FileNameParser.hs +30/−0
confsolve.cabal +9/−1

+ ConfsolveArgs.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveDataTypeable #-}++module ConfsolveArgs where+import System.Console.CmdArgs++data Confsolve = Confsolve {+   dropbox   :: Bool,+   wuala     :: Bool,+   directory :: FilePath+   } deriving (Data, Typeable, Show, Eq)++confsolve = Confsolve {+   dropbox   = def &= help "Resolve Dropbox file conflicts",+   wuala     = def &= help "Resolve Wuala file conflicts",+   directory = def &= args &= typ "DIRECTORY"+   }+   &= summary summaryInfo+   &= 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.3.7"+summaryInfo = ""++confsolveArgs :: IO Confsolve+confsolveArgs = cmdArgs confsolve

+ Dropbox/Conflict.hs view

@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Dropbox.Conflict where+import FileConflict+import qualified Dropbox.FileNameParser as P+import qualified Data.Text as T++data Parser = Parser++(<++>) = T.append++instance ConflictParser Parser where+   parseConflict _ baseName =+      case P.parse baseName of+           Just (P.FileInfo realBaseName host date) ->+              Just (realBaseName, "Version " <++> date <++> " from " <++> host)++           Nothing -> Nothing

+ Dropbox/FileNameParser.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Dropbox.FileNameParser where++import Control.Applicative ((<*>), (<$>), (*>), (<*), (<|>))+import qualified Data.Attoparsec.Text as P+import qualified Data.Text as T++parse :: T.Text -> Maybe FileInfo+parse fileName =+   case P.feed (P.parse fileInfo fileName) T.empty of+        P.Fail _ _ _ -> Nothing+        P.Partial _  -> Nothing+        P.Done _ r   -> Just r++fileInfo :: P.Parser FileInfo+fileInfo = FileInfo <$> (T.strip <$> tillLeftPar)+                    <*> (P.char '(' *> till')+                    <*> (P.string "'s conflicted copy " *> tillRightPar <* P.char ')')+   where+      tillLeftPar  = P.takeWhile1 (/= '(')+      till'        = P.takeWhile1 (/= '\'')+      tillRightPar = P.takeWhile1 (/= ')')++data FileInfo = FileInfo {+   fileName :: T.Text,+   host     :: T.Text,+   date     :: T.Text+   } deriving (Show)

+ FileConflict.hs view

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module FileConflict where+import qualified Data.Text as T+import qualified Filesystem.Path.CurrentOS as FP+import Filesystem.Path.CurrentOS ((</>), (<.>))++-- base name possibly containing conflict info+type BaseName     = T.Text++-- base name without conflict info+type RealBaseName = T.Text++-- conflicting file details displayed to the user+type Details      = T.Text++class ConflictParser a where+   parseConflict :: a -> BaseName -> Maybe (RealBaseName, Details)++-- the details and filePath of a conflicting file+data ConflictingFile = ConflictingFile {+   details  :: Details,+   filePath :: FP.FilePath } deriving (Show)++-- file path having a conflict+data Conflict = Conflict {+   origFilePath     :: FP.FilePath,+   conflictingFiles :: [ConflictingFile]+   } deriving (Show)

+ ParseInput.hs view

@@ -0,0 +1,54 @@++module ParseInput where+import Data.Char (toLower)++type FileNum = Int+data UserReply = TakeFile FileNum+               | MoveToTrash+               | ShowDiff+               | ShowDiffWith FileNum+               | ShowDiffBetween FileNum FileNum+               | Skip+               | Quit+               | Help+               deriving Show+++type NumFiles = Int+parseInput :: String -> NumFiles -> Maybe UserReply+parseInput str numFiles =+   case map toLower str of+        ('t':rest) | [num] <- parseInts rest -> if validFileNum num +                                                   then Just $ TakeFile num+                                                   else Nothing+                   | otherwise               -> Nothing++        ('m':[])   -> Just MoveToTrash++        ('d':rest) -> case parseInts rest of+                           []           -> if numFiles == 1 then Just ShowDiff else Nothing+                           [num]        -> if validFileNum num+                                              then Just $ ShowDiffWith num+                                              else Nothing+                           [num1, num2] -> if validFileNum num1 && validFileNum num2+                                              then Just $ ShowDiffBetween num1 num2+                                              else Nothing+                           _            -> Nothing++        ('s':[])   -> Just Skip+        ('q':[])   -> Just Quit+        ('h':[])   -> Just Help+        ('?':[])   -> Just Help++        _          -> Nothing++   where+      validFileNum num = num > 0 && num <= numFiles+++parseInts :: String -> [Int]+parseInts str = go str []+   where+      go str ints+         | [(int, rest)] <- reads str :: [(Int, String)] = go rest (ints ++ [int])+         | otherwise                                     = ints

+ Utils.hs view

@@ -0,0 +1,73 @@+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}++module Utils where+import System.IO+import System.Environment+import Data.Time.Clock+import Data.Time.Calendar+import Control.Exception.Base (try)+import qualified Data.Text as T+import qualified Filesystem as FS+import qualified Filesystem.Path.CurrentOS as FP+import Filesystem.Path ((</>), (<.>))++errorsToStderr :: IO () -> IO ()+errorsToStderr action =+   catch action (\e -> appPutStrLn stderr (show e))++appPutStrLn :: Handle -> String -> IO ()+appPutStrLn handle string = do+   progName <- normalizedProgName+   hPutStrLn handle ("\n" ++ T.unpack progName ++ ": " ++ string)++normalizedProgName :: IO T.Text+normalizedProgName = do+   pn <- getProgName+   return (T.pack $ takeWhile (/= '.') pn)++appDataDirectory = do+   pn <- normalizedProgName+   hd <- FS.getHomeDirectory+   return $ hd </> FP.fromText (T.append "." pn)++trashDirectory = do+   ad <- appDataDirectory+   return $ ad </> "trash"++defaultDiff = "gvimdiff -f"++getCurrentDate :: IO (Integer,Int,Int) -- :: (year,month,day)+getCurrentDate = getCurrentTime >>= return . toGregorian . utctDay++getEnvOrDefault :: String -> String -> IO String+getEnvOrDefault envVar defaultValue = do+   result <- try $ getEnv envVar+   case result of+	Right value          -> return value+	Left  (_ :: IOError) -> return defaultValue++toText :: FP.FilePath -> T.Text+toText filePath =+   either id id (FP.toText filePath)++toString :: FP.FilePath -> String+toString = T.unpack . toText++-- splits filePath into (directory, baseName, extension)+splitFilePath :: FP.FilePath -> (FP.FilePath, FP.FilePath, T.Text)+splitFilePath filePath = (dir, bname, ext)+   where+      dir   = FP.directory filePath+      bname = FP.basename filePath+      ext   = allExtensions filePath++allExtensions :: FP.FilePath -> T.Text+allExtensions = (T.intercalate ".") . FP.extensions++replaceBaseName :: FP.FilePath -> FP.FilePath -> FP.FilePath+replaceBaseName filePath newBaseName+   | T.null ext = dir </> newBaseName+   | otherwise  = dir </> newBaseName <.> ext+   where+      dir = FP.directory filePath+      ext = allExtensions filePath

+ Wuala/Conflict.hs view

@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++module Wuala.Conflict where+import FileConflict+import qualified Wuala.FileNameParser as P+import qualified Data.Text as T++data Parser = Parser++(<++>) = T.append++instance ConflictParser Parser where+   parseConflict _ baseName =+      case P.parse baseName of+           Just (P.FileInfo realBaseName version host) ->+              Just (realBaseName, "Version " <++> version <++> " from " <++> host)++           Nothing -> Nothing

+ Wuala/FileNameParser.hs view

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Wuala.FileNameParser where++import Control.Applicative ((<*>), (<$>), (*>))+import qualified Data.Attoparsec.Text as P+import qualified Data.Text as T+import Data.Char (isNumber)++parse :: T.Text -> Maybe FileInfo+parse fileName =+   case P.feed (P.parse fileInfo fileName) T.empty of+        P.Fail _ _ _ -> Nothing+        P.Partial _  -> Nothing+        P.Done _ r   -> Just r++fileInfo :: P.Parser FileInfo+fileInfo = FileInfo <$> (T.strip <$> tillLeftPar)+                    <*> (P.string "(conflicting version " *> version)+                    <*> (P.string " from " *> tillRightPar)+   where+      version      = P.takeWhile1 isNumber+      tillLeftPar  = P.takeWhile1 (/= '(')+      tillRightPar = P.takeWhile1 (/= ')')++data FileInfo = FileInfo {+   fileName :: T.Text,+   version  :: T.Text,+   host     :: T.Text+   } deriving (Show)

confsolve.cabal view

@@ -1,5 +1,5 @@ Name:          confsolve-Version:       0.3.6+Version:       0.3.7 License:       BSD3 License-file:  LICENSE Author:        Daniel Trstenjak@@ -16,5 +16,13 @@  Executable confsolve   Main-is:       confsolve.hs+  other-modules: FileConflict+                 ParseInput+                 Dropbox.Conflict+                 Dropbox.FileNameParser+                 Utils+                 Wuala.Conflict+                 Wuala.FileNameParser+                 ConfsolveArgs   ghc-options:   -funbox-strict-fields   Build-Depends: base >= 3 && < 5, time, process, unordered-containers, text, attoparsec, system-filepath, system-fileio, cmdargs