module Data.FileStore.Utils (
runShellCommand
, mergeContents
, hashsMatch
, isInsideRepo
, escapeRegexSpecialChars
, parseMatchLine ) where
import Codec.Binary.UTF8.String (encodeString)
import Control.Monad (liftM)
import Data.ByteString.Lazy.UTF8 (toString)
import Data.List (isPrefixOf)
import Data.List.Split (splitWhen)
import Data.Maybe (isJust)
import System.Directory (canonicalizePath)
import System.Directory (getTemporaryDirectory, removeFile, findExecutable)
import System.Exit (ExitCode(..))
import System.IO (openTempFile, hClose)
import System.Process (runProcess, waitForProcess)
import qualified Data.ByteString.Lazy as B
import Data.FileStore.Types (SearchMatch(..))
runShellCommand :: FilePath
-> Maybe [(String, String)]
-> String
-> [String]
-> IO (ExitCode, B.ByteString, B.ByteString)
runShellCommand workingDir environment command optionList = do
tempPath <- catch getTemporaryDirectory (\_ -> return ".")
(outputPath, hOut) <- openTempFile tempPath "out"
(errorPath, hErr) <- openTempFile tempPath "err"
hProcess <- runProcess (encodeString command) (map encodeString optionList) (Just workingDir) environment Nothing (Just hOut) (Just hErr)
status <- waitForProcess hProcess
errorOutput <- B.readFile errorPath
output <- B.readFile outputPath
removeFile errorPath
removeFile outputPath
return (status, errorOutput, output)
mergeContents :: (String, B.ByteString)
-> (String, B.ByteString)
-> (String, B.ByteString)
-> IO (Bool, String)
mergeContents (newLabel, newContents) (originalLabel, originalContents) (latestLabel, latestContents) = do
tempPath <- catch getTemporaryDirectory (\_ -> return ".")
(originalPath, hOriginal) <- openTempFile tempPath "orig"
(latestPath, hLatest) <- openTempFile tempPath "latest"
(newPath, hNew) <- openTempFile tempPath "new"
B.hPutStr hOriginal originalContents >> hClose hOriginal
B.hPutStr hLatest latestContents >> hClose hLatest
B.hPutStr hNew newContents >> hClose hNew
gitExists <- liftM isJust (findExecutable "git")
(conflicts, mergedContents) <-
if gitExists
then do
(status, err, out) <- runShellCommand tempPath Nothing "git" ["merge-file", "--stdout", "-L", newLabel, "-L",
originalLabel, "-L", latestLabel, newPath, originalPath, latestPath]
case status of
ExitSuccess -> return (False, out)
ExitFailure n | n >= 0 -> return (True, out)
_ -> error $ "merge failed: " ++ toString err
else do
mergeExists <- liftM isJust (findExecutable "merge")
if mergeExists
then do
(status, err, out) <- runShellCommand tempPath Nothing "merge" ["-p", "-q", "-L", newLabel, "-L",
originalLabel, "-L", latestLabel, newPath, originalPath, latestPath]
case status of
ExitSuccess -> return (False, out)
ExitFailure 1 -> return (True, out)
_ -> error $ "merge failed: " ++ toString err
else error "mergeContents requires 'git' or 'merge', and neither was found in the path."
removeFile originalPath
removeFile latestPath
removeFile newPath
return (conflicts, toString mergedContents)
escapeRegexSpecialChars :: String -> String
escapeRegexSpecialChars = backslashEscape "?*+{}[]\\^$.()"
where backslashEscape chars (x:xs) | x `elem` chars = '\\' : x : backslashEscape chars xs
backslashEscape chars (x:xs) = x : backslashEscape chars xs
backslashEscape _ [] = []
hashsMatch :: (Eq a) => [a] -> [a] -> Bool
hashsMatch r1 r2 = r1 `isPrefixOf` r2 || r2 `isPrefixOf` r1
isInsideRepo :: FilePath -> FilePath -> IO Bool
isInsideRepo repo name = do
gitRepoPathCanon <- canonicalizePath repo
filenameCanon <- canonicalizePath name
return (gitRepoPathCanon `isPrefixOf` filenameCanon)
parseMatchLine :: String -> SearchMatch
parseMatchLine str =
let (fn:n:res:_) = splitWhen (==':') str
in SearchMatch{matchResourceName = fn, matchLineNumber = read n, matchLine = res}