vcswrapper 0.0.4 → 0.1.0

raw patch · 13 files changed

+223/−183 lines, 13 filesdep ~mtlnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: mtl

API changes (from Hackage documentation)

Files

• src/VCSWrapper/Common/Process.hs +30/−26
• src/VCSWrapper/Common/TemporaryFiles.hs +2/−1
• src/VCSWrapper/Common/Types.hs +17/−14
• src/VCSWrapper/Git.hs +20/−17
• src/VCSWrapper/Git/Parsers.hs +23/−18
• src/VCSWrapper/Git/Process.hs +13/−11
• src/VCSWrapper/Mercurial.hs +13/−10
• src/VCSWrapper/Mercurial/Parsers.hs +24/−17
• src/VCSWrapper/Mercurial/Process.hs +8/−6
• src/VCSWrapper/Svn.hs +33/−29
• src/VCSWrapper/Svn/Parsers.hs +16/−13
• src/VCSWrapper/Svn/Process.hs +19/−17
• vcswrapper.cabal +5/−4

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Common.Process@@ -26,13 +27,16 @@ import qualified Control.Exception as Exc import VCSWrapper.Common.Types import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T (null, unpack, pack)+import Control.Monad (unless)  -- | Internal function to execute a VCS command. Throws an exception if the command fails.-vcsExecThrowingOnError :: String -- ^ VCS shell-command, e.g. git-        -> String -- ^ VCS command, e.g. checkout-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment variables-        -> Ctx String+vcsExecThrowingOnError :: FilePath -- ^ VCS shell-command, e.g. git+        -> Text -- ^ VCS command, e.g. checkout+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment variables+        -> Ctx Text vcsExecThrowingOnError vcsName cmd opts menv = do     o <- vcsExec vcsName cmd opts menv     case o of@@ -40,20 +44,20 @@         Left exc  -> Exc.throw exc  -- | Internal function to execute a VCS command-vcsExec :: String -- ^ VCS shell-command, e.g. git-        -> String -- ^ VCS command, e.g. checkout-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment variables-        -> Ctx (Either VCSException String)+vcsExec :: FilePath -- ^ VCS shell-command, e.g. git+        -> Text -- ^ VCS command, e.g. checkout+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment variables+        -> Ctx (Either VCSException Text) vcsExec vcsName cmd opts menv  = exec cmd opts menv vcsName configPath  -- | Internal function to execute a VCS command-exec :: String -- ^ VCS command, e.g. checkout-     -> [String] -- ^ options-     -> [(String, String)] -- ^ environment variables-     -> String -- ^ VCS shell-command, e.g. git+exec :: Text -- ^ VCS command, e.g. checkout+     -> [Text] -- ^ options+     -> [(Text, Text)] -- ^ environment variables+     -> FilePath -- ^ VCS shell-command, e.g. git      -> (Config -> Maybe FilePath) -- ^ variable getter applied to content of Ctx-     -> Ctx (Either VCSException String)+     -> Ctx (Either VCSException Text) exec cmd opts menv fallBackExecutable getter = do     cfg <- ask     let args = cmd : opts@@ -69,14 +73,14 @@      environment. -} readProc :: Maybe FilePath --working directory or Nothing if not set-            -> String  --command-            -> [String] --arguments-            -> [(String, String)] --environment can be empty-            -> String --input can be empty-            -> IO (ExitCode, String, String)+            -> FilePath  --command+            -> [Text] --arguments+            -> [(Text, Text)] --environment can be empty+            -> Text --input can be empty+            -> IO (ExitCode, Text, Text) readProc mcwd command args menv input = do     putStrLn $ "Executing process, mcwd: "++show mcwd++", command: "++command++-                ",args: "++show args++",menv: "++show menv++", input"++input+                ",args: "++show args++",menv: "++show menv++", input"++T.unpack input     (inh, outh, errh, pid) <- execProcWithPipes mcwd command args menv      outMVar <- newEmptyMVar@@ -87,7 +91,7 @@     err <- hGetContents errh     _ <- forkIO $ Exc.evaluate (length err) >> putMVar outMVar () -    when (length input > 0) $ do hPutStr inh input; hFlush inh+    unless (T.null input) $ do hPutStr inh (T.unpack input); hFlush inh     hClose inh      takeMVar outMVar@@ -96,20 +100,20 @@     hClose errh      ex <- waitForProcess pid-    return (ex, out, err)+    return (ex, T.pack out, T.pack err)   {- |     Setting pipes as in 'System.Process.readProcessWithExitCode' in ' but having a configurable working directory and      environment. -}-execProcWithPipes :: Maybe FilePath -> String -> [String] -> [(String, String)]+execProcWithPipes :: Maybe FilePath -> FilePath -> [Text] -> [(Text, Text)]                   -> IO (Handle, Handle, Handle, ProcessHandle) execProcWithPipes mcwd command args menv = do-    (Just inh, Just outh, Just errh, pid) <- createProcess (proc command args)+    (Just inh, Just outh, Just errh, pid) <- createProcess (proc command (map T.unpack args))         { std_in = CreatePipe,           std_out = CreatePipe,           std_err = CreatePipe,           cwd = mcwd,-          env = Just menv }+          env = Just (map (\(k,v) -> (T.unpack k, T.unpack v)) menv) }     return (inh, outh, errh, pid)

@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Common.TemporaryFiles@@ -24,7 +25,7 @@ {- |     Executes given function using a tempory file.     -}-withTempFile :: String -- ^ Filename+withTempFile :: FilePath -- ^ Filename              -> (FilePath -- 'FilePath' to temporary file                 -> Handle -- 'Handle' for temporary file                 -> IO a) -- ^ Fn to be called

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  Common.Types@@ -11,7 +13,6 @@ -- | Defines all types and their associated accessorfunctions. -- ------------------------------------------------------------------------------{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module VCSWrapper.Common.Types (     VCSType(..)     ,IsLocked@@ -32,6 +33,8 @@ import Control.Monad.Reader import Data.Typeable (Typeable) import Control.Exception (Exception)+import Data.Text (Text)+import Control.Applicative (Applicative)  -- | Available VCS types implemented in this package. data VCSType = SVN | GIT | Mercurial@@ -72,13 +75,13 @@  -- | Represents a log entry in the history managed by the VCS. data LogEntry = LogEntry {-    mbBranch :: Maybe String -- ^ Maybe Branchname-    , commitID :: String -- ^ Commit identifier-    , author :: String -- ^ Author of this commit.-    , email :: String -- ^ Email address of the author.-    , date :: String -- ^ Date this log entry was created.-    , subject :: String -- ^ Short commit message.-    , body :: String -- ^ Long body of the commit message.+    mbBranch :: Maybe Text -- ^ Maybe Branchname+    , commitID :: Text -- ^ Commit identifier+    , author :: Text -- ^ Author of this commit.+    , email :: Text -- ^ Email address of the author.+    , date :: Text -- ^ Date this log entry was created.+    , subject :: Text -- ^ Short commit message.+    , body :: Text -- ^ Long body of the commit message. } deriving (Show)  -- | 'True', if this file is locked by the VCS.@@ -89,13 +92,13 @@     { configCwd :: Maybe FilePath -- ^ Path to the main directory of the repository. E.g. for Git: the directory of the repository containing the @.git@ config directory.     , configPath :: Maybe FilePath -- ^ Path to the vcs executable. If 'Nothing', the PATH environment variable will be search for a matching executable.     , configAuthor :: Maybe Author -- ^ Author to be used for different VCS actions. If 'Nothing', the default for the selected repository will be used.-    , configEnvironment :: [(String, String)] -- ^ List of environment variables mappings passed to the underlying VCS executable.+    , configEnvironment :: [(Text, Text)] -- ^ List of environment variables mappings passed to the underlying VCS executable.     } deriving (Show, Read)  -- | Author to be passed to VCS commands where applicable. data Author = Author-    { authorName :: String -- ^ Name of the author.-    , authorEmail :: Maybe String -- ^ Email address of the author.+    { authorName :: Text -- ^ Name of the author.+    , authorEmail :: Maybe Text -- ^ Email address of the author.     } deriving (Show, Read)  {- | Context for all VCS commands.@@ -108,13 +111,13 @@     >    runVcs config $ initDB False -} newtype Ctx a = Ctx (ReaderT Config IO a)-    deriving (Monad, MonadIO, MonadReader Config)+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Config)  -- | Creates a new 'Config' with a list of environment variables. makeConfigWithEnvironment :: Maybe FilePath -- ^ Path to the main directory of the repository. E.g. for Git: the directory of the repository containing the @.git@ config directory.     -> Maybe FilePath -- ^ Path to the vcs executable. If 'Nothing', the PATH environment variable will be search for a matching executable.     -> Maybe Author -- ^ Author to be used for different VCS actions. If 'Nothing', the default for the selected repository will be used.-    -> [(String, String)] -- ^ List of environment variables mappings passed to the underlying VCS executable.+    -> [(Text, Text)] -- ^ List of environment variables mappings passed to the underlying VCS executable.     -> Config makeConfigWithEnvironment repoPath executablePath author environment = Config {         configCwd = repoPath@@ -137,7 +140,7 @@ -- | This 'Exception'-type will be thrown if a VCS command fails unexpectedly. data VCSException     -- | Exit code -> stdout -> errout -> 'configCwd' of the 'Config' -> List containing the executed command and its options-    = VCSException Int String String String [String]+    = VCSException Int Text Text FilePath [Text]     deriving (Show, Typeable)  instance Exception VCSException

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Git@@ -48,7 +49,9 @@  import Data.Maybe import qualified Data.List-import Data.Text (strip, pack, unpack)+import Data.Text (Text)+import qualified Data.Text as T (strip, pack)+import Data.Monoid ((<>))   {- | Initialize a new git repository. Executes @git init@. -}@@ -63,27 +66,27 @@     -> Ctx () add paths = do     let opts = "--" : paths-    gitExecWithoutResult "add" opts []+    gitExecWithoutResult "add" (map T.pack opts) []  {- | Remove files from the index and the working directory. Executes @git rm@. -} rm :: [ FilePath ] -- ^ 'FilePath's to remove.     -> Ctx () rm paths = do-    let opts = "--" : paths+    let opts = "--" : map T.pack paths     gitExecWithoutResult "rm" opts []  {- | Commit the current index or the specified files to the repository. Executes @git commit@. -} commit :: [ FilePath ] -- ^ 'FilePath's to be commited instead of the current index. Leave empty to commit the index.-    -> Maybe (String, String) -- ^ (Author name, email)-    -> String -- ^ Commit message. Don't leave this empty.-    -> [String] -- ^ Options to be passed to the git executable.+    -> Maybe (Text, Text) -- ^ (Author name, email)+    -> Text -- ^ Commit message. Don't leave this empty.+    -> [Text] -- ^ Options to be passed to the git executable.     -> Ctx () commit rsrcs mbAuthor logmsg extraopts = do         case mbAuthor of             Just (author, author_email) ->-                commit' rsrcs logmsg extraopts ["--author", author ++ " <" ++ author_email ++ ">"]+                commit' (map T.pack rsrcs) logmsg extraopts ["--author", author <> " <" <> author_email <> ">"]             Nothing ->-                commit' rsrcs logmsg extraopts []+                commit' (map T.pack rsrcs) logmsg extraopts []     where     commit' files logmsg extraopts authopts = do         let msgopts = [ "-m", logmsg ]@@ -91,8 +94,8 @@         gitExecWithoutResult "commit" opts []  {- | Checkout the index to some commit ID. Executes @git checkout@. -}-checkout :: Maybe String -- ^ Commit ID-        -> Maybe String -- ^ Branchname. If specified, @git checkout -b \<branchname\>@ will be executed.+checkout :: Maybe Text -- ^ Commit ID+        -> Maybe Text -- ^ Branchname. If specified, @git checkout -b \<branchname\>@ will be executed.         -> Ctx () checkout rev branch = do     let bopt = maybe [] (\b -> [ "-b", b ]) branch@@ -106,7 +109,7 @@     return $ parseStatus o  {- | Get all commit messages. Executes @git log@. -}-simpleLog :: Maybe String -- ^ The branch from which to get the commit messages. (If 'Nothing', the current branch will be used).+simpleLog :: Maybe Text -- ^ The branch from which to get the commit messages. (If 'Nothing', the current branch will be used).     -> Ctx [LogEntry] simpleLog mbBranch = do     -- double dash on end prevent crash if branch and filename are equal@@ -118,13 +121,13 @@   {- | Get all local branches. Executes @git branch@. -}-localBranches :: Ctx (String, [String]) -- ^ (currently checked out branch, list of all other branches)+localBranches :: Ctx (Text, [Text]) -- ^ (currently checked out branch, list of all other branches) localBranches = do     o <- gitExec "branch" [] []     return $ parseBranches o  {- | Get all remotes. Executes @git remote@. -}-remote :: Ctx [String]+remote :: Ctx [Text] remote = do     o <- gitExec "remote" [] []     return $ parseRemotes o@@ -136,7 +139,7 @@ {- | Pull changes from the remote as configured in the git configuration. If a merge conflict     is detected, the error message is returned, otherwise 'Right ()' is returned.     Executes @git pull@. -}-pull :: Ctx (Either String ())+pull :: Ctx (Either Text ()) pull = do     o <- gitExec' "pull" [] []     case o of@@ -145,11 +148,11 @@                                             else Exc.throw exc  {- | Rev-parse a revision. Executes @git rev-parse@. -}-revparse :: String -- ^ Revision to pass to rev-parse.-    -> Ctx (String)+revparse :: Text -- ^ Revision to pass to rev-parse.+    -> Ctx (Text) revparse commit = do     o <- gitExec "rev-parse" [commit] []-    return . unpack . strip $ pack o+    return $ T.strip o   

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Git.Parsers@@ -26,50 +27,54 @@ import Text.ParserCombinators.Parsec  import VCSWrapper.Common.Types+import Data.Text (Text)+import qualified Data.Text as T+       (isPrefixOf, pack, lines, unpack, splitOn)+import Control.Applicative ((<$>))  -- | Parse the status of a Git repo. Expects command @git status --porcelain@.-parseStatus :: String -- ^ Output of @git status --porcelain@.+parseStatus :: Text -- ^ Output of @git status --porcelain@.     -> [Status] -- ^ 'Status' for each file. parseStatus status = [ GITStatus filepath Modified | (_:x:_:filepath) <- lines, x == 'M'] -- M only displayed in second column         ++ [ GITStatus filepath Untracked | (x:_:_:filepath) <- lines, x == '?']         ++ [ GITStatus filepath Added | (x:_:_:filepath) <- lines, x == 'A'] -- A only displayed in second column         ++ [ GITStatus filepath Deleted | (x:y:_:filepath) <- lines, x == 'D' || y == 'D'] -- D flag depends on index state (both columns)         where-        lines = splitOn "\n" status+        lines = map T.unpack $ T.splitOn "\n" status  -- | Parse the output of @git branch@.-parseBranches :: String -> (String, [String]) -- ^ (currently checked out branch, list of all other branches)-parseBranches string = (head [branchname | ('*':_:branchname) <- lined],-    [branchname | (' ':' ':branchname) <- lined])+parseBranches :: Text -> (Text, [Text]) -- ^ (currently checked out branch, list of all other branches)+parseBranches string = (head [T.pack branchname | ('*':_:branchname) <- lined],+    [T.pack branchname | (' ':' ':branchname) <- lined])     where-    lined = lines string+    lined = map T.unpack $ T.lines string  -- | Parse @git remote@.-parseRemotes :: String -> [String]-parseRemotes = splitOn "\n"+parseRemotes :: Text -> [Text]+parseRemotes = T.splitOn "\n"  -- | Parse output of @git pull@ and return if the repository is in conflict state.-parsePullMergeConflict :: String -> Bool-parsePullMergeConflict s = isPrefixOf "CONFLICT" s -- TODO improve this implementation, conflict after attemted automerge is not detected.+parsePullMergeConflict :: Text -> Bool+parsePullMergeConflict s = T.isPrefixOf "CONFLICT" s -- TODO improve this implementation, conflict after attemted automerge is not detected.  -- | Parse output of @git log --pretty=tformat:commit:%H%n%an%n%ae%n%ai%n%s%n%b%x00@.-parseSimpleLog :: String -> [LogEntry]+parseSimpleLog :: Text -> [LogEntry] parseSimpleLog log =     case parsed of         Right entries -> entries         Left _ -> []-    where parsed = parse logEntries "" log+    where parsed = parse logEntries "" (T.unpack log)  -- | Parse a single log entry. Expects @git log --pretty=tformat:commit:%H%n%an%n%ae%n%ai%n%s%n%b%x00@ logEntry :: Parser LogEntry logEntry = do     string "commit:"-    commitID <- wholeLine-    author <- wholeLine-    email <- wholeLine-    date <- wholeLine-    subject <- wholeLine-    body <- bodyLines+    commitID <- T.pack <$> wholeLine+    author <- T.pack <$> wholeLine+    email <- T.pack <$> wholeLine+    date <- T.pack <$> wholeLine+    subject <- T.pack <$> wholeLine+    body <- T.pack <$> bodyLines     char '\n'     return $ LogEntry Nothing commitID author email date subject body 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Git.Process@@ -25,13 +26,14 @@  import Control.Monad.Reader.Class (asks) import qualified Control.Exception as Exc+import Data.Text (Text)   -- | Internal function to execute a git command-gitExec :: String -- ^ git command, e.g. checkout, commit-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment-        -> Ctx String+gitExec :: Text -- ^ git command, e.g. checkout, commit+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment+        -> Ctx Text gitExec cmd opts env = do     cfgEnv <- asks configEnvironment     vcsExecThrowingOnError "git" cmd opts (cfgEnv ++ env)@@ -39,18 +41,18 @@  -- | Internal function to execute a git command. Doesn't throw an exception if the command failes, -- but returns an Either with exit information.-gitExec' :: String -- ^ git command, e.g. checkout, commit-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment-        -> Ctx (Either VCSException String)+gitExec' :: Text -- ^ git command, e.g. checkout, commit+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment+        -> Ctx (Either VCSException Text) gitExec' cmd opts env = do     cfgEnv <- asks configEnvironment     vcsExec "git" cmd opts (cfgEnv ++ env)  -gitExecWithoutResult :: String -- ^ git command to execute, e.g. checkout, commit-                    -> [String] -- ^ options-                    -> [(String, String)] -- ^ environment+gitExecWithoutResult :: Text -- ^ git command to execute, e.g. checkout, commit+                    -> [Text] -- ^ options+                    -> [(Text, Text)] -- ^ environment                     -> Ctx () gitExecWithoutResult cmd opts env = gitExec cmd opts env >> return () 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Mercurial@@ -37,21 +38,23 @@ import System.IO import Control.Monad.Reader import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack)  {- |     Add all new files, delete all missing files. Executes @hg addremove@. -} addremove :: [FilePath] -- ^ files to add     -> Ctx ()-addremove files = hgExecNoEnv "addremove" files+addremove files = hgExecNoEnv "addremove" (map T.pack files)  {- |     Update the repository's working directory to the specified changeset. If     no changeset is specified, update to the tip of the current named branch.     Executes @hg checkout@. -}-checkout :: Maybe String -- ^ optional changeset-         -> [String]     -- ^ options+checkout :: Maybe Text -- ^ optional changeset+         -> [Text]     -- ^ options          -> Ctx () checkout mbChangeset options = hgExecNoEnv "checkout" opts     where@@ -62,16 +65,16 @@     Commit the specified files or all outstanding changes. Executes @hg commit@. -} commit :: [FilePath]  -- ^ files to commit. List may be empty - if not only specified files will be commited-         -> String       -- ^ message, can be empty-         -> [String]     -- ^ options+         -> Text       -- ^ message, can be empty+         -> [Text]     -- ^ options          -> Ctx () commit filesToCommit logMsg options = hgExecNoEnv "commit" opts     where         msgOpt = [ "--message", logMsg ]-        opts = msgOpt ++ options ++ filesToCommit+        opts = msgOpt ++ options ++ (map T.pack filesToCommit)  {- | Get all local branches. Executes @hg branches@. -}-localBranches :: Ctx (String, [String]) -- ^ (currently checked out branch, list of all other branches)+localBranches :: Ctx (Text, [Text]) -- ^ (currently checked out branch, list of all other branches) localBranches = do     currentBranch <- hgExec "branch" [] []     o <- hgExec "branches" ["-q"] []@@ -97,7 +100,7 @@ {- |     Show revision history of entire repository or files. Executes @hg log@. -}-simpleLog :: Maybe String -- ^ Show the specified revision or range or branch+simpleLog :: Maybe Text -- ^ Show the specified revision or range or branch           -> Ctx[LogEntry] simpleLog mbRev = do     o <- hgExec "log" opts []@@ -108,7 +111,7 @@         rev (Just revision) = ["-r",revision]         opts = ["--style", "xml"] ++ (rev mbRev)         parseLog out path handle = do-                    hPutStrLn handle out+                    hPutStrLn handle (T.unpack out)                     hClose handle   -- closing handle so parseDocument can open one                     parseLogFile path @@ -124,7 +127,7 @@     Update the repository's working directory to the specified changeset. If     no changeset is specified, update to the tip of the current named branch. -}-update :: Maybe String+update :: Maybe Text        -> Ctx () update mbRev = hgExecNoEnv "update" opts       where

@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Mercurial.Parsers@@ -21,20 +23,23 @@ import qualified VCSWrapper.Mercurial.Types as Common import Text.XML.HXT.Core import Data.List.Split (splitOn)+import Data.Text (Text)+import qualified Data.Text as T (pack, unpack, lines, splitOn)+import Control.Applicative ((<$>))  {- |-    Parses given 'String' and returns a list of 'Status'.+    Parses given 'Text' and returns a list of 'Status'. -}-parseStatusOut :: String -- ^ String which is required to have same format as output from @svn status@+parseStatusOut :: Text -- ^ Text which is required to have same format as output from @svn status@             -> [Common.Status] parseStatusOut out = parseRows rows         where             rows = init' splitRows-            splitRows = splitOn "\n" out :: [String]+            splitRows = T.splitOn "\n" out :: [Text]  -- | Parse the output of @hg branch -q@.-parseBranches :: String -> [String] -- ^ list of all branches-parseBranches string = lines string+parseBranches :: Text -> [Text] -- ^ list of all branches+parseBranches string = T.lines string  {- |     Attempts to parse given file and returns a list of 'Common.LogEntry'.@@ -56,7 +61,7 @@ init' ls = init ls  -- parses given rows from @hg status@. Supports only first seven columns and filename so far-parseRows :: [String] -> [Common.Status]+parseRows :: [Text] -> [Common.Status] parseRows rows = map mapRow rows     where         mapRow = \row -> Common.GITStatus (getFileName row) (getModification row)@@ -65,8 +70,8 @@ --                                      ,modification=(getModification row) --                                      ,isLocked=(getLockStatus row) --                                   }-        getFileName = (\row -> nFunc tail 2 row) :: String -> FilePath-        getModification = (\row -> parseFirstCol $ row!!0) :: String -> Common.Modification+        getFileName = (\row -> nFunc tail 2 $ T.unpack row) :: Text -> FilePath+        getModification = (\row -> parseFirstCol $ T.unpack row!!0) :: Text -> Common.Modification   @@ -97,16 +102,16 @@  data LogEntry = LogEntry {     revision :: Int-    ,node :: String-    ,branch :: Maybe String+    ,node :: Text+    ,branch :: Maybe Text     ,author :: Author     , date :: Date     , message :: Message     } deriving (Show, Read) -type Author = (String, String)-type Date = String-type Message = String+type Author = (Text, Text)+type Date = Text+type Message = Text  xpLog :: PU Log xpLog = xpWrap (\l -> Log l, \l -> (logEntries l))@@ -120,8 +125,8 @@  xpLogEntry :: PU LogEntry xpLogEntry =  xpWrap (\(rev,nod,bra,par,tag,aut,dat,msg) ->-                        LogEntry { revision = rev, node = nod, branch = bra, author = aut, date = dat, message = msg},-                      \e -> (revision e, node e, branch e, Nothing, Nothing, author e, date e, message e))+                        LogEntry { revision = rev, node = T.pack nod, branch = T.pack <$> bra, author = aut, date = T.pack dat, message = T.pack msg},+                      \e -> (revision e, T.unpack $ node e, T.unpack <$> branch e, Nothing, Nothing, author e, T.unpack $ date e, T.unpack $ message e))                 $ xpElem "logentry"                 $ xp8Tuple (xpAttr "revision" xpInt)                            (xpAttr "node" xpText0)@@ -136,8 +141,10 @@   xpAuthor :: PU Author-xpAuthor = xpWrap (id, id)+xpAuthor = xpWrap (packPair, unpackPair)             $ xpElem "author"             $ xpPair (xpAttr "email" xpText0)                      (xpText0)-+    where+        packPair (a, b) = (T.pack a, T.pack b)+        unpackPair (a, b) = (T.unpack a, T.unpack b)

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Mercurial.Process@@ -22,9 +23,10 @@ import VCSWrapper.Common.Process import VCSWrapper.Mercurial.Types import Control.Monad.Reader(ask)+import Data.Text (Text) -hgExecNoEnv :: String          -- ^ cmd-         -> [String]      -- ^ opts+hgExecNoEnv :: Text          -- ^ cmd+         -> [Text]      -- ^ opts          -> Ctx() hgExecNoEnv cmd options =  do                 config <- ask@@ -39,10 +41,10 @@ {- |     Execute given hg command with given options and environment. -}-hgExec :: String -- ^ hg command, e.g. checkout-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment-        -> Ctx String+hgExec :: Text -- ^ hg command, e.g. checkout+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment+        -> Ctx Text hgExec cmd opts = do     let extOpts = opts++globalOpts     vcsExecThrowingOnError "hg" cmd extOpts

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- -- Module      :  Svn@@ -14,7 +16,6 @@ -- On unexpected behavior, these functions will throw a 'VCSException'. -- All functions will be executed with options @--non-interactive@ and @--no-auth-cache@ set. ------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables #-} module VCSWrapper.Svn (     -- svn commands     add@@ -51,6 +52,9 @@ import Control.Monad (filterM) import System.Directory(doesFileExist, getDirectoryContents) import System.FilePath(combine, splitFileName)+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack)+import Data.Monoid ((<>))  -- --  SVN COMMANDS@@ -61,25 +65,25 @@     They will be added in next commit.. Executes @svn add@. -} add :: [FilePath] -- ^ files to add-        -> Maybe String -- ^ optional password-        -> [String]     -- ^ options+        -> Maybe Text -- ^ optional password+        -> [Text]     -- ^ options         -> Ctx ()-add files = svnExec_ "add" files+add files = svnExec_ "add" (map T.pack files)  {- |     Checkout out a working copy from a repository. Executes @svn checkout@. -}-checkout :: [(String, Maybe String)]    -- ^ list of (url, 'Maybe' revision). List must not be empty, however revision need not to be set-         -> Maybe String                -- ^ optional path-         -> Maybe String -- ^ optional password-         -> [String]     -- ^ options+checkout :: [(Text, Maybe Text)]    -- ^ list of (url, 'Maybe' revision). List must not be empty, however revision need not to be set+         -> Maybe Text                -- ^ optional path+         -> Maybe Text -- ^ optional password+         -> [Text]     -- ^ options          -> Ctx () checkout repos path = svnExec_ "checkout" opts     where         realPath = [fromMaybe "" path]         urls =  map  (\(x,y) -> x-                    ++ (if (isNothing y) then "" else "@")-                    ++ fromMaybe "" y)+                    <> (if (isNothing y) then "" else "@")+                    <> fromMaybe "" y)                     repos         opts = urls++realPath @@ -87,24 +91,24 @@     Send changes from your working copy to the repository. Executes @svn commit@. -} commit :: [FilePath]  -- ^ files to commit. List may be empty - if not only specified files will be commited-         -> String       -- ^ message, can be empty-         -> Maybe String -- ^ optional password-         -> [String]     -- ^ options+         -> Text       -- ^ message, can be empty+         -> Maybe Text -- ^ optional password+         -> [Text]     -- ^ options          -> Ctx () commit filesToCommit logMsg = svnExec_ "commit" opts     where         msgopts = [ "--message", logMsg ]-        opts = msgopts ++ filesToCommit+        opts = msgopts ++ (map T.pack filesToCommit)  {- |     Lock working copy paths or URLs in the repository, so that no other user can commit changes to     them. Executes @svn lock@. -} lock :: [FilePath]   -- ^ Files to lock, must not be empty-        -> Maybe String -- ^ optional password-        -> [String]     -- ^ options+        -> Maybe Text -- ^ optional password+        -> [Text]     -- ^ options         -> Ctx ()-lock files = svnExec_ "lock" files+lock files = svnExec_ "lock" (map T.pack files)   @@ -113,19 +117,19 @@     Reverts working copy to given revision. Executes @svn merge -rHEAD:$revision .@. -} mergeHeadToRevision :: Integer           -- ^ revision, e.g. 3-                    -> Maybe String -- ^ optional password-                    -> [String]     -- ^ options+                    -> Maybe Text -- ^ optional password+                    -> [Text]     -- ^ options                     -> Ctx()-mergeHeadToRevision revision = svnExec_ "merge" ["-rHEAD:"++show revision,"."]+mergeHeadToRevision revision = svnExec_ "merge" ["-rHEAD:"<>(T.pack $ show revision),"."]  {- |     Remove @conflicted@ state on working copy files or directories. Executes @svn resolved@.  -} resolved :: [FilePath]   -- ^ files or directories to mark resolved-        -> Maybe String -- ^ optional password-        -> [String]     -- ^ options+        -> Maybe Text -- ^ optional password+        -> [Text]     -- ^ options         -> Ctx()-resolved files = svnExec_ "resolved" files+resolved files = svnExec_ "resolved" (map T.pack files)  {- |     Get the log messages for the current working copy. Executes @svn log@.@@ -137,7 +141,7 @@     return logEntries     where         parseLog out path handle = do-                    hPutStrLn handle out+                    hPutStrLn handle (T.unpack out)                     hClose handle   -- closing handle so parseDocument can open one                     parseLogFile path @@ -153,16 +157,16 @@     Unlock working copy paths or URLs. Executes @svn unlock@. -} unlock :: [FilePath] -- ^ Files to unlock, must not be empty-          -> Maybe String -- ^ optional password-          -> [String]     -- ^ options+          -> Maybe Text -- ^ optional password+          -> [Text]     -- ^ options           -> Ctx ()-unlock files = svnExec_ "unlock" files+unlock files = svnExec_ "unlock" (map T.pack files)  {- |     Bring changes from the repository into the working copy. Executes @svn update@. -}-update :: Maybe String -- ^ optional password-       -> [String]     -- ^ options+update :: Maybe Text -- ^ optional password+       -> [Text]     -- ^ options        -> Ctx() update = svnExec_ "update" [] 

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  VCSWrapper.Svn.Parsers@@ -21,6 +22,8 @@ import Text.XML.HXT.Core import Data.List.Split (splitOn) import qualified VCSWrapper.Common.Types as Common+import Data.Text (Text)+import qualified Data.Text as T (unpack, pack, splitOn)  instance XmlPickler Log where     xpickle = xpLog@@ -34,19 +37,19 @@             do             logs <- runX (xunpickleDocument xpLog [ withRemoveWS yes, withValidate no] document)             let log = head logs-            let entries = map (\(LogEntry rev aut dat msg) -> Common.LogEntry Nothing (show rev) aut "" dat msg msg)+            let entries = map (\(LogEntry rev aut dat msg) -> Common.LogEntry Nothing (T.pack $ show rev) aut "" dat msg msg)                               (logEntries log)             return entries  {- |-    Parses given 'String' and returns a list of 'Common.Status'.+    Parses given 'Text' and returns a list of 'Common.Status'. -}-parseStatusOut :: String -- ^ String which is required to have same format as output from @svn status@+parseStatusOut :: Text -- ^ Text which is required to have same format as output from @svn status@             -> [Common.Status] parseStatusOut out = parseRows rows         where             rows = init' splitRows-            splitRows = splitOn "\n" out :: [String]+            splitRows = T.splitOn "\n" out :: [Text]   --@@ -68,9 +71,9 @@     , message :: Message     } deriving (Show, Read) -type Author = String-type Date = String-type Message = String+type Author = Text+type Date = Text+type Message = Text  xpLog :: PU Log xpLog = xpWrap (\l -> Log l, \l -> (logEntries l)) $@@ -83,8 +86,8 @@   xpLogEntry :: PU LogEntry-xpLogEntry =  xpWrap (\(rev,aut,dat,msg) -> LogEntry { revision = rev, author = aut, date = dat, message = msg},-                                                         \e -> (revision e, author e, date e, message e)) $+xpLogEntry =  xpWrap (\(rev,aut,dat,msg) -> LogEntry { revision = rev, author = T.pack aut, date = T.pack dat, message = T.pack msg},+                                                         \e -> (revision e, T.unpack $ author e, T.unpack $ date e, T.unpack $ message e)) $               xpElem "logentry" $               xp4Tuple    (xpAttr "revision" xpInt)                           (xpElemWithText "author")@@ -100,7 +103,7 @@ init' ls = init ls  -- parses given rows from @svn status@. Supports only first seven columns and filename so far-parseRows :: [String] -> [Common.Status]+parseRows :: [Text] -> [Common.Status] parseRows rows = map mapRow rows     where         mapRow = \row -> Common.SVNStatus (getFileName row) (getModification row)  (getLockStatus row)@@ -109,9 +112,9 @@ --                                      ,modification=(getModification row) --                                      ,isLocked=(getLockStatus row) --                                   }-        getFileName = (\row -> nFunc tail 8 row) :: String -> FilePath-        getModification = (\row -> parseFirstCol $ row!!0) :: String -> Common.Modification-        getLockStatus = (\row -> parseSixthCol $ row!!5) :: String -> Common.IsLocked+        getFileName = (\row -> nFunc tail 8 $ T.unpack row) :: Text -> FilePath+        getModification = (\row -> parseFirstCol $ T.unpack row!!0) :: Text -> Common.Modification+        getLockStatus = (\row -> parseSixthCol $ T.unpack row!!5) :: Text -> Common.IsLocked  nFunc :: (a -> a) -> Int -> a -> a nFunc _ 0 = id

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- -- Module      :  Process@@ -28,11 +29,12 @@ import Control.Monad.Reader(ask)  import qualified Control.Exception as Exc+import Data.Text (Text) -svnExec_ :: String          -- ^ cmd-         -> [String]        -- ^ cmd specific opts-         -> Maybe String -- ^ optional password-         -> [String]     -- ^ additional arguments+svnExec_ :: Text          -- ^ cmd+         -> [Text]        -- ^ cmd specific opts+         -> Maybe Text -- ^ optional password+         -> [Text]     -- ^ additional arguments          -> Ctx() svnExec_ cmd cmdOpts pw opts =  do                 config <- ask@@ -49,24 +51,24 @@     authopts (Just a) =  ["--username", authorName a] {- | Execute given svn command with given options. -}-svnExecNoEnvirNoOpts :: String  -- ^ svn command, e.g. checkout-                     -> Ctx String+svnExecNoEnvirNoOpts :: Text  -- ^ svn command, e.g. checkout+                     -> Ctx Text svnExecNoEnvirNoOpts cmd = svnExecNoEnvir cmd []   {- | Execute given svn command with given options. -}-svnExecNoEnvir :: String    -- ^ svn command, e.g. checkout-        -> [String]         -- ^ options-        -> Ctx String+svnExecNoEnvir :: Text    -- ^ svn command, e.g. checkout+        -> [Text]         -- ^ options+        -> Ctx Text svnExecNoEnvir cmd opts = svnExec cmd opts []  {- | Execute given svn command with given options and environment. -}-svnExec :: String -- ^ svn command, e.g. checkout-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment-        -> Ctx String+svnExec :: Text -- ^ svn command, e.g. checkout+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment+        -> Ctx Text svnExec cmd opts = do     let extOpts = opts++globalOpts     vcsExecThrowingOnError "svn" cmd extOpts@@ -75,10 +77,10 @@  -- | Internal function to execute a svn command. Doesn't throw an exception if the command failes, -- but returns an Either with exit information.-svnExec' :: String -- ^ svn command, e.g. checkout, commit-        -> [String] -- ^ options-        -> [(String, String)] -- ^ environment-        -> Ctx (Either VCSException String)+svnExec' :: Text -- ^ svn command, e.g. checkout, commit+        -> [Text] -- ^ options+        -> [(Text, Text)] -- ^ environment+        -> Ctx (Either VCSException Text) svnExec' cmd opts = do     let extOpts = opts++globalOpts     vcsExec "svn" cmd extOpts

@@ -1,5 +1,5 @@ name: vcswrapper-version: 0.0.4+version: 0.1.0 cabal-version: >= 1.8 build-type: Simple license: GPL@@ -23,7 +23,7 @@                base >=4.0.0.0 && <4.8,                directory >=1.1.0.0 && <1.3,                hxt >=9.1.2 && <9.4,-               mtl >=2.0.1.0 && <2.2,+               mtl >=2.0.1.0 && <2.3,                parsec >=3.1.1 && <3.2,                process >=1.0.1.5 && <1.3,                filepath >=1.2.0.0 && < 1.4,@@ -46,11 +46,12 @@                base >=4.0.0.0 && <4.8,                directory >=1.1.0.0 && <1.3,                hxt >=9.1.2 && <9.4,-               mtl >=2.0.1.0 && <2.2,+               mtl >=2.0.1.0 && <2.3,                parsec >=3.1.1 && <3.2,                process >=1.0.1.5 && <1.3,                filepath >=1.2.0.0 && < 1.4,-               split >=0.2.2 && <0.3+               split >=0.2.2 && <0.3,+               text >=0.11.1.5 && <1.2     buildable: True     hs-source-dirs: src     other-modules: